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