Initial git import
[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         char buf[64];
1034
1035         sprintf(buf, "#<INTERNAL OBJECT (SXEmacs bug?) (timeout) 0x%lx>",
1036                 (unsigned long)t);
1037         write_c_string(buf, printcharfun);
1038 }
1039
1040 static const struct lrecord_description timeout_description[] = {
1041         {XD_LISP_OBJECT, offsetof(Lisp_Timeout, function)},
1042         {XD_LISP_OBJECT, offsetof(Lisp_Timeout, object)},
1043         {XD_END}
1044 };
1045
1046 DEFINE_LRECORD_IMPLEMENTATION("timeout", timeout,
1047                               mark_timeout, print_timeout,
1048                               0, 0, 0, timeout_description, Lisp_Timeout);
1049
1050 /* Generate a timeout and return its ID. */
1051
1052 int
1053 event_stream_generate_wakeup(unsigned int milliseconds,
1054                              unsigned int vanilliseconds,
1055                              Lisp_Object function, Lisp_Object object,
1056                              int async_p)
1057 {
1058 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1059         Lisp_Object op = wrap_object(
1060                 alloc_lcrecord(sizeof(Lisp_Timeout), &lrecord_timeout));
1061 #else  /* !BDWGC */
1062         Lisp_Object op = allocate_managed_lcrecord(Vtimeout_free_list);
1063 #endif  /* BDWGC */
1064         Lisp_Timeout *timeout = XTIMEOUT(op);
1065         EMACS_TIME current_time;
1066         EMACS_TIME interval;
1067
1068         timeout->id = timeout_id_tick++;
1069         timeout->resignal_msecs = vanilliseconds;
1070         timeout->function = function;
1071         timeout->object = object;
1072
1073         EMACS_GET_TIME(current_time);
1074         EMACS_SET_SECS_USECS(interval, milliseconds / 1000,
1075                              1000 * (milliseconds % 1000));
1076         EMACS_ADD_TIME(timeout->next_signal_time, current_time, interval);
1077
1078         if (async_p) {
1079                 timeout->interval_id =
1080                     event_stream_add_async_timeout(timeout->next_signal_time);
1081                 pending_async_timeout_list = noseeum_cons(op,
1082                                                           pending_async_timeout_list);
1083         } else {
1084                 timeout->interval_id =
1085                     event_stream_add_timeout(timeout->next_signal_time);
1086                 pending_timeout_list = noseeum_cons(op, pending_timeout_list);
1087         }
1088         return timeout->id;
1089 }
1090
1091 /* Given the INTERVAL-ID of a timeout just signalled, resignal the timeout
1092    as necessary and return the timeout's ID and function and object slots.
1093
1094    This should be called as a result of receiving notice that a timeout
1095    has fired.  INTERVAL-ID is *not* the timeout's ID, but is the ID that
1096    identifies this particular firing of the timeout.  INTERVAL-ID's and
1097    timeout ID's are in separate number spaces and bear no relation to
1098    each other.  The INTERVAL-ID is all that the event callback routines
1099    work with: they work only with one-shot intervals, not with timeouts
1100    that may fire repeatedly.
1101
1102    NOTE: The returned FUNCTION and OBJECT are *not* GC-protected at all.
1103 */
1104
1105 static int
1106 event_stream_resignal_wakeup(int interval_id, int async_p,
1107                              Lisp_Object * function, Lisp_Object * object)
1108 {
1109         Lisp_Object op = Qnil, rest;
1110         Lisp_Timeout *timeout;
1111         Lisp_Object *timeout_list;
1112         struct gcpro gcpro1;
1113         int id;
1114
1115         GCPRO1(op);             /* just in case ...  because it's removed from the list
1116                                    for awhile. */
1117
1118         timeout_list =
1119             async_p ? &pending_async_timeout_list : &pending_timeout_list;
1120
1121         /* Find the timeout on the list of pending ones. */
1122         LIST_LOOP(rest, *timeout_list) {
1123                 timeout = XTIMEOUT(XCAR(rest));
1124                 if (timeout->interval_id == interval_id)
1125                         break;
1126         }
1127
1128         assert(!NILP(rest));
1129         op = XCAR(rest);
1130         timeout = XTIMEOUT(op);
1131         /* We make sure to snarf the data out of the timeout object before
1132            we free it with free_managed_lcrecord(). */
1133         id = timeout->id;
1134         *function = timeout->function;
1135         *object = timeout->object;
1136
1137         /* Remove this one from the list of pending timeouts */
1138         *timeout_list = delq_no_quit_and_free_cons(op, *timeout_list);
1139
1140         /* If this timeout wants to be resignalled, do it now. */
1141         if (timeout->resignal_msecs) {
1142                 EMACS_TIME current_time;
1143                 EMACS_TIME interval;
1144
1145                 /* Determine the time that the next resignalling should occur.
1146                    We do that by adding the interval time to the last signalled
1147                    time until we get a time that's current.
1148
1149                    (This way, it doesn't matter if the timeout was signalled
1150                    exactly when we asked for it, or at some time later.)
1151                  */
1152                 EMACS_GET_TIME(current_time);
1153                 EMACS_SET_SECS_USECS(interval, timeout->resignal_msecs / 1000,
1154                                      1000 * (timeout->resignal_msecs % 1000));
1155                 do {
1156                         EMACS_ADD_TIME(timeout->next_signal_time,
1157                                        timeout->next_signal_time, interval);
1158                 } while (EMACS_TIME_GREATER
1159                          (current_time, timeout->next_signal_time));
1160
1161                 if (async_p) {
1162                         timeout->interval_id =
1163                                 event_stream_add_async_timeout(
1164                                         timeout->next_signal_time);
1165                 } else {
1166                         timeout->interval_id =
1167                                 event_stream_add_timeout(
1168                                         timeout->next_signal_time);
1169                 }
1170                 /* Add back onto the list.  Note that the effect of this
1171                    is to move frequently-hit timeouts to the front of the
1172                    list, which is a good thing. */
1173                 *timeout_list = noseeum_cons(op, *timeout_list);
1174         } else {
1175 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1176                 xfree(op);
1177 #else  /* !BDWGC */
1178                 free_managed_lcrecord(Vtimeout_free_list, op);
1179 #endif  /* BDWGC */
1180         }
1181         UNGCPRO;
1182         return id;
1183 }
1184
1185 void event_stream_disable_wakeup(int id, int async_p)
1186 {
1187         Lisp_Timeout *timeout = 0;
1188         Lisp_Object rest;
1189         Lisp_Object *timeout_list;
1190
1191         if (async_p) {
1192                 timeout_list = &pending_async_timeout_list;
1193         } else {
1194                 timeout_list = &pending_timeout_list;
1195         }
1196         /* Find the timeout on the list of pending ones, if it's still there. */
1197         LIST_LOOP(rest, *timeout_list) {
1198                 timeout = XTIMEOUT(XCAR(rest));
1199                 if (timeout->id == id) {
1200                         break;
1201                 }
1202         }
1203
1204         /* If we found it, remove it from the list and disable the pending
1205            one-shot. */
1206         if (!NILP(rest)) {
1207                 Lisp_Object op = XCAR(rest);
1208                 *timeout_list = delq_no_quit_and_free_cons(op, *timeout_list);
1209                 if (async_p) {
1210                         event_stream_remove_async_timeout(timeout->interval_id);
1211                 } else {
1212                         event_stream_remove_timeout(timeout->interval_id);
1213                 }
1214 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1215                 xfree(op);
1216 #else  /* !BDWGC */
1217                 free_managed_lcrecord(Vtimeout_free_list, op);
1218 #endif  /* BDWGC */
1219         }
1220 }
1221
1222 static int event_stream_wakeup_pending_p(int id, int async_p)
1223 {
1224         Lisp_Timeout *timeout;
1225         Lisp_Object rest;
1226         Lisp_Object timeout_list;
1227         int found = 0;
1228
1229         if (async_p)
1230                 timeout_list = pending_async_timeout_list;
1231         else
1232                 timeout_list = pending_timeout_list;
1233
1234         /* Find the element on the list of pending ones, if it's still there. */
1235         LIST_LOOP(rest, timeout_list) {
1236                 timeout = XTIMEOUT(XCAR(rest));
1237                 if (timeout->id == id) {
1238                         found = 1;
1239                         break;
1240                 }
1241         }
1242
1243         return found;
1244 }
1245 \f
1246 /**** Asynch. timeout functions (see also signal.c) ****/
1247
1248 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1249 extern int poll_for_quit_id;
1250 #endif
1251
1252 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1253 extern int poll_for_sigchld_id;
1254 #endif
1255
1256 void event_stream_deal_with_async_timeout(int interval_id)
1257 {
1258         /* This function can GC */
1259         Lisp_Object humpty, dumpty;
1260 #if ((!defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)) \
1261      || defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD))
1262         int id =
1263 #endif
1264             event_stream_resignal_wakeup(interval_id, 1, &humpty, &dumpty);
1265
1266 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1267         if (id == poll_for_quit_id) {
1268                 quit_check_signal_happened = 1;
1269                 quit_check_signal_tick_count++;
1270                 return;
1271         }
1272 #endif
1273
1274 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1275         if (id == poll_for_sigchld_id) {
1276                 kick_status_notify();
1277                 return;
1278         }
1279 #endif
1280
1281         /* call1 GC-protects its arguments */
1282         call1_trapping_errors("Error in asynchronous timeout callback",
1283                               humpty, dumpty);
1284 }
1285 \f
1286 /**** Lisp-level timeout functions. ****/
1287
1288 static unsigned long lisp_number_to_milliseconds(Lisp_Object secs, int allow_0)
1289 {
1290 #if defined(WITH_NUMBER_TYPES)
1291         double fsecs;
1292         CHECK_NUMBER(secs);
1293         fsecs = extract_float(secs);
1294 #else  /* !WITH_NUMBER_TYPES */
1295 #ifdef HAVE_FPFLOAT
1296         double fsecs;
1297         CHECK_INT_OR_FLOAT(secs);
1298         fsecs = XFLOATINT(secs);
1299 #else
1300         long fsecs;
1301         CHECK_INT(secs);
1302         fsecs = XINT(secs);
1303 #endif  /* HAVE_FPFLOAT */
1304 #endif  /* WITH_NUMBER_TYPES */
1305         if (fsecs < 0)
1306                 signal_simple_error("timeout is negative", secs);
1307         if (!allow_0 && fsecs == 0)
1308                 signal_simple_error("timeout is non-positive", secs);
1309         if (fsecs >= (((unsigned int)0xFFFFFFFF) / 1000))
1310                 signal_simple_error
1311                     ("timeout would exceed 32 bits when represented in milliseconds",
1312                      secs);
1313
1314         return (unsigned long)(1000 * fsecs);
1315 }
1316
1317 DEFUN("add-timeout", Fadd_timeout, 3, 4, 0,     /*
1318 Add a timeout, to be signaled after the timeout period has elapsed.
1319 SECS is a number of seconds, expressed as an integer or a float.
1320 FUNCTION will be called after that many seconds have elapsed, with one
1321 argument, the given OBJECT.  If the optional RESIGNAL argument is provided,
1322 then after this timeout expires, `add-timeout' will automatically be called
1323 again with RESIGNAL as the first argument.
1324
1325 This function returns an object which is the id number of this particular
1326 timeout.  You can pass that object to `disable-timeout' to turn off the
1327 timeout before it has been signalled.
1328
1329 NOTE: Id numbers as returned by this function are in a distinct namespace
1330 from those returned by `add-async-timeout'.  This means that the same id
1331 number could refer to a pending synchronous timeout and a different pending
1332 asynchronous timeout, and that you cannot pass an id from `add-timeout'
1333 to `disable-async-timeout', or vice-versa.
1334
1335 The number of seconds may be expressed as a floating-point number, in which
1336 case some fractional part of a second will be used.  Caveat: the usable
1337 timeout granularity will vary from system to system.
1338
1339 Adding a timeout causes a timeout event to be returned by `next-event', and
1340 the function will be invoked by `dispatch-event,' so if emacs is in a tight
1341 loop, the function will not be invoked until the next call to sit-for or
1342 until the return to top-level (the same is true of process filters).
1343
1344 If you need to have a timeout executed even when SXEmacs is in the midst of
1345 running Lisp code, use `add-async-timeout'.
1346
1347 WARNING: if you are thinking of calling add-timeout from inside of a
1348 callback function as a way of resignalling a timeout, think again.  There
1349 is a race condition.  That's why the RESIGNAL argument exists.
1350 */
1351       (secs, function, object, resignal))
1352 {
1353         unsigned long msecs = lisp_number_to_milliseconds(secs, 0);
1354         unsigned long msecs2 = (NILP(resignal) ? 0 :
1355                                 lisp_number_to_milliseconds(resignal, 0));
1356         int id;
1357         Lisp_Object lid;
1358         id = event_stream_generate_wakeup(msecs, msecs2, function, object, 0);
1359         lid = make_int(id);
1360         if (id != XINT(lid))
1361                 abort();
1362         return lid;
1363 }
1364
1365 DEFUN("disable-timeout", Fdisable_timeout, 1, 1, 0,     /*
1366 Disable a timeout from signalling any more.
1367 ID should be a timeout id number as returned by `add-timeout'.  If ID
1368 corresponds to a one-shot timeout that has already signalled, nothing
1369 will happen.
1370
1371 It will not work to call this function on an id number returned by
1372 `add-async-timeout'.  Use `disable-async-timeout' for that.
1373 */
1374       (id))
1375 {
1376         CHECK_INT(id);
1377         event_stream_disable_wakeup(XINT(id), 0);
1378         return Qnil;
1379 }
1380
1381 DEFUN("add-async-timeout", Fadd_async_timeout, 3, 4, 0, /*
1382 Add an asynchronous timeout, to be signaled after an interval has elapsed.
1383 SECS is a number of seconds, expressed as an integer or a float.
1384 FUNCTION will be called after that many seconds have elapsed, with one
1385 argument, the given OBJECT.  If the optional RESIGNAL argument is provided,
1386 then after this timeout expires, `add-async-timeout' will automatically be
1387 called again with RESIGNAL as the first argument.
1388
1389 This function returns an object which is the id number of this particular
1390 timeout.  You can pass that object to `disable-async-timeout' to turn off
1391 the timeout before it has been signalled.
1392
1393 NOTE: Id numbers as returned by this function are in a distinct namespace
1394 from those returned by `add-timeout'.  This means that the same id number
1395 could refer to a pending synchronous timeout and a different pending
1396 asynchronous timeout, and that you cannot pass an id from
1397 `add-async-timeout' to `disable-timeout', or vice-versa.
1398
1399 The number of seconds may be expressed as a floating-point number, in which
1400 case some fractional part of a second will be used.  Caveat: the usable
1401 timeout granularity will vary from system to system.
1402
1403 Adding an asynchronous timeout causes the function to be invoked as soon
1404 as the timeout occurs, even if SXEmacs is in the midst of executing some
1405 other code. (This is unlike the synchronous timeouts added with
1406 `add-timeout', where the timeout will only be signalled when SXEmacs is
1407 waiting for events, i.e. the next return to top-level or invocation of
1408 `sit-for' or related functions.) This means that the function that is
1409 called *must* not signal an error or change any global state (e.g. switch
1410 buffers or windows) except when locking code is in place to make sure
1411 that race conditions don't occur in the interaction between the
1412 asynchronous timeout function and other code.
1413
1414 Under most circumstances, you should use `add-timeout' instead, as it is
1415 much safer.  Asynchronous timeouts should only be used when such behavior
1416 is really necessary.
1417
1418 Asynchronous timeouts are blocked and will not occur when `inhibit-quit'
1419 is non-nil.  As soon as `inhibit-quit' becomes nil again, any pending
1420 asynchronous timeouts will get called immediately. (Multiple occurrences
1421 of the same asynchronous timeout are not queued, however.) While the
1422 callback function of an asynchronous timeout is invoked, `inhibit-quit'
1423 is automatically bound to non-nil, and thus other asynchronous timeouts
1424 will be blocked unless the callback function explicitly sets `inhibit-quit'
1425 to nil.
1426
1427 WARNING: if you are thinking of calling `add-async-timeout' from inside of a
1428 callback function as a way of resignalling a timeout, think again.  There
1429 is a race condition.  That's why the RESIGNAL argument exists.
1430 */
1431       (secs, function, object, resignal))
1432 {
1433         unsigned long msecs = lisp_number_to_milliseconds(secs, 0);
1434         unsigned long msecs2 = (NILP(resignal) ? 0 :
1435                                 lisp_number_to_milliseconds(resignal, 0));
1436         int id;
1437         Lisp_Object lid;
1438         id = event_stream_generate_wakeup(msecs, msecs2, function, object, 1);
1439         lid = make_int(id);
1440         if (id != XINT(lid))
1441                 abort();
1442         return lid;
1443 }
1444
1445 DEFUN("disable-async-timeout", Fdisable_async_timeout, 1, 1, 0, /*
1446 Disable an asynchronous timeout from signalling any more.
1447 ID should be a timeout id number as returned by `add-async-timeout'.  If ID
1448 corresponds to a one-shot timeout that has already signalled, nothing
1449 will happen.
1450
1451 It will not work to call this function on an id number returned by
1452 `add-timeout'.  Use `disable-timeout' for that.
1453 */
1454       (id))
1455 {
1456         CHECK_INT(id);
1457         event_stream_disable_wakeup(XINT(id), 1);
1458         return Qnil;
1459 }
1460 \f
1461 /**********************************************************************/
1462 /*                    enqueuing and dequeuing events                  */
1463 /**********************************************************************/
1464
1465 /* Add an event to the back of the command-event queue: it will be the next
1466    event read after all pending events.   This only works on keyboard,
1467    mouse-click, misc-user, and eval events.
1468  */
1469 static void enqueue_command_event(Lisp_Object event)
1470 {
1471 #ifdef EF_USE_ASYNEQ
1472         eq_enqueue(asyneq, event);
1473 #else
1474         enqueue_event(event, &command_event_queue, &command_event_queue_tail);
1475 #endif
1476 }
1477
1478 static Lisp_Object dequeue_command_event(void)
1479 {
1480 #ifdef EF_USE_ASYNEQ
1481         return eq_dequeue(asyneq);
1482 #else
1483         return dequeue_event(&command_event_queue, &command_event_queue_tail);
1484 #endif
1485 }
1486
1487 /* put the event on the typeahead queue, unless
1488    the event is the quit char, in which case the `QUIT'
1489    which will occur on the next trip through this loop is
1490    all the processing we should do - leaving it on the queue
1491    would cause the quit to be processed twice.
1492    */
1493 static void enqueue_command_event_1(Lisp_Object event_to_copy)
1494 {
1495         /* do not call check_quit() here.  Vquit_flag was set in
1496            next_event_internal. */
1497         if (NILP(Vquit_flag))
1498                 enqueue_command_event(Fcopy_event(event_to_copy, Qnil));
1499 }
1500
1501 void enqueue_magic_eval_event(void (*fun) (Lisp_Object), Lisp_Object object)
1502 {
1503         Lisp_Object event = Fmake_event(Qnil, Qnil);
1504
1505         XEVENT(event)->event_type = magic_eval_event;
1506         /* channel for magic_eval events is nil */
1507         XEVENT(event)->event.magic_eval.internal_function = fun;
1508         XEVENT(event)->event.magic_eval.object = object;
1509         enqueue_command_event(event);
1510 }
1511
1512 DEFUN("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0,       /*
1513 Add an eval event to the back of the eval event queue.
1514 When this event is dispatched, FUNCTION (which should be a function
1515 of one argument) will be called with OBJECT as its argument.
1516 See `next-event' for a description of event types and how events
1517 are received.
1518 */
1519       (function, object))
1520 {
1521         Lisp_Object event = Fmake_event(Qnil, Qnil);
1522
1523         XEVENT(event)->event_type = eval_event;
1524         /* channel for eval events is nil */
1525         XEVENT(event)->event.eval.function = function;
1526         XEVENT(event)->event.eval.object = object;
1527         enqueue_command_event(event);
1528
1529         return event;
1530 }
1531
1532 Lisp_Object
1533 enqueue_misc_user_event(Lisp_Object channel, Lisp_Object function,
1534                         Lisp_Object object)
1535 {
1536         Lisp_Object event = Fmake_event(Qnil, Qnil);
1537
1538         XEVENT(event)->event_type = misc_user_event;
1539         XEVENT(event)->channel = channel;
1540         XEVENT(event)->event.misc.function = function;
1541         XEVENT(event)->event.misc.object = object;
1542         XEVENT(event)->event.misc.button = 0;
1543         XEVENT(event)->event.misc.modifiers = 0;
1544         XEVENT(event)->event.misc.x = -1;
1545         XEVENT(event)->event.misc.y = -1;
1546         enqueue_command_event(event);
1547
1548         return event;
1549 }
1550
1551 Lisp_Object
1552 enqueue_misc_user_event_pos(Lisp_Object channel, Lisp_Object function,
1553                             Lisp_Object object,
1554                             int button, int modifiers, int x, int y)
1555 {
1556         Lisp_Object event = Fmake_event(Qnil, Qnil);
1557
1558         XEVENT(event)->event_type = misc_user_event;
1559         XEVENT(event)->channel = channel;
1560         XEVENT(event)->event.misc.function = function;
1561         XEVENT(event)->event.misc.object = object;
1562         XEVENT(event)->event.misc.button = button;
1563         XEVENT(event)->event.misc.modifiers = modifiers;
1564         XEVENT(event)->event.misc.x = x;
1565         XEVENT(event)->event.misc.y = y;
1566         enqueue_command_event(event);
1567
1568         return event;
1569 }
1570 \f
1571 /**********************************************************************/
1572 /*                       focus-event handling                         */
1573 /**********************************************************************/
1574
1575 /*
1576
1577 Ben's capsule lecture on focus:
1578
1579 In FSFmacs `select-frame' never changes the window-manager frame
1580 focus.  All it does is change the "selected frame".  This is similar
1581 to what happens when we call `select-device' or `select-console'.
1582 Whenever an event comes in (including a keyboard event), its frame is
1583 selected; therefore, evaluating `select-frame' in *scratch* won't
1584 cause any effects because the next received event (in the same frame)
1585 will cause a switch back to the frame displaying *scratch*.
1586
1587 Whenever a focus-change event is received from the window manager, it
1588 generates a `switch-frame' event, which causes the Lisp function
1589 `handle-switch-frame' to get run.  This basically just runs
1590 `select-frame' (see below, however).
1591
1592 In FSFmacs, if you want to have an operation run when a frame is
1593 selected, you supply an event binding for `switch-frame' (and then
1594 maybe call `handle-switch-frame', or something ...).
1595
1596 In SXEmacs, we *do* change the window-manager frame focus as a result
1597 of `select-frame', but not until the next time an event is received,
1598 so that a function that momentarily changes the selected frame won't
1599 cause WM focus flashing. (#### There's something not quite right here;
1600 this is causing the wrong-cursor-focus problems that you occasionally
1601 see.  But the general idea is correct.) This approach is winning for
1602 people who use the explicit-focus model, but is trickier to implement.
1603
1604 We also don't make the `switch-frame' event visible but instead have
1605 `select-frame-hook', which is a better approach.
1606
1607 There is the problem of surrogate minibuffers, where when we enter the
1608 minibuffer, you essentially want to temporarily switch the WM focus to
1609 the frame with the minibuffer, and switch it back when you exit the
1610 minibuffer.
1611
1612 FSFmacs solves this with the crockish `redirect-frame-focus', which
1613 says "for keyboard events received from FRAME, act like they're
1614 coming from FOCUS-FRAME".  I think what this means is that, when
1615 a keyboard event comes in and the event manager is about to select the
1616 event's frame, if that frame has its focus redirected, the redirected-to
1617 frame is selected instead.  That way, if you're in a minibufferless
1618 frame and enter the minibuffer, then all Lisp functions that run see
1619 the selected frame as the minibuffer's frame rather than the minibufferless
1620 frame you came from, so that (e.g.) your typing actually appears in
1621 the minibuffer's frame and things behave sanely.
1622
1623 There's also some weird logic that switches the redirected frame focus
1624 from one frame to another if Lisp code explicitly calls `select-frame'
1625 \(but not if `handle-switch-frame' is called), and saves and restores
1626 the frame focus in window configurations, etc. etc.  All of this logic
1627 is heavily #if 0'd, with lots of comments saying "No, this approach
1628 doesn't seem to work, so I'm trying this ...  is it reasonable?
1629 Well, I'm not sure ..." that are a red flag indicating crockishness.
1630
1631 Because of our way of doing things, we can avoid all this crock.
1632 Keyboard events never cause a select-frame (who cares what frame
1633 they're associated with?  They come from a console, only).  We change
1634 the actual WM focus to a surrogate minibuffer frame, so we don't have
1635 to do any internal redirection.  In order to get the focus back,
1636 I took the approach in minibuf.el of just checking to see if the
1637 frame we moved to is still the selected frame, and move back to the
1638 old one if so.  Conceivably we might have to do the weird "tracking"
1639 that FSFmacs does when `select-frame' is called, but I don't think
1640 so.  If the selected frame moved from the minibuffer frame, then
1641 we just leave it there, figuring that someone knows what they're
1642 doing.  Because we don't have any redirection recorded anywhere,
1643 it's safe to do this, and we don't end up with unwanted redirection.
1644
1645 */
1646
1647 static void run_select_frame_hook(void)
1648 {
1649         run_hook(Qselect_frame_hook);
1650 }
1651
1652 static void run_deselect_frame_hook(void)
1653 {
1654         run_hook(Qdeselect_frame_hook);
1655 }
1656
1657 /* When select-frame is called and focus_follows_mouse is false, we want
1658    to tell the window system that the focus should be changed to point to
1659    the new frame.  However,
1660    sometimes Lisp functions will temporarily change the selected frame
1661    (e.g. to call a function that operates on the selected frame),
1662    and it's annoying if this focus-change happens exactly when
1663    select-frame is called, because then you get some flickering of the
1664    window-manager border and perhaps other undesirable results.  We
1665    really only want to change the focus when we're about to retrieve
1666    an event from the user.  To do this, we keep track of the frame
1667    where the window-manager focus lies on, and just before waiting
1668    for user events, check the currently selected frame and change
1669    the focus as necessary.
1670
1671    On the other hand, if focus_follows_mouse is true, we need to switch the
1672    selected frame back to the frame with window manager focus just before we
1673    execute the next command in Fcommand_loop_1, just as the selected buffer is
1674    reverted after a set-buffer.
1675
1676    Both cases are handled by this function.  It must be called as appropriate
1677    from these two places, depending on the value of focus_follows_mouse. */
1678
1679 void investigate_frame_change(void)
1680 {
1681         Lisp_Object devcons, concons;
1682
1683         /* if the selected frame was changed, change the window-system
1684            focus to the new frame.  We don't do it when select-frame was
1685            called, to avoid flickering and other unwanted side effects when
1686            the frame is just changed temporarily. */
1687         DEVICE_LOOP_NO_BREAK(devcons, concons) {
1688                 struct device *d = XDEVICE(XCAR(devcons));
1689                 Lisp_Object sel_frame = DEVICE_SELECTED_FRAME(d);
1690
1691                 /* You'd think that maybe we should use FRAME_WITH_FOCUS_REAL,
1692                    but that can cause us to end up in an infinite loop focusing
1693                    between two frames.  It seems that since the call to `select-frame'
1694                    in emacs_handle_focus_change_final() is based on the _FOR_HOOKS
1695                    value, we need to do so too. */
1696                 if (!NILP(sel_frame) &&
1697                     !EQ(DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d), sel_frame) &&
1698                     !NILP(DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d)) &&
1699                     !EQ(DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d), sel_frame)) {
1700                         /* At this point, we know that the frame has been changed.  Now, if
1701                          * focus_follows_mouse is not set, we finish off the frame change,
1702                          * so that user events will now come from the new frame.  Otherwise,
1703                          * if focus_follows_mouse is set, no gratuitous frame changing
1704                          * should take place.  Set the focus back to the frame which was
1705                          * originally selected for user input.
1706                          */
1707                         if (!focus_follows_mouse) {
1708                                 /* prevent us from issuing the same request more than once */
1709                                 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d) =
1710                                     sel_frame;
1711                                 MAYBE_DEVMETH(d, focus_on_frame,
1712                                               (XFRAME(sel_frame)));
1713                         } else {
1714                                 Lisp_Object old_frame = Qnil;
1715
1716                                 /* #### Do we really want to check OUGHT ??
1717                                  * It seems to make sense, though I have never seen us
1718                                  * get here and have it be non-nil.
1719                                  */
1720                                 if (FRAMEP
1721                                     (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d)))
1722                                         old_frame =
1723                                             DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS
1724                                             (d);
1725                                 else if (FRAMEP
1726                                          (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d)))
1727                                         old_frame =
1728                                             DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS
1729                                             (d);
1730
1731                                 /* #### Can old_frame ever be NIL?  play it safe.. */
1732                                 if (!NILP(old_frame)) {
1733                                         /* Fselect_frame is not really the right thing: it frobs the
1734                                          * buffer stack.  But there's no easy way to do the right
1735                                          * thing, and this code already had this problem anyway.
1736                                          */
1737                                         Fselect_frame(old_frame);
1738                                 }
1739                         }
1740                 }
1741         }
1742 }
1743
1744 static Lisp_Object cleanup_after_missed_defocusing(Lisp_Object frame)
1745 {
1746         if (FRAMEP(frame) && FRAME_LIVE_P(XFRAME(frame)))
1747                 Fselect_frame(frame);
1748         return Qnil;
1749 }
1750
1751 void emacs_handle_focus_change_preliminary(Lisp_Object frame_inp_and_dev)
1752 {
1753         Lisp_Object frame = Fcar(frame_inp_and_dev);
1754         Lisp_Object device = Fcar(Fcdr(frame_inp_and_dev));
1755         int in_p = !NILP(Fcdr(Fcdr(frame_inp_and_dev)));
1756         struct device *d;
1757
1758         if (!DEVICE_LIVE_P(XDEVICE(device)))
1759                 return;
1760         else
1761                 d = XDEVICE(device);
1762
1763         /* Any received focus-change notifications render invalid any
1764            pending focus-change requests. */
1765         DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d) = Qnil;
1766         if (in_p) {
1767                 Lisp_Object focus_frame;
1768
1769                 if (!FRAME_LIVE_P(XFRAME(frame)))
1770                         return;
1771                 else
1772                         focus_frame = DEVICE_FRAME_WITH_FOCUS_REAL(d);
1773
1774                 /* Mark the minibuffer as changed to make sure it gets updated
1775                    properly if the echo area is active. */
1776                 {
1777                         struct window *w =
1778                             XWINDOW(FRAME_MINIBUF_WINDOW(XFRAME(frame)));
1779                         MARK_WINDOWS_CHANGED(w);
1780                 }
1781
1782                 if (FRAMEP(focus_frame) && FRAME_LIVE_P(XFRAME(focus_frame))
1783                     && !EQ(frame, focus_frame)) {
1784                         /* Oops, we missed a focus-out event. */
1785                         DEVICE_FRAME_WITH_FOCUS_REAL(d) = Qnil;
1786                         redisplay_redraw_cursor(XFRAME(focus_frame), 1);
1787                 }
1788                 DEVICE_FRAME_WITH_FOCUS_REAL(d) = frame;
1789                 if (!EQ(frame, focus_frame)) {
1790                         redisplay_redraw_cursor(XFRAME(frame), 1);
1791                 }
1792         } else {
1793                 /* We ignore the frame reported in the event.  If it's different
1794                    from where we think the focus was, oh well -- we messed up.
1795                    Nonetheless, we pretend we were right, for sensible behavior. */
1796                 frame = DEVICE_FRAME_WITH_FOCUS_REAL(d);
1797                 if (!NILP(frame)) {
1798                         DEVICE_FRAME_WITH_FOCUS_REAL(d) = Qnil;
1799
1800                         if (FRAME_LIVE_P(XFRAME(frame)))
1801                                 redisplay_redraw_cursor(XFRAME(frame), 1);
1802                 }
1803         }
1804 }
1805
1806 /* Called from the window-system-specific code when we receive a
1807    notification that the focus lies on a particular frame.
1808    Argument is a cons: (frame . (device . in-p)) where in-p is non-nil
1809    for focus-in.
1810  */
1811 void emacs_handle_focus_change_final(Lisp_Object frame_inp_and_dev)
1812 {
1813         Lisp_Object frame = Fcar(frame_inp_and_dev);
1814         Lisp_Object device = Fcar(Fcdr(frame_inp_and_dev));
1815         int in_p = !NILP(Fcdr(Fcdr(frame_inp_and_dev)));
1816         struct device *d;
1817         int count;
1818
1819         if (!DEVICE_LIVE_P(XDEVICE(device)))
1820                 return;
1821         else
1822                 d = XDEVICE(device);
1823
1824         if (in_p) {
1825                 Lisp_Object focus_frame;
1826
1827                 if (!FRAME_LIVE_P(XFRAME(frame)))
1828                         return;
1829                 else
1830                         focus_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d);
1831
1832                 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d) = frame;
1833                 if (FRAMEP(focus_frame) && !EQ(frame, focus_frame)) {
1834                         /* Oops, we missed a focus-out event. */
1835                         Fselect_frame(focus_frame);
1836                         /* Do an unwind-protect in case an error occurs in
1837                            the deselect-frame-hook */
1838                         count = specpdl_depth();
1839                         record_unwind_protect(cleanup_after_missed_defocusing,
1840                                               frame);
1841                         run_deselect_frame_hook();
1842                         unbind_to(count, Qnil);
1843                         /* the cleanup method changed the focus frame to nil, so
1844                            we need to reflect this */
1845                         focus_frame = Qnil;
1846                 } else
1847                         Fselect_frame(frame);
1848                 if (!EQ(frame, focus_frame))
1849                         run_select_frame_hook();
1850         } else {
1851                 /* We ignore the frame reported in the event.  If it's different
1852                    from where we think the focus was, oh well -- we messed up.
1853                    Nonetheless, we pretend we were right, for sensible behavior. */
1854                 frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d);
1855                 if (!NILP(frame)) {
1856                         DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d) = Qnil;
1857                         run_deselect_frame_hook();
1858                 }
1859         }
1860 }
1861 \f
1862 /**********************************************************************/
1863 /*                      retrieving the next event                     */
1864 /**********************************************************************/
1865
1866 static int in_single_console;
1867
1868 /* #### These functions don't currently do anything. */
1869 void single_console_state(void)
1870 {
1871         in_single_console = 1;
1872 }
1873
1874 void any_console_state(void)
1875 {
1876         in_single_console = 0;
1877 }
1878
1879 int in_single_console_state(void)
1880 {
1881         return in_single_console;
1882 }
1883
1884 /* the number of keyboard characters read.  callint.c wants this. */
1885 Charcount num_input_chars;
1886
1887 static void next_event_internal(Lisp_Object target_event, int allow_queued)
1888 {
1889         struct gcpro gcpro1;
1890         /* QUIT;   This is incorrect - the caller must do this because some
1891            callers (ie, Fnext_event()) do not want to QUIT. */
1892
1893         assert(NILP(XEVENT_NEXT(target_event)));
1894
1895         GCPRO1(target_event);
1896
1897         /* When focus_follows_mouse is nil, if a frame change took place, we need
1898          * to actually switch window manager focus to the selected window now.
1899          */
1900         if (!focus_follows_mouse)
1901                 investigate_frame_change();
1902
1903         if (allow_queued && !EQ_EMPTY_P()) {
1904                 Lisp_Object event = dequeue_command_event();
1905                 Fcopy_event(event, target_event);
1906                 Fdeallocate_event(event);
1907                 DEBUG_PRINT_EMACS_EVENT("command event queue", target_event);
1908         } else {
1909                 Lisp_Event *e = XEVENT(target_event);
1910
1911                 /* The command_event_queue was empty.  Wait for an event. */
1912                 event_stream_next_event(e);
1913                 /* If this was a timeout, then we need to extract some data
1914                    out of the returned closure and might need to resignal
1915                    it. */
1916                 if (e->event_type == timeout_event) {
1917                         Lisp_Object tristan, isolde;
1918
1919                         e->event.timeout.id_number =
1920                             event_stream_resignal_wakeup(e->event.timeout.
1921                                                          interval_id, 0,
1922                                                          &tristan, &isolde);
1923
1924                         e->event.timeout.function = tristan;
1925                         e->event.timeout.object = isolde;
1926                         /* next_event_internal() doesn't print out timeout events
1927                            because of the extra info we just set. */
1928                         DEBUG_PRINT_EMACS_EVENT("real, timeout", target_event);
1929                 }
1930
1931                 /* If we read a ^G, then set quit-flag but do not discard the ^G.
1932                    The callers of next_event_internal() will do one of two things:
1933
1934                    -- set Vquit_flag to Qnil. (next-event does this.) This will
1935                    cause the ^G to be treated as a normal keystroke.
1936                    -- not change Vquit_flag but attempt to enqueue the ^G, at
1937                    which point it will be discarded.  The next time QUIT is
1938                    called, it will notice that Vquit_flag was set.
1939
1940                  */
1941                 if (e->event_type == key_press_event &&
1942                     event_matches_key_specifier_p
1943                     (e,
1944                      make_char(CONSOLE_QUIT_CHAR(XCONSOLE(EVENT_CHANNEL(e))))))
1945                 {
1946                         Vquit_flag = Qt;
1947                 }
1948         }
1949
1950         UNGCPRO;
1951 }
1952
1953 static void run_pre_idle_hook(void)
1954 {
1955         if (!NILP(Vpre_idle_hook)
1956             && !detect_input_pending())
1957                 safe_run_hook_trapping_errors
1958                     ("Error in `pre-idle-hook' (setting hook to nil)",
1959                      Qpre_idle_hook, 1);
1960 }
1961
1962 static void push_this_command_keys(Lisp_Object event);
1963 static void push_recent_keys(Lisp_Object event);
1964 static void dribble_out_event(Lisp_Object event);
1965 static void execute_internal_event(Lisp_Object event);
1966 static int is_scrollbar_event(Lisp_Object event);
1967
1968 DEFUN("next-event", Fnext_event, 0, 2, 0,       /*
1969 Return the next available event.
1970 Pass this object to `dispatch-event' to handle it.
1971 In most cases, you will want to use `next-command-event', which returns
1972 the next available "user" event (i.e. keypress, button-press,
1973 button-release, or menu selection) instead of this function.
1974
1975 If EVENT is non-nil, it should be an event object and will be filled in
1976 and returned; otherwise a new event object will be created and returned.
1977 If PROMPT is non-nil, it should be a string and will be displayed in the
1978 echo area while this function is waiting for an event.
1979
1980 The next available event will be
1981
1982 -- any events in `unread-command-events' or `unread-command-event'; else
1983 -- the next event in the currently executing keyboard macro, if any; else
1984 -- an event queued by `enqueue-eval-event', if any, or any similar event
1985    queued internally, such as a misc-user event. (For example, when an item
1986    is selected from a menu or from a `question'-type dialog box, the item's
1987    callback is not immediately executed, but instead a misc-user event
1988    is generated and placed onto this queue; when it is dispatched, the
1989    callback is executed.) Else
1990 -- the next available event from the window system or terminal driver.
1991
1992 In the last case, this function will block until an event is available.
1993
1994 The returned event will be one of the following types:
1995
1996 -- a key-press event.
1997 -- a button-press or button-release event.
1998 -- a misc-user-event, meaning the user selected an item on a menu or used
1999    the scrollbar.
2000 -- a process event, meaning that output from a subprocess is available.
2001 -- a timeout event, meaning that a timeout has elapsed.
2002 -- an eval event, which simply causes a function to be executed when the
2003    event is dispatched.  Eval events are generated by `enqueue-eval-event'
2004    or by certain other conditions happening.
2005 -- a magic event, indicating that some window-system-specific event
2006    happened (such as a focus-change notification) that must be handled
2007    synchronously with other events.  `dispatch-event' knows what to do with
2008    these events.
2009 */
2010       (event, prompt))
2011 {
2012         /* This function can call lisp */
2013         /* #### We start out using the selected console before an event
2014            is received, for echoing the partially completed command.
2015            This is most definitely wrong -- there needs to be a separate
2016            echo area for each console! */
2017         struct console *con = XCONSOLE(Vselected_console);
2018         struct command_builder *command_builder =
2019             XCOMMAND_BUILDER(con->command_builder);
2020         int store_this_key = 0;
2021         struct gcpro gcpro1;
2022
2023         GCPRO1(event);
2024         /* DO NOT do QUIT anywhere within this function or the functions it calls.
2025            We want to read the ^G as an event. */
2026
2027 #ifdef LWLIB_MENUBARS_LUCID
2028         /*
2029          * #### Fix the menu code so this isn't necessary.
2030          *
2031          * We cannot allow the lwmenu code to be reentered, because the
2032          * code is not written to be reentrant and will crash.  Therefore
2033          * paths from the menu callbacks back into the menu code have to
2034          * be blocked.  Fnext_event is the normal path into the menu code,
2035          * so we signal an error here.
2036          */
2037         if (in_menu_callback)
2038                 error("Attempt to call next-event inside menu callback");
2039 #endif                          /* LWLIB_MENUBARS_LUCID */
2040
2041         if (NILP(event))
2042                 event = Fmake_event(Qnil, Qnil);
2043         else
2044                 CHECK_LIVE_EVENT(event);
2045
2046         if (!NILP(prompt)) {
2047                 Bytecount len;
2048                 CHECK_STRING(prompt);
2049
2050                 len = XSTRING_LENGTH(prompt);
2051                 if (command_builder->echo_buf_length < len)
2052                         len = command_builder->echo_buf_length - 1;
2053                 memcpy(command_builder->echo_buf, XSTRING_DATA(prompt), len);
2054                 command_builder->echo_buf[len] = 0;
2055                 command_builder->echo_buf_index = len;
2056                 echo_area_message(XFRAME(CONSOLE_SELECTED_FRAME(con)),
2057                                   command_builder->echo_buf,
2058                                   Qnil, 0,
2059                                   command_builder->echo_buf_index, Qcommand);
2060         }
2061
2062       start_over_and_avoid_hosage:
2063         /* If there is something in unread-command-events, simply return it.
2064            But do some error checking to make sure the user hasn't put something
2065            in the unread-command-events that they shouldn't have.
2066            This does not update this-command-keys and recent-keys.
2067          */
2068         if (!NILP(Vunread_command_events)) {
2069                 if (!CONSP(Vunread_command_events)) {
2070                         Vunread_command_events = Qnil;
2071                         signal_error(Qwrong_type_argument,
2072                                      list3(Qconsp, Vunread_command_events,
2073                                            Qunread_command_events));
2074                 } else {
2075                         Lisp_Object e = XCAR(Vunread_command_events);
2076                         Vunread_command_events = XCDR(Vunread_command_events);
2077                         if (!EVENTP(e) || !command_event_p(e))
2078                                 signal_error(Qwrong_type_argument,
2079                                              list3(Qcommand_event_p, e,
2080                                                    Qunread_command_events));
2081                         redisplay();
2082                         if (!EQ(e, event))
2083                                 Fcopy_event(e, event);
2084                         DEBUG_PRINT_EMACS_EVENT("unread-command-events", event);
2085                 }
2086         }
2087
2088         /* Do similar for unread-command-event (obsoleteness support). */
2089         else if (!NILP(Vunread_command_event)) {
2090                 Lisp_Object e = Vunread_command_event;
2091                 Vunread_command_event = Qnil;
2092
2093                 if (!EVENTP(e) || !command_event_p(e)) {
2094                         signal_error(Qwrong_type_argument,
2095                                      list3(Qeventp, e, Qunread_command_event));
2096                 }
2097                 if (!EQ(e, event))
2098                         Fcopy_event(e, event);
2099                 redisplay();
2100                 DEBUG_PRINT_EMACS_EVENT("unread-command-event", event);
2101         }
2102
2103         /* If we're executing a keyboard macro, take the next event from that,
2104            and update this-command-keys and recent-keys.
2105            Note that the unread-command-events take precedence over kbd macros.
2106          */
2107         else {
2108                 if (!NILP(Vexecuting_macro)) {
2109                         redisplay();
2110                         pop_kbd_macro_event(event);     /* This throws past us at
2111                                                            end-of-macro. */
2112                         store_this_key = 1;
2113                         DEBUG_PRINT_EMACS_EVENT("keyboard macro", event);
2114                 }
2115                 /* Otherwise, read a real event, possibly from the
2116                    command_event_queue, and update this-command-keys and
2117                    recent-keys. */
2118                 else {
2119                         run_pre_idle_hook();
2120                         redisplay();
2121                         next_event_internal(event, 1);
2122                         Vquit_flag = Qnil;      /* Read C-g as an event. */
2123                         store_this_key = 1;
2124                 }
2125         }
2126
2127         status_notify();        /* Notice process change */
2128
2129 #ifdef C_ALLOCA
2130         alloca(0);              /* Cause a garbage collection now */
2131         /* Since we can free the most stuff here
2132          *  (since this is typically called from
2133          *  the command-loop top-level). */
2134 #endif                          /* C_ALLOCA */
2135
2136         if (object_dead_p(XEVENT(event)->channel)) {
2137                 /* event_console_or_selected may crash if the channel is dead.
2138                    Best just to eat it and get the next event. */
2139                 goto start_over_and_avoid_hosage;
2140         }
2141
2142         /* OK, now we can stop the selected-console kludge and use the
2143            actual console from the event. */
2144         con = event_console_or_selected(event);
2145         command_builder = XCOMMAND_BUILDER(con->command_builder);
2146
2147         switch (XEVENT_TYPE(event)) {
2148         case button_release_event:
2149         case misc_user_event:
2150                 /* don't echo menu accelerator keys */
2151                 reset_key_echo(command_builder, 1);
2152                 goto EXECUTE_KEY;
2153         case button_press_event:
2154                 /* key or mouse input can trigger prompting */
2155                 goto STORE_AND_EXECUTE_KEY;
2156         case key_press_event:
2157                 /* any key input can trigger autosave */
2158                 break;
2159
2160                 /* just list the other events here */
2161         case empty_event:
2162         case pointer_motion_event:
2163         case process_event:
2164         case timeout_event:
2165         case magic_event:
2166         case magic_eval_event:
2167         case eval_event:
2168 #ifdef EF_USE_ASYNEQ
2169         case eaten_myself_event:
2170         case work_started_event:
2171         case work_finished_event:
2172 #endif  /* EF_USE_ASYNEQ */
2173         case dead_event:
2174         default:
2175                 goto RETURN;
2176         }
2177
2178         maybe_do_auto_save();
2179         num_input_chars++;
2180       STORE_AND_EXECUTE_KEY:
2181         if (store_this_key) {
2182                 echo_key_event(command_builder, event);
2183         }
2184
2185       EXECUTE_KEY:
2186         /* Store the last-input-event.  The semantics of this is that it is
2187            the thing most recently returned by next-command-event.  It need
2188            not have come from the keyboard or a keyboard macro, it may have
2189            come from unread-command-events.  It's always a command-event (a
2190            key, click, or menu selection), never a motion or process event.
2191          */
2192         if (!EVENTP(Vlast_input_event))
2193                 Vlast_input_event = Fmake_event(Qnil, Qnil);
2194         if (XEVENT_TYPE(Vlast_input_event) == dead_event) {
2195                 Vlast_input_event = Fmake_event(Qnil, Qnil);
2196                 error("Someone deallocated last-input-event!");
2197         }
2198         if (!EQ(event, Vlast_input_event))
2199                 Fcopy_event(event, Vlast_input_event);
2200
2201         /* last-input-char and last-input-time are derived from
2202            last-input-event.
2203            Note that last-input-char will never have its high-bit set, in an
2204            effort to sidestep the ambiguity between M-x and oslash.
2205          */
2206         Vlast_input_char = Fevent_to_character(Vlast_input_event,
2207                                                Qnil, Qnil, Qnil);
2208         {
2209                 EMACS_TIME t;
2210                 EMACS_GET_TIME(t);
2211                 if (!CONSP(Vlast_input_time))
2212                         Vlast_input_time = Fcons(Qnil, Qnil);
2213                 XCAR(Vlast_input_time) =
2214                     make_int((EMACS_SECS(t) >> 16) & 0xffff);
2215                 XCDR(Vlast_input_time) =
2216                     make_int((EMACS_SECS(t) >> 0) & 0xffff);
2217                 if (!CONSP(Vlast_command_event_time))
2218                         Vlast_command_event_time = list3(Qnil, Qnil, Qnil);
2219                 XCAR(Vlast_command_event_time) =
2220                     make_int((EMACS_SECS(t) >> 16) & 0xffff);
2221                 XCAR(XCDR(Vlast_command_event_time)) =
2222                     make_int((EMACS_SECS(t) >> 0) & 0xffff);
2223                 XCAR(XCDR(XCDR(Vlast_command_event_time)))
2224                     = make_int(EMACS_USECS(t));
2225         }
2226         /* If this key came from the keyboard or from a keyboard macro, then
2227            it goes into the recent-keys and this-command-keys vectors.
2228            If this key came from the keyboard, and we're defining a keyboard
2229            macro, then it goes into the macro.
2230          */
2231         if (store_this_key) {
2232                 if (!is_scrollbar_event(event)) /* #### not quite right, see
2233                                                    comment in execute_command_event */
2234                         push_this_command_keys(event);
2235                 if (!inhibit_input_event_recording)
2236                         push_recent_keys(event);
2237                 dribble_out_event(event);
2238                 if (!NILP(con->defining_kbd_macro) && NILP(Vexecuting_macro)) {
2239                         if (!EVENTP(command_builder->current_events))
2240                                 finalize_kbd_macro_chars(con);
2241                         store_kbd_macro_event(event);
2242                 }
2243         }
2244         /* If this is the help char and there is a help form, then execute the
2245            help form and swallow this character.  This is the only place where
2246            calling Fnext_event() can cause arbitrary lisp code to run.  Note
2247            that execute_help_form() calls Fnext_command_event(), which calls
2248            this function, as well as Fdispatch_event.
2249          */
2250         if (!NILP(Vhelp_form) &&
2251             event_matches_key_specifier_p(XEVENT(event), Vhelp_char))
2252                 execute_help_form(command_builder, event);
2253
2254       RETURN:
2255         UNGCPRO;
2256         return event;
2257 }
2258
2259 DEFUN("next-command-event", Fnext_command_event, 0, 2, 0,       /*
2260 Return the next available "user" event.
2261 Pass this object to `dispatch-event' to handle it.
2262
2263 If EVENT is non-nil, it should be an event object and will be filled in
2264 and returned; otherwise a new event object will be created and returned.
2265 If PROMPT is non-nil, it should be a string and will be displayed in the
2266 echo area while this function is waiting for an event.
2267
2268 The event returned will be a keyboard, mouse press, or mouse release event.
2269 If there are non-command events available (mouse motion, sub-process output,
2270 etc) then these will be executed (with `dispatch-event') and discarded.  This
2271 function is provided as a convenience; it is roughly equivalent to the lisp code
2272
2273   (while (progn
2274            (next-event event prompt)
2275            (not (or (key-press-event-p event)
2276                     (button-press-event-p event)
2277                     (button-release-event-p event)
2278                     (misc-user-event-p event))))
2279     (dispatch-event event))
2280
2281 but it also makes a provision for displaying keystrokes in the echo area.
2282 */
2283       (event, prompt))
2284 {
2285         /* This function can GC */
2286         struct gcpro gcpro1;
2287         GCPRO1(event);
2288         maybe_echo_keys(XCOMMAND_BUILDER(XCONSOLE(Vselected_console)->command_builder), 0);     /* #### This sucks bigtime */
2289         for (;;) {
2290                 event = Fnext_event(event, prompt);
2291                 if (command_event_p(event))
2292                         break;
2293                 else
2294                         execute_internal_event(event);
2295         }
2296         UNGCPRO;
2297         return event;
2298 }
2299
2300 DEFUN("dispatch-non-command-events", Fdispatch_non_command_events, 0, 0, 0,     /*
2301 Dispatch any pending "magic" events.
2302
2303 This function is useful for forcing the redisplay of native
2304 widgets. Normally these are redisplayed through a native window-system
2305 event encoded as magic event, rather than by the redisplay code.  This
2306 function does not call redisplay or do any of the other things that
2307 `next-event' does.
2308 */
2309       ())
2310 {
2311         /* This function can GC */
2312         Lisp_Object event = Qnil;
2313         struct gcpro gcpro1;
2314         GCPRO1(event);
2315         event = Fmake_event(Qnil, Qnil);
2316
2317         /* Make sure that there will be something in the native event queue
2318            so that externally managed things (e.g. widgets) get some CPU
2319            time. */
2320         event_stream_force_event_pending(selected_frame());
2321
2322         while (event_stream_event_pending_p(0)) {
2323                 QUIT;           /* next_event_internal() does not QUIT. */
2324
2325                 /* We're a generator of the command_event_queue, so we can't be a
2326                    consumer as well.  Also, we have no reason to consult the
2327                    command_event_queue; there are only user and eval-events there,
2328                    and we'd just have to put them back anyway.
2329                  */
2330                 next_event_internal(event, 0);  /* blocks */
2331                 /* See the comment in accept-process-output about Vquit_flag */
2332                 if (XEVENT_TYPE(event) == magic_event ||
2333                     XEVENT_TYPE(event) == timeout_event ||
2334                     XEVENT_TYPE(event) == process_event ||
2335                     XEVENT_TYPE(event) == pointer_motion_event)
2336                         execute_internal_event(event);
2337                 else {
2338                         enqueue_command_event_1(event);
2339                         break;
2340                 }
2341         }
2342
2343         Fdeallocate_event(event);
2344         UNGCPRO;
2345         return Qnil;
2346 }
2347
2348 static void reset_current_events(struct command_builder *command_builder)
2349 {
2350         Lisp_Object event = command_builder->current_events;
2351         reset_command_builder_event_chain(command_builder);
2352         if (EVENTP(event))
2353                 deallocate_event_chain(event);
2354 }
2355
2356 DEFUN("discard-input", Fdiscard_input, 0, 0, 0, /*
2357 Discard any pending "user" events.
2358 Also cancel any kbd macro being defined.
2359 A user event is a key press, button press, button release, or
2360 "misc-user" event (menu selection or scrollbar action).
2361 */
2362       ())
2363 {
2364         /* This throws away user-input on the queue, but doesn't process any
2365            events.  Calling dispatch_event() here leads to a race condition.
2366          */
2367         Lisp_Object event = Fmake_event(Qnil, Qnil);
2368 #ifndef EF_USE_ASYNEQ
2369         Lisp_Object head = Qnil, tail = Qnil;
2370 #endif
2371         Lisp_Object oiq = Vinhibit_quit;
2372         struct gcpro gcpro1, gcpro2;
2373         /* #### not correct here with Vselected_console?  Should
2374            discard-input take a console argument, or maybe map over
2375            all consoles? */
2376         struct console *con = XCONSOLE(Vselected_console);
2377
2378         /* next_event_internal() can cause arbitrary Lisp code to be evalled */
2379         GCPRO2(event, oiq);
2380         Vinhibit_quit = Qt;
2381         /* If a macro was being defined then we have to mark the modeline
2382            has changed to ensure that it gets updated correctly. */
2383         if (!NILP(con->defining_kbd_macro))
2384                 MARK_MODELINE_CHANGED;
2385         con->defining_kbd_macro = Qnil;
2386         reset_current_events(XCOMMAND_BUILDER(con->command_builder));
2387
2388 #ifdef EF_USE_ASYNEQ
2389         /* very raw :| */
2390         WITH_DLLIST_TRAVERSE(
2391                 eq_queue(asyneq),
2392                 sxe_event_t *ev = dllist_item;
2393                 if (command_event_p((Lisp_Object)ev)) {
2394                         dllist_pop_inner(eq_queue(asyneq), _el);
2395                 });
2396 #else
2397         while (!EQ_EMPTY_P() || event_stream_event_pending_p(1)) {
2398                 /* This will take stuff off the command_event_queue, or read it
2399                    from the event_stream, but it will not block.
2400                  */
2401                 next_event_internal(event, 1);
2402                 Vquit_flag = Qnil;      /* Treat C-g as a user event (ignore it).
2403                                            It is vitally important that we reset
2404                                            Vquit_flag here.  Otherwise, if we're
2405                                            reading from a TTY console,
2406                                            maybe_read_quit_event() will notice
2407                                            that C-g has been set and send us
2408                                            another C-g.  That will cause us
2409                                            to get right back here, and read
2410                                            another C-g, ad infinitum ... */
2411
2412                 /* If the event is a user event, ignore it. */
2413                 if (!command_event_p(event)) {
2414                         /* Otherwise, chain the event onto our list of events
2415                            not to ignore, and keep reading until the queue is
2416                            empty.  This does not mean that if a subprocess is
2417                            generating an infinite amount of output, we will
2418                            never terminate (*provided* that the behavior of
2419                            next_event_cb() is correct -- see the comment in
2420                            events.h), because this loop ends as soon as there
2421                            are no more user events on the command_event_queue or
2422                            event_stream.
2423                          */
2424                         enqueue_event(Fcopy_event(event, Qnil), &head, &tail);
2425                 }
2426         }
2427
2428         if (!EQ_EMPTY_P() || EQ_LARGE_P())
2429                 abort();
2430
2431         /* Now tack our chain of events back on to the front of the queue.
2432            Actually, since the queue is now drained, we can just replace it.
2433            The effect of this will be that we have deleted all user events
2434            from the input stream without changing the relative ordering of
2435            any other events.  (Some events may have been taken from the
2436            event_stream and added to the command_event_queue, however.)
2437
2438            At this time, the command_event_queue will contain only eval_events.
2439          */
2440         command_event_queue = head;
2441         command_event_queue_tail = tail;
2442 #endif
2443
2444         Fdeallocate_event(event);
2445         UNGCPRO;
2446
2447         Vinhibit_quit = oiq;
2448         return Qnil;
2449 }
2450 \f
2451 /**********************************************************************/
2452 /*                     pausing until an action occurs                 */
2453 /**********************************************************************/
2454
2455 /* This is used in accept-process-output, sleep-for and sit-for.
2456    Before running any process_events in these routines, we set
2457    recursive_sit_for to Qt, and use this unwind protect to reset it to
2458    Qnil upon exit.  When recursive_sit_for is Qt, calling sit-for will
2459    cause it to return immediately.
2460
2461    All of these routines install timeouts, so we clear the installed
2462    timeout as well.
2463
2464    Note: It's very easy to break the desired behaviors of these
2465    3 routines.  If you make any changes to anything in this area, run
2466    the regression tests at the bottom of the file.  -- dmoore */
2467
2468 static Lisp_Object sit_for_unwind(Lisp_Object timeout_id)
2469 {
2470         if (!NILP(timeout_id))
2471                 Fdisable_timeout(timeout_id);
2472
2473         recursive_sit_for = Qnil;
2474         return Qnil;
2475 }
2476
2477 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)?
2478  */
2479
2480 DEFUN("accept-process-output", Faccept_process_output, 0, 3, 0, /*
2481 Allow any pending output from subprocesses to be read by Emacs.
2482 It is read into the process' buffers or given to their filter functions.
2483 Non-nil arg PROCESS means do not return until some output has been received
2484 from PROCESS. Nil arg PROCESS means do not return until some output has
2485 been received from any process.
2486
2487 If the second arg is non-nil, it is the maximum number of seconds to wait:
2488 this function will return after that much time even if no input has arrived
2489 from PROCESS.  This argument may be a float, meaning wait some fractional
2490 part of a second.
2491
2492 If the third arg is non-nil, it is a number of milliseconds that is added
2493 to the second arg.  (This exists only for compatibility.)
2494 Return non-nil iff we received any output before the timeout expired.
2495 */
2496       (process, timeout_secs, timeout_msecs))
2497 {
2498         /* This function can GC */
2499         struct gcpro gcpro1, gcpro2;
2500         Lisp_Object event = Qnil;
2501         Lisp_Object result = Qnil;
2502         int timeout_id = -1;
2503         int timeout_enabled = 0;
2504         int done = 0;
2505         struct buffer *old_buffer = current_buffer;
2506         int count;
2507
2508         /* We preserve the current buffer but nothing else.  If a focus
2509            change alters the selected window then the top level event loop
2510            will eventually alter current_buffer to match.  In the mean time
2511            we don't want to mess up whatever called this function. */
2512
2513         if (!NILP(process))
2514                 CHECK_PROCESS(process);
2515
2516         GCPRO2(event, process);
2517
2518         if (!NILP(timeout_secs) || !NILP(timeout_msecs)) {
2519                 unsigned long msecs = 0;
2520                 if (!NILP(timeout_secs))
2521                         msecs = lisp_number_to_milliseconds(timeout_secs, 1);
2522                 if (!NILP(timeout_msecs)) {
2523                         CHECK_NATNUM(timeout_msecs);
2524                         msecs += XINT(timeout_msecs);
2525                 }
2526                 if (msecs) {
2527                         timeout_id =
2528                             event_stream_generate_wakeup(msecs, 0, Qnil, Qnil,
2529                                                          0);
2530                         timeout_enabled = 1;
2531                 }
2532         }
2533
2534         event = Fmake_event(Qnil, Qnil);
2535
2536         count = specpdl_depth();
2537         record_unwind_protect(sit_for_unwind,
2538                               timeout_enabled ? make_int(timeout_id) : Qnil);
2539         recursive_sit_for = Qt;
2540
2541         while (!done &&
2542                ((NILP(process) && timeout_enabled) ||
2543                 (NILP(process) && event_stream_event_pending_p(0)) ||
2544                 (!NILP(process))))
2545                 /* Calling detect_input_pending() is the wrong thing here, because
2546                    that considers the Vunread_command_events and command_event_queue.
2547                    We don't need to look at the command_event_queue because we are
2548                    only interested in process events, which don't go on that.  In
2549                    fact, we can't read from it anyway, because we put stuff on it.
2550
2551                    Note that event_stream->event_pending_p must be called in such
2552                    a way that it says whether any events *of any kind* are ready,
2553                    not just user events, or (accept-process-output nil) will fail
2554                    to dispatch any process events that may be on the queue.  It is
2555                    not clear to me that this is important, because the top-level
2556                    loop will process it, and I don't think that there is ever a
2557                    time when one calls accept-process-output with a nil argument
2558                    and really need the processes to be handled. */
2559         {
2560                 /* If our timeout has arrived, we move along. */
2561                 if (timeout_enabled
2562                     && !event_stream_wakeup_pending_p(timeout_id, 0)) {
2563                         timeout_enabled = 0;
2564                         done = 1;       /* We're  done. */
2565                         continue;       /* Don't call next_event_internal */
2566                 }
2567
2568                 QUIT;           /* next_event_internal() does not QUIT, so check
2569                                    for ^G before reading output from the process
2570                                    - this makes it less likely that the filter
2571                                    will actually be aborted.
2572                                  */
2573
2574                 next_event_internal(event, 0);
2575                 /* If C-g was pressed while we were waiting, Vquit_flag got
2576                    set and next_event_internal() also returns C-g.  When
2577                    we enqueue the C-g below, it will get discarded.  The
2578                    next time through, QUIT will be called and will signal a quit. */
2579                 switch (XEVENT_TYPE(event)) {
2580                 case process_event:
2581                         if (NILP(process) ||
2582                             EQ(XEVENT(event)->event.process.process,
2583                                process)) {
2584                                 done = 1;
2585                                 /* RMS's version always returns nil when
2586                                    proc is nil, and only returns t if
2587                                    input ever arrived on proc. */
2588                                 result = Qt;
2589                         }
2590
2591                         execute_internal_event(event);
2592                         break;
2593
2594                 case timeout_event:
2595                         /* We execute the event even if it's ours, and notice
2596                            that it's happened above. */
2597                 case pointer_motion_event:
2598                 case magic_event:
2599                         execute_internal_event(event);
2600                         break;
2601
2602                 /* just list the other events here */
2603                 case empty_event:
2604                 case key_press_event:
2605                 case button_press_event:
2606                 case button_release_event:
2607                 case misc_user_event:
2608                 case magic_eval_event:
2609                 case eval_event:
2610 #ifdef EF_USE_ASYNEQ
2611                 case eaten_myself_event:
2612                 case work_started_event:
2613                 case work_finished_event:
2614 #endif  /* EF_USE_ASYNEQ */
2615                 case dead_event:
2616                 default:
2617                         enqueue_command_event_1(event);
2618                         break;
2619                 }
2620         }
2621
2622         unbind_to(count, timeout_enabled ? make_int(timeout_id) : Qnil);
2623
2624         Fdeallocate_event(event);
2625         UNGCPRO;
2626         current_buffer = old_buffer;
2627         return result;
2628 }
2629
2630 DEFUN("sleep-for", Fsleep_for, 1, 1, 0, /*
2631 Pause, without updating display, for SECONDS seconds.
2632 SECONDS may be a float, allowing pauses for fractional parts of a second.
2633
2634 It is recommended that you never call sleep-for from inside of a process
2635 filter function or timer event (either synchronous or asynchronous).
2636 */
2637       (seconds))
2638 {
2639         /* This function can GC */
2640         unsigned long msecs = lisp_number_to_milliseconds(seconds, 1);
2641         int id;
2642         Lisp_Object event = Qnil;
2643         int count;
2644         struct gcpro gcpro1;
2645
2646         GCPRO1(event);
2647
2648         id = event_stream_generate_wakeup(msecs, 0, Qnil, Qnil, 0);
2649         event = Fmake_event(Qnil, Qnil);
2650
2651         count = specpdl_depth();
2652         record_unwind_protect(sit_for_unwind, make_int(id));
2653         recursive_sit_for = Qt;
2654
2655         while (1) {
2656                 /* If our timeout has arrived, we move along. */
2657                 if (!event_stream_wakeup_pending_p(id, 0))
2658                         goto DONE_LABEL;
2659
2660                 /* next_event_internal() does not QUIT, so check for ^G before
2661                    reading output from the process - this makes it less likely
2662                    that the filter will actually be aborted.
2663                 */
2664                 QUIT;
2665
2666                 /* We're a generator of the command_event_queue, so we can't be
2667                    a consumer as well.  We don't care about command and
2668                    eval-events anyway.
2669                  */
2670                 next_event_internal(event, 0);  /* blocks */
2671                 /* See the comment in accept-process-output about Vquit_flag */
2672                 switch (XEVENT_TYPE(event)) {
2673                 case timeout_event:
2674                         /* We execute the event even if it's ours, and notice
2675                            that it's happened above. */
2676                 case process_event:
2677                 case pointer_motion_event:
2678                 case magic_event:
2679                         execute_internal_event(event);
2680                         break;
2681
2682                         /* just list the other events here */
2683                 case empty_event:
2684                 case key_press_event:
2685                 case button_press_event:
2686                 case button_release_event:
2687                 case magic_eval_event:
2688                 case eval_event:
2689                 case misc_user_event:
2690 #ifdef EF_USE_ASYNEQ
2691                 case eaten_myself_event:
2692                 case work_started_event:
2693                 case work_finished_event:
2694 #endif  /* EF_USE_ASYNEQ */
2695                 case dead_event:
2696                 default:
2697                         enqueue_command_event_1(event);
2698                         break;
2699                 }
2700         }
2701       DONE_LABEL:
2702         unbind_to(count, make_int(id));
2703         Fdeallocate_event(event);
2704         UNGCPRO;
2705         return Qnil;
2706 }
2707
2708 DEFUN("sit-for", Fsit_for, 1, 2, 0,     /*
2709 Perform redisplay, then wait SECONDS seconds or until user input is available.
2710 SECONDS may be a float, meaning a fractional part of a second.
2711 Optional second arg NODISPLAY non-nil means don't redisplay; just wait.
2712 Redisplay is preempted as always if user input arrives, and does not
2713 happen if input is available before it starts.
2714 Value is t if waited the full time with no input arriving.
2715
2716 If sit-for is called from within a process filter function or timer
2717 event (either synchronous or asynchronous) it will return immediately.
2718 */
2719       (seconds, nodisplay))
2720 {
2721         /* This function can GC */
2722         unsigned long msecs = lisp_number_to_milliseconds(seconds, 1);
2723         Lisp_Object event, result;
2724         struct gcpro gcpro1;
2725         int id;
2726         int count;
2727
2728         /* The unread-command-events count as pending input */
2729         if (!NILP(Vunread_command_events) || !NILP(Vunread_command_event))
2730                 return Qnil;
2731
2732         /* If the command-builder already has user-input on it (not eval events)
2733            then that means we're done too.
2734          */
2735         if (!EQ_EMPTY_P()) {
2736 #if defined(EF_USE_ASYNEQ)
2737                 EQ_TRAVERSE(
2738                         asyneq, event,
2739                         if (command_event_p(event)) {
2740                                 RETURN_FROM_EQ_TRAVERSE(asyneq, Qnil);
2741                         });
2742 #else
2743                 EVENT_CHAIN_LOOP(event, command_event_queue) {
2744                         if (command_event_p(event))
2745                                 return Qnil;
2746                 }
2747 #endif
2748         }
2749
2750         /* If we're in a macro, or noninteractive, or early in temacs, then
2751            don't wait. */
2752         if (noninteractive || !NILP(Vexecuting_macro))
2753                 return Qnil;
2754
2755         /* Recursive call from a filter function or timeout handler. */
2756         if (!NILP(recursive_sit_for)) {
2757                 if (!event_stream_event_pending_p(1) && NILP(nodisplay)) {
2758                         run_pre_idle_hook();
2759                         redisplay();
2760                 }
2761                 return Qnil;
2762         }
2763
2764         /* Otherwise, start reading events from the event_stream.
2765            Do this loop at least once even if (sit-for 0) so that we
2766            redisplay when no input pending.
2767          */
2768         GCPRO1(event);
2769         event = Fmake_event(Qnil, Qnil);
2770
2771         /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc.
2772            events get processed.  The old (pre-19.12) code special-cased this
2773            and didn't generate a wakeup, but the resulting behavior was less than
2774            ideal; viz. the occurrence of (sit-for 0.001) scattered throughout
2775            the E-Lisp universe. */
2776
2777         id = event_stream_generate_wakeup(msecs, 0, Qnil, Qnil, 0);
2778
2779         count = specpdl_depth();
2780         record_unwind_protect(sit_for_unwind, make_int(id));
2781         recursive_sit_for = Qt;
2782
2783         while (1) {
2784                 /* If there is no user input pending, then redisplay.
2785                  */
2786                 if (!event_stream_event_pending_p(1) && NILP(nodisplay)) {
2787                         run_pre_idle_hook();
2788                         redisplay();
2789                 }
2790
2791                 /* If our timeout has arrived, we move along. */
2792                 if (!event_stream_wakeup_pending_p(id, 0)) {
2793                         result = Qt;
2794                         goto DONE_LABEL;
2795                 }
2796
2797                 /* next_event_internal() does not QUIT, so check for ^G
2798                    before reading output from the process - this makes it
2799                    less likely that the filter will actually be aborted.
2800                 */
2801                 QUIT;
2802
2803                 /* We're a generator of the command_event_queue, so we can't be
2804                    a consumer as well.  In fact, we know there's nothing on the
2805                    command_event_queue that we didn't just put there.
2806                  */
2807                 next_event_internal(event, 0);  /* blocks */
2808                 /* See the comment in accept-process-output about Vquit_flag */
2809
2810                 if (command_event_p(event)) {
2811                         QUIT;   /* If the command was C-g check it here
2812                                    so that we abort out of the sit-for,
2813                                    not the next command.  sleep-for and
2814                                    accept-process-output continue looping
2815                                    so they check QUIT again implicitly. */
2816                         result = Qnil;
2817                         goto DONE_LABEL;
2818                 }
2819
2820                 switch (XEVENT_TYPE(event)) {
2821                 case eval_event:
2822                         /* eval-events get delayed until later. */
2823                         enqueue_command_event(Fcopy_event(event, Qnil));
2824                         break;
2825
2826                 case timeout_event:
2827                         /* We execute the event even if it's ours, and notice
2828                            that it's happened above. */
2829
2830                         /* just list the rest here too */
2831                 case empty_event:
2832                 case key_press_event:
2833                 case button_press_event:
2834                 case button_release_event:
2835                 case pointer_motion_event:
2836                 case process_event:
2837                 case magic_event:
2838                 case magic_eval_event:
2839                 case misc_user_event:
2840 #ifdef EF_USE_ASYNEQ
2841                 case eaten_myself_event:
2842                 case work_started_event:
2843                 case work_finished_event:
2844 #endif  /* EF_USE_ASYNEQ */
2845                 case dead_event:
2846                 default:
2847                         execute_internal_event(event);
2848                         break;
2849                 }
2850         }
2851
2852       DONE_LABEL:
2853         unbind_to(count, make_int(id));
2854
2855         /* Put back the event (if any) that made Fsit_for() exit before the
2856            timeout.  Note that it is being added to the back of the queue, which
2857            would be inappropriate if there were any user events on the queue
2858            already: we would be misordering them.  But we know that there are
2859            no user-events on the queue, or else we would not have reached this
2860            point at all.
2861          */
2862         if (NILP(result))
2863                 enqueue_command_event(event);
2864         else
2865                 Fdeallocate_event(event);
2866
2867         UNGCPRO;
2868         return result;
2869 }
2870
2871 /* This handy little function is used by select-x.c to wait for replies
2872    from processes that aren't really processes (e.g. the X server) */
2873 void wait_delaying_user_input(int (*predicate) (void *arg), void *predicate_arg)
2874 {
2875         /* This function can GC */
2876         Lisp_Object event = Fmake_event(Qnil, Qnil);
2877         struct gcpro gcpro1;
2878         GCPRO1(event);
2879
2880         while (!(*predicate) (predicate_arg)) {
2881                 QUIT;           /* next_event_internal() does not QUIT. */
2882
2883                 /* We're a generator of the command_event_queue, so we can't be a
2884                    consumer as well.  Also, we have no reason to consult the
2885                    command_event_queue; there are only user and eval-events there,
2886                    and we'd just have to put them back anyway.
2887                  */
2888                 next_event_internal(event, 0);
2889                 /* See the comment in accept-process-output about Vquit_flag */
2890                 if (command_event_p(event)
2891                     || (XEVENT_TYPE(event) == eval_event)
2892                     || (XEVENT_TYPE(event) == magic_eval_event))
2893                         enqueue_command_event_1(event);
2894                 else
2895                         execute_internal_event(event);
2896         }
2897         UNGCPRO;
2898 }
2899 \f
2900 /**********************************************************************/
2901 /*                dispatching events; command builder                 */
2902 /**********************************************************************/
2903
2904 static void
2905 execute_internal_event(Lisp_Object event)
2906 {
2907         /* events on dead channels get silently eaten */
2908         if (object_dead_p(XEVENT(event)->channel)) {
2909                 return;
2910         }
2911
2912         /* This function can GC */
2913         switch (XEVENT_TYPE(event)) {
2914         case empty_event:
2915                 return;
2916
2917         case eval_event:
2918                 call1(XEVENT(event)->event.eval.function,
2919                       XEVENT(event)->event.eval.object);
2920                 return;
2921
2922         case magic_eval_event:
2923                 (XEVENT(event)->event.magic_eval.internal_function)
2924                         (XEVENT(event)->event.magic_eval.object);
2925                 return;
2926
2927         case pointer_motion_event:
2928                 if (!NILP(Vmouse_motion_handler))
2929                         call1(Vmouse_motion_handler, event);
2930                 return;
2931
2932         case process_event: {
2933                 Lisp_Object p = XEVENT(event)->event.process.process;
2934                 Charcount readstatus;
2935
2936                 assert(PROCESSP(p));
2937                 while ((readstatus = read_process_output(p)) > 0) ;
2938                 if (readstatus > 0) ;   /* this clauses never gets
2939                                            executed but allows the
2940                                            #ifdefs to work cleanly. */
2941 #ifdef EWOULDBLOCK
2942                 else if (readstatus == -1 && errno == EWOULDBLOCK) ;
2943 #endif                          /* EWOULDBLOCK */
2944 #ifdef EAGAIN
2945                 else if (readstatus == -1 && errno == EAGAIN) ;
2946 #endif                          /* EAGAIN */
2947                 else if ((readstatus == 0 &&
2948                           /* Note that we cannot distinguish between no
2949                              input available now and a closed pipe.
2950                              With luck, a closed pipe will be
2951                              accompanied by subprocess termination and
2952                              SIGCHLD.  */
2953                           (!network_connection_p(p) ||
2954                            /*
2955                              When connected to ToolTalk (i.e.
2956                              connected_via_filedesc_p()), it's not
2957                              possible to reliably determine whether
2958                              there is a message waiting for ToolTalk to
2959                              receive.  ToolTalk expects to have
2960                              tt_message_receive() called exactly once
2961                              every time the file descriptor becomes
2962                              active, so the filter function forces this
2963                              by returning 0.  Emacs must not interpret
2964                              this as a closed pipe. */
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 (XEVENT(event)->event_type != misc_user_event)
3764                 return 0;
3765         fun = XEVENT(event)->event.misc.function;
3766
3767         return (EQ(fun, Qscrollbar_line_up) ||
3768                 EQ(fun, Qscrollbar_line_down) ||
3769                 EQ(fun, Qscrollbar_page_up) ||
3770                 EQ(fun, Qscrollbar_page_down) ||
3771                 EQ(fun, Qscrollbar_to_top) ||
3772                 EQ(fun, Qscrollbar_to_bottom) ||
3773                 EQ(fun, Qscrollbar_vertical_drag) ||
3774                 EQ(fun, Qscrollbar_char_left) ||
3775                 EQ(fun, Qscrollbar_char_right) ||
3776                 EQ(fun, Qscrollbar_page_left) ||
3777                 EQ(fun, Qscrollbar_page_right) ||
3778                 EQ(fun, Qscrollbar_to_left) ||
3779                 EQ(fun, Qscrollbar_to_right) ||
3780                 EQ(fun, Qscrollbar_horizontal_drag));
3781 #else
3782         return 0;
3783 #endif                          /* HAVE_SCROLLBARS */
3784 }
3785
3786 static void
3787 execute_command_event(struct command_builder *cmd_builder, Lisp_Object event)
3788 {
3789         /* This function can GC */
3790         struct console *con = XCONSOLE(cmd_builder->console);
3791         struct gcpro gcpro1;
3792
3793         GCPRO1(event);          /* event may be freshly created */
3794
3795         /* #### This call to is_scrollbar_event() isn't quite right, but
3796            fixing properly it requires more work than can go into 21.4.
3797            (We really need to split out menu, scrollbar, dialog, and other
3798            types of events from misc-user, and put the remaining ones in a
3799            new `user-eval' type that behaves like an eval event but is a
3800            user event and thus has all of its semantics -- e.g. being
3801            delayed during `accept-process-output' and similar wait states.)
3802
3803            The real issue here is that "user events" and "command events"
3804            are not the same thing, but are very much confused in
3805            event-stream.c.  User events are, essentially, any event that
3806            should be delayed by accept-process-output, should terminate a
3807            sit-for, etc. -- basically, any event that needs to be processed
3808            synchronously with key and mouse events.  Command events are
3809            those that participate in command building; scrollbar events
3810            clearly don't belong because they should be transparent in a
3811            sequence like C-x @ h <scrollbar-drag> x, which used to cause a
3812            crash before checks similar to the is_scrollbar_event() call were
3813            added.  Do other events belong with scrollbar events?  I'm not
3814            sure; we need to categorize all misc-user events and see what
3815            their semantics are.
3816
3817            (You might ask, why do scrollbar events need to be user events?
3818            That's a good question.  The answer seems to be that they can
3819            change point, and having this happen asynchronously would be a
3820            very bad idea.  According to the "proper" functioning of
3821            scrollbars, this should not happen, but SXEmacs does not allow
3822            point to go outside of the window.)
3823
3824            Scrollbar events and similar non-command events should obviously
3825            not be recorded in this-command-keys, so we need to check for
3826            this in next-event.
3827
3828            #### We call reset_current_events() twice in this function --
3829            #### here, and later as a result of reset_this_command_keys().
3830            #### This is almost certainly wrong; need to figure out what's
3831            #### correct.
3832
3833            #### We need to figure out what's really correct w.r.t. scrollbar
3834            #### events.  With these new fixes in, it actually works to do
3835            #### C-x <scrollbar-drag> 5 2, but the key echo gets messed up
3836            #### (starts over at 5).  We really need to be special-casing
3837            #### scrollbar events at a lower level, and not really passing
3838            #### them through the command builder at all.  (e.g. do scrollbar
3839            #### events belong in macros???  doubtful; probably only the
3840            #### point movement, if any, belongs, special-cased as a
3841            #### pseudo-issued M-x goto-char command).  #### Need more work
3842            #### here.  Do this when separating out scrollbar events.
3843          */
3844
3845         if (!is_scrollbar_event(event))
3846                 reset_current_events(cmd_builder);
3847
3848         switch (XEVENT(event)->event_type) {
3849         case key_press_event:
3850                 Vcurrent_mouse_event = Qnil;
3851                 break;
3852         case button_press_event:
3853         case button_release_event:
3854         case misc_user_event:
3855                 Vcurrent_mouse_event = Fcopy_event(event, Qnil);
3856                 break;
3857
3858                 /* just list the other cases here */
3859         case empty_event:
3860         case pointer_motion_event:
3861         case process_event:
3862         case timeout_event:
3863         case magic_event:
3864         case magic_eval_event:
3865         case eval_event:
3866 #ifdef EF_USE_ASYNEQ
3867         case eaten_myself_event:
3868         case work_started_event:
3869         case work_finished_event:
3870 #endif  /* EF_USE_ASYNEQ */
3871         case dead_event:
3872         default:
3873                 break;
3874         }
3875
3876         /* Store the last-command-event.  The semantics of this is that it
3877            is the last event most recently involved in command-lookup. */
3878         if (!EVENTP(Vlast_command_event))
3879                 Vlast_command_event = Fmake_event(Qnil, Qnil);
3880         if (XEVENT(Vlast_command_event)->event_type == dead_event) {
3881                 Vlast_command_event = Fmake_event(Qnil, Qnil);
3882                 error("Someone deallocated the last-command-event!");
3883         }
3884
3885         if (!EQ(event, Vlast_command_event))
3886                 Fcopy_event(event, Vlast_command_event);
3887
3888         /* Note that last-command-char will never have its high-bit set, in
3889            an effort to sidestep the ambiguity between M-x and oslash. */
3890         Vlast_command_char = Fevent_to_character(Vlast_command_event,
3891                                                  Qnil, Qnil, Qnil);
3892
3893         /* Actually call the command, with all sorts of hair to preserve or clear
3894            the echo-area and region as appropriate and call the pre- and post-
3895            command-hooks. */
3896         {
3897                 int old_kbd_macro = con->kbd_macro_end;
3898                 Lisp_Object tmp = Fselected_window(Qnil);
3899                 struct window *w = XWINDOW(tmp);
3900
3901                 /* We're executing a new command, so the old value is irrelevant. */
3902                 zmacs_region_stays = 0;
3903
3904                 /* If the previous command tried to force a specific window-start,
3905                    reset the flag in case this command moves point far away from
3906                    that position.  Also, reset the window's buffer's change
3907                    information so that we don't trigger an incremental update. */
3908                 if (w->force_start) {
3909                         w->force_start = 0;
3910                         buffer_reset_changes(XBUFFER(w->buffer));
3911                 }
3912
3913                 pre_command_hook();
3914
3915                 if (XEVENT(event)->event_type == misc_user_event) {
3916                         call1(XEVENT(event)->event.eval.function,
3917                               XEVENT(event)->event.eval.object);
3918                 } else {
3919                         Fcommand_execute(Vthis_command, Qnil, Qnil);
3920                 }
3921
3922                 post_command_hook();
3923
3924                 /* Console might have been deleted by command */
3925                 if (CONSOLE_LIVE_P(con) && !NILP(con->prefix_arg)) {
3926                         /* Commands that set the prefix arg don't update
3927                            last-command, don't reset the echoing state, and
3928                            don't go into keyboard macros unless followed by
3929                            another command.  Also don't quit here.  */
3930                         int speccount = specpdl_depth();
3931                         specbind(Qinhibit_quit, Qt);
3932                         maybe_echo_keys(cmd_builder, 0);
3933                         unbind_to(speccount, Qnil);
3934
3935                         /* If we're recording a keyboard macro, and the last
3936                            command executed set a prefix argument, then
3937                            decrement the pointer to the "last character really
3938                            in the macro" to be just before this command.  This
3939                            is so that the ^U in "^U ^X )" doesn't go onto the
3940                            end of macro. */
3941                         if (!NILP(con->defining_kbd_macro))
3942                                 con->kbd_macro_end = old_kbd_macro;
3943                 } else {
3944                         /* Start a new command next time */
3945                         Vlast_command = Vthis_command;
3946                         Vlast_command_properties = Vthis_command_properties;
3947                         Vthis_command_properties = Qnil;
3948
3949                         /* Emacs 18 doesn't unconditionally clear the echoed
3950                            keystrokes, so we don't either */
3951                         /* who cares about RMSmacs 18? */
3952                         if (!is_scrollbar_event(event))
3953                                 reset_this_command_keys(CONSOLE_LIVE_P(con) ?
3954                                                         make_console(con)
3955                                                         : Qnil, 0);
3956                 }
3957         }
3958         UNGCPRO;
3959 }
3960
3961 /* Run the pre command hook. */
3962
3963 static void pre_command_hook(void)
3964 {
3965         last_point_position = BUF_PT(current_buffer);
3966         XSETBUFFER(last_point_position_buffer, current_buffer);
3967         /* This function can GC */
3968         safe_run_hook_trapping_errors
3969             ("Error in `pre-command-hook' (setting hook to nil)",
3970              Qpre_command_hook, 1);
3971
3972         /* This is a kludge, but necessary; see simple.el */
3973         call0(Qhandle_pre_motion_command);
3974 }
3975
3976 /* Run the post command hook. */
3977
3978 static void post_command_hook(void)
3979 {
3980         /* This function can GC */
3981         /* Turn off region highlighting unless this command requested that
3982            it be left on, or we're in the minibuffer.  We don't turn it off
3983            when we're in the minibuffer so that things like M-x write-region
3984            still work!
3985
3986            This could be done via a function on the post-command-hook, but
3987            we don't want the user to accidentally remove it.
3988          */
3989
3990         Lisp_Object win = Fselected_window(Qnil);
3991
3992         /* If the last command deleted the frame, `win' might be nil.
3993            It seems safest to do nothing in this case. */
3994         /* Note: Someone added the following comment and put #if 0's around
3995            this code, not realizing that doing this invites a crash in the
3996            line after. */
3997         /* #### This doesn't really fix the problem,
3998            if delete-frame is called by some hook */
3999         if (NILP(win))
4000                 return;
4001
4002         /* This is a kludge, but necessary; see simple.el */
4003         call0(Qhandle_post_motion_command);
4004
4005         if (!zmacs_region_stays && (!MINI_WINDOW_P(XWINDOW(win))
4006                                     || EQ(zmacs_region_buffer(),
4007                                           WINDOW_BUFFER(XWINDOW(win)))))
4008                 zmacs_deactivate_region();
4009         else
4010                 zmacs_update_region();
4011
4012         safe_run_hook_trapping_errors
4013             ("Error in `post-command-hook' (setting hook to nil)",
4014              Qpost_command_hook, 1);
4015
4016         /* #### Kludge!!! This is necessary to make sure that things
4017            are properly positioned even if post-command-hook moves point.
4018            #### There should be a cleaner way of handling this. */
4019         call0(Qauto_show_make_point_visible);
4020 }
4021 \f
4022 DEFUN("dispatch-event", Fdispatch_event, 1, 1, 0,       /*
4023 Given an event object EVENT as returned by `next-event', execute it.
4024
4025 Key-press, button-press, and button-release events get accumulated
4026 until a complete key sequence (see `read-key-sequence') is reached,
4027 at which point the sequence is looked up in the current keymaps and
4028 acted upon.
4029
4030 Mouse motion events cause the low-level handling function stored in
4031 `mouse-motion-handler' to be called. (There are very few circumstances
4032 under which you should change this handler.  Use `mode-motion-hook'
4033 instead.)
4034
4035 Menu, timeout, and eval events cause the associated function or handler
4036 to be called.
4037
4038 Process events cause the subprocess's output to be read and acted upon
4039 appropriately (see `start-process').
4040
4041 Magic events are handled as necessary.
4042 */
4043       (event))
4044 {
4045         /* This function can GC */
4046         struct command_builder *command_builder;
4047         Lisp_Event *ev;
4048         Lisp_Object console;
4049         Lisp_Object channel;
4050
4051         CHECK_LIVE_EVENT(event);
4052         ev = XEVENT(event);
4053
4054         /* events on dead channels get silently eaten */
4055         channel = EVENT_CHANNEL(ev);
4056         if (object_dead_p(channel))
4057                 return Qnil;
4058
4059         /* Some events don't have channels (e.g. eval events). */
4060         console = CDFW_CONSOLE(channel);
4061         if (NILP(console))
4062                 console = Vselected_console;
4063         else if (!EQ(console, Vselected_console))
4064                 Fselect_console(console);
4065
4066         command_builder = XCOMMAND_BUILDER(XCONSOLE(console)->command_builder);
4067         switch (XEVENT(event)->event_type) {
4068         case button_press_event:
4069         case button_release_event:
4070         case key_press_event: {
4071                 Lisp_Object leaf =
4072                         lookup_command_event(command_builder, event, 1);
4073
4074                 if (KEYMAPP(leaf))
4075                         /* Incomplete key sequence */
4076                         break;
4077                 if (NILP(leaf)) {
4078                         /* At this point, we know that the sequence is
4079                            not bound to a command.  Normally, we beep
4080                            and print a message informing the user of
4081                            this.  But we do not beep or print a message
4082                            when:
4083
4084                            o  the last event in this sequence is a
4085                            mouse-up event; or
4086                            o  the last event in this sequence is a
4087                            mouse-down event and there is a binding
4088                            for the mouse-up version.
4089
4090                            That is, if the sequence ``C-x button1'' is
4091                            typed, and is not bound to a command, but the
4092                            sequence ``C-x button1up'' is bound to a
4093                            command, we do not complain about the ``C-x
4094                            button1'' sequence.  If neither ``C-x
4095                            button1'' nor ``C-x button1up'' is bound to a
4096                            command, then we complain about the ``C-x
4097                            button1'' sequence, but later will *not*
4098                            complain about the ``C-x button1up''
4099                            sequence, which would be redundant.
4100
4101                            This is pretty hairy, but I think it's the
4102                            most intuitive behavior.
4103                         */
4104                         Lisp_Object terminal =
4105                                 command_builder->most_current_event;
4106
4107                         if (XEVENT_TYPE(terminal) == button_press_event) {
4108                                 int no_bitching;
4109                                 /* Temporarily pretend the last event
4110                                    was an "up" instead of a "down", and
4111                                    look up its binding. */
4112                                 XEVENT_TYPE(terminal) =
4113                                         button_release_event;
4114                                 /* If the "up" version is bound, don't
4115                                    complain. */
4116                                 no_bitching
4117                                         =
4118                                         !NILP(command_builder_find_leaf
4119                                               (command_builder, 0));
4120                                 /* Undo the temporary changes we just made. */
4121                                 XEVENT_TYPE(terminal) =
4122                                         button_press_event;
4123                                 if (no_bitching) {
4124                                         /* Pretend this press was not
4125                                            seen (treat as a prefix) */
4126                                         if (EQ
4127                                             (command_builder->
4128                                              current_events,
4129                                              terminal)) {
4130                                                 reset_current_events
4131                                                         (command_builder);
4132                                         } else {
4133                                                 Lisp_Object eve;
4134
4135                                                 EVENT_CHAIN_LOOP(eve,
4136                                                                  command_builder->
4137                                                                  current_events)
4138                                                         if (EQ
4139                                                             (XEVENT_NEXT
4140                                                              (eve),
4141                                                              terminal))
4142                                                                 break;
4143
4144                                                 Fdeallocate_event
4145                                                         (command_builder->
4146                                                          most_current_event);
4147                                                 XSET_EVENT_NEXT(eve,
4148                                                                 Qnil);
4149                                                 command_builder->
4150                                                         most_current_event =
4151                                                         eve;
4152                                         }
4153                                         maybe_echo_keys(command_builder,
4154                                                         1);
4155                                         break;
4156                                 }
4157                         }
4158
4159                         /* Complain that the typed sequence is not
4160                            defined, if this is the kind of sequence that
4161                            warrants a complaint. */
4162                         XCONSOLE(console)->defining_kbd_macro = Qnil;
4163                         XCONSOLE(console)->prefix_arg = Qnil;
4164                         /* Don't complain about undefined button-release
4165                            events */
4166                         if (XEVENT_TYPE(terminal) !=
4167                             button_release_event) {
4168                                 Lisp_Object keys =
4169                                         current_events_into_vector
4170                                         (command_builder);
4171                                 struct gcpro gcpro1;
4172
4173                                 /* Run the pre-command-hook before
4174                                    barfing about an undefined key. */
4175                                 Vthis_command = Qnil;
4176                                 GCPRO1(keys);
4177                                 pre_command_hook();
4178                                 UNGCPRO;
4179                                 /* The post-command-hook doesn't run. */
4180                                 Fsignal(Qundefined_keystroke_sequence,
4181                                         list1(keys));
4182                         }
4183                         /* Reset the command builder for reading the
4184                            next sequence. */
4185                         reset_this_command_keys(console, 1);
4186                 } else {        /* key sequence is bound to a command */
4187
4188                         int magic_undo = 0;
4189                         int magic_undo_count = 20;
4190
4191                         Vthis_command = leaf;
4192
4193                         /* Don't push an undo boundary if the command
4194                            set the prefix arg, or if we are executing a
4195                            keyboard macro, or if in the minibuffer.  If
4196                            the command we are about to execute is
4197                            self-insert, it's tricky: up to 20
4198                            consecutive self-inserts may be done without
4199                            an undo boundary.  This counter is reset as
4200                            soon as a command other than
4201                            self-insert-command is executed.
4202
4203                            Programmers can also use the
4204                            `self-insert-defer-undo' property to install
4205                            that behavior on functions other than
4206                            `self-insert-command', or to change the magic
4207                            number 20 to something else.  #### DOCUMENT
4208                            THIS!  */
4209
4210                         if (SYMBOLP(leaf)) {
4211                                 Lisp_Object prop =
4212                                         Fget(leaf, Qself_insert_defer_undo,
4213                                              Qnil);
4214                                 if (NATNUMP(prop))
4215                                         magic_undo =
4216                                                 1, magic_undo_count =
4217                                                 XINT(prop);
4218                                 else if (!NILP(prop))
4219                                         magic_undo = 1;
4220                                 else if (EQ(leaf, Qself_insert_command))
4221                                         magic_undo = 1;
4222                         }
4223
4224                         if (!magic_undo)
4225                                 command_builder->self_insert_countdown =
4226                                         0;
4227                         if (NILP(XCONSOLE(console)->prefix_arg)
4228                             && NILP(Vexecuting_macro)
4229                             && command_builder->self_insert_countdown ==
4230                             0)
4231                                 Fundo_boundary();
4232
4233                         if (magic_undo) {
4234                                 if (--command_builder->
4235                                     self_insert_countdown < 0)
4236                                         command_builder->
4237                                                 self_insert_countdown =
4238                                                 magic_undo_count;
4239                         }
4240                         execute_command_event
4241                                 (command_builder,
4242                                  internal_equal(event,
4243                                                 command_builder->
4244                                                 most_current_event, 0)
4245                                  ? event
4246                                  /* Use the translated event that was most
4247                                     recently seen.  This way,
4248                                     last-command-event becomes f1 instead of
4249                                     the P from ESC O P.  But we must copy
4250                                     it, else we'll lose when the
4251                                     command-builder events are
4252                                     deallocated. */
4253                                  : Fcopy_event(command_builder->
4254                                                most_current_event, Qnil));
4255                 }
4256                 break;
4257         }
4258         case misc_user_event: {
4259                 /* Jamie said:
4260
4261                    We could just always use the menu item entry,
4262                    whatever it is, but this might break some Lisp code
4263                    that expects `this-command' to always contain a
4264                    symbol.  So only store it if this is a simple
4265                    `call-interactively' sort of menu item.
4266
4267                    But this is bogus.  `this-command' could be a string
4268                    or vector anyway (for keyboard macros).  There's even
4269                    one instance (in pending-del.el) of `this-command'
4270                    getting set to a cons (a lambda expression).  So in
4271                    the `eval' case I'll just convert it into a lambda
4272                    expression.
4273                 */
4274                 if (EQ
4275                     (XEVENT(event)->event.eval.function,
4276                      Qcall_interactively)
4277                     && SYMBOLP(XEVENT(event)->event.eval.object)) {
4278                         Vthis_command =
4279                                 XEVENT(event)->event.eval.object;
4280                 } else if (EQ(XEVENT(event)->event.eval.function, Qeval)) {
4281                         Vthis_command =
4282                                 Fcons(Qlambda,
4283                                       Fcons(Qnil,
4284                                             XEVENT(event)->event.eval.
4285                                             object));
4286                 } else if (SYMBOLP(XEVENT(event)->event.eval.function)) {
4287                         /* A scrollbar command or the like. */
4288                         Vthis_command =
4289                                 XEVENT(event)->event.eval.function;
4290                 } else {
4291                         /* Huh? */
4292                         Vthis_command = Qnil;
4293                 }
4294
4295                 /* clear the echo area */
4296                 reset_key_echo(command_builder, 1);
4297
4298                 command_builder->self_insert_countdown = 0;
4299                 if (NILP(XCONSOLE(console)->prefix_arg)
4300                     && NILP(Vexecuting_macro)
4301                     && !EQ(minibuf_window, Fselected_window(Qnil)))
4302                         Fundo_boundary();
4303                 execute_command_event(command_builder, event);
4304                 break;
4305         }
4306 #ifdef EF_USE_ASYNEQ
4307         case eaten_myself_event:
4308                 /* try to find the worker in the workers dllist and pop it */
4309                 /* raw :( */
4310                 /* since this affects garbage collection, we better lock that
4311                    mutex, too */
4312                 lock_allocator();
4313                 WITH_DLLIST_TRAVERSE(
4314                         workers,
4315                         if (ev->event.eaten_myself.worker == dllist_item) {
4316                                 dllist_pop_inner(workers, _el);
4317                                 break;
4318                         });
4319                 unlock_allocator();
4320                 fini_worker(ev->event.eaten_myself.worker);
4321                 EQUEUE_DEBUG_WORKER("Successfully eaten 0x%lx\n",
4322                                     (long unsigned int)
4323                                     ev->event.eaten_myself.worker);
4324                 break;
4325         case work_started_event: {
4326                 Lisp_Object ljob = ev->event.work_started.job;
4327                 worker_job_t job = XWORKER_JOB(ljob);
4328                 work_handler_t hdl = XWORKER_JOB_HANDLER(ljob);
4329                 if (hdl && work_started(hdl))
4330                         work_started(hdl)(job);
4331                 break;
4332         }
4333         case work_finished_event: {
4334                 Lisp_Object ljob = ev->event.work_finished.job;
4335                 worker_job_t job = XWORKER_JOB(ljob);
4336                 work_handler_t hdl = XWORKER_JOB_HANDLER(ljob);
4337                 if (hdl && work_finished(hdl))
4338                         work_finished(hdl)(job);
4339                 break;
4340         }
4341 #endif
4342
4343                 /* and the rest */
4344         case empty_event:
4345         case pointer_motion_event:
4346         case process_event:
4347         case timeout_event:
4348         case magic_event:
4349         case magic_eval_event:
4350         case eval_event:
4351         case dead_event:
4352         default:
4353                 execute_internal_event(event);
4354                 break;
4355         }
4356         return Qnil;
4357 }
4358
4359 DEFUN("read-key-sequence", Fread_key_sequence, 1, 3, 0, /*
4360 Read a sequence of keystrokes or mouse clicks.
4361 Returns a vector of the event objects read.  The vector and the event
4362 objects it contains are freshly created (and so will not be side-effected
4363 by subsequent calls to this function).
4364
4365 The sequence read is sufficient to specify a non-prefix command starting
4366 from the current local and global keymaps.  A C-g typed while in this
4367 function is treated like any other character, and `quit-flag' is not set.
4368
4369 First arg PROMPT is a prompt string.  If nil, do not prompt specially.
4370
4371 Second optional arg CONTINUE-ECHO non-nil means this key echoes as a
4372 continuation of the previous key.
4373
4374 Third optional arg DONT-DOWNCASE-LAST non-nil means do not convert the
4375 last event to lower case.  (Normally any upper case event is converted
4376 to lower case if the original event is undefined and the lower case
4377 equivalent is defined.) This argument is provided mostly for FSF
4378 compatibility; the equivalent effect can be achieved more generally by
4379 binding `retry-undefined-key-binding-unshifted' to nil around the call
4380 to `read-key-sequence'.
4381
4382 If the user selects a menu item while we are prompting for a key-sequence,
4383 the returned value will be a vector of a single menu-selection event.
4384 An error will be signalled if you pass this value to `lookup-key' or a
4385 related function.
4386
4387 `read-key-sequence' checks `function-key-map' for function key
4388 sequences, where they wouldn't conflict with ordinary bindings.
4389 See `function-key-map' for more details.
4390 */
4391       (prompt, continue_echo, dont_downcase_last))
4392 {
4393         /* This function can GC */
4394         struct console *con = XCONSOLE(Vselected_console);      /* #### correct?
4395                                                                    Probably not -- see
4396                                                                    comment in
4397                                                                    next-event */
4398         struct command_builder *command_builder =
4399             XCOMMAND_BUILDER(con->command_builder);
4400         Lisp_Object result;
4401         Lisp_Object event = Fmake_event(Qnil, Qnil);
4402         int speccount = specpdl_depth();
4403         struct gcpro gcpro1;
4404         GCPRO1(event);
4405
4406         record_unwind_protect(Fset_buffer, Fcurrent_buffer());
4407         if (!NILP(prompt))
4408                 CHECK_STRING(prompt);
4409         /* else prompt = Fkeymap_prompt (current_buffer->keymap); may GC */
4410         QUIT;
4411
4412         if (NILP(continue_echo))
4413                 reset_this_command_keys(make_console(con), 1);
4414
4415         specbind(Qinhibit_quit, Qt);
4416
4417         if (!NILP(dont_downcase_last))
4418                 specbind(Qretry_undefined_key_binding_unshifted, Qnil);
4419
4420         for (;;) {
4421                 Fnext_event(event, prompt);
4422                 /* restore the selected-console damage */
4423                 con = event_console_or_selected(event);
4424                 command_builder = XCOMMAND_BUILDER(con->command_builder);
4425                 if (!command_event_p(event))
4426                         execute_internal_event(event);
4427                 else {
4428                         if (XEVENT(event)->event_type == misc_user_event)
4429                                 reset_current_events(command_builder);
4430                         result =
4431                             lookup_command_event(command_builder, event, 1);
4432                         if (!KEYMAPP(result)) {
4433                                 result =
4434                                     current_events_into_vector(command_builder);
4435                                 reset_key_echo(command_builder, 0);
4436                                 break;
4437                         }
4438                         prompt = Qnil;
4439                 }
4440         }
4441
4442         Vquit_flag = Qnil;      /* In case we read a ^G; do not call
4443                                    check_quit() here */
4444         Fdeallocate_event(event);
4445         RETURN_UNGCPRO(unbind_to(speccount, result));
4446 }
4447
4448 DEFUN("this-command-keys", Fthis_command_keys, 0, 0, 0, /*
4449 Return a vector of the keyboard or mouse button events that were used
4450 to invoke this command.  This copies the vector and the events; it is safe
4451 to keep and modify them.
4452 */
4453       ())
4454 {
4455         Lisp_Object event;
4456         Lisp_Object result;
4457         int len;
4458
4459         if (NILP(Vthis_command_keys))
4460                 return make_vector(0, Qnil);
4461
4462         len = event_chain_count(Vthis_command_keys);
4463
4464         result = make_vector(len, Qnil);
4465         len = 0;
4466         EVENT_CHAIN_LOOP(event, Vthis_command_keys)
4467             XVECTOR_DATA(result)[len++] = Fcopy_event(event, Qnil);
4468         return result;
4469 }
4470
4471 DEFUN("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0,       /*
4472 Used for complicated reasons in `universal-argument-other-key'.
4473
4474 `universal-argument-other-key' rereads the event just typed.
4475 It then gets translated through `function-key-map'.
4476 The translated event gets included in the echo area and in
4477 the value of `this-command-keys' in addition to the raw original event.
4478 That is not right.
4479
4480 Calling this function directs the translated event to replace
4481 the original event, so that only one version of the event actually
4482 appears in the echo area and in the value of `this-command-keys'.
4483 */
4484       ())
4485 {
4486         /* #### I don't understand this at all, so currently it does nothing.
4487            If there is ever a problem, maybe someone should investigate. */
4488         return Qnil;
4489 }
4490 \f
4491 static void dribble_out_event(Lisp_Object event)
4492 {
4493         if (NILP(Vdribble_file))
4494                 return;
4495
4496         if (XEVENT(event)->event_type == key_press_event &&
4497             !XEVENT(event)->event.key.modifiers) {
4498                 Lisp_Object keysym = XEVENT(event)->event.key.keysym;
4499                 if (CHARP(XEVENT(event)->event.key.keysym)) {
4500                         Emchar ch = XCHAR(keysym);
4501                         Bufbyte str[MAX_EMCHAR_LEN];
4502                         Bytecount len = set_charptr_emchar(str, ch);
4503                         Lstream_write(XLSTREAM(Vdribble_file), str, len);
4504                 } else if (string_char_length(XSYMBOL(keysym)->name) == 1)
4505                         /* one-char key events are printed with just the key name */
4506                         Fprinc(keysym, Vdribble_file);
4507                 else if (EQ(keysym, Qreturn))
4508                         Lstream_putc(XLSTREAM(Vdribble_file), '\n');
4509                 else if (EQ(keysym, Qspace))
4510                         Lstream_putc(XLSTREAM(Vdribble_file), ' ');
4511                 else
4512                         Fprinc(event, Vdribble_file);
4513         } else
4514                 Fprinc(event, Vdribble_file);
4515         Lstream_flush(XLSTREAM(Vdribble_file));
4516 }
4517
4518 DEFUN("open-dribble-file", Fopen_dribble_file, 1, 1, "FOpen dribble file: ",    /*
4519 Start writing all keyboard characters to a dribble file called FILENAME.
4520 If FILENAME is nil, close any open dribble file.
4521 */
4522       (filename))
4523 {
4524         /* This function can GC */
4525         /* XEmacs change: always close existing dribble file. */
4526         /* FSFmacs uses FILE *'s here.  With lstreams, that's unnecessary. */
4527         if (!NILP(Vdribble_file)) {
4528                 Lstream_close(XLSTREAM(Vdribble_file));
4529                 Vdribble_file = Qnil;
4530         }
4531         if (!NILP(filename)) {
4532                 int fd;
4533
4534                 filename = Fexpand_file_name(filename, Qnil);
4535                 fd = open((char *)XSTRING_DATA(filename),
4536                           O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4537                           CREAT_MODE);
4538                 if (fd < 0)
4539                         error("Unable to create dribble file");
4540                 Vdribble_file =
4541                     make_filedesc_output_stream(fd, 0, 0, LSTR_CLOSING);
4542 #ifdef MULE
4543                 Vdribble_file =
4544                     make_encoding_output_stream(XLSTREAM(Vdribble_file),
4545                                                 Fget_coding_system
4546                                                 (Qescape_quoted));
4547 #endif
4548         }
4549         return Qnil;
4550 }
4551 \f
4552 DEFUN("current-event-timestamp", Fcurrent_event_timestamp, 0, 1, 0,     /*
4553 Return the current event timestamp of the window system associated with CONSOLE.
4554 CONSOLE defaults to the selected console if omitted.
4555 */
4556       (console))
4557 {
4558         struct console *c = decode_console(console);
4559         int tiempo = event_stream_current_event_timestamp(c);
4560
4561         /* This junk is so that timestamps don't get to be negative, but contain
4562            as many bits as this particular emacs will allow.
4563          */
4564         return make_int(EMACS_INT_MAX & tiempo);
4565 }
4566
4567 \f
4568 /* generalised asynchronous worker queue */
4569 #if defined(EF_USE_ASYNEQ)
4570 void
4571 asyneq_handle_event(event_queue_t eq)
4572 {
4573         if (!eq_queue_empty_p(eq)) {
4574                 Lisp_Object eqev = eq_dequeue(eq);
4575                 Fdispatch_event(eqev);
4576         }
4577 }
4578
4579 void
4580 asyneq_handle_non_command_event(event_queue_t eq)
4581 {
4582         Lisp_Object eqev = Qnil;
4583
4584         WITH_DLLIST_TRAVERSE(
4585                 eq_queue(eq),
4586                 if (!command_event_p((Lisp_Object)dllist_item)) {
4587                         eqev = (Lisp_Object)dllist_pop_inner(eq_queue(eq), _el);
4588                         break;
4589                 });
4590
4591         if (!NILP(eqev))
4592                 execute_internal_event(eqev);
4593 }
4594 #endif
4595 \f
4596 /************************************************************************/
4597 /*                            initialization                            */
4598 /************************************************************************/
4599
4600 void syms_of_event_stream(void)
4601 {
4602         INIT_LRECORD_IMPLEMENTATION(command_builder);
4603         INIT_LRECORD_IMPLEMENTATION(timeout);
4604
4605         defsymbol(&Qdisabled, "disabled");
4606         defsymbol(&Qcommand_event_p, "command-event-p");
4607
4608         DEFERROR_STANDARD(Qundefined_keystroke_sequence, Qinvalid_argument);
4609
4610         DEFSUBR(Frecent_keys);
4611         DEFSUBR(Frecent_keys_ring_size);
4612         DEFSUBR(Fset_recent_keys_ring_size);
4613         DEFSUBR(Finput_pending_p);
4614         DEFSUBR(Fenqueue_eval_event);
4615         DEFSUBR(Fnext_event);
4616         DEFSUBR(Fnext_command_event);
4617         DEFSUBR(Fdiscard_input);
4618         DEFSUBR(Fsit_for);
4619         DEFSUBR(Fsleep_for);
4620         DEFSUBR(Faccept_process_output);
4621         DEFSUBR(Fadd_timeout);
4622         DEFSUBR(Fdisable_timeout);
4623         DEFSUBR(Fadd_async_timeout);
4624         DEFSUBR(Fdisable_async_timeout);
4625         DEFSUBR(Fdispatch_event);
4626         DEFSUBR(Fdispatch_non_command_events);
4627         DEFSUBR(Fread_key_sequence);
4628         DEFSUBR(Fthis_command_keys);
4629         DEFSUBR(Freset_this_command_lengths);
4630         DEFSUBR(Fopen_dribble_file);
4631         DEFSUBR(Fcurrent_event_timestamp);
4632
4633         defsymbol(&Qpre_command_hook, "pre-command-hook");
4634         defsymbol(&Qpost_command_hook, "post-command-hook");
4635         defsymbol(&Qunread_command_events, "unread-command-events");
4636         defsymbol(&Qunread_command_event, "unread-command-event");
4637         defsymbol(&Qpre_idle_hook, "pre-idle-hook");
4638         defsymbol(&Qhandle_pre_motion_command, "handle-pre-motion-command");
4639         defsymbol(&Qhandle_post_motion_command, "handle-post-motion-command");
4640         defsymbol(&Qretry_undefined_key_binding_unshifted,
4641                   "retry-undefined-key-binding-unshifted");
4642         defsymbol(&Qauto_show_make_point_visible,
4643                   "auto-show-make-point-visible");
4644
4645         defsymbol(&Qself_insert_defer_undo, "self-insert-defer-undo");
4646         defsymbol(&Qcancel_mode_internal, "cancel-mode-internal");
4647 }
4648
4649 void reinit_vars_of_event_stream(void)
4650 {
4651         recent_keys_ring_index = 0;
4652         recent_keys_ring_size = 100;
4653         num_input_chars = 0;
4654 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
4655         Vtimeout_free_list = make_lcrecord_list(sizeof(Lisp_Timeout),
4656                                                 &lrecord_timeout);
4657         staticpro_nodump(&Vtimeout_free_list);
4658 #endif  /* !BDWGC */
4659         the_low_level_timeout_blocktype =
4660                 Blocktype_new(struct low_level_timeout_blocktype);
4661         something_happened = 0;
4662         recursive_sit_for = Qnil;
4663
4664 #if defined(EF_USE_ASYNEQ)
4665         /* the main event queue */
4666         asyneq = make_event_queue();
4667         XSETEVENT_QUEUE(Vasyneq, asyneq);
4668         staticpro_nodump(&Vasyneq);
4669 #endif  /* EF_USE_ASYNEQ */
4670 }
4671
4672 void vars_of_event_stream(void)
4673 {
4674         reinit_vars_of_event_stream();
4675         Vrecent_keys_ring = Qnil;
4676         staticpro(&Vrecent_keys_ring);
4677
4678         Vthis_command_keys = Qnil;
4679         staticpro(&Vthis_command_keys);
4680         Vthis_command_keys_tail = Qnil;
4681         dump_add_root_object(&Vthis_command_keys_tail);
4682
4683 #ifndef EF_USE_ASYNEQ
4684         command_event_queue = Qnil;
4685         staticpro(&command_event_queue);
4686         command_event_queue_tail = Qnil;
4687         dump_add_root_object(&command_event_queue_tail);
4688 #endif
4689
4690         Vlast_selected_frame = Qnil;
4691         staticpro(&Vlast_selected_frame);
4692
4693         pending_timeout_list = Qnil;
4694         staticpro(&pending_timeout_list);
4695
4696         pending_async_timeout_list = Qnil;
4697         staticpro(&pending_async_timeout_list);
4698
4699         last_point_position_buffer = Qnil;
4700         staticpro(&last_point_position_buffer);
4701
4702         DEFVAR_LISP("echo-keystrokes", &Vecho_keystrokes        /*
4703 *Nonzero means echo unfinished commands after this many seconds of pause.
4704                                                                  */ );
4705         Vecho_keystrokes = make_int(1);
4706
4707         DEFVAR_INT("auto-save-interval", &auto_save_interval    /*
4708 *Number of keyboard input characters between auto-saves.
4709 Zero means disable autosaving due to number of characters typed.
4710 See also the variable `auto-save-timeout'.
4711                                                                  */ );
4712         auto_save_interval = 300;
4713
4714         DEFVAR_LISP("pre-command-hook", &Vpre_command_hook      /*
4715 Function or functions to run before every command.
4716 This may examine the `this-command' variable to find out what command
4717 is about to be run, or may change it to cause a different command to run.
4718 Function on this hook must be careful to avoid signalling errors!
4719                                                                  */ );
4720         Vpre_command_hook = Qnil;
4721
4722         DEFVAR_LISP("post-command-hook", &Vpost_command_hook    /*
4723 Function or functions to run after every command.
4724 This may examine the `this-command' variable to find out what command
4725 was just executed.
4726                                                                  */ );
4727         Vpost_command_hook = Qnil;
4728
4729         DEFVAR_LISP("pre-idle-hook", &Vpre_idle_hook    /*
4730 Normal hook run when SXEmacs it about to be idle.
4731 This occurs whenever it is going to block, waiting for an event.
4732 This generally happens as a result of a call to `next-event',
4733 `next-command-event', `sit-for', `sleep-for', `accept-process-output',
4734 or `x-get-selection'.
4735
4736 Errors running the hook are caught and ignored.
4737                                                          */ );
4738         Vpre_idle_hook = Qnil;
4739
4740         DEFVAR_BOOL("focus-follows-mouse", &focus_follows_mouse /*
4741 *Variable to control SXEmacs behavior with respect to focus changing.
4742 If this variable is set to t, then SXEmacs will not gratuitously change
4743 the keyboard focus.  SXEmacs cannot in general detect when this mode is
4744 used by the window manager, so it is up to the user to set it.
4745                                                                  */ );
4746         focus_follows_mouse = 0;
4747
4748         DEFVAR_LISP("last-command-event", &Vlast_command_event  /*
4749 Last keyboard or mouse button event that was part of a command.  This
4750 variable is off limits: you may not set its value or modify the event that
4751 is its value, as it is destructively modified by `read-key-sequence'.  If
4752 you want to keep a pointer to this value, you must use `copy-event'.
4753                                                                  */ );
4754         Vlast_command_event = Qnil;
4755
4756         DEFVAR_LISP("last-command-char", &Vlast_command_char    /*
4757 If the value of `last-command-event' is a keyboard event, then
4758 this is the nearest ASCII equivalent to it.  This is the value that
4759 `self-insert-command' will put in the buffer.  Remember that there is
4760 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
4761 of keyboard events is much larger, so writing code that examines this
4762 variable to determine what key has been typed is bad practice, unless
4763 you are certain that it will be one of a small set of characters.
4764                                                                  */ );
4765         Vlast_command_char = Qnil;
4766
4767         DEFVAR_LISP("last-input-event", &Vlast_input_event      /*
4768 Last keyboard or mouse button event received.  This variable is off
4769 limits: you may not set its value or modify the event that is its value, as
4770 it is destructively modified by `next-event'.  If you want to keep a pointer
4771 to this value, you must use `copy-event'.
4772                                                                  */ );
4773         Vlast_input_event = Qnil;
4774
4775         DEFVAR_LISP("current-mouse-event", &Vcurrent_mouse_event        /*
4776 The mouse-button event which invoked this command, or nil.
4777 This is usually what `(interactive "e")' returns.
4778                                                                          */ );
4779         Vcurrent_mouse_event = Qnil;
4780
4781         DEFVAR_LISP("last-input-char", &Vlast_input_char        /*
4782 If the value of `last-input-event' is a keyboard event, then
4783 this is the nearest ASCII equivalent to it.  Remember that there is
4784 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
4785 of keyboard events is much larger, so writing code that examines this
4786 variable to determine what key has been typed is bad practice, unless
4787 you are certain that it will be one of a small set of characters.
4788                                                                  */ );
4789         Vlast_input_char = Qnil;
4790
4791         DEFVAR_LISP("last-input-time", &Vlast_input_time        /*
4792 The time (in seconds since Jan 1, 1970) of the last-command-event,
4793 represented as a cons of two 16-bit integers.  This is destructively
4794 modified, so copy it if you want to keep it.
4795                                                                  */ );
4796         Vlast_input_time = Qnil;
4797
4798         DEFVAR_LISP("last-command-event-time", &Vlast_command_event_time        /*
4799 The time (in seconds since Jan 1, 1970) of the last-command-event,
4800 represented as a list of three integers.  The first integer contains
4801 the most significant 16 bits of the number of seconds, and the second
4802 integer contains the least significant 16 bits.  The third integer
4803 contains the remainder number of microseconds, if the current system
4804 supports microsecond clock resolution.  This list is destructively
4805 modified, so copy it if you want to keep it.
4806                                                                                  */ );
4807         Vlast_command_event_time = Qnil;
4808
4809         DEFVAR_LISP("unread-command-events", &Vunread_command_events    /*
4810 List of event objects to be read as next command input events.
4811 This can be used to simulate the receipt of events from the user.
4812 Normally this is nil.
4813 Events are removed from the front of this list.
4814                                                                          */ );
4815         Vunread_command_events = Qnil;
4816
4817         DEFVAR_LISP("unread-command-event", &Vunread_command_event      /*
4818 Obsolete.  Use `unread-command-events' instead.
4819                                                                          */ );
4820         Vunread_command_event = Qnil;
4821
4822         DEFVAR_LISP("last-command", &Vlast_command      /*
4823 The last command executed.  Normally a symbol with a function definition,
4824 but can be whatever was found in the keymap, or whatever the variable
4825 `this-command' was set to by that command.
4826                                                          */ );
4827         Vlast_command = Qnil;
4828
4829         DEFVAR_LISP("this-command", &Vthis_command      /*
4830 The command now being executed.
4831 The command can set this variable; whatever is put here
4832 will be in `last-command' during the following command.
4833                                                          */ );
4834         Vthis_command = Qnil;
4835
4836         DEFVAR_LISP("last-command-properties", &Vlast_command_properties        /*
4837 Value of `this-command-properties' for the last command.
4838 Used by commands to help synchronize consecutive commands, in preference
4839 to looking at `last-command' directly.
4840                                                                                  */ );
4841         Vlast_command_properties = Qnil;
4842
4843         DEFVAR_LISP("this-command-properties", &Vthis_command_properties        /*
4844 Properties set by the current command.
4845 At the beginning of each command, the current value of this variable is
4846 copied to `last-command-properties', and then it is set to nil.  Use `putf'
4847 to add properties to this variable.  Commands should use this to communicate
4848 with pre/post-command hooks, subsequent commands, wrapping commands, etc.
4849 in preference to looking at and/or setting `this-command'.
4850                                                                                  */ );
4851         Vthis_command_properties = Qnil;
4852
4853         DEFVAR_LISP("help-char", &Vhelp_char    /*
4854 Character to recognize as meaning Help.
4855 When it is read, do `(eval help-form)', and display result if it's a string.
4856 If the value of `help-form' is nil, this char can be read normally.
4857 This can be any form recognized as a single key specifier.
4858 The help-char cannot be a negative number in SXEmacs.
4859                                                  */ );
4860         Vhelp_char = make_char(8);      /* C-h */
4861
4862         DEFVAR_LISP("help-form", &Vhelp_form    /*
4863 Form to execute when character help-char is read.
4864 If the form returns a string, that string is displayed.
4865 If `help-form' is nil, the help char is not recognized.
4866                                                  */ );
4867         Vhelp_form = Qnil;
4868
4869         DEFVAR_LISP("prefix-help-command", &Vprefix_help_command        /*
4870 Command to run when `help-char' character follows a prefix key.
4871 This command is used only when there is no actual binding
4872 for that character after that prefix key.
4873                                                                          */ );
4874         Vprefix_help_command = Qnil;
4875
4876         DEFVAR_CONST_LISP("keyboard-translate-table", &Vkeyboard_translate_table        /*
4877 sh table used as translate table for keyboard input.
4878 e `keyboard-translate' to portably add entries to this table.
4879 ch key-press event is looked up in this table as follows:
4880
4881 -- If an entry maps a symbol to a symbol, then a key-press event whose
4882    keysym is the former symbol (with any modifiers at all) gets its
4883    keysym changed and its modifiers left alone.  This is useful for
4884    dealing with non-standard X keyboards, such as the grievous damage
4885    that Sun has inflicted upon the world.
4886
4887 -- If an entry maps a symbol to a character, then a key-press event
4888    whose keysym is the former symbol (with any modifiers at all) gets
4889    changed into a key-press event matching the latter character, and the
4890    resulting modifiers are the union of the original and new modifiers.
4891
4892 -- If an entry maps a character to a character, then a key-press event
4893    matching the former character gets converted to a key-press event
4894    matching the latter character.  This is useful on ASCII terminals
4895    for (e.g.) making C-\\ look like C-s, to get around flow-control
4896    problems.
4897
4898 -- If an entry maps a character to a symbol, then a key-press event
4899    matching the character gets converted to a key-press event whose
4900    keysym is the given symbol and which has no modifiers.
4901
4902 re's an example: This makes typing parens and braces easier by rerouting
4903 eir positions to eliminate the need to use the Shift key.
4904
4905 (keyboard-translate ?[ ?()
4906 (keyboard-translate ?] ?))
4907 (keyboard-translate ?{ ?[)
4908 (keyboard-translate ?} ?])
4909 (keyboard-translate 'f11 ?{)
4910 (keyboard-translate 'f12 ?})
4911                                                                                          */ );
4912
4913         DEFVAR_LISP("retry-undefined-key-binding-unshifted", &Vretry_undefined_key_binding_unshifted    /*
4914 If a key-sequence which ends with a shifted keystroke is undefined
4915 and this variable is non-nil then the command lookup is retried again
4916 with the last key unshifted.  (e.g. C-X C-F would be retried as C-X C-f.)
4917 If lookup still fails, a normal error is signalled.  In general,
4918 you should *bind* this, not set it.
4919                                                                                                          */ );
4920         Vretry_undefined_key_binding_unshifted = Qt;
4921
4922         DEFVAR_BOOL("modifier-keys-are-sticky", &modifier_keys_are_sticky       /*
4923 *Non-nil makes modifier keys sticky.
4924 This means that you can release the modifier key before pressing down
4925 the key that you wish to be modified.  Although this is non-standard
4926 behavior, it is recommended because it reduces the strain on your hand,
4927 thus reducing the incidence of the dreaded Emacs-pinky syndrome.
4928
4929 Modifier keys are sticky within the inverval specified by
4930 `modifier-keys-sticky-time'.
4931                     */ );
4932         modifier_keys_are_sticky = 0;
4933
4934         DEFVAR_LISP("modifier-keys-sticky-time", 
4935                     &Vmodifier_keys_sticky_time /*
4936 *Modifier keys are sticky within this many milliseconds.
4937 If you don't want modifier keys sticking to be bounded, set this to
4938 non-integer value.
4939
4940 This variable has no effect when `modifier-keys-are-sticky' is nil.
4941 Currently only implemented under X Window System.
4942                                                 */ );
4943         Vmodifier_keys_sticky_time = make_int(500);
4944
4945 #ifdef HAVE_XIM
4946         DEFVAR_LISP("composed-character-default-binding", 
4947                     &Vcomposed_character_default_binding        /*
4948 The default keybinding to use for key events from composed input.
4949 Window systems frequently have ways to allow the user to compose
4950 single characters in a language using multiple keystrokes.
4951 SXEmacs sees these as single character keypress events.
4952                                                                 */ );
4953         Vcomposed_character_default_binding = Qself_insert_command;
4954 #endif                          /* HAVE_XIM */
4955
4956         Vcontrolling_terminal = Qnil;
4957         staticpro(&Vcontrolling_terminal);
4958
4959         Vdribble_file = Qnil;
4960         staticpro(&Vdribble_file);
4961
4962 #ifdef DEBUG_SXEMACS
4963         DEFVAR_INT("debug-emacs-events", &debug_emacs_events    /*
4964 o, display debug information about Emacs events that SXEmacs sees.
4965 n is displayed on stderr.
4966
4967  event, the source of the event is displayed in parentheses,
4968  of the following:
4969
4970 real event from the window system or
4971 rminal driver, as far as SXEmacs can tell.
4972
4973  macro) An event generated from a keyboard macro.
4974
4975 ommand-events) An event taken from `unread-command-events'.
4976
4977 ommand-event) An event taken from `unread-command-event'.
4978
4979 event queue) An event taken from an internal queue.
4980              Events end up on this queue when
4981              `enqueue-eval-event' is called or when
4982              user or eval events are received while
4983              SXEmacs is blocking (e.g. in `sit-for',
4984              `sleep-for', or `accept-process-output',
4985              or while waiting for the reply to an
4986              X selection).
4987
4988 rd-translate-table) The result of an event translated 
4989                     through keyboard-translate-table.  Note 
4990                     that in this case, two events are 
4991                     printed even though only one is really
4992                     generated.
4993
4994 A faked C-g resulting when SXEmacs receives
4995 a SIGINT (e.g. C-c was pressed in SXEmacs'
4996 controlling terminal or the signal was
4997 explicitly sent to the SXEmacs process).
4998                                                                 */ );
4999         debug_emacs_events = 0;
5000 #endif
5001
5002         DEFVAR_BOOL("inhibit-input-event-recording",
5003                     &inhibit_input_event_recording      /*
5004 Non-nil inhibits recording of input-events to recent-keys ring.
5005                                                         */ );
5006         inhibit_input_event_recording = 0;
5007 }
5008
5009 void complex_vars_of_event_stream(void)
5010 {
5011         Vkeyboard_translate_table =
5012             make_lisp_hash_table(100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
5013 }
5014
5015 void init_event_stream(void)
5016 {
5017         if (initialized) {
5018 #ifdef HAVE_UNIXOID_EVENT_LOOP
5019                 init_event_unixoid();
5020 #endif
5021 #ifdef HAVE_X_WINDOWS
5022                 if (!strcmp(display_use, "x"))
5023                         init_event_Xt_late();
5024                 else
5025 #endif
5026 #ifdef HAVE_GTK
5027                 if (!strcmp(display_use, "gtk"))
5028                         init_event_gtk_late();
5029                 else
5030 #endif
5031                 {
5032                         /* For TTY's, use the Xt event loop if we can; it allows
5033                            us to later open an X connection. */
5034 #if defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
5035                         init_event_Xt_late();
5036 #elif defined (HAVE_TTY)
5037                         init_event_tty_late();
5038 #endif
5039                 }
5040                 init_interrupts_late();
5041         }
5042 }
5043 \f
5044 /*
5045 useful testcases for v18/v19 compatibility:
5046
5047 (defun foo ()
5048  (interactive)
5049  (setq unread-command-event (character-to-event ?A (allocate-event)))
5050  (setq x (list (read-char)
5051 ;         (read-key-sequence "") ; try it with and without this
5052           last-command-char last-input-char
5053           (recent-keys) (this-command-keys))))
5054 (global-set-key "\^Q" 'foo)
5055
5056 without the read-key-sequence:
5057   ^Q            ==>  (?A ?\^Q ?A [... ^Q] [^Q])
5058   ^U^U^Q        ==>  (?A ?\^Q ?A [... ^U ^U ^Q] [^U ^U ^Q])
5059   ^U^U^U^G^Q    ==>  (?A ?\^Q ?A [... ^U ^U ^U ^G ^Q] [^Q])
5060
5061 with the read-key-sequence:
5062   ^Qb           ==>  (?A [b] ?\^Q ?b [... ^Q b] [b])
5063   ^U^U^Qb       ==>  (?A [b] ?\^Q ?b [... ^U ^U ^Q b] [b])
5064   ^U^U^U^G^Qb   ==>  (?A [b] ?\^Q ?b [... ^U ^U ^U ^G ^Q b] [b])
5065
5066 ;the evi-mode command "4dlj.j.j.j.j.j." is also a good testcase (gag)
5067
5068 ;(setq x (list (read-char) quit-flag))^J^G
5069 ;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G
5070 ;for BOTH, x should get set to (7 t), but no result should be printed.
5071 ;; #### According to the doc of quit-flag, second test should return
5072 ;; (?\^G nil).  Accidentaly SXEmacs returns correct value.  However,
5073 ;; XEmacs 21.1.12 and 21.2.36 both fails on first test.
5074
5075 ;also do this: make two frames, one viewing "*scratch*", the other "foo".
5076 ;in *scratch*, type (sit-for 20)^J
5077 ;wait a couple of seconds, move cursor to foo, type "a"
5078 ;a should be inserted in foo.  Cursor highlighting should not change in
5079 ;the meantime.
5080
5081 ;do it with sleep-for.  move cursor into foo, then back into *scratch*
5082 ;before typing.
5083 ;repeat also with (accept-process-output nil 20)
5084
5085 ;make sure ^G aborts sit-for, sleep-for and accept-process-output:
5086
5087  (defun tst ()
5088   (list (condition-case c
5089             (sleep-for 20)
5090           (quit c))
5091         (read-char)))
5092
5093  (tst)^Ja^G    ==>  ((quit) ?a) with no signal
5094  (tst)^J^Ga    ==>  ((quit) ?a) with no signal
5095  (tst)^Jabc^G  ==>  ((quit) ?a) with no signal, and "bc" inserted in buffer
5096
5097 ; with sit-for only do the 2nd test.
5098 ; Do all 3 tests with (accept-process-output nil 20)
5099
5100 Do this:
5101   (setq enable-recursive-minibuffers t
5102       minibuffer-max-depth nil)
5103  ESC ESC ESC ESC        - there are now two minibuffers active
5104  C-g C-g C-g            - there should be active 0, not 1
5105 Similarly:
5106  C-x C-f ~ / ?          - wait for "Making completion list..." to display
5107  C-g                    - wait for "Quit" to display
5108  C-g                    - minibuffer should not be active
5109 however C-g before "Quit" is displayed should leave minibuffer active.
5110
5111 ;do it all in both v18 and v19 and make sure all results are the same.
5112 ;all of these cases matter a lot, but some in quite subtle ways.
5113 */
5114
5115 /*
5116 Additional test cases for accept-process-output, sleep-for, sit-for.
5117 Be sure you do all of the above checking for C-g and focus, too!
5118
5119 ; Make sure that timer handlers are run during, not after sit-for:
5120 (defun timer-check ()
5121   (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil)
5122   (sit-for 5)
5123   (message "after sit-for"))
5124
5125 ; The first message should appear after 2 seconds, and the final message
5126 ; 3 seconds after that.
5127 ; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
5128
5129 ; Make sure that process filters are run during, not after sit-for.
5130 (defun fubar ()
5131   (message "sit-for = %s" (sit-for 30)))
5132 (add-hook 'post-command-hook 'fubar)
5133
5134 ; Now type M-x shell RET
5135 ; wait for the shell prompt then send: ls RET
5136 ; the output of ls should fill immediately, and not wait 30 seconds.
5137
5138 ; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
5139
5140 ; Make sure that recursive invocations return immediately:
5141 (defmacro test-diff-time (start end)
5142   `(+ (* (- (car ,end) (car ,start)) 65536.0)
5143       (- (cadr ,end) (cadr ,start))
5144       (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
5145
5146 (defun testee (ignore)
5147   (sit-for 10))
5148
5149 (defun test-them ()
5150   (let ((start (current-time))
5151         end)
5152     (add-timeout 2 'testee nil)
5153     (sit-for 5)
5154     (add-timeout 2 'testee nil)
5155     (sleep-for 5)
5156     (add-timeout 2 'testee nil)
5157     (accept-process-output nil 5)
5158     (setq end (current-time))
5159     (test-diff-time start end)))
5160
5161 (test-them) should sit for 15 seconds.
5162 Repeat with testee set to sleep-for and accept-process-output.
5163 These should each delay 36 seconds.
5164
5165 */