1 /* The portable interface to event streams.
2 Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Board of Trustees, University of Illinois.
4 Copyright (C) 1995 Sun Microsystems, Inc.
5 Copyright (C) 1995, 1996 Ben Wing.
7 This file is part of SXEmacs
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.
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.
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/>. */
23 /* Synched up with: Not in FSF. */
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?.
39 /* This file has been Mule-ized. */
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.
52 This stuff is way too hard to maintain - needs rework.
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.
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).
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?
67 After prefix-help is run, one should be able to CONTINUE TYPING,
68 instead of RETYPING, the key sequence.
74 #include "mem/blocktype.h"
77 #include "ui/device.h"
79 #define INCLUDE_EVENTS_H_PRIVATE_SPHERE
82 #include "ui/insdel.h" /* for buffer_reset_changes */
83 #include "ui/keymap.h"
85 #include "macros.h" /* for defining_keyboard_macro */
86 #include "ui/menubar.h" /* #### for evil kludges. */
88 #include "ui/window.h"
90 #include "sysdep.h" /* init_poll_for_quit() */
91 #include "syssignal.h" /* SIGCHLD, etc. */
93 #include "systime.h" /* to set Vlast_input_time */
95 #include "events-mod.h"
97 #include "event-queue.h"
99 #include "worker-asyneq.h"
102 #include "mule/file-coding.h"
107 /* The number of keystrokes between auto-saves. */
108 static Fixnum auto_save_interval;
110 Lisp_Object Qundefined_keystroke_sequence;
112 Lisp_Object Qcommand_event_p;
114 /* Hooks to run before and after each command. */
115 Lisp_Object Vpre_command_hook, Vpost_command_hook;
116 Lisp_Object Qpre_command_hook, Qpost_command_hook;
119 Lisp_Object Qhandle_pre_motion_command, Qhandle_post_motion_command;
121 /* Hook run when SXEmacs is about to be idle. */
122 Lisp_Object Qpre_idle_hook, Vpre_idle_hook;
124 /* Control gratuitous keyboard focus throwing. */
125 int focus_follows_mouse;
127 /* When true, modifier keys are sticky. */
128 int modifier_keys_are_sticky;
129 /* Modifier keys are sticky for this many milliseconds. */
130 Lisp_Object Vmodifier_keys_sticky_time;
132 /* Here FSF Emacs 20.7 defines Vpost_command_idle_hook,
133 post_command_idle_delay, Vdeferred_action_list, and
134 Vdeferred_action_function, but we don't because that stuff is crap,
135 and we're smarter than them, and their momas are fat. */
137 /* FSF Emacs 20.7 also defines Vinput_method_function,
138 Qinput_method_exit_on_first_char and Qinput_method_use_echo_area.
139 I don't know this should be imported or not. */
141 /* Non-nil disable property on a command means
142 do not execute it; call disabled-command-hook's value instead. */
143 Lisp_Object Qdisabled, Vdisabled_command_hook;
145 EXFUN(Fnext_command_event, 2);
147 static void pre_command_hook(void);
148 static void post_command_hook(void);
150 /* Last keyboard or mouse input event read as a command. */
151 Lisp_Object Vlast_command_event;
153 /* The nearest ASCII equivalent of the above. */
154 Lisp_Object Vlast_command_char;
156 /* Last keyboard or mouse event read for any purpose. */
157 Lisp_Object Vlast_input_event;
159 /* The nearest ASCII equivalent of the above. */
160 Lisp_Object Vlast_input_char;
162 Lisp_Object Vcurrent_mouse_event;
164 /* This is fbound in cmdloop.el, see the commentary there */
165 Lisp_Object Qcancel_mode_internal;
167 /* If not Qnil, event objects to be read as the next command input */
168 Lisp_Object Vunread_command_events;
169 Lisp_Object Vunread_command_event; /* obsoleteness support */
171 static Lisp_Object Qunread_command_events, Qunread_command_event;
173 /* Previous command, represented by a Lisp object.
174 Does not include prefix commands and arg setting commands. */
175 Lisp_Object Vlast_command;
177 /* Contents of this-command-properties for the last command. */
178 Lisp_Object Vlast_command_properties;
180 /* If a command sets this, the value goes into
181 last-command for the next command. */
182 Lisp_Object Vthis_command;
184 /* If a command sets this, the value goes into
185 last-command-properties for the next command. */
186 Lisp_Object Vthis_command_properties;
188 /* The value of point when the last command was executed. */
189 Bufpos last_point_position;
191 /* The frame that was current when the last command was started. */
192 Lisp_Object Vlast_selected_frame;
194 /* The buffer that was current when the last command was started. */
195 Lisp_Object last_point_position_buffer;
197 /* A (16bit . 16bit) representation of the time of the last-command-event. */
198 Lisp_Object Vlast_input_time;
200 /* A (16bit 16bit usec) representation of the time
201 of the last-command-event. */
202 Lisp_Object Vlast_command_event_time;
204 /* Character to recognize as the help char. */
205 Lisp_Object Vhelp_char;
207 /* Form to execute when help char is typed. */
208 Lisp_Object Vhelp_form;
210 /* Command to run when the help character follows a prefix key. */
211 Lisp_Object Vprefix_help_command;
213 /* Flag to tell QUIT that some interesting occurrence (e.g. a keypress)
214 may have happened. */
215 volatile int something_happened;
217 /* Hash table to translate keysyms through */
218 Lisp_Object Vkeyboard_translate_table;
220 /* If control-meta-super-shift-X is undefined, try control-meta-super-x */
221 Lisp_Object Vretry_undefined_key_binding_unshifted;
222 Lisp_Object Qretry_undefined_key_binding_unshifted;
225 /* If composed input is undefined, use self-insert-char */
226 Lisp_Object Vcomposed_character_default_binding;
227 #endif /* HAVE_XIM */
229 /* Console that corresponds to our controlling terminal */
230 Lisp_Object Vcontrolling_terminal;
232 /* An event (actually an event chain linked through event_next) or Qnil.
234 Lisp_Object Vthis_command_keys;
235 Lisp_Object Vthis_command_keys_tail;
238 Lisp_Object Qauto_show_make_point_visible;
240 /* File in which we write all commands we read; an lstream */
241 static Lisp_Object Vdribble_file;
243 /* Recent keys ring location; a vector of events or nil-s */
244 Lisp_Object Vrecent_keys_ring;
245 int recent_keys_ring_size;
246 int recent_keys_ring_index;
248 /* Boolean specifying whether keystrokes should be added to
250 int inhibit_input_event_recording;
252 Lisp_Object Qself_insert_defer_undo;
254 /* this is in keymap.c */
255 extern Lisp_Object Fmake_keymap(Lisp_Object name);
258 Fixnum debug_emacs_events;
261 external_debugging_print_event(char *event_description, Lisp_Object event)
263 write_c_string("(", Qexternal_debugging_output);
264 write_c_string(event_description, Qexternal_debugging_output);
265 write_c_string(") ", Qexternal_debugging_output);
266 print_internal(event, Qexternal_debugging_output, 1);
267 write_c_string("\n", Qexternal_debugging_output);
270 #define DEBUG_PRINT_EMACS_EVENT(event_description, event) do { \
271 if (debug_emacs_events) \
272 external_debugging_print_event (event_description, event); \
275 #define DEBUG_PRINT_EMACS_EVENT(string, event)
278 /* The callback routines for the window system or terminal driver */
279 struct event_stream *event_stream;
281 static void echo_key_event(struct command_builder *, Lisp_Object event);
282 static void maybe_kbd_translate(Lisp_Object event);
284 #if defined(EF_USE_ASYNEQ)
285 /* everybody may use me */
286 event_queue_t asyneq = Qnull_pointer;
287 static Lisp_Object Vasyneq;
288 #define EQ_EMPTY_P() eq_queue_empty_p(asyneq)
289 #define EQ_LARGE_P() (eq_queue_size(asyneq) > 1)
291 /* This structure is basically a typeahead queue: things like
292 wait-reading-process-output will delay the execution of
293 keyboard and mouse events by pushing them here.
295 Chained through event_next()
296 command_event_queue_tail is a pointer to the last-added element.
298 static Lisp_Object command_event_queue;
299 static Lisp_Object command_event_queue_tail;
300 #define EQ_EMPTY_P() NILP(command_event_queue)
301 #define EQ_LARGE_P() !NILP(command_event_queue_tail)
304 /* Nonzero means echo unfinished commands after this many seconds of pause. */
305 static Lisp_Object Vecho_keystrokes;
307 /* The number of keystrokes since the last auto-save. */
308 static int keystrokes_since_auto_save;
310 /* Used by the C-g signal handler so that it will never "hard quit"
311 when waiting for an event. Otherwise holding down C-g could
312 cause a suspension back to the shell, which is generally
313 undesirable. (#### This doesn't fully work.) */
315 int emacs_is_blocking;
317 /* Handlers which run during sit-for, sleep-for and accept-process-output
318 are not allowed to recursively call these routines. We record here
319 if we are in that situation. */
321 static Lisp_Object recursive_sit_for;
323 /**********************************************************************/
324 /* Command-builder object */
325 /**********************************************************************/
327 #define XCOMMAND_BUILDER(x) \
328 XRECORD (x, command_builder, struct command_builder)
329 #define XSETCOMMAND_BUILDER(x, p) XSETRECORD (x, p, command_builder)
330 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder)
331 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
333 static Lisp_Object mark_command_builder(Lisp_Object obj)
335 struct command_builder *builder = XCOMMAND_BUILDER(obj);
336 mark_object(builder->prefix_events);
337 mark_object(builder->current_events);
338 mark_object(builder->most_current_event);
339 mark_object(builder->last_non_munged_event);
340 mark_object(builder->munge_me[0].first_mungeable_event);
341 mark_object(builder->munge_me[1].first_mungeable_event);
342 return builder->console;
345 static void finalize_command_builder(void *header, int for_disksave)
348 xfree(((struct command_builder *)header)->echo_buf);
349 ((struct command_builder *)header)->echo_buf = 0;
353 DEFINE_LRECORD_IMPLEMENTATION("command-builder", command_builder,
354 mark_command_builder, internal_object_printer,
355 finalize_command_builder, 0, 0, 0,
356 struct command_builder);
358 static void reset_command_builder_event_chain(struct command_builder *builder)
360 builder->prefix_events = Qnil;
361 builder->current_events = Qnil;
362 builder->most_current_event = Qnil;
363 builder->last_non_munged_event = Qnil;
364 builder->munge_me[0].first_mungeable_event = Qnil;
365 builder->munge_me[1].first_mungeable_event = Qnil;
368 Lisp_Object allocate_command_builder(Lisp_Object console)
370 Lisp_Object builder_obj;
371 struct command_builder *builder =
372 alloc_lcrecord_type(struct command_builder,
373 &lrecord_command_builder);
375 builder->console = console;
376 reset_command_builder_event_chain(builder);
377 builder->echo_buf_length = 300; /* #### Kludge */
379 xnew_atomic_array(Bufbyte, builder->echo_buf_length);
380 builder->echo_buf[0] = 0;
381 builder->echo_buf_index = -1;
382 builder->echo_buf_index = -1;
383 builder->self_insert_countdown = 0;
385 XSETCOMMAND_BUILDER(builder_obj, builder);
390 command_builder_append_event(struct command_builder *builder, Lisp_Object event)
392 assert(EVENTP(event));
394 if (EVENTP(builder->most_current_event))
395 XSET_EVENT_NEXT(builder->most_current_event, event);
397 builder->current_events = event;
399 builder->most_current_event = event;
400 if (NILP(builder->munge_me[0].first_mungeable_event))
401 builder->munge_me[0].first_mungeable_event = event;
402 if (NILP(builder->munge_me[1].first_mungeable_event))
403 builder->munge_me[1].first_mungeable_event = event;
406 /**********************************************************************/
407 /* Low-level interfaces onto event methods */
408 /**********************************************************************/
410 enum event_stream_operation {
411 EVENT_STREAM_PROCESS,
412 EVENT_STREAM_TIMEOUT,
413 EVENT_STREAM_CONSOLE,
417 static void check_event_stream_ok(enum event_stream_operation op)
419 if (!event_stream && noninteractive) {
421 case EVENT_STREAM_PROCESS:
422 error("Can't start subprocesses in -batch mode");
423 case EVENT_STREAM_TIMEOUT:
424 error("Can't add timeouts in -batch mode");
425 case EVENT_STREAM_CONSOLE:
426 error("Can't add consoles in -batch mode");
427 case EVENT_STREAM_READ:
428 error("Can't read events in -batch mode");
432 } else if (!event_stream) {
434 ("event-stream callbacks not initialized (internal error?)");
438 static int event_stream_event_pending_p(int user)
440 return event_stream && event_stream->event_pending_p(user);
443 static void event_stream_force_event_pending(struct frame *f)
445 if (event_stream->force_event_pending)
446 event_stream->force_event_pending(f);
449 static int maybe_read_quit_event(Lisp_Event * event)
451 /* A C-g that came from `sigint_happened' will always come from the
452 controlling terminal. If that doesn't exist, however, then the
453 user manually sent us a SIGINT, and we pretend the C-g came from
454 the selected console. */
457 if (CONSOLEP(Vcontrolling_terminal) &&
458 CONSOLE_LIVE_P(XCONSOLE(Vcontrolling_terminal))) {
459 con = XCONSOLE(Vcontrolling_terminal);
461 Lisp_Object tmp = Fselected_console();
465 if (sigint_happened) {
466 int ch = CONSOLE_QUIT_CHAR(con);
469 character_to_event(ch, event, con, 1, 1);
470 event->channel = make_console(con);
476 void event_stream_next_event(Lisp_Event * event)
478 Lisp_Object event_obj;
480 check_event_stream_ok(EVENT_STREAM_READ);
482 XSETEVENT(event_obj, event);
484 /* If C-g was pressed, treat it as a character to be read.
485 Note that if C-g was pressed while we were blocking,
486 the SIGINT signal handler will be called. It will
487 set Vquit_flag and write a byte on our "fake pipe",
488 which will unblock us. */
489 if (maybe_read_quit_event(event)) {
490 DEBUG_PRINT_EMACS_EVENT("SIGINT", event_obj);
494 /* If a longjmp() happens in the callback, we're screwed.
495 Let's hope it doesn't. I think the code here is fairly
496 clean and doesn't do this. */
497 emacs_is_blocking = 1;
498 event_stream->next_event_cb(event);
499 emacs_is_blocking = 0;
502 /* timeout events have more info set later, so
503 print the event out in next_event_internal(). */
504 if (event->event_type != timeout_event)
505 DEBUG_PRINT_EMACS_EVENT("real", event_obj);
507 maybe_kbd_translate(event_obj);
510 void event_stream_handle_magic_event(Lisp_Event * event)
512 check_event_stream_ok(EVENT_STREAM_READ);
513 event_stream->handle_magic_event_cb(event);
516 static int event_stream_add_timeout(EMACS_TIME timeout)
518 check_event_stream_ok(EVENT_STREAM_TIMEOUT);
519 return event_stream->add_timeout_cb(timeout);
522 static void event_stream_remove_timeout(int id)
524 check_event_stream_ok(EVENT_STREAM_TIMEOUT);
525 event_stream->remove_timeout_cb(id);
528 void event_stream_select_console(struct console *con)
530 check_event_stream_ok(EVENT_STREAM_CONSOLE);
531 if (!con->input_enabled) {
532 event_stream->select_console_cb(con);
533 con->input_enabled = 1;
537 void event_stream_unselect_console(struct console *con)
539 check_event_stream_ok(EVENT_STREAM_CONSOLE);
540 if (con->input_enabled) {
541 event_stream->unselect_console_cb(con);
542 con->input_enabled = 0;
546 void event_stream_select_process(Lisp_Process * proc)
548 check_event_stream_ok(EVENT_STREAM_PROCESS);
549 if (!get_process_selected_p(proc)) {
550 event_stream->select_process_cb(proc);
551 set_process_selected_p(proc, 1);
555 void event_stream_unselect_process(Lisp_Process * proc)
557 check_event_stream_ok(EVENT_STREAM_PROCESS);
558 if (get_process_selected_p(proc)) {
559 event_stream->unselect_process_cb(proc);
560 set_process_selected_p(proc, 0);
565 event_stream_create_stream_pair(void *inhandle, void *outhandle,
566 Lisp_Object * instream, Lisp_Object * outstream,
569 check_event_stream_ok(EVENT_STREAM_PROCESS);
570 return event_stream->create_stream_pair_cb
571 (inhandle, outhandle, instream, outstream, flags);
575 event_stream_delete_stream_pair(Lisp_Object instream, Lisp_Object outstream)
577 check_event_stream_ok(EVENT_STREAM_PROCESS);
578 return event_stream->delete_stream_pair_cb(instream, outstream);
581 void event_stream_quit_p(void)
584 event_stream->quit_p_cb();
587 static int event_stream_current_event_timestamp(struct console *c)
589 if (event_stream && event_stream->current_event_timestamp_cb)
590 return event_stream->current_event_timestamp_cb(c);
595 /**********************************************************************/
596 /* Character prompting */
597 /**********************************************************************/
600 echo_key_event(struct command_builder *command_builder, Lisp_Object event)
602 /* This function can GC */
604 Bytecount buf_index = command_builder->echo_buf_index;
609 buf_index = 0; /* We're echoing now */
610 clear_echo_area(selected_frame(), Qnil, 0);
613 format_event_object(buf, XEVENT(event), 1);
616 if (len + buf_index + 4 > command_builder->echo_buf_length)
618 e = command_builder->echo_buf + buf_index;
627 command_builder->echo_buf_index = buf_index + len + 1;
631 regenerate_echo_keys_from_this_command_keys(struct command_builder *builder)
635 builder->echo_buf_index = 0;
637 EVENT_CHAIN_LOOP(event, Vthis_command_keys)
638 echo_key_event(builder, event);
642 maybe_echo_keys(struct command_builder *command_builder, int no_snooze)
644 /* This function can GC */
645 double echo_keystrokes;
646 struct frame *f = selected_frame();
647 /* Message turns off echoing unless more keystrokes turn it on again. */
648 if (echo_area_active(f) && !EQ(Qcommand, echo_area_status(f)))
651 if (INTP(Vecho_keystrokes) || FLOATP(Vecho_keystrokes))
652 echo_keystrokes = extract_float(Vecho_keystrokes);
656 if (minibuf_level == 0 && echo_keystrokes > 0.0
657 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
658 && !x_kludge_lw_menu_active()
662 /* #### C-g here will cause QUIT. Setting dont_check_for_quit
663 doesn't work. See check_quit. */
664 if (NILP(Fsit_for(Vecho_keystrokes, Qnil)))
665 /* input came in, so don't echo. */
669 echo_area_message(f, command_builder->echo_buf, Qnil, 0,
670 /* not echo_buf_index. That doesn't include
671 the terminating " - ". */
672 strlen((char *)command_builder->echo_buf),
678 reset_key_echo(struct command_builder *command_builder,
679 int remove_echo_area_echo)
681 /* This function can GC */
682 struct frame *f = selected_frame();
685 command_builder->echo_buf_index = -1;
687 if (remove_echo_area_echo)
688 clear_echo_area(f, Qcommand, 0);
691 /**********************************************************************/
693 /**********************************************************************/
695 static void maybe_kbd_translate(Lisp_Object event)
698 int did_translate = 0;
700 if (XEVENT_TYPE(event) != key_press_event)
702 if (!HASH_TABLEP(Vkeyboard_translate_table))
704 if (EQ(Fhash_table_count(Vkeyboard_translate_table), Qzero))
707 c = event_to_character(XEVENT(event), 0, 0, 0);
709 Lisp_Object traduit =
710 Fgethash(make_char(c), Vkeyboard_translate_table,
712 if (!NILP(traduit) && SYMBOLP(traduit)) {
713 XEVENT(event)->event.key.keysym = traduit;
714 XEVENT(event)->event.key.modifiers = 0;
716 } else if (CHARP(traduit)) {
719 /* This used to call Fcharacter_to_event() directly into EVENT,
720 but that can eradicate timestamps and other such stuff.
721 This way is safer. */
723 character_to_event(XCHAR(traduit), &ev2,
724 XCONSOLE(EVENT_CHANNEL
725 (XEVENT(event))), 0, 1);
726 XEVENT(event)->event.key.keysym = ev2.event.key.keysym;
727 XEVENT(event)->event.key.modifiers =
728 ev2.event.key.modifiers;
733 if (!did_translate) {
734 Lisp_Object traduit = Fgethash(XEVENT(event)->event.key.keysym,
735 Vkeyboard_translate_table, Qnil);
736 if (!NILP(traduit) && SYMBOLP(traduit)) {
737 XEVENT(event)->event.key.keysym = traduit;
739 } else if (CHARP(traduit)) {
743 character_to_event(XCHAR(traduit), &ev2,
744 XCONSOLE(EVENT_CHANNEL
745 (XEVENT(event))), 0, 1);
746 XEVENT(event)->event.key.keysym = ev2.event.key.keysym;
747 XEVENT(event)->event.key.modifiers |=
748 ev2.event.key.modifiers;
754 DEBUG_PRINT_EMACS_EVENT("->keyboard-translate-table", event);
758 /* NB: The following auto-save stuff is in keyboard.c in FSFmacs, and
759 keystrokes_since_auto_save is equivalent to the difference between
760 num_nonmacro_input_chars and last_auto_save. */
762 /* When an auto-save happens, record the number of keystrokes, and
763 don't do again soon. */
765 void record_auto_save(void)
767 keystrokes_since_auto_save = 0;
770 /* Make an auto save happen as soon as possible at command level. */
772 void force_auto_save_soon(void)
774 keystrokes_since_auto_save = 1 + max(auto_save_interval, 20);
777 static void maybe_do_auto_save(void)
779 /* This function can call lisp */
780 keystrokes_since_auto_save++;
781 if (auto_save_interval > 0 &&
782 keystrokes_since_auto_save > max(auto_save_interval, 20) &&
783 !detect_input_pending()) {
784 Fdo_auto_save(Qnil, Qnil);
789 static Lisp_Object print_help(Lisp_Object object)
791 Fprinc(object, Qnil);
796 execute_help_form(struct command_builder *command_builder, Lisp_Object event)
798 /* This function can GC */
799 Lisp_Object help = Qnil;
800 int speccount = specpdl_depth();
801 Bytecount buf_index = command_builder->echo_buf_index;
802 Lisp_Object echo = ((buf_index <= 0)
803 ? Qnil : make_string(command_builder->echo_buf,
805 struct gcpro gcpro1, gcpro2;
808 record_unwind_protect(save_window_excursion_unwind,
809 Fcurrent_window_configuration(Qnil));
810 reset_key_echo(command_builder, 1);
812 help = Feval(Vhelp_form);
814 internal_with_output_to_temp_buffer(build_string("*Help*"),
815 print_help, help, Qnil);
816 Fnext_command_event(event, Qnil);
817 /* Remove the help from the frame */
818 unbind_to(speccount, Qnil);
819 /* Hmmmm. Tricky. The unbind restores an old window configuration,
820 apparently bypassing any setting of windows_structure_changed.
821 So we need to set it so that things get redrawn properly. */
822 /* #### This is massive overkill. Look at doing it better once the
823 new redisplay is fully in place. */
825 Lisp_Object frmcons, devcons, concons;
826 FRAME_LOOP_NO_BREAK(frmcons, devcons, concons) {
827 struct frame *f = XFRAME(XCAR(frmcons));
828 MARK_FRAME_WINDOWS_STRUCTURE_CHANGED(f);
833 if (event_matches_key_specifier_p(XEVENT(event), make_char(' '))) {
834 /* Discard next key if it is a space */
835 reset_key_echo(command_builder, 1);
836 Fnext_command_event(event, Qnil);
839 command_builder->echo_buf_index = buf_index;
841 memcpy(command_builder->echo_buf, XSTRING_DATA(echo), buf_index + 1); /* terminating 0 */
845 /**********************************************************************/
847 /**********************************************************************/
849 int detect_input_pending(void)
851 /* Always call the event_pending_p hook even if there's an unread
852 character, because that might do some needed ^G detection (on
853 systems without SIGIO, for example).
855 if (event_stream_event_pending_p(1))
857 if (!NILP(Vunread_command_events) || !NILP(Vunread_command_event))
862 #if defined(EF_USE_ASYNEQ)
865 if (XEVENT_TYPE(event) != eval_event &&
866 XEVENT_TYPE(event) != magic_eval_event) {
867 RETURN_FROM_EQ_TRAVERSE(asyneq, 1);
870 EVENT_CHAIN_LOOP(event, command_event_queue) {
871 if (XEVENT_TYPE(event) != eval_event
872 && XEVENT_TYPE(event) != magic_eval_event)
880 DEFUN("input-pending-p", Finput_pending_p, 0, 0, 0, /*
881 Return t if command input is currently available with no waiting.
882 Actually, the value is nil only if we can be sure that no input is available.
886 return detect_input_pending()? Qt : Qnil;
889 /**********************************************************************/
891 /**********************************************************************/
893 /**** Low-level timeout functions. ****
895 These functions maintain a sorted list of one-shot timeouts (where
896 the timeouts are in absolute time). They are intended for use by
897 functions that need to convert a list of absolute timeouts into a
898 series of intervals to wait for. */
900 /* We ensure that 0 is never a valid ID, so that a value of 0 can be
901 used to indicate an absence of a timer. */
902 static int low_level_timeout_id_tick;
904 static struct low_level_timeout_blocktype {
905 Blocktype_declare(struct low_level_timeout);
906 } *the_low_level_timeout_blocktype;
908 /* Add a one-shot timeout at time TIME to TIMEOUT_LIST. Return
909 a unique ID identifying the timeout. */
912 add_low_level_timeout(struct low_level_timeout **timeout_list, EMACS_TIME thyme)
914 struct low_level_timeout *tm;
915 struct low_level_timeout *t, **tt;
917 /* Allocate a new time struct. */
919 tm = Blocktype_alloc(the_low_level_timeout_blocktype);
921 if (low_level_timeout_id_tick == 0)
922 low_level_timeout_id_tick++;
923 tm->id = low_level_timeout_id_tick++;
926 /* Add it to the queue. */
930 while (t && EMACS_TIME_EQUAL_OR_GREATER(tm->time, t->time)) {
940 /* Remove the low-level timeout identified by ID from TIMEOUT_LIST.
941 If the timeout is not there, do nothing. */
943 void remove_low_level_timeout(struct low_level_timeout **timeout_list, int id)
945 struct low_level_timeout *t, *prev;
949 for (t = *timeout_list, prev = NULL; t && t->id != id; t = t->next)
953 return; /* couldn't find it */
956 *timeout_list = t->next;
958 prev->next = t->next;
960 Blocktype_free(the_low_level_timeout_blocktype, t);
963 /* If there are timeouts on TIMEOUT_LIST, store the relative time
964 interval to the first timeout on the list into INTERVAL and
965 return 1. Otherwise, return 0. */
968 get_low_level_timeout_interval(struct low_level_timeout *timeout_list,
969 EMACS_TIME * interval)
971 if (!timeout_list) /* no timer events; block indefinitely */
974 EMACS_TIME current_time;
976 /* The time to block is the difference between the first
977 (earliest) timer on the queue and the current time.
978 If that is negative, then the timer will fire immediately
979 but we still have to call select(), with a zero-valued
980 timeout: user events must have precedence over timer events. */
981 EMACS_GET_TIME(current_time);
982 if (EMACS_TIME_GREATER(timeout_list->time, current_time))
983 EMACS_SUB_TIME(*interval, timeout_list->time,
986 EMACS_SET_SECS_USECS(*interval, 0, 0);
991 /* Pop the first (i.e. soonest) timeout off of TIMEOUT_LIST and return
992 its ID. Also, if TIME_OUT is not 0, store the absolute time of the
993 timeout into TIME_OUT. */
996 pop_low_level_timeout(struct low_level_timeout **timeout_list,
997 EMACS_TIME * time_out)
999 struct low_level_timeout *tm = *timeout_list;
1005 *time_out = tm->time;
1006 *timeout_list = tm->next;
1007 Blocktype_free(the_low_level_timeout_blocktype, tm);
1011 /**** High-level timeout functions. ****/
1013 static int timeout_id_tick;
1015 static Lisp_Object pending_timeout_list, pending_async_timeout_list;
1017 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1018 static Lisp_Object Vtimeout_free_list;
1021 static Lisp_Object mark_timeout(Lisp_Object obj)
1023 Lisp_Timeout *tm = XTIMEOUT(obj);
1024 mark_object(tm->function);
1028 /* Should never, ever be called. (except by an external debugger) */
1030 print_timeout(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1032 const Lisp_Timeout *t = XTIMEOUT(obj);
1035 sprintf(buf, "#<INTERNAL OBJECT (SXEmacs bug?) (timeout) 0x%lx>",
1037 write_c_string(buf, printcharfun);
1040 static const struct lrecord_description timeout_description[] = {
1041 {XD_LISP_OBJECT, offsetof(Lisp_Timeout, function)},
1042 {XD_LISP_OBJECT, offsetof(Lisp_Timeout, object)},
1046 DEFINE_LRECORD_IMPLEMENTATION("timeout", timeout,
1047 mark_timeout, print_timeout,
1048 0, 0, 0, timeout_description, Lisp_Timeout);
1050 /* Generate a timeout and return its ID. */
1053 event_stream_generate_wakeup(unsigned int milliseconds,
1054 unsigned int vanilliseconds,
1055 Lisp_Object function, Lisp_Object object,
1058 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1059 Lisp_Object op = wrap_object(
1060 alloc_lcrecord(sizeof(Lisp_Timeout), &lrecord_timeout));
1062 Lisp_Object op = allocate_managed_lcrecord(Vtimeout_free_list);
1064 Lisp_Timeout *timeout = XTIMEOUT(op);
1065 EMACS_TIME current_time;
1066 EMACS_TIME interval;
1068 timeout->id = timeout_id_tick++;
1069 timeout->resignal_msecs = vanilliseconds;
1070 timeout->function = function;
1071 timeout->object = object;
1073 EMACS_GET_TIME(current_time);
1074 EMACS_SET_SECS_USECS(interval, milliseconds / 1000,
1075 1000 * (milliseconds % 1000));
1076 EMACS_ADD_TIME(timeout->next_signal_time, current_time, interval);
1079 timeout->interval_id =
1080 event_stream_add_async_timeout(timeout->next_signal_time);
1081 pending_async_timeout_list = noseeum_cons(op,
1082 pending_async_timeout_list);
1084 timeout->interval_id =
1085 event_stream_add_timeout(timeout->next_signal_time);
1086 pending_timeout_list = noseeum_cons(op, pending_timeout_list);
1091 /* Given the INTERVAL-ID of a timeout just signalled, resignal the timeout
1092 as necessary and return the timeout's ID and function and object slots.
1094 This should be called as a result of receiving notice that a timeout
1095 has fired. INTERVAL-ID is *not* the timeout's ID, but is the ID that
1096 identifies this particular firing of the timeout. INTERVAL-ID's and
1097 timeout ID's are in separate number spaces and bear no relation to
1098 each other. The INTERVAL-ID is all that the event callback routines
1099 work with: they work only with one-shot intervals, not with timeouts
1100 that may fire repeatedly.
1102 NOTE: The returned FUNCTION and OBJECT are *not* GC-protected at all.
1106 event_stream_resignal_wakeup(int interval_id, int async_p,
1107 Lisp_Object * function, Lisp_Object * object)
1109 Lisp_Object op = Qnil, rest;
1110 Lisp_Timeout *timeout;
1111 Lisp_Object *timeout_list;
1112 struct gcpro gcpro1;
1115 GCPRO1(op); /* just in case ... because it's removed from the list
1119 async_p ? &pending_async_timeout_list : &pending_timeout_list;
1121 /* Find the timeout on the list of pending ones. */
1122 LIST_LOOP(rest, *timeout_list) {
1123 timeout = XTIMEOUT(XCAR(rest));
1124 if (timeout->interval_id == interval_id)
1128 assert(!NILP(rest));
1130 timeout = XTIMEOUT(op);
1131 /* We make sure to snarf the data out of the timeout object before
1132 we free it with free_managed_lcrecord(). */
1134 *function = timeout->function;
1135 *object = timeout->object;
1137 /* Remove this one from the list of pending timeouts */
1138 *timeout_list = delq_no_quit_and_free_cons(op, *timeout_list);
1140 /* If this timeout wants to be resignalled, do it now. */
1141 if (timeout->resignal_msecs) {
1142 EMACS_TIME current_time;
1143 EMACS_TIME interval;
1145 /* Determine the time that the next resignalling should occur.
1146 We do that by adding the interval time to the last signalled
1147 time until we get a time that's current.
1149 (This way, it doesn't matter if the timeout was signalled
1150 exactly when we asked for it, or at some time later.)
1152 EMACS_GET_TIME(current_time);
1153 EMACS_SET_SECS_USECS(interval, timeout->resignal_msecs / 1000,
1154 1000 * (timeout->resignal_msecs % 1000));
1156 EMACS_ADD_TIME(timeout->next_signal_time,
1157 timeout->next_signal_time, interval);
1158 } while (EMACS_TIME_GREATER
1159 (current_time, timeout->next_signal_time));
1162 timeout->interval_id =
1163 event_stream_add_async_timeout(
1164 timeout->next_signal_time);
1166 timeout->interval_id =
1167 event_stream_add_timeout(
1168 timeout->next_signal_time);
1170 /* Add back onto the list. Note that the effect of this
1171 is to move frequently-hit timeouts to the front of the
1172 list, which is a good thing. */
1173 *timeout_list = noseeum_cons(op, *timeout_list);
1175 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1178 free_managed_lcrecord(Vtimeout_free_list, op);
1185 void event_stream_disable_wakeup(int id, int async_p)
1187 Lisp_Timeout *timeout = 0;
1189 Lisp_Object *timeout_list;
1192 timeout_list = &pending_async_timeout_list;
1194 timeout_list = &pending_timeout_list;
1196 /* Find the timeout on the list of pending ones, if it's still there. */
1197 LIST_LOOP(rest, *timeout_list) {
1198 timeout = XTIMEOUT(XCAR(rest));
1199 if (timeout->id == id) {
1204 /* If we found it, remove it from the list and disable the pending
1207 Lisp_Object op = XCAR(rest);
1208 *timeout_list = delq_no_quit_and_free_cons(op, *timeout_list);
1210 event_stream_remove_async_timeout(timeout->interval_id);
1212 event_stream_remove_timeout(timeout->interval_id);
1214 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1217 free_managed_lcrecord(Vtimeout_free_list, op);
1222 static int event_stream_wakeup_pending_p(int id, int async_p)
1224 Lisp_Timeout *timeout;
1226 Lisp_Object timeout_list;
1230 timeout_list = pending_async_timeout_list;
1232 timeout_list = pending_timeout_list;
1234 /* Find the element on the list of pending ones, if it's still there. */
1235 LIST_LOOP(rest, timeout_list) {
1236 timeout = XTIMEOUT(XCAR(rest));
1237 if (timeout->id == id) {
1246 /**** Asynch. timeout functions (see also signal.c) ****/
1248 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1249 extern int poll_for_quit_id;
1252 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1253 extern int poll_for_sigchld_id;
1256 void event_stream_deal_with_async_timeout(int interval_id)
1258 /* This function can GC */
1259 Lisp_Object humpty, dumpty;
1260 #if ((!defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)) \
1261 || defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD))
1264 event_stream_resignal_wakeup(interval_id, 1, &humpty, &dumpty);
1266 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1267 if (id == poll_for_quit_id) {
1268 quit_check_signal_happened = 1;
1269 quit_check_signal_tick_count++;
1274 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1275 if (id == poll_for_sigchld_id) {
1276 kick_status_notify();
1281 /* call1 GC-protects its arguments */
1282 call1_trapping_errors("Error in asynchronous timeout callback",
1286 /**** Lisp-level timeout functions. ****/
1288 static unsigned long lisp_number_to_milliseconds(Lisp_Object secs, int allow_0)
1290 #if defined(WITH_NUMBER_TYPES)
1293 fsecs = extract_float(secs);
1294 #else /* !WITH_NUMBER_TYPES */
1297 CHECK_INT_OR_FLOAT(secs);
1298 fsecs = XFLOATINT(secs);
1303 #endif /* HAVE_FPFLOAT */
1304 #endif /* WITH_NUMBER_TYPES */
1306 signal_simple_error("timeout is negative", secs);
1307 if (!allow_0 && fsecs == 0)
1308 signal_simple_error("timeout is non-positive", secs);
1309 if (fsecs >= (((unsigned int)0xFFFFFFFF) / 1000))
1311 ("timeout would exceed 32 bits when represented in milliseconds",
1314 return (unsigned long)(1000 * fsecs);
1317 DEFUN("add-timeout", Fadd_timeout, 3, 4, 0, /*
1318 Add a timeout, to be signaled after the timeout period has elapsed.
1319 SECS is a number of seconds, expressed as an integer or a float.
1320 FUNCTION will be called after that many seconds have elapsed, with one
1321 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1322 then after this timeout expires, `add-timeout' will automatically be called
1323 again with RESIGNAL as the first argument.
1325 This function returns an object which is the id number of this particular
1326 timeout. You can pass that object to `disable-timeout' to turn off the
1327 timeout before it has been signalled.
1329 NOTE: Id numbers as returned by this function are in a distinct namespace
1330 from those returned by `add-async-timeout'. This means that the same id
1331 number could refer to a pending synchronous timeout and a different pending
1332 asynchronous timeout, and that you cannot pass an id from `add-timeout'
1333 to `disable-async-timeout', or vice-versa.
1335 The number of seconds may be expressed as a floating-point number, in which
1336 case some fractional part of a second will be used. Caveat: the usable
1337 timeout granularity will vary from system to system.
1339 Adding a timeout causes a timeout event to be returned by `next-event', and
1340 the function will be invoked by `dispatch-event,' so if emacs is in a tight
1341 loop, the function will not be invoked until the next call to sit-for or
1342 until the return to top-level (the same is true of process filters).
1344 If you need to have a timeout executed even when SXEmacs is in the midst of
1345 running Lisp code, use `add-async-timeout'.
1347 WARNING: if you are thinking of calling add-timeout from inside of a
1348 callback function as a way of resignalling a timeout, think again. There
1349 is a race condition. That's why the RESIGNAL argument exists.
1351 (secs, function, object, resignal))
1353 unsigned long msecs = lisp_number_to_milliseconds(secs, 0);
1354 unsigned long msecs2 = (NILP(resignal) ? 0 :
1355 lisp_number_to_milliseconds(resignal, 0));
1358 id = event_stream_generate_wakeup(msecs, msecs2, function, object, 0);
1360 if (id != XINT(lid))
1365 DEFUN("disable-timeout", Fdisable_timeout, 1, 1, 0, /*
1366 Disable a timeout from signalling any more.
1367 ID should be a timeout id number as returned by `add-timeout'. If ID
1368 corresponds to a one-shot timeout that has already signalled, nothing
1371 It will not work to call this function on an id number returned by
1372 `add-async-timeout'. Use `disable-async-timeout' for that.
1377 event_stream_disable_wakeup(XINT(id), 0);
1381 DEFUN("add-async-timeout", Fadd_async_timeout, 3, 4, 0, /*
1382 Add an asynchronous timeout, to be signaled after an interval has elapsed.
1383 SECS is a number of seconds, expressed as an integer or a float.
1384 FUNCTION will be called after that many seconds have elapsed, with one
1385 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1386 then after this timeout expires, `add-async-timeout' will automatically be
1387 called again with RESIGNAL as the first argument.
1389 This function returns an object which is the id number of this particular
1390 timeout. You can pass that object to `disable-async-timeout' to turn off
1391 the timeout before it has been signalled.
1393 NOTE: Id numbers as returned by this function are in a distinct namespace
1394 from those returned by `add-timeout'. This means that the same id number
1395 could refer to a pending synchronous timeout and a different pending
1396 asynchronous timeout, and that you cannot pass an id from
1397 `add-async-timeout' to `disable-timeout', or vice-versa.
1399 The number of seconds may be expressed as a floating-point number, in which
1400 case some fractional part of a second will be used. Caveat: the usable
1401 timeout granularity will vary from system to system.
1403 Adding an asynchronous timeout causes the function to be invoked as soon
1404 as the timeout occurs, even if SXEmacs is in the midst of executing some
1405 other code. (This is unlike the synchronous timeouts added with
1406 `add-timeout', where the timeout will only be signalled when SXEmacs is
1407 waiting for events, i.e. the next return to top-level or invocation of
1408 `sit-for' or related functions.) This means that the function that is
1409 called *must* not signal an error or change any global state (e.g. switch
1410 buffers or windows) except when locking code is in place to make sure
1411 that race conditions don't occur in the interaction between the
1412 asynchronous timeout function and other code.
1414 Under most circumstances, you should use `add-timeout' instead, as it is
1415 much safer. Asynchronous timeouts should only be used when such behavior
1416 is really necessary.
1418 Asynchronous timeouts are blocked and will not occur when `inhibit-quit'
1419 is non-nil. As soon as `inhibit-quit' becomes nil again, any pending
1420 asynchronous timeouts will get called immediately. (Multiple occurrences
1421 of the same asynchronous timeout are not queued, however.) While the
1422 callback function of an asynchronous timeout is invoked, `inhibit-quit'
1423 is automatically bound to non-nil, and thus other asynchronous timeouts
1424 will be blocked unless the callback function explicitly sets `inhibit-quit'
1427 WARNING: if you are thinking of calling `add-async-timeout' from inside of a
1428 callback function as a way of resignalling a timeout, think again. There
1429 is a race condition. That's why the RESIGNAL argument exists.
1431 (secs, function, object, resignal))
1433 unsigned long msecs = lisp_number_to_milliseconds(secs, 0);
1434 unsigned long msecs2 = (NILP(resignal) ? 0 :
1435 lisp_number_to_milliseconds(resignal, 0));
1438 id = event_stream_generate_wakeup(msecs, msecs2, function, object, 1);
1440 if (id != XINT(lid))
1445 DEFUN("disable-async-timeout", Fdisable_async_timeout, 1, 1, 0, /*
1446 Disable an asynchronous timeout from signalling any more.
1447 ID should be a timeout id number as returned by `add-async-timeout'. If ID
1448 corresponds to a one-shot timeout that has already signalled, nothing
1451 It will not work to call this function on an id number returned by
1452 `add-timeout'. Use `disable-timeout' for that.
1457 event_stream_disable_wakeup(XINT(id), 1);
1461 /**********************************************************************/
1462 /* enqueuing and dequeuing events */
1463 /**********************************************************************/
1465 /* Add an event to the back of the command-event queue: it will be the next
1466 event read after all pending events. This only works on keyboard,
1467 mouse-click, misc-user, and eval events.
1469 static void enqueue_command_event(Lisp_Object event)
1471 #ifdef EF_USE_ASYNEQ
1472 eq_enqueue(asyneq, event);
1474 enqueue_event(event, &command_event_queue, &command_event_queue_tail);
1478 static Lisp_Object dequeue_command_event(void)
1480 #ifdef EF_USE_ASYNEQ
1481 return eq_dequeue(asyneq);
1483 return dequeue_event(&command_event_queue, &command_event_queue_tail);
1487 /* put the event on the typeahead queue, unless
1488 the event is the quit char, in which case the `QUIT'
1489 which will occur on the next trip through this loop is
1490 all the processing we should do - leaving it on the queue
1491 would cause the quit to be processed twice.
1493 static void enqueue_command_event_1(Lisp_Object event_to_copy)
1495 /* do not call check_quit() here. Vquit_flag was set in
1496 next_event_internal. */
1497 if (NILP(Vquit_flag))
1498 enqueue_command_event(Fcopy_event(event_to_copy, Qnil));
1501 void enqueue_magic_eval_event(void (*fun) (Lisp_Object), Lisp_Object object)
1503 Lisp_Object event = Fmake_event(Qnil, Qnil);
1505 XEVENT(event)->event_type = magic_eval_event;
1506 /* channel for magic_eval events is nil */
1507 XEVENT(event)->event.magic_eval.internal_function = fun;
1508 XEVENT(event)->event.magic_eval.object = object;
1509 enqueue_command_event(event);
1512 DEFUN("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0, /*
1513 Add an eval event to the back of the eval event queue.
1514 When this event is dispatched, FUNCTION (which should be a function
1515 of one argument) will be called with OBJECT as its argument.
1516 See `next-event' for a description of event types and how events
1521 Lisp_Object event = Fmake_event(Qnil, Qnil);
1523 XEVENT(event)->event_type = eval_event;
1524 /* channel for eval events is nil */
1525 XEVENT(event)->event.eval.function = function;
1526 XEVENT(event)->event.eval.object = object;
1527 enqueue_command_event(event);
1533 enqueue_misc_user_event(Lisp_Object channel, Lisp_Object function,
1536 Lisp_Object event = Fmake_event(Qnil, Qnil);
1538 XEVENT(event)->event_type = misc_user_event;
1539 XEVENT(event)->channel = channel;
1540 XEVENT(event)->event.misc.function = function;
1541 XEVENT(event)->event.misc.object = object;
1542 XEVENT(event)->event.misc.button = 0;
1543 XEVENT(event)->event.misc.modifiers = 0;
1544 XEVENT(event)->event.misc.x = -1;
1545 XEVENT(event)->event.misc.y = -1;
1546 enqueue_command_event(event);
1552 enqueue_misc_user_event_pos(Lisp_Object channel, Lisp_Object function,
1554 int button, int modifiers, int x, int y)
1556 Lisp_Object event = Fmake_event(Qnil, Qnil);
1558 XEVENT(event)->event_type = misc_user_event;
1559 XEVENT(event)->channel = channel;
1560 XEVENT(event)->event.misc.function = function;
1561 XEVENT(event)->event.misc.object = object;
1562 XEVENT(event)->event.misc.button = button;
1563 XEVENT(event)->event.misc.modifiers = modifiers;
1564 XEVENT(event)->event.misc.x = x;
1565 XEVENT(event)->event.misc.y = y;
1566 enqueue_command_event(event);
1571 /**********************************************************************/
1572 /* focus-event handling */
1573 /**********************************************************************/
1577 Ben's capsule lecture on focus:
1579 In FSFmacs `select-frame' never changes the window-manager frame
1580 focus. All it does is change the "selected frame". This is similar
1581 to what happens when we call `select-device' or `select-console'.
1582 Whenever an event comes in (including a keyboard event), its frame is
1583 selected; therefore, evaluating `select-frame' in *scratch* won't
1584 cause any effects because the next received event (in the same frame)
1585 will cause a switch back to the frame displaying *scratch*.
1587 Whenever a focus-change event is received from the window manager, it
1588 generates a `switch-frame' event, which causes the Lisp function
1589 `handle-switch-frame' to get run. This basically just runs
1590 `select-frame' (see below, however).
1592 In FSFmacs, if you want to have an operation run when a frame is
1593 selected, you supply an event binding for `switch-frame' (and then
1594 maybe call `handle-switch-frame', or something ...).
1596 In SXEmacs, we *do* change the window-manager frame focus as a result
1597 of `select-frame', but not until the next time an event is received,
1598 so that a function that momentarily changes the selected frame won't
1599 cause WM focus flashing. (#### There's something not quite right here;
1600 this is causing the wrong-cursor-focus problems that you occasionally
1601 see. But the general idea is correct.) This approach is winning for
1602 people who use the explicit-focus model, but is trickier to implement.
1604 We also don't make the `switch-frame' event visible but instead have
1605 `select-frame-hook', which is a better approach.
1607 There is the problem of surrogate minibuffers, where when we enter the
1608 minibuffer, you essentially want to temporarily switch the WM focus to
1609 the frame with the minibuffer, and switch it back when you exit the
1612 FSFmacs solves this with the crockish `redirect-frame-focus', which
1613 says "for keyboard events received from FRAME, act like they're
1614 coming from FOCUS-FRAME". I think what this means is that, when
1615 a keyboard event comes in and the event manager is about to select the
1616 event's frame, if that frame has its focus redirected, the redirected-to
1617 frame is selected instead. That way, if you're in a minibufferless
1618 frame and enter the minibuffer, then all Lisp functions that run see
1619 the selected frame as the minibuffer's frame rather than the minibufferless
1620 frame you came from, so that (e.g.) your typing actually appears in
1621 the minibuffer's frame and things behave sanely.
1623 There's also some weird logic that switches the redirected frame focus
1624 from one frame to another if Lisp code explicitly calls `select-frame'
1625 \(but not if `handle-switch-frame' is called), and saves and restores
1626 the frame focus in window configurations, etc. etc. All of this logic
1627 is heavily #if 0'd, with lots of comments saying "No, this approach
1628 doesn't seem to work, so I'm trying this ... is it reasonable?
1629 Well, I'm not sure ..." that are a red flag indicating crockishness.
1631 Because of our way of doing things, we can avoid all this crock.
1632 Keyboard events never cause a select-frame (who cares what frame
1633 they're associated with? They come from a console, only). We change
1634 the actual WM focus to a surrogate minibuffer frame, so we don't have
1635 to do any internal redirection. In order to get the focus back,
1636 I took the approach in minibuf.el of just checking to see if the
1637 frame we moved to is still the selected frame, and move back to the
1638 old one if so. Conceivably we might have to do the weird "tracking"
1639 that FSFmacs does when `select-frame' is called, but I don't think
1640 so. If the selected frame moved from the minibuffer frame, then
1641 we just leave it there, figuring that someone knows what they're
1642 doing. Because we don't have any redirection recorded anywhere,
1643 it's safe to do this, and we don't end up with unwanted redirection.
1647 static void run_select_frame_hook(void)
1649 run_hook(Qselect_frame_hook);
1652 static void run_deselect_frame_hook(void)
1654 run_hook(Qdeselect_frame_hook);
1657 /* When select-frame is called and focus_follows_mouse is false, we want
1658 to tell the window system that the focus should be changed to point to
1659 the new frame. However,
1660 sometimes Lisp functions will temporarily change the selected frame
1661 (e.g. to call a function that operates on the selected frame),
1662 and it's annoying if this focus-change happens exactly when
1663 select-frame is called, because then you get some flickering of the
1664 window-manager border and perhaps other undesirable results. We
1665 really only want to change the focus when we're about to retrieve
1666 an event from the user. To do this, we keep track of the frame
1667 where the window-manager focus lies on, and just before waiting
1668 for user events, check the currently selected frame and change
1669 the focus as necessary.
1671 On the other hand, if focus_follows_mouse is true, we need to switch the
1672 selected frame back to the frame with window manager focus just before we
1673 execute the next command in Fcommand_loop_1, just as the selected buffer is
1674 reverted after a set-buffer.
1676 Both cases are handled by this function. It must be called as appropriate
1677 from these two places, depending on the value of focus_follows_mouse. */
1679 void investigate_frame_change(void)
1681 Lisp_Object devcons, concons;
1683 /* if the selected frame was changed, change the window-system
1684 focus to the new frame. We don't do it when select-frame was
1685 called, to avoid flickering and other unwanted side effects when
1686 the frame is just changed temporarily. */
1687 DEVICE_LOOP_NO_BREAK(devcons, concons) {
1688 struct device *d = XDEVICE(XCAR(devcons));
1689 Lisp_Object sel_frame = DEVICE_SELECTED_FRAME(d);
1691 /* You'd think that maybe we should use FRAME_WITH_FOCUS_REAL,
1692 but that can cause us to end up in an infinite loop focusing
1693 between two frames. It seems that since the call to `select-frame'
1694 in emacs_handle_focus_change_final() is based on the _FOR_HOOKS
1695 value, we need to do so too. */
1696 if (!NILP(sel_frame) &&
1697 !EQ(DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d), sel_frame) &&
1698 !NILP(DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d)) &&
1699 !EQ(DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d), sel_frame)) {
1700 /* At this point, we know that the frame has been changed. Now, if
1701 * focus_follows_mouse is not set, we finish off the frame change,
1702 * so that user events will now come from the new frame. Otherwise,
1703 * if focus_follows_mouse is set, no gratuitous frame changing
1704 * should take place. Set the focus back to the frame which was
1705 * originally selected for user input.
1707 if (!focus_follows_mouse) {
1708 /* prevent us from issuing the same request more than once */
1709 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d) =
1711 MAYBE_DEVMETH(d, focus_on_frame,
1712 (XFRAME(sel_frame)));
1714 Lisp_Object old_frame = Qnil;
1716 /* #### Do we really want to check OUGHT ??
1717 * It seems to make sense, though I have never seen us
1718 * get here and have it be non-nil.
1721 (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d)))
1723 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS
1726 (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d)))
1728 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS
1731 /* #### Can old_frame ever be NIL? play it safe.. */
1732 if (!NILP(old_frame)) {
1733 /* Fselect_frame is not really the right thing: it frobs the
1734 * buffer stack. But there's no easy way to do the right
1735 * thing, and this code already had this problem anyway.
1737 Fselect_frame(old_frame);
1744 static Lisp_Object cleanup_after_missed_defocusing(Lisp_Object frame)
1746 if (FRAMEP(frame) && FRAME_LIVE_P(XFRAME(frame)))
1747 Fselect_frame(frame);
1751 void emacs_handle_focus_change_preliminary(Lisp_Object frame_inp_and_dev)
1753 Lisp_Object frame = Fcar(frame_inp_and_dev);
1754 Lisp_Object device = Fcar(Fcdr(frame_inp_and_dev));
1755 int in_p = !NILP(Fcdr(Fcdr(frame_inp_and_dev)));
1758 if (!DEVICE_LIVE_P(XDEVICE(device)))
1761 d = XDEVICE(device);
1763 /* Any received focus-change notifications render invalid any
1764 pending focus-change requests. */
1765 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d) = Qnil;
1767 Lisp_Object focus_frame;
1769 if (!FRAME_LIVE_P(XFRAME(frame)))
1772 focus_frame = DEVICE_FRAME_WITH_FOCUS_REAL(d);
1774 /* Mark the minibuffer as changed to make sure it gets updated
1775 properly if the echo area is active. */
1778 XWINDOW(FRAME_MINIBUF_WINDOW(XFRAME(frame)));
1779 MARK_WINDOWS_CHANGED(w);
1782 if (FRAMEP(focus_frame) && FRAME_LIVE_P(XFRAME(focus_frame))
1783 && !EQ(frame, focus_frame)) {
1784 /* Oops, we missed a focus-out event. */
1785 DEVICE_FRAME_WITH_FOCUS_REAL(d) = Qnil;
1786 redisplay_redraw_cursor(XFRAME(focus_frame), 1);
1788 DEVICE_FRAME_WITH_FOCUS_REAL(d) = frame;
1789 if (!EQ(frame, focus_frame)) {
1790 redisplay_redraw_cursor(XFRAME(frame), 1);
1793 /* We ignore the frame reported in the event. If it's different
1794 from where we think the focus was, oh well -- we messed up.
1795 Nonetheless, we pretend we were right, for sensible behavior. */
1796 frame = DEVICE_FRAME_WITH_FOCUS_REAL(d);
1798 DEVICE_FRAME_WITH_FOCUS_REAL(d) = Qnil;
1800 if (FRAME_LIVE_P(XFRAME(frame)))
1801 redisplay_redraw_cursor(XFRAME(frame), 1);
1806 /* Called from the window-system-specific code when we receive a
1807 notification that the focus lies on a particular frame.
1808 Argument is a cons: (frame . (device . in-p)) where in-p is non-nil
1811 void emacs_handle_focus_change_final(Lisp_Object frame_inp_and_dev)
1813 Lisp_Object frame = Fcar(frame_inp_and_dev);
1814 Lisp_Object device = Fcar(Fcdr(frame_inp_and_dev));
1815 int in_p = !NILP(Fcdr(Fcdr(frame_inp_and_dev)));
1819 if (!DEVICE_LIVE_P(XDEVICE(device)))
1822 d = XDEVICE(device);
1825 Lisp_Object focus_frame;
1827 if (!FRAME_LIVE_P(XFRAME(frame)))
1830 focus_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d);
1832 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d) = frame;
1833 if (FRAMEP(focus_frame) && !EQ(frame, focus_frame)) {
1834 /* Oops, we missed a focus-out event. */
1835 Fselect_frame(focus_frame);
1836 /* Do an unwind-protect in case an error occurs in
1837 the deselect-frame-hook */
1838 count = specpdl_depth();
1839 record_unwind_protect(cleanup_after_missed_defocusing,
1841 run_deselect_frame_hook();
1842 unbind_to(count, Qnil);
1843 /* the cleanup method changed the focus frame to nil, so
1844 we need to reflect this */
1847 Fselect_frame(frame);
1848 if (!EQ(frame, focus_frame))
1849 run_select_frame_hook();
1851 /* We ignore the frame reported in the event. If it's different
1852 from where we think the focus was, oh well -- we messed up.
1853 Nonetheless, we pretend we were right, for sensible behavior. */
1854 frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d);
1856 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d) = Qnil;
1857 run_deselect_frame_hook();
1862 /**********************************************************************/
1863 /* retrieving the next event */
1864 /**********************************************************************/
1866 static int in_single_console;
1868 /* #### These functions don't currently do anything. */
1869 void single_console_state(void)
1871 in_single_console = 1;
1874 void any_console_state(void)
1876 in_single_console = 0;
1879 int in_single_console_state(void)
1881 return in_single_console;
1884 /* the number of keyboard characters read. callint.c wants this. */
1885 Charcount num_input_chars;
1887 static void next_event_internal(Lisp_Object target_event, int allow_queued)
1889 struct gcpro gcpro1;
1890 /* QUIT; This is incorrect - the caller must do this because some
1891 callers (ie, Fnext_event()) do not want to QUIT. */
1893 assert(NILP(XEVENT_NEXT(target_event)));
1895 GCPRO1(target_event);
1897 /* When focus_follows_mouse is nil, if a frame change took place, we need
1898 * to actually switch window manager focus to the selected window now.
1900 if (!focus_follows_mouse)
1901 investigate_frame_change();
1903 if (allow_queued && !EQ_EMPTY_P()) {
1904 Lisp_Object event = dequeue_command_event();
1905 Fcopy_event(event, target_event);
1906 Fdeallocate_event(event);
1907 DEBUG_PRINT_EMACS_EVENT("command event queue", target_event);
1909 Lisp_Event *e = XEVENT(target_event);
1911 /* The command_event_queue was empty. Wait for an event. */
1912 event_stream_next_event(e);
1913 /* If this was a timeout, then we need to extract some data
1914 out of the returned closure and might need to resignal
1916 if (e->event_type == timeout_event) {
1917 Lisp_Object tristan, isolde;
1919 e->event.timeout.id_number =
1920 event_stream_resignal_wakeup(e->event.timeout.
1924 e->event.timeout.function = tristan;
1925 e->event.timeout.object = isolde;
1926 /* next_event_internal() doesn't print out timeout events
1927 because of the extra info we just set. */
1928 DEBUG_PRINT_EMACS_EVENT("real, timeout", target_event);
1931 /* If we read a ^G, then set quit-flag but do not discard the ^G.
1932 The callers of next_event_internal() will do one of two things:
1934 -- set Vquit_flag to Qnil. (next-event does this.) This will
1935 cause the ^G to be treated as a normal keystroke.
1936 -- not change Vquit_flag but attempt to enqueue the ^G, at
1937 which point it will be discarded. The next time QUIT is
1938 called, it will notice that Vquit_flag was set.
1941 if (e->event_type == key_press_event &&
1942 event_matches_key_specifier_p
1944 make_char(CONSOLE_QUIT_CHAR(XCONSOLE(EVENT_CHANNEL(e))))))
1953 static void run_pre_idle_hook(void)
1955 if (!NILP(Vpre_idle_hook)
1956 && !detect_input_pending())
1957 safe_run_hook_trapping_errors
1958 ("Error in `pre-idle-hook' (setting hook to nil)",
1962 static void push_this_command_keys(Lisp_Object event);
1963 static void push_recent_keys(Lisp_Object event);
1964 static void dribble_out_event(Lisp_Object event);
1965 static void execute_internal_event(Lisp_Object event);
1966 static int is_scrollbar_event(Lisp_Object event);
1968 DEFUN("next-event", Fnext_event, 0, 2, 0, /*
1969 Return the next available event.
1970 Pass this object to `dispatch-event' to handle it.
1971 In most cases, you will want to use `next-command-event', which returns
1972 the next available "user" event (i.e. keypress, button-press,
1973 button-release, or menu selection) instead of this function.
1975 If EVENT is non-nil, it should be an event object and will be filled in
1976 and returned; otherwise a new event object will be created and returned.
1977 If PROMPT is non-nil, it should be a string and will be displayed in the
1978 echo area while this function is waiting for an event.
1980 The next available event will be
1982 -- any events in `unread-command-events' or `unread-command-event'; else
1983 -- the next event in the currently executing keyboard macro, if any; else
1984 -- an event queued by `enqueue-eval-event', if any, or any similar event
1985 queued internally, such as a misc-user event. (For example, when an item
1986 is selected from a menu or from a `question'-type dialog box, the item's
1987 callback is not immediately executed, but instead a misc-user event
1988 is generated and placed onto this queue; when it is dispatched, the
1989 callback is executed.) Else
1990 -- the next available event from the window system or terminal driver.
1992 In the last case, this function will block until an event is available.
1994 The returned event will be one of the following types:
1996 -- a key-press event.
1997 -- a button-press or button-release event.
1998 -- a misc-user-event, meaning the user selected an item on a menu or used
2000 -- a process event, meaning that output from a subprocess is available.
2001 -- a timeout event, meaning that a timeout has elapsed.
2002 -- an eval event, which simply causes a function to be executed when the
2003 event is dispatched. Eval events are generated by `enqueue-eval-event'
2004 or by certain other conditions happening.
2005 -- a magic event, indicating that some window-system-specific event
2006 happened (such as a focus-change notification) that must be handled
2007 synchronously with other events. `dispatch-event' knows what to do with
2012 /* This function can call lisp */
2013 /* #### We start out using the selected console before an event
2014 is received, for echoing the partially completed command.
2015 This is most definitely wrong -- there needs to be a separate
2016 echo area for each console! */
2017 struct console *con = XCONSOLE(Vselected_console);
2018 struct command_builder *command_builder =
2019 XCOMMAND_BUILDER(con->command_builder);
2020 int store_this_key = 0;
2021 struct gcpro gcpro1;
2024 /* DO NOT do QUIT anywhere within this function or the functions it calls.
2025 We want to read the ^G as an event. */
2027 #ifdef LWLIB_MENUBARS_LUCID
2029 * #### Fix the menu code so this isn't necessary.
2031 * We cannot allow the lwmenu code to be reentered, because the
2032 * code is not written to be reentrant and will crash. Therefore
2033 * paths from the menu callbacks back into the menu code have to
2034 * be blocked. Fnext_event is the normal path into the menu code,
2035 * so we signal an error here.
2037 if (in_menu_callback)
2038 error("Attempt to call next-event inside menu callback");
2039 #endif /* LWLIB_MENUBARS_LUCID */
2042 event = Fmake_event(Qnil, Qnil);
2044 CHECK_LIVE_EVENT(event);
2046 if (!NILP(prompt)) {
2048 CHECK_STRING(prompt);
2050 len = XSTRING_LENGTH(prompt);
2051 if (command_builder->echo_buf_length < len)
2052 len = command_builder->echo_buf_length - 1;
2053 memcpy(command_builder->echo_buf, XSTRING_DATA(prompt), len);
2054 command_builder->echo_buf[len] = 0;
2055 command_builder->echo_buf_index = len;
2056 echo_area_message(XFRAME(CONSOLE_SELECTED_FRAME(con)),
2057 command_builder->echo_buf,
2059 command_builder->echo_buf_index, Qcommand);
2062 start_over_and_avoid_hosage:
2063 /* If there is something in unread-command-events, simply return it.
2064 But do some error checking to make sure the user hasn't put something
2065 in the unread-command-events that they shouldn't have.
2066 This does not update this-command-keys and recent-keys.
2068 if (!NILP(Vunread_command_events)) {
2069 if (!CONSP(Vunread_command_events)) {
2070 Vunread_command_events = Qnil;
2071 signal_error(Qwrong_type_argument,
2072 list3(Qconsp, Vunread_command_events,
2073 Qunread_command_events));
2075 Lisp_Object e = XCAR(Vunread_command_events);
2076 Vunread_command_events = XCDR(Vunread_command_events);
2077 if (!EVENTP(e) || !command_event_p(e))
2078 signal_error(Qwrong_type_argument,
2079 list3(Qcommand_event_p, e,
2080 Qunread_command_events));
2083 Fcopy_event(e, event);
2084 DEBUG_PRINT_EMACS_EVENT("unread-command-events", event);
2088 /* Do similar for unread-command-event (obsoleteness support). */
2089 else if (!NILP(Vunread_command_event)) {
2090 Lisp_Object e = Vunread_command_event;
2091 Vunread_command_event = Qnil;
2093 if (!EVENTP(e) || !command_event_p(e)) {
2094 signal_error(Qwrong_type_argument,
2095 list3(Qeventp, e, Qunread_command_event));
2098 Fcopy_event(e, event);
2100 DEBUG_PRINT_EMACS_EVENT("unread-command-event", event);
2103 /* If we're executing a keyboard macro, take the next event from that,
2104 and update this-command-keys and recent-keys.
2105 Note that the unread-command-events take precedence over kbd macros.
2108 if (!NILP(Vexecuting_macro)) {
2110 pop_kbd_macro_event(event); /* This throws past us at
2113 DEBUG_PRINT_EMACS_EVENT("keyboard macro", event);
2115 /* Otherwise, read a real event, possibly from the
2116 command_event_queue, and update this-command-keys and
2119 run_pre_idle_hook();
2121 next_event_internal(event, 1);
2122 Vquit_flag = Qnil; /* Read C-g as an event. */
2127 status_notify(); /* Notice process change */
2130 alloca(0); /* Cause a garbage collection now */
2131 /* Since we can free the most stuff here
2132 * (since this is typically called from
2133 * the command-loop top-level). */
2134 #endif /* C_ALLOCA */
2136 if (object_dead_p(XEVENT(event)->channel)) {
2137 /* event_console_or_selected may crash if the channel is dead.
2138 Best just to eat it and get the next event. */
2139 goto start_over_and_avoid_hosage;
2142 /* OK, now we can stop the selected-console kludge and use the
2143 actual console from the event. */
2144 con = event_console_or_selected(event);
2145 command_builder = XCOMMAND_BUILDER(con->command_builder);
2147 switch (XEVENT_TYPE(event)) {
2148 case button_release_event:
2149 case misc_user_event:
2150 /* don't echo menu accelerator keys */
2151 reset_key_echo(command_builder, 1);
2153 case button_press_event:
2154 /* key or mouse input can trigger prompting */
2155 goto STORE_AND_EXECUTE_KEY;
2156 case key_press_event:
2157 /* any key input can trigger autosave */
2160 /* just list the other events here */
2162 case pointer_motion_event:
2166 case magic_eval_event:
2168 #ifdef EF_USE_ASYNEQ
2169 case eaten_myself_event:
2170 case work_started_event:
2171 case work_finished_event:
2172 #endif /* EF_USE_ASYNEQ */
2178 maybe_do_auto_save();
2180 STORE_AND_EXECUTE_KEY:
2181 if (store_this_key) {
2182 echo_key_event(command_builder, event);
2186 /* Store the last-input-event. The semantics of this is that it is
2187 the thing most recently returned by next-command-event. It need
2188 not have come from the keyboard or a keyboard macro, it may have
2189 come from unread-command-events. It's always a command-event (a
2190 key, click, or menu selection), never a motion or process event.
2192 if (!EVENTP(Vlast_input_event))
2193 Vlast_input_event = Fmake_event(Qnil, Qnil);
2194 if (XEVENT_TYPE(Vlast_input_event) == dead_event) {
2195 Vlast_input_event = Fmake_event(Qnil, Qnil);
2196 error("Someone deallocated last-input-event!");
2198 if (!EQ(event, Vlast_input_event))
2199 Fcopy_event(event, Vlast_input_event);
2201 /* last-input-char and last-input-time are derived from
2203 Note that last-input-char will never have its high-bit set, in an
2204 effort to sidestep the ambiguity between M-x and oslash.
2206 Vlast_input_char = Fevent_to_character(Vlast_input_event,
2211 if (!CONSP(Vlast_input_time))
2212 Vlast_input_time = Fcons(Qnil, Qnil);
2213 XCAR(Vlast_input_time) =
2214 make_int((EMACS_SECS(t) >> 16) & 0xffff);
2215 XCDR(Vlast_input_time) =
2216 make_int((EMACS_SECS(t) >> 0) & 0xffff);
2217 if (!CONSP(Vlast_command_event_time))
2218 Vlast_command_event_time = list3(Qnil, Qnil, Qnil);
2219 XCAR(Vlast_command_event_time) =
2220 make_int((EMACS_SECS(t) >> 16) & 0xffff);
2221 XCAR(XCDR(Vlast_command_event_time)) =
2222 make_int((EMACS_SECS(t) >> 0) & 0xffff);
2223 XCAR(XCDR(XCDR(Vlast_command_event_time)))
2224 = make_int(EMACS_USECS(t));
2226 /* If this key came from the keyboard or from a keyboard macro, then
2227 it goes into the recent-keys and this-command-keys vectors.
2228 If this key came from the keyboard, and we're defining a keyboard
2229 macro, then it goes into the macro.
2231 if (store_this_key) {
2232 if (!is_scrollbar_event(event)) /* #### not quite right, see
2233 comment in execute_command_event */
2234 push_this_command_keys(event);
2235 if (!inhibit_input_event_recording)
2236 push_recent_keys(event);
2237 dribble_out_event(event);
2238 if (!NILP(con->defining_kbd_macro) && NILP(Vexecuting_macro)) {
2239 if (!EVENTP(command_builder->current_events))
2240 finalize_kbd_macro_chars(con);
2241 store_kbd_macro_event(event);
2244 /* If this is the help char and there is a help form, then execute the
2245 help form and swallow this character. This is the only place where
2246 calling Fnext_event() can cause arbitrary lisp code to run. Note
2247 that execute_help_form() calls Fnext_command_event(), which calls
2248 this function, as well as Fdispatch_event.
2250 if (!NILP(Vhelp_form) &&
2251 event_matches_key_specifier_p(XEVENT(event), Vhelp_char))
2252 execute_help_form(command_builder, event);
2259 DEFUN("next-command-event", Fnext_command_event, 0, 2, 0, /*
2260 Return the next available "user" event.
2261 Pass this object to `dispatch-event' to handle it.
2263 If EVENT is non-nil, it should be an event object and will be filled in
2264 and returned; otherwise a new event object will be created and returned.
2265 If PROMPT is non-nil, it should be a string and will be displayed in the
2266 echo area while this function is waiting for an event.
2268 The event returned will be a keyboard, mouse press, or mouse release event.
2269 If there are non-command events available (mouse motion, sub-process output,
2270 etc) then these will be executed (with `dispatch-event') and discarded. This
2271 function is provided as a convenience; it is roughly equivalent to the lisp code
2274 (next-event event prompt)
2275 (not (or (key-press-event-p event)
2276 (button-press-event-p event)
2277 (button-release-event-p event)
2278 (misc-user-event-p event))))
2279 (dispatch-event event))
2281 but it also makes a provision for displaying keystrokes in the echo area.
2285 /* This function can GC */
2286 struct gcpro gcpro1;
2288 maybe_echo_keys(XCOMMAND_BUILDER(XCONSOLE(Vselected_console)->command_builder), 0); /* #### This sucks bigtime */
2290 event = Fnext_event(event, prompt);
2291 if (command_event_p(event))
2294 execute_internal_event(event);
2300 DEFUN("dispatch-non-command-events", Fdispatch_non_command_events, 0, 0, 0, /*
2301 Dispatch any pending "magic" events.
2303 This function is useful for forcing the redisplay of native
2304 widgets. Normally these are redisplayed through a native window-system
2305 event encoded as magic event, rather than by the redisplay code. This
2306 function does not call redisplay or do any of the other things that
2311 /* This function can GC */
2312 Lisp_Object event = Qnil;
2313 struct gcpro gcpro1;
2315 event = Fmake_event(Qnil, Qnil);
2317 /* Make sure that there will be something in the native event queue
2318 so that externally managed things (e.g. widgets) get some CPU
2320 event_stream_force_event_pending(selected_frame());
2322 while (event_stream_event_pending_p(0)) {
2323 QUIT; /* next_event_internal() does not QUIT. */
2325 /* We're a generator of the command_event_queue, so we can't be a
2326 consumer as well. Also, we have no reason to consult the
2327 command_event_queue; there are only user and eval-events there,
2328 and we'd just have to put them back anyway.
2330 next_event_internal(event, 0); /* blocks */
2331 /* See the comment in accept-process-output about Vquit_flag */
2332 if (XEVENT_TYPE(event) == magic_event ||
2333 XEVENT_TYPE(event) == timeout_event ||
2334 XEVENT_TYPE(event) == process_event ||
2335 XEVENT_TYPE(event) == pointer_motion_event)
2336 execute_internal_event(event);
2338 enqueue_command_event_1(event);
2343 Fdeallocate_event(event);
2348 static void reset_current_events(struct command_builder *command_builder)
2350 Lisp_Object event = command_builder->current_events;
2351 reset_command_builder_event_chain(command_builder);
2353 deallocate_event_chain(event);
2356 DEFUN("discard-input", Fdiscard_input, 0, 0, 0, /*
2357 Discard any pending "user" events.
2358 Also cancel any kbd macro being defined.
2359 A user event is a key press, button press, button release, or
2360 "misc-user" event (menu selection or scrollbar action).
2364 /* This throws away user-input on the queue, but doesn't process any
2365 events. Calling dispatch_event() here leads to a race condition.
2367 Lisp_Object event = Fmake_event(Qnil, Qnil);
2368 #ifndef EF_USE_ASYNEQ
2369 Lisp_Object head = Qnil, tail = Qnil;
2371 Lisp_Object oiq = Vinhibit_quit;
2372 struct gcpro gcpro1, gcpro2;
2373 /* #### not correct here with Vselected_console? Should
2374 discard-input take a console argument, or maybe map over
2376 struct console *con = XCONSOLE(Vselected_console);
2378 /* next_event_internal() can cause arbitrary Lisp code to be evalled */
2381 /* If a macro was being defined then we have to mark the modeline
2382 has changed to ensure that it gets updated correctly. */
2383 if (!NILP(con->defining_kbd_macro))
2384 MARK_MODELINE_CHANGED;
2385 con->defining_kbd_macro = Qnil;
2386 reset_current_events(XCOMMAND_BUILDER(con->command_builder));
2388 #ifdef EF_USE_ASYNEQ
2390 WITH_DLLIST_TRAVERSE(
2392 sxe_event_t *ev = dllist_item;
2393 if (command_event_p((Lisp_Object)ev)) {
2394 dllist_pop_inner(eq_queue(asyneq), _el);
2397 while (!EQ_EMPTY_P() || event_stream_event_pending_p(1)) {
2398 /* This will take stuff off the command_event_queue, or read it
2399 from the event_stream, but it will not block.
2401 next_event_internal(event, 1);
2402 Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it).
2403 It is vitally important that we reset
2404 Vquit_flag here. Otherwise, if we're
2405 reading from a TTY console,
2406 maybe_read_quit_event() will notice
2407 that C-g has been set and send us
2408 another C-g. That will cause us
2409 to get right back here, and read
2410 another C-g, ad infinitum ... */
2412 /* If the event is a user event, ignore it. */
2413 if (!command_event_p(event)) {
2414 /* Otherwise, chain the event onto our list of events
2415 not to ignore, and keep reading until the queue is
2416 empty. This does not mean that if a subprocess is
2417 generating an infinite amount of output, we will
2418 never terminate (*provided* that the behavior of
2419 next_event_cb() is correct -- see the comment in
2420 events.h), because this loop ends as soon as there
2421 are no more user events on the command_event_queue or
2424 enqueue_event(Fcopy_event(event, Qnil), &head, &tail);
2428 if (!EQ_EMPTY_P() || EQ_LARGE_P())
2431 /* Now tack our chain of events back on to the front of the queue.
2432 Actually, since the queue is now drained, we can just replace it.
2433 The effect of this will be that we have deleted all user events
2434 from the input stream without changing the relative ordering of
2435 any other events. (Some events may have been taken from the
2436 event_stream and added to the command_event_queue, however.)
2438 At this time, the command_event_queue will contain only eval_events.
2440 command_event_queue = head;
2441 command_event_queue_tail = tail;
2444 Fdeallocate_event(event);
2447 Vinhibit_quit = oiq;
2451 /**********************************************************************/
2452 /* pausing until an action occurs */
2453 /**********************************************************************/
2455 /* This is used in accept-process-output, sleep-for and sit-for.
2456 Before running any process_events in these routines, we set
2457 recursive_sit_for to Qt, and use this unwind protect to reset it to
2458 Qnil upon exit. When recursive_sit_for is Qt, calling sit-for will
2459 cause it to return immediately.
2461 All of these routines install timeouts, so we clear the installed
2464 Note: It's very easy to break the desired behaviors of these
2465 3 routines. If you make any changes to anything in this area, run
2466 the regression tests at the bottom of the file. -- dmoore */
2468 static Lisp_Object sit_for_unwind(Lisp_Object timeout_id)
2470 if (!NILP(timeout_id))
2471 Fdisable_timeout(timeout_id);
2473 recursive_sit_for = Qnil;
2477 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)?
2480 DEFUN("accept-process-output", Faccept_process_output, 0, 3, 0, /*
2481 Allow any pending output from subprocesses to be read by Emacs.
2482 It is read into the process' buffers or given to their filter functions.
2483 Non-nil arg PROCESS means do not return until some output has been received
2484 from PROCESS. Nil arg PROCESS means do not return until some output has
2485 been received from any process.
2487 If the second arg is non-nil, it is the maximum number of seconds to wait:
2488 this function will return after that much time even if no input has arrived
2489 from PROCESS. This argument may be a float, meaning wait some fractional
2492 If the third arg is non-nil, it is a number of milliseconds that is added
2493 to the second arg. (This exists only for compatibility.)
2494 Return non-nil iff we received any output before the timeout expired.
2496 (process, timeout_secs, timeout_msecs))
2498 /* This function can GC */
2499 struct gcpro gcpro1, gcpro2;
2500 Lisp_Object event = Qnil;
2501 Lisp_Object result = Qnil;
2502 int timeout_id = -1;
2503 int timeout_enabled = 0;
2505 struct buffer *old_buffer = current_buffer;
2508 /* We preserve the current buffer but nothing else. If a focus
2509 change alters the selected window then the top level event loop
2510 will eventually alter current_buffer to match. In the mean time
2511 we don't want to mess up whatever called this function. */
2514 CHECK_PROCESS(process);
2516 GCPRO2(event, process);
2518 if (!NILP(timeout_secs) || !NILP(timeout_msecs)) {
2519 unsigned long msecs = 0;
2520 if (!NILP(timeout_secs))
2521 msecs = lisp_number_to_milliseconds(timeout_secs, 1);
2522 if (!NILP(timeout_msecs)) {
2523 CHECK_NATNUM(timeout_msecs);
2524 msecs += XINT(timeout_msecs);
2528 event_stream_generate_wakeup(msecs, 0, Qnil, Qnil,
2530 timeout_enabled = 1;
2534 event = Fmake_event(Qnil, Qnil);
2536 count = specpdl_depth();
2537 record_unwind_protect(sit_for_unwind,
2538 timeout_enabled ? make_int(timeout_id) : Qnil);
2539 recursive_sit_for = Qt;
2542 ((NILP(process) && timeout_enabled) ||
2543 (NILP(process) && event_stream_event_pending_p(0)) ||
2545 /* Calling detect_input_pending() is the wrong thing here, because
2546 that considers the Vunread_command_events and command_event_queue.
2547 We don't need to look at the command_event_queue because we are
2548 only interested in process events, which don't go on that. In
2549 fact, we can't read from it anyway, because we put stuff on it.
2551 Note that event_stream->event_pending_p must be called in such
2552 a way that it says whether any events *of any kind* are ready,
2553 not just user events, or (accept-process-output nil) will fail
2554 to dispatch any process events that may be on the queue. It is
2555 not clear to me that this is important, because the top-level
2556 loop will process it, and I don't think that there is ever a
2557 time when one calls accept-process-output with a nil argument
2558 and really need the processes to be handled. */
2560 /* If our timeout has arrived, we move along. */
2562 && !event_stream_wakeup_pending_p(timeout_id, 0)) {
2563 timeout_enabled = 0;
2564 done = 1; /* We're done. */
2565 continue; /* Don't call next_event_internal */
2568 QUIT; /* next_event_internal() does not QUIT, so check
2569 for ^G before reading output from the process
2570 - this makes it less likely that the filter
2571 will actually be aborted.
2574 next_event_internal(event, 0);
2575 /* If C-g was pressed while we were waiting, Vquit_flag got
2576 set and next_event_internal() also returns C-g. When
2577 we enqueue the C-g below, it will get discarded. The
2578 next time through, QUIT will be called and will signal a quit. */
2579 switch (XEVENT_TYPE(event)) {
2581 if (NILP(process) ||
2582 EQ(XEVENT(event)->event.process.process,
2585 /* RMS's version always returns nil when
2586 proc is nil, and only returns t if
2587 input ever arrived on proc. */
2591 execute_internal_event(event);
2595 /* We execute the event even if it's ours, and notice
2596 that it's happened above. */
2597 case pointer_motion_event:
2599 execute_internal_event(event);
2602 /* just list the other events here */
2604 case key_press_event:
2605 case button_press_event:
2606 case button_release_event:
2607 case misc_user_event:
2608 case magic_eval_event:
2610 #ifdef EF_USE_ASYNEQ
2611 case eaten_myself_event:
2612 case work_started_event:
2613 case work_finished_event:
2614 #endif /* EF_USE_ASYNEQ */
2617 enqueue_command_event_1(event);
2622 unbind_to(count, timeout_enabled ? make_int(timeout_id) : Qnil);
2624 Fdeallocate_event(event);
2626 current_buffer = old_buffer;
2630 DEFUN("sleep-for", Fsleep_for, 1, 1, 0, /*
2631 Pause, without updating display, for SECONDS seconds.
2632 SECONDS may be a float, allowing pauses for fractional parts of a second.
2634 It is recommended that you never call sleep-for from inside of a process
2635 filter function or timer event (either synchronous or asynchronous).
2639 /* This function can GC */
2640 unsigned long msecs = lisp_number_to_milliseconds(seconds, 1);
2642 Lisp_Object event = Qnil;
2644 struct gcpro gcpro1;
2648 id = event_stream_generate_wakeup(msecs, 0, Qnil, Qnil, 0);
2649 event = Fmake_event(Qnil, Qnil);
2651 count = specpdl_depth();
2652 record_unwind_protect(sit_for_unwind, make_int(id));
2653 recursive_sit_for = Qt;
2656 /* If our timeout has arrived, we move along. */
2657 if (!event_stream_wakeup_pending_p(id, 0))
2660 /* next_event_internal() does not QUIT, so check for ^G before
2661 reading output from the process - this makes it less likely
2662 that the filter will actually be aborted.
2666 /* We're a generator of the command_event_queue, so we can't be
2667 a consumer as well. We don't care about command and
2670 next_event_internal(event, 0); /* blocks */
2671 /* See the comment in accept-process-output about Vquit_flag */
2672 switch (XEVENT_TYPE(event)) {
2674 /* We execute the event even if it's ours, and notice
2675 that it's happened above. */
2677 case pointer_motion_event:
2679 execute_internal_event(event);
2682 /* just list the other events here */
2684 case key_press_event:
2685 case button_press_event:
2686 case button_release_event:
2687 case magic_eval_event:
2689 case misc_user_event:
2690 #ifdef EF_USE_ASYNEQ
2691 case eaten_myself_event:
2692 case work_started_event:
2693 case work_finished_event:
2694 #endif /* EF_USE_ASYNEQ */
2697 enqueue_command_event_1(event);
2702 unbind_to(count, make_int(id));
2703 Fdeallocate_event(event);
2708 DEFUN("sit-for", Fsit_for, 1, 2, 0, /*
2709 Perform redisplay, then wait SECONDS seconds or until user input is available.
2710 SECONDS may be a float, meaning a fractional part of a second.
2711 Optional second arg NODISPLAY non-nil means don't redisplay; just wait.
2712 Redisplay is preempted as always if user input arrives, and does not
2713 happen if input is available before it starts.
2714 Value is t if waited the full time with no input arriving.
2716 If sit-for is called from within a process filter function or timer
2717 event (either synchronous or asynchronous) it will return immediately.
2719 (seconds, nodisplay))
2721 /* This function can GC */
2722 unsigned long msecs = lisp_number_to_milliseconds(seconds, 1);
2723 Lisp_Object event, result;
2724 struct gcpro gcpro1;
2728 /* The unread-command-events count as pending input */
2729 if (!NILP(Vunread_command_events) || !NILP(Vunread_command_event))
2732 /* If the command-builder already has user-input on it (not eval events)
2733 then that means we're done too.
2735 if (!EQ_EMPTY_P()) {
2736 #if defined(EF_USE_ASYNEQ)
2739 if (command_event_p(event)) {
2740 RETURN_FROM_EQ_TRAVERSE(asyneq, Qnil);
2743 EVENT_CHAIN_LOOP(event, command_event_queue) {
2744 if (command_event_p(event))
2750 /* If we're in a macro, or noninteractive, or early in temacs, then
2752 if (noninteractive || !NILP(Vexecuting_macro))
2755 /* Recursive call from a filter function or timeout handler. */
2756 if (!NILP(recursive_sit_for)) {
2757 if (!event_stream_event_pending_p(1) && NILP(nodisplay)) {
2758 run_pre_idle_hook();
2764 /* Otherwise, start reading events from the event_stream.
2765 Do this loop at least once even if (sit-for 0) so that we
2766 redisplay when no input pending.
2769 event = Fmake_event(Qnil, Qnil);
2771 /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc.
2772 events get processed. The old (pre-19.12) code special-cased this
2773 and didn't generate a wakeup, but the resulting behavior was less than
2774 ideal; viz. the occurrence of (sit-for 0.001) scattered throughout
2775 the E-Lisp universe. */
2777 id = event_stream_generate_wakeup(msecs, 0, Qnil, Qnil, 0);
2779 count = specpdl_depth();
2780 record_unwind_protect(sit_for_unwind, make_int(id));
2781 recursive_sit_for = Qt;
2784 /* If there is no user input pending, then redisplay.
2786 if (!event_stream_event_pending_p(1) && NILP(nodisplay)) {
2787 run_pre_idle_hook();
2791 /* If our timeout has arrived, we move along. */
2792 if (!event_stream_wakeup_pending_p(id, 0)) {
2797 /* next_event_internal() does not QUIT, so check for ^G
2798 before reading output from the process - this makes it
2799 less likely that the filter will actually be aborted.
2803 /* We're a generator of the command_event_queue, so we can't be
2804 a consumer as well. In fact, we know there's nothing on the
2805 command_event_queue that we didn't just put there.
2807 next_event_internal(event, 0); /* blocks */
2808 /* See the comment in accept-process-output about Vquit_flag */
2810 if (command_event_p(event)) {
2811 QUIT; /* If the command was C-g check it here
2812 so that we abort out of the sit-for,
2813 not the next command. sleep-for and
2814 accept-process-output continue looping
2815 so they check QUIT again implicitly. */
2820 switch (XEVENT_TYPE(event)) {
2822 /* eval-events get delayed until later. */
2823 enqueue_command_event(Fcopy_event(event, Qnil));
2827 /* We execute the event even if it's ours, and notice
2828 that it's happened above. */
2830 /* just list the rest here too */
2832 case key_press_event:
2833 case button_press_event:
2834 case button_release_event:
2835 case pointer_motion_event:
2838 case magic_eval_event:
2839 case misc_user_event:
2840 #ifdef EF_USE_ASYNEQ
2841 case eaten_myself_event:
2842 case work_started_event:
2843 case work_finished_event:
2844 #endif /* EF_USE_ASYNEQ */
2847 execute_internal_event(event);
2853 unbind_to(count, make_int(id));
2855 /* Put back the event (if any) that made Fsit_for() exit before the
2856 timeout. Note that it is being added to the back of the queue, which
2857 would be inappropriate if there were any user events on the queue
2858 already: we would be misordering them. But we know that there are
2859 no user-events on the queue, or else we would not have reached this
2863 enqueue_command_event(event);
2865 Fdeallocate_event(event);
2871 /* This handy little function is used by select-x.c to wait for replies
2872 from processes that aren't really processes (e.g. the X server) */
2873 void wait_delaying_user_input(int (*predicate) (void *arg), void *predicate_arg)
2875 /* This function can GC */
2876 Lisp_Object event = Fmake_event(Qnil, Qnil);
2877 struct gcpro gcpro1;
2880 while (!(*predicate) (predicate_arg)) {
2881 QUIT; /* next_event_internal() does not QUIT. */
2883 /* We're a generator of the command_event_queue, so we can't be a
2884 consumer as well. Also, we have no reason to consult the
2885 command_event_queue; there are only user and eval-events there,
2886 and we'd just have to put them back anyway.
2888 next_event_internal(event, 0);
2889 /* See the comment in accept-process-output about Vquit_flag */
2890 if (command_event_p(event)
2891 || (XEVENT_TYPE(event) == eval_event)
2892 || (XEVENT_TYPE(event) == magic_eval_event))
2893 enqueue_command_event_1(event);
2895 execute_internal_event(event);
2900 /**********************************************************************/
2901 /* dispatching events; command builder */
2902 /**********************************************************************/
2905 execute_internal_event(Lisp_Object event)
2907 /* events on dead channels get silently eaten */
2908 if (object_dead_p(XEVENT(event)->channel)) {
2912 /* This function can GC */
2913 switch (XEVENT_TYPE(event)) {
2918 call1(XEVENT(event)->event.eval.function,
2919 XEVENT(event)->event.eval.object);
2922 case magic_eval_event:
2923 (XEVENT(event)->event.magic_eval.internal_function)
2924 (XEVENT(event)->event.magic_eval.object);
2927 case pointer_motion_event:
2928 if (!NILP(Vmouse_motion_handler))
2929 call1(Vmouse_motion_handler, event);
2932 case process_event: {
2933 Lisp_Object p = XEVENT(event)->event.process.process;
2934 Charcount readstatus;
2936 assert(PROCESSP(p));
2937 while ((readstatus = read_process_output(p)) > 0) ;
2938 if (readstatus > 0) ; /* this clauses never gets
2939 executed but allows the
2940 #ifdefs to work cleanly. */
2942 else if (readstatus == -1 && errno == EWOULDBLOCK) ;
2943 #endif /* EWOULDBLOCK */
2945 else if (readstatus == -1 && errno == EAGAIN) ;
2947 else if ((readstatus == 0 &&
2948 /* Note that we cannot distinguish between no
2949 input available now and a closed pipe.
2950 With luck, a closed pipe will be
2951 accompanied by subprocess termination and
2953 (!network_connection_p(p) ||
2955 When connected to ToolTalk (i.e.
2956 connected_via_filedesc_p()), it's not
2957 possible to reliably determine whether
2958 there is a message waiting for ToolTalk to
2959 receive. ToolTalk expects to have
2960 tt_message_receive() called exactly once
2961 every time the file descriptor becomes
2962 active, so the filter function forces this
2963 by returning 0. Emacs must not interpret
2964 this as a closed pipe. */
2965 connected_via_filedesc_p(XPROCESS(p))))
2967 /* On some OSs with ptys, when the process on
2968 one end of a pty exits, the other end gets
2969 an error reading with errno = EIO instead of
2970 getting an EOF (0 bytes read). Therefore,
2971 if we get an error reading and errno = EIO,
2972 just continue, because the child process has
2973 exited and should clean itself up soon
2974 (e.g. when we get a SIGCHLD). */
2975 || (readstatus == -1 && errno == EIO)
2978 /* Currently, we rely on SIGCHLD to indicate
2979 that the process has terminated.
2980 Unfortunately, on some systems the SIGCHLD
2981 gets missed some of the time. So we put an
2982 additional check in status_notify() to see
2983 whether a process has terminated. We must
2984 tell status_notify() to enable that check,
2985 and we do so now. */
2986 kick_status_notify();
2988 /* Deactivate network connection */
2989 Lisp_Object status = Fprocess_status(p);
2990 if (EQ(status, Qopen)
2991 /* In case somebody changes the theory of
2992 whether to return open as opposed to run
2993 for network connection "processes"... */
2994 || EQ(status, Qrun))
2995 update_process_status(p, Qexit, 256, 0);
2996 deactivate_process(p);
2999 /* We must call status_notify here to allow the
3000 event_stream->unselect_process_cb to be run if appropriate.
3001 Otherwise, dead fds may be selected for, and we will get a
3002 continuous stream of process events for them. Since we don't
3003 return until all process events have been flushed, we would
3004 get stuck here, processing events on a process whose status
3005 was 'exit. Call this after dispatch-event, or the fds will
3006 have been closed before we read the last data from them.
3007 It's safe for the filter to signal an error because
3008 status_notify() will be called on return to top-level.
3014 case timeout_event: {
3015 Lisp_Event *e = XEVENT(event);
3016 if (!NILP(e->event.timeout.function))
3017 call1(e->event.timeout.function,
3018 e->event.timeout.object);
3023 event_stream_handle_magic_event(XEVENT(event));
3026 #ifdef EF_USE_ASYNEQ
3027 case work_started_event:
3028 case work_finished_event:
3029 case eaten_myself_event:
3031 #endif /* EF_USE_ASYNEQ */
3033 /* not sure about the next ones, but they've
3034 * always been unhandled and so be they ... */
3035 case key_press_event:
3036 case button_press_event:
3037 case button_release_event:
3038 case misc_user_event:
3039 /* and now the ones i'm quite sure about */
3048 this_command_keys_replace_suffix(Lisp_Object suffix, Lisp_Object chain)
3050 Lisp_Object first_before_suffix =
3051 event_chain_find_previous(Vthis_command_keys, suffix);
3053 if (NILP(first_before_suffix))
3054 Vthis_command_keys = chain;
3056 XSET_EVENT_NEXT(first_before_suffix, chain);
3057 deallocate_event_chain(suffix);
3058 Vthis_command_keys_tail = event_chain_tail(chain);
3062 command_builder_replace_suffix(struct command_builder *builder,
3063 Lisp_Object suffix, Lisp_Object chain)
3065 Lisp_Object first_before_suffix =
3066 event_chain_find_previous(builder->current_events, suffix);
3068 if (NILP(first_before_suffix))
3069 builder->current_events = chain;
3071 XSET_EVENT_NEXT(first_before_suffix, chain);
3072 deallocate_event_chain(suffix);
3073 builder->most_current_event = event_chain_tail(chain);
3076 static Lisp_Object command_builder_find_leaf_1(struct command_builder *builder)
3078 Lisp_Object event0 = builder->current_events;
3083 return event_binding(event0, 1);
3086 /* See if we can do function-key-map or key-translation-map translation
3087 on the current events in the command builder. If so, do this, and
3088 return the resulting binding, if any. */
3091 munge_keymap_translate(struct command_builder *builder,
3092 enum munge_me_out_the_door munge,
3093 int has_normal_binding_p)
3097 EVENT_CHAIN_LOOP(suffix, builder->munge_me[munge].first_mungeable_event) {
3098 Lisp_Object result =
3099 munging_key_map_event_binding(suffix, munge);
3104 if (KEYMAPP(result)) {
3105 if (NILP(builder->last_non_munged_event)
3106 && !has_normal_binding_p)
3107 builder->last_non_munged_event =
3108 builder->most_current_event;
3110 builder->last_non_munged_event = Qnil;
3112 if (!KEYMAPP(result) && !VECTORP(result) && !STRINGP(result)) {
3113 struct gcpro gcpro1;
3115 result = call1(result, Qnil);
3121 if (KEYMAPP(result))
3124 if (VECTORP(result) || STRINGP(result)) {
3125 Lisp_Object new_chain =
3126 key_sequence_to_event_chain(result);
3130 /* If the first_mungeable_event of the other munger is
3131 within the events we're munging, then it will point to
3132 deallocated events afterwards, which is bad -- so make it
3133 point at the beginning of the munged events. */
3134 EVENT_CHAIN_LOOP(tempev, suffix) {
3135 Lisp_Object *mungeable_event =
3136 &builder->munge_me[1 -
3138 first_mungeable_event;
3139 if (EQ(tempev, *mungeable_event)) {
3140 *mungeable_event = new_chain;
3145 n = event_chain_count(suffix);
3146 command_builder_replace_suffix(builder, suffix,
3148 builder->munge_me[munge].first_mungeable_event = Qnil;
3149 /* Now hork this-command-keys as well. */
3151 /* We just assume that the events we just replaced are
3152 sitting in copied form at the end of this-command-keys.
3153 If the user did weird things with `dispatch-event' this
3154 may not be the case, but at least we make sure we won't
3156 new_chain = copy_event_chain(new_chain);
3157 tckn = event_chain_count(Vthis_command_keys);
3159 this_command_keys_replace_suffix
3161 (Vthis_command_keys, tckn - n), new_chain);
3164 result = command_builder_find_leaf_1(builder);
3168 signal_simple_error((munge == MUNGE_ME_FUNCTION_KEY ?
3169 "Invalid binding in function-key-map" :
3170 "Invalid binding in key-translation-map"),
3177 /* Compare the current state of the command builder against the local and
3178 global keymaps, and return the binding. If there is no match, try again,
3179 case-insensitively. The return value will be one of:
3180 -- nil (there is no binding)
3181 -- a keymap (part of a command has been specified)
3182 -- a command (anything that satisfies `commandp'; this includes
3183 some symbols, lists, subrs, strings, vectors, and
3184 compiled-function objects)
3187 command_builder_find_leaf(struct command_builder *builder,
3188 int allow_misc_user_events_p)
3190 /* This function can GC */
3192 Lisp_Object evee = builder->current_events;
3194 if (XEVENT_TYPE(evee) == misc_user_event) {
3195 if (allow_misc_user_events_p && (NILP(XEVENT_NEXT(evee))))
3196 return list2(XEVENT(evee)->event.eval.function,
3197 XEVENT(evee)->event.eval.object);
3202 /* if we're currently in a menu accelerator, check there for further
3204 /* #### fuck me! who wrote this crap? think "abstraction", baby. */
3205 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3206 if (x_kludge_lw_menu_active()) {
3207 return command_builder_operate_menu_accelerator(builder);
3210 if (EQ(Vmenu_accelerator_enabled, Qmenu_force))
3211 result = command_builder_find_menu_accelerator(builder);
3214 result = command_builder_find_leaf_1(builder);
3215 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3217 && EQ(Vmenu_accelerator_enabled, Qmenu_fallback))
3218 result = command_builder_find_menu_accelerator(builder);
3222 /* Check to see if we have a potential function-key-map match. */
3225 munge_keymap_translate(builder, MUNGE_ME_FUNCTION_KEY, 0);
3226 regenerate_echo_keys_from_this_command_keys(builder);
3228 /* Check to see if we have a potential key-translation-map match. */
3230 Lisp_Object key_translate_result =
3231 munge_keymap_translate(builder, MUNGE_ME_KEY_TRANSLATION,
3233 if (!NILP(key_translate_result)) {
3234 result = key_translate_result;
3235 regenerate_echo_keys_from_this_command_keys(builder);
3242 /* If key-sequence wasn't bound, we'll try some fallbacks. */
3244 /* If we didn't find a binding, and the last event in the sequence is
3245 a shifted character, then try again with the lowercase version. */
3247 if (XEVENT_TYPE(builder->most_current_event) == key_press_event
3248 && !NILP(Vretry_undefined_key_binding_unshifted)) {
3249 Lisp_Object terminal = builder->most_current_event;
3250 struct key_data *key = &XEVENT(terminal)->event.key;
3252 if ((key->modifiers & XEMACS_MOD_SHIFT)
3253 || (CHAR_OR_CHAR_INTP(key->keysym)
3254 && ((c = XCHAR_OR_CHAR_INT(key->keysym)), c >= 'A'
3256 Lisp_Event terminal_copy = *XEVENT(terminal);
3258 if (key->modifiers & XEMACS_MOD_SHIFT)
3259 key->modifiers &= (~XEMACS_MOD_SHIFT);
3261 key->keysym = make_char(c + 'a' - 'A');
3264 command_builder_find_leaf(builder,
3265 allow_misc_user_events_p);
3268 /* If there was no match with the lower-case version either,
3269 then put back the upper-case event for the error
3270 message. But make sure that function-key-map didn't
3271 change things out from under us. */
3272 if (EQ(terminal, builder->most_current_event))
3273 *XEVENT(terminal) = terminal_copy;
3277 /* help-char is `auto-bound' in every keymap */
3278 if (!NILP(Vprefix_help_command) &&
3279 event_matches_key_specifier_p(XEVENT(builder->most_current_event),
3281 return Vprefix_help_command;
3284 /* If keysym is a non-ASCII char, bind it to self-insert-char by default. */
3285 if (XEVENT_TYPE(builder->most_current_event) == key_press_event
3286 && !NILP(Vcomposed_character_default_binding)) {
3287 Lisp_Object keysym =
3288 XEVENT(builder->most_current_event)->event.key.keysym;
3289 if (CHARP(keysym) && !CHAR_ASCII_P(XCHAR(keysym)))
3290 return Vcomposed_character_default_binding;
3292 #endif /* HAVE_XIM */
3294 /* If we read extra events attempting to match a function key but end
3295 up failing, then we release those events back to the command loop
3296 and fail on the original lookup. The released events will then be
3297 reprocessed in the context of the first part having failed. */
3298 if (!NILP(builder->last_non_munged_event)) {
3299 Lisp_Object event0 = builder->last_non_munged_event;
3301 /* Put the commands back on the event queue. */
3302 #ifdef EF_USE_ASYNEQ
3303 eq_enqueue_event_chain(asyneq, XEVENT_NEXT(event0));
3305 enqueue_event_chain(XEVENT_NEXT(event0),
3306 &command_event_queue,
3307 &command_event_queue_tail);
3309 /* Then remove them from the command builder. */
3310 XSET_EVENT_NEXT(event0, Qnil);
3311 builder->most_current_event = event0;
3312 builder->last_non_munged_event = Qnil;
3318 /* Every time a command-event (a key, button, or menu selection) is read by
3319 Fnext_event(), it is stored in the recent_keys_ring, in Vlast_input_event,
3320 and in Vthis_command_keys. (Eval-events are not stored there.)
3322 Every time a command is invoked, Vlast_command_event is set to the last
3323 event in the sequence.
3325 This means that Vthis_command_keys is really about "input read since the
3326 last command was executed" rather than about "what keys invoked this
3327 command." This is a little counterintuitive, but that's the way it
3330 As an extra kink, the function read-key-sequence resets/updates the
3331 last-command-event and this-command-keys. It doesn't append to the
3332 command-keys as read-char does. Such are the pitfalls of having to
3333 maintain compatibility with a program for which the only specification
3336 (We could implement recent_keys_ring and Vthis_command_keys as the same
3340 DEFUN("recent-keys", Frecent_keys, 0, 1, 0, /*
3341 Return a vector of recent keyboard or mouse button events read.
3342 If NUMBER is non-nil, not more than NUMBER events will be returned.
3343 Change number of events stored using `set-recent-keys-ring-size'.
3345 This copies the event objects into a new vector; it is safe to keep and
3350 struct gcpro gcpro1;
3351 Lisp_Object val = Qnil;
3353 int start, nkeys, i, j;
3357 nwanted = recent_keys_ring_size;
3359 CHECK_NATNUM(number);
3360 nwanted = XINT(number);
3363 /* Create the keys ring vector, if none present. */
3364 if (NILP(Vrecent_keys_ring)) {
3365 Vrecent_keys_ring = make_vector(recent_keys_ring_size, Qnil);
3366 /* And return nothing in particular. */
3367 RETURN_UNGCPRO(make_vector(0, Qnil));
3370 if (NILP(XVECTOR_DATA(Vrecent_keys_ring)[recent_keys_ring_index]))
3371 /* This means the vector has not yet wrapped */
3373 nkeys = recent_keys_ring_index;
3376 nkeys = recent_keys_ring_size;
3378 ((recent_keys_ring_index ==
3379 nkeys) ? 0 : recent_keys_ring_index);
3382 if (nwanted < nkeys) {
3383 start += nkeys - nwanted;
3384 if (start >= recent_keys_ring_size)
3385 start -= recent_keys_ring_size;
3390 val = make_vector(nwanted, Qnil);
3392 for (i = 0, j = start; i < nkeys; i++) {
3393 Lisp_Object e = XVECTOR_DATA(Vrecent_keys_ring)[j];
3397 XVECTOR_DATA(val)[i] = Fcopy_event(e, Qnil);
3398 if (++j >= recent_keys_ring_size)
3405 DEFUN("recent-keys-ring-size", Frecent_keys_ring_size, 0, 0, 0, /*
3406 The maximum number of events `recent-keys' can return.
3410 return make_int(recent_keys_ring_size);
3413 DEFUN("set-recent-keys-ring-size", Fset_recent_keys_ring_size, 1, 1, 0, /*
3414 Set the maximum number of events to be stored internally.
3418 Lisp_Object new_vector = Qnil;
3419 int i, j, nkeys, start, min;
3420 struct gcpro gcpro1;
3423 if (XINT(size) <= 0)
3424 error("Recent keys ring size must be positive");
3425 if (XINT(size) == recent_keys_ring_size)
3429 new_vector = make_vector(XINT(size), Qnil);
3431 if (NILP(Vrecent_keys_ring)) {
3432 Vrecent_keys_ring = new_vector;
3433 RETURN_UNGCPRO(size);
3436 if (NILP(XVECTOR_DATA(Vrecent_keys_ring)[recent_keys_ring_index]))
3437 /* This means the vector has not yet wrapped */
3439 nkeys = recent_keys_ring_index;
3442 nkeys = recent_keys_ring_size;
3444 ((recent_keys_ring_index ==
3445 nkeys) ? 0 : recent_keys_ring_index);
3448 if (XINT(size) > nkeys)
3453 for (i = 0, j = start; i < min; i++) {
3454 XVECTOR_DATA(new_vector)[i] =
3455 XVECTOR_DATA(Vrecent_keys_ring)[j];
3456 if (++j >= recent_keys_ring_size)
3459 recent_keys_ring_size = XINT(size);
3460 recent_keys_ring_index = (i < recent_keys_ring_size) ? i : 0;
3462 Vrecent_keys_ring = new_vector;
3468 /* Vthis_command_keys having value Qnil means that the next time
3469 push_this_command_keys is called, it should start over.
3470 The times at which the command-keys are reset
3471 (instead of merely being augmented) are pretty counterintuitive.
3474 -- We do not reset this-command-keys when we finish reading a
3475 command. This is because some commands (e.g. C-u) act
3476 like command prefixes; they signal this by setting prefix-arg
3478 -- Therefore, we reset this-command-keys when we finish
3479 executing a command, unless prefix-arg is set.
3480 -- However, if we ever do a non-local exit out of a command
3481 loop (e.g. an error in a command), we need to reset
3482 this-command-keys. We do this by calling reset_this_command_keys()
3483 from cmdloop.c, whenever an error causes an invocation of the
3484 default error handler, and whenever there's a throw to top-level.)
3487 void reset_this_command_keys(Lisp_Object console, int clear_echo_area_p)
3489 if (!NILP(console)) {
3490 /* console is nil if we just deleted the console as a result of C-x 5
3491 0. Unfortunately things are currently in a messy situation where
3492 some stuff is console-local and other stuff isn't, so we need to
3493 do everything that's not console-local. */
3494 struct command_builder *command_builder =
3495 XCOMMAND_BUILDER(XCONSOLE(console)->command_builder);
3497 reset_key_echo(command_builder, clear_echo_area_p);
3498 reset_current_events(command_builder);
3500 reset_key_echo(0, clear_echo_area_p);
3502 deallocate_event_chain(Vthis_command_keys);
3503 Vthis_command_keys = Qnil;
3504 Vthis_command_keys_tail = Qnil;
3507 static void push_this_command_keys(Lisp_Object event)
3509 Lisp_Object new = Fmake_event(Qnil, Qnil);
3511 Fcopy_event(event, new);
3512 enqueue_event(new, &Vthis_command_keys, &Vthis_command_keys_tail);
3515 /* The following two functions are used in call-interactively,
3516 for the @ and e specifications. We used to just use
3517 `current-mouse-event' (i.e. the last mouse event in this-command-keys),
3518 but FSF does it more generally so we follow their lead. */
3520 Lisp_Object extract_this_command_keys_nth_mouse_event(int n)
3524 EVENT_CHAIN_LOOP(event, Vthis_command_keys) {
3526 && (XEVENT_TYPE(event) == button_press_event
3527 || XEVENT_TYPE(event) == button_release_event
3528 || XEVENT_TYPE(event) == misc_user_event)) {
3530 /* must copy to avoid an abort() in next_event_internal() */
3531 if (!NILP(XEVENT_NEXT(event)))
3532 return Fcopy_event(event, Qnil);
3543 Lisp_Object extract_vector_nth_mouse_event(Lisp_Object vector, int n)
3546 int len = XVECTOR_LENGTH(vector);
3548 for (i = 0; i < len; i++) {
3549 Lisp_Object event = XVECTOR_DATA(vector)[i];
3550 if (EVENTP(event)) {
3551 switch (XEVENT_TYPE(event)) {
3552 case button_press_event:
3553 case button_release_event:
3554 case misc_user_event:
3560 /* the rest of 'em cases */
3562 case key_press_event:
3563 case pointer_motion_event:
3567 case magic_eval_event:
3569 #ifdef EF_USE_ASYNEQ
3570 case eaten_myself_event:
3571 case work_started_event:
3572 case work_finished_event:
3573 #endif /* EF_USE_ASYNEQ */
3584 static void push_recent_keys(Lisp_Object event)
3588 if (NILP(Vrecent_keys_ring))
3589 Vrecent_keys_ring = make_vector(recent_keys_ring_size, Qnil);
3591 e = XVECTOR_DATA(Vrecent_keys_ring)[recent_keys_ring_index];
3594 e = Fmake_event(Qnil, Qnil);
3595 XVECTOR_DATA(Vrecent_keys_ring)[recent_keys_ring_index] = e;
3597 Fcopy_event(event, e);
3598 if (++recent_keys_ring_index == recent_keys_ring_size)
3599 recent_keys_ring_index = 0;
3603 current_events_into_vector(struct command_builder *command_builder)
3607 int n = event_chain_count(command_builder->current_events);
3609 /* Copy the vector and the events in it. */
3610 /* No need to copy the events, since they're already copies, and
3611 nobody other than the command-builder has pointers to them */
3612 vector = make_vector(n, Qnil);
3614 EVENT_CHAIN_LOOP(event, command_builder->current_events)
3615 XVECTOR_DATA(vector)[n++] = event;
3616 reset_command_builder_event_chain(command_builder);
3621 Given the current state of the command builder and a new command event
3622 that has just been dispatched:
3624 -- add the event to the event chain forming the current command
3625 (doing meta-translation as necessary)
3626 -- return the binding of this event chain; this will be one of:
3627 -- nil (there is no binding)
3628 -- a keymap (part of a command has been specified)
3629 -- a command (anything that satisfies `commandp'; this includes
3630 some symbols, lists, subrs, strings, vectors, and
3631 compiled-function objects)
3634 lookup_command_event(struct command_builder *command_builder,
3635 Lisp_Object event, int allow_misc_user_events_p)
3637 /* This function can GC */
3638 struct frame *f = selected_frame();
3639 /* Clear output from previous command execution */
3640 if (!EQ(Qcommand, echo_area_status(f))
3641 /* but don't let mouse-up clear what mouse-down just printed */
3642 && (XEVENT(event)->event_type != button_release_event))
3643 clear_echo_area(f, Qnil, 0);
3645 /* Add the given event to the command builder.
3646 Extra hack: this also updates the recent_keys_ring and Vthis_command_keys
3647 vectors to translate "ESC x" to "M-x" (for any "x" of course).
3650 Lisp_Object recent = command_builder->most_current_event;
3653 && event_matches_key_specifier_p(XEVENT(recent),
3654 Vmeta_prefix_char)) {
3656 /* When we see a sequence like "ESC x", pretend we really saw "M-x".
3657 DoubleThink the recent-keys and this-command-keys as well. */
3659 /* Modify the previous most-recently-pushed event on the command
3660 builder to be a copy of this one with the meta-bit set instead of
3661 pushing a new event.
3663 Fcopy_event(event, recent);
3665 if (e->event_type == key_press_event)
3666 e->event.key.modifiers |= XEMACS_MOD_META;
3667 else if (e->event_type == button_press_event
3668 || e->event_type == button_release_event)
3669 e->event.button.modifiers |= XEMACS_MOD_META;
3675 event_chain_count(Vthis_command_keys);
3677 /* ??? very strange if it's < 2. */
3678 this_command_keys_replace_suffix
3680 (Vthis_command_keys, tckn - 2),
3681 Fcopy_event(recent, Qnil));
3684 regenerate_echo_keys_from_this_command_keys
3687 event = Fcopy_event(event, Fmake_event(Qnil, Qnil));
3689 command_builder_append_event(command_builder, event);
3694 Lisp_Object leaf = command_builder_find_leaf(command_builder,
3695 allow_misc_user_events_p);
3696 struct gcpro gcpro1;
3699 if (KEYMAPP(leaf)) {
3700 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
3701 if (!x_kludge_lw_menu_active())
3706 Lisp_Object prompt = Fkeymap_prompt(leaf, Qt);
3707 if (STRINGP(prompt)) {
3708 /* Append keymap prompt to key echo buffer */
3710 command_builder->echo_buf_index;
3711 Bytecount len = XSTRING_LENGTH(prompt);
3713 if (len + buf_index + 1 <=
3714 command_builder->echo_buf_length) {
3716 command_builder->echo_buf +
3719 XSTRING_DATA(prompt),
3723 maybe_echo_keys(command_builder, 1);
3725 maybe_echo_keys(command_builder, 0);
3726 } else if (!NILP(Vquit_flag)) {
3727 Lisp_Object quit_event =
3728 Fmake_event(Qnil, Qnil);
3729 Lisp_Event *e = XEVENT(quit_event);
3730 /* if quit happened during menu acceleration,
3731 pretend we read it */
3732 Lisp_Object tmp = Fselected_console();
3733 struct console *con = XCONSOLE(tmp);
3734 int ch = CONSOLE_QUIT_CHAR(con);
3736 character_to_event(ch, e, con, 1, 1);
3737 e->channel = make_console(con);
3739 enqueue_command_event(quit_event);
3742 } else if (!NILP(leaf)) {
3743 if (EQ(Qcommand, echo_area_status(f))
3744 && command_builder->echo_buf_index > 0) {
3745 /* If we had been echoing keys, echo the last
3746 one (without the trailing dash) and redisplay
3747 before executing the command. */
3748 command_builder->echo_buf[command_builder->
3749 echo_buf_index] = 0;
3750 maybe_echo_keys(command_builder, 1);
3751 Fsit_for(Qzero, Qt);
3754 RETURN_UNGCPRO(leaf);
3758 static int is_scrollbar_event(Lisp_Object event)
3760 #ifdef HAVE_SCROLLBARS
3763 if (XEVENT(event)->event_type != misc_user_event)
3765 fun = XEVENT(event)->event.misc.function;
3767 return (EQ(fun, Qscrollbar_line_up) ||
3768 EQ(fun, Qscrollbar_line_down) ||
3769 EQ(fun, Qscrollbar_page_up) ||
3770 EQ(fun, Qscrollbar_page_down) ||
3771 EQ(fun, Qscrollbar_to_top) ||
3772 EQ(fun, Qscrollbar_to_bottom) ||
3773 EQ(fun, Qscrollbar_vertical_drag) ||
3774 EQ(fun, Qscrollbar_char_left) ||
3775 EQ(fun, Qscrollbar_char_right) ||
3776 EQ(fun, Qscrollbar_page_left) ||
3777 EQ(fun, Qscrollbar_page_right) ||
3778 EQ(fun, Qscrollbar_to_left) ||
3779 EQ(fun, Qscrollbar_to_right) ||
3780 EQ(fun, Qscrollbar_horizontal_drag));
3783 #endif /* HAVE_SCROLLBARS */
3787 execute_command_event(struct command_builder *cmd_builder, Lisp_Object event)
3789 /* This function can GC */
3790 struct console *con = XCONSOLE(cmd_builder->console);
3791 struct gcpro gcpro1;
3793 GCPRO1(event); /* event may be freshly created */
3795 /* #### This call to is_scrollbar_event() isn't quite right, but
3796 fixing properly it requires more work than can go into 21.4.
3797 (We really need to split out menu, scrollbar, dialog, and other
3798 types of events from misc-user, and put the remaining ones in a
3799 new `user-eval' type that behaves like an eval event but is a
3800 user event and thus has all of its semantics -- e.g. being
3801 delayed during `accept-process-output' and similar wait states.)
3803 The real issue here is that "user events" and "command events"
3804 are not the same thing, but are very much confused in
3805 event-stream.c. User events are, essentially, any event that
3806 should be delayed by accept-process-output, should terminate a
3807 sit-for, etc. -- basically, any event that needs to be processed
3808 synchronously with key and mouse events. Command events are
3809 those that participate in command building; scrollbar events
3810 clearly don't belong because they should be transparent in a
3811 sequence like C-x @ h <scrollbar-drag> x, which used to cause a
3812 crash before checks similar to the is_scrollbar_event() call were
3813 added. Do other events belong with scrollbar events? I'm not
3814 sure; we need to categorize all misc-user events and see what
3815 their semantics are.
3817 (You might ask, why do scrollbar events need to be user events?
3818 That's a good question. The answer seems to be that they can
3819 change point, and having this happen asynchronously would be a
3820 very bad idea. According to the "proper" functioning of
3821 scrollbars, this should not happen, but SXEmacs does not allow
3822 point to go outside of the window.)
3824 Scrollbar events and similar non-command events should obviously
3825 not be recorded in this-command-keys, so we need to check for
3828 #### We call reset_current_events() twice in this function --
3829 #### here, and later as a result of reset_this_command_keys().
3830 #### This is almost certainly wrong; need to figure out what's
3833 #### We need to figure out what's really correct w.r.t. scrollbar
3834 #### events. With these new fixes in, it actually works to do
3835 #### C-x <scrollbar-drag> 5 2, but the key echo gets messed up
3836 #### (starts over at 5). We really need to be special-casing
3837 #### scrollbar events at a lower level, and not really passing
3838 #### them through the command builder at all. (e.g. do scrollbar
3839 #### events belong in macros??? doubtful; probably only the
3840 #### point movement, if any, belongs, special-cased as a
3841 #### pseudo-issued M-x goto-char command). #### Need more work
3842 #### here. Do this when separating out scrollbar events.
3845 if (!is_scrollbar_event(event))
3846 reset_current_events(cmd_builder);
3848 switch (XEVENT(event)->event_type) {
3849 case key_press_event:
3850 Vcurrent_mouse_event = Qnil;
3852 case button_press_event:
3853 case button_release_event:
3854 case misc_user_event:
3855 Vcurrent_mouse_event = Fcopy_event(event, Qnil);
3858 /* just list the other cases here */
3860 case pointer_motion_event:
3864 case magic_eval_event:
3866 #ifdef EF_USE_ASYNEQ
3867 case eaten_myself_event:
3868 case work_started_event:
3869 case work_finished_event:
3870 #endif /* EF_USE_ASYNEQ */
3876 /* Store the last-command-event. The semantics of this is that it
3877 is the last event most recently involved in command-lookup. */
3878 if (!EVENTP(Vlast_command_event))
3879 Vlast_command_event = Fmake_event(Qnil, Qnil);
3880 if (XEVENT(Vlast_command_event)->event_type == dead_event) {
3881 Vlast_command_event = Fmake_event(Qnil, Qnil);
3882 error("Someone deallocated the last-command-event!");
3885 if (!EQ(event, Vlast_command_event))
3886 Fcopy_event(event, Vlast_command_event);
3888 /* Note that last-command-char will never have its high-bit set, in
3889 an effort to sidestep the ambiguity between M-x and oslash. */
3890 Vlast_command_char = Fevent_to_character(Vlast_command_event,
3893 /* Actually call the command, with all sorts of hair to preserve or clear
3894 the echo-area and region as appropriate and call the pre- and post-
3897 int old_kbd_macro = con->kbd_macro_end;
3898 Lisp_Object tmp = Fselected_window(Qnil);
3899 struct window *w = XWINDOW(tmp);
3901 /* We're executing a new command, so the old value is irrelevant. */
3902 zmacs_region_stays = 0;
3904 /* If the previous command tried to force a specific window-start,
3905 reset the flag in case this command moves point far away from
3906 that position. Also, reset the window's buffer's change
3907 information so that we don't trigger an incremental update. */
3908 if (w->force_start) {
3910 buffer_reset_changes(XBUFFER(w->buffer));
3915 if (XEVENT(event)->event_type == misc_user_event) {
3916 call1(XEVENT(event)->event.eval.function,
3917 XEVENT(event)->event.eval.object);
3919 Fcommand_execute(Vthis_command, Qnil, Qnil);
3922 post_command_hook();
3924 /* Console might have been deleted by command */
3925 if (CONSOLE_LIVE_P(con) && !NILP(con->prefix_arg)) {
3926 /* Commands that set the prefix arg don't update
3927 last-command, don't reset the echoing state, and
3928 don't go into keyboard macros unless followed by
3929 another command. Also don't quit here. */
3930 int speccount = specpdl_depth();
3931 specbind(Qinhibit_quit, Qt);
3932 maybe_echo_keys(cmd_builder, 0);
3933 unbind_to(speccount, Qnil);
3935 /* If we're recording a keyboard macro, and the last
3936 command executed set a prefix argument, then
3937 decrement the pointer to the "last character really
3938 in the macro" to be just before this command. This
3939 is so that the ^U in "^U ^X )" doesn't go onto the
3941 if (!NILP(con->defining_kbd_macro))
3942 con->kbd_macro_end = old_kbd_macro;
3944 /* Start a new command next time */
3945 Vlast_command = Vthis_command;
3946 Vlast_command_properties = Vthis_command_properties;
3947 Vthis_command_properties = Qnil;
3949 /* Emacs 18 doesn't unconditionally clear the echoed
3950 keystrokes, so we don't either */
3951 /* who cares about RMSmacs 18? */
3952 if (!is_scrollbar_event(event))
3953 reset_this_command_keys(CONSOLE_LIVE_P(con) ?
3961 /* Run the pre command hook. */
3963 static void pre_command_hook(void)
3965 last_point_position = BUF_PT(current_buffer);
3966 XSETBUFFER(last_point_position_buffer, current_buffer);
3967 /* This function can GC */
3968 safe_run_hook_trapping_errors
3969 ("Error in `pre-command-hook' (setting hook to nil)",
3970 Qpre_command_hook, 1);
3972 /* This is a kludge, but necessary; see simple.el */
3973 call0(Qhandle_pre_motion_command);
3976 /* Run the post command hook. */
3978 static void post_command_hook(void)
3980 /* This function can GC */
3981 /* Turn off region highlighting unless this command requested that
3982 it be left on, or we're in the minibuffer. We don't turn it off
3983 when we're in the minibuffer so that things like M-x write-region
3986 This could be done via a function on the post-command-hook, but
3987 we don't want the user to accidentally remove it.
3990 Lisp_Object win = Fselected_window(Qnil);
3992 /* If the last command deleted the frame, `win' might be nil.
3993 It seems safest to do nothing in this case. */
3994 /* Note: Someone added the following comment and put #if 0's around
3995 this code, not realizing that doing this invites a crash in the
3997 /* #### This doesn't really fix the problem,
3998 if delete-frame is called by some hook */
4002 /* This is a kludge, but necessary; see simple.el */
4003 call0(Qhandle_post_motion_command);
4005 if (!zmacs_region_stays && (!MINI_WINDOW_P(XWINDOW(win))
4006 || EQ(zmacs_region_buffer(),
4007 WINDOW_BUFFER(XWINDOW(win)))))
4008 zmacs_deactivate_region();
4010 zmacs_update_region();
4012 safe_run_hook_trapping_errors
4013 ("Error in `post-command-hook' (setting hook to nil)",
4014 Qpost_command_hook, 1);
4016 /* #### Kludge!!! This is necessary to make sure that things
4017 are properly positioned even if post-command-hook moves point.
4018 #### There should be a cleaner way of handling this. */
4019 call0(Qauto_show_make_point_visible);
4022 DEFUN("dispatch-event", Fdispatch_event, 1, 1, 0, /*
4023 Given an event object EVENT as returned by `next-event', execute it.
4025 Key-press, button-press, and button-release events get accumulated
4026 until a complete key sequence (see `read-key-sequence') is reached,
4027 at which point the sequence is looked up in the current keymaps and
4030 Mouse motion events cause the low-level handling function stored in
4031 `mouse-motion-handler' to be called. (There are very few circumstances
4032 under which you should change this handler. Use `mode-motion-hook'
4035 Menu, timeout, and eval events cause the associated function or handler
4038 Process events cause the subprocess's output to be read and acted upon
4039 appropriately (see `start-process').
4041 Magic events are handled as necessary.
4045 /* This function can GC */
4046 struct command_builder *command_builder;
4048 Lisp_Object console;
4049 Lisp_Object channel;
4051 CHECK_LIVE_EVENT(event);
4054 /* events on dead channels get silently eaten */
4055 channel = EVENT_CHANNEL(ev);
4056 if (object_dead_p(channel))
4059 /* Some events don't have channels (e.g. eval events). */
4060 console = CDFW_CONSOLE(channel);
4062 console = Vselected_console;
4063 else if (!EQ(console, Vselected_console))
4064 Fselect_console(console);
4066 command_builder = XCOMMAND_BUILDER(XCONSOLE(console)->command_builder);
4067 switch (XEVENT(event)->event_type) {
4068 case button_press_event:
4069 case button_release_event:
4070 case key_press_event: {
4072 lookup_command_event(command_builder, event, 1);
4075 /* Incomplete key sequence */
4078 /* At this point, we know that the sequence is
4079 not bound to a command. Normally, we beep
4080 and print a message informing the user of
4081 this. But we do not beep or print a message
4084 o the last event in this sequence is a
4086 o the last event in this sequence is a
4087 mouse-down event and there is a binding
4088 for the mouse-up version.
4090 That is, if the sequence ``C-x button1'' is
4091 typed, and is not bound to a command, but the
4092 sequence ``C-x button1up'' is bound to a
4093 command, we do not complain about the ``C-x
4094 button1'' sequence. If neither ``C-x
4095 button1'' nor ``C-x button1up'' is bound to a
4096 command, then we complain about the ``C-x
4097 button1'' sequence, but later will *not*
4098 complain about the ``C-x button1up''
4099 sequence, which would be redundant.
4101 This is pretty hairy, but I think it's the
4102 most intuitive behavior.
4104 Lisp_Object terminal =
4105 command_builder->most_current_event;
4107 if (XEVENT_TYPE(terminal) == button_press_event) {
4109 /* Temporarily pretend the last event
4110 was an "up" instead of a "down", and
4111 look up its binding. */
4112 XEVENT_TYPE(terminal) =
4113 button_release_event;
4114 /* If the "up" version is bound, don't
4118 !NILP(command_builder_find_leaf
4119 (command_builder, 0));
4120 /* Undo the temporary changes we just made. */
4121 XEVENT_TYPE(terminal) =
4124 /* Pretend this press was not
4125 seen (treat as a prefix) */
4130 reset_current_events
4135 EVENT_CHAIN_LOOP(eve,
4146 most_current_event);
4147 XSET_EVENT_NEXT(eve,
4150 most_current_event =
4153 maybe_echo_keys(command_builder,
4159 /* Complain that the typed sequence is not
4160 defined, if this is the kind of sequence that
4161 warrants a complaint. */
4162 XCONSOLE(console)->defining_kbd_macro = Qnil;
4163 XCONSOLE(console)->prefix_arg = Qnil;
4164 /* Don't complain about undefined button-release
4166 if (XEVENT_TYPE(terminal) !=
4167 button_release_event) {
4169 current_events_into_vector
4171 struct gcpro gcpro1;
4173 /* Run the pre-command-hook before
4174 barfing about an undefined key. */
4175 Vthis_command = Qnil;
4179 /* The post-command-hook doesn't run. */
4180 Fsignal(Qundefined_keystroke_sequence,
4183 /* Reset the command builder for reading the
4185 reset_this_command_keys(console, 1);
4186 } else { /* key sequence is bound to a command */
4189 int magic_undo_count = 20;
4191 Vthis_command = leaf;
4193 /* Don't push an undo boundary if the command
4194 set the prefix arg, or if we are executing a
4195 keyboard macro, or if in the minibuffer. If
4196 the command we are about to execute is
4197 self-insert, it's tricky: up to 20
4198 consecutive self-inserts may be done without
4199 an undo boundary. This counter is reset as
4200 soon as a command other than
4201 self-insert-command is executed.
4203 Programmers can also use the
4204 `self-insert-defer-undo' property to install
4205 that behavior on functions other than
4206 `self-insert-command', or to change the magic
4207 number 20 to something else. #### DOCUMENT
4210 if (SYMBOLP(leaf)) {
4212 Fget(leaf, Qself_insert_defer_undo,
4216 1, magic_undo_count =
4218 else if (!NILP(prop))
4220 else if (EQ(leaf, Qself_insert_command))
4225 command_builder->self_insert_countdown =
4227 if (NILP(XCONSOLE(console)->prefix_arg)
4228 && NILP(Vexecuting_macro)
4229 && command_builder->self_insert_countdown ==
4234 if (--command_builder->
4235 self_insert_countdown < 0)
4237 self_insert_countdown =
4240 execute_command_event
4242 internal_equal(event,
4244 most_current_event, 0)
4246 /* Use the translated event that was most
4247 recently seen. This way,
4248 last-command-event becomes f1 instead of
4249 the P from ESC O P. But we must copy
4250 it, else we'll lose when the
4251 command-builder events are
4253 : Fcopy_event(command_builder->
4254 most_current_event, Qnil));
4258 case misc_user_event: {
4261 We could just always use the menu item entry,
4262 whatever it is, but this might break some Lisp code
4263 that expects `this-command' to always contain a
4264 symbol. So only store it if this is a simple
4265 `call-interactively' sort of menu item.
4267 But this is bogus. `this-command' could be a string
4268 or vector anyway (for keyboard macros). There's even
4269 one instance (in pending-del.el) of `this-command'
4270 getting set to a cons (a lambda expression). So in
4271 the `eval' case I'll just convert it into a lambda
4275 (XEVENT(event)->event.eval.function,
4276 Qcall_interactively)
4277 && SYMBOLP(XEVENT(event)->event.eval.object)) {
4279 XEVENT(event)->event.eval.object;
4280 } else if (EQ(XEVENT(event)->event.eval.function, Qeval)) {
4284 XEVENT(event)->event.eval.
4286 } else if (SYMBOLP(XEVENT(event)->event.eval.function)) {
4287 /* A scrollbar command or the like. */
4289 XEVENT(event)->event.eval.function;
4292 Vthis_command = Qnil;
4295 /* clear the echo area */
4296 reset_key_echo(command_builder, 1);
4298 command_builder->self_insert_countdown = 0;
4299 if (NILP(XCONSOLE(console)->prefix_arg)
4300 && NILP(Vexecuting_macro)
4301 && !EQ(minibuf_window, Fselected_window(Qnil)))
4303 execute_command_event(command_builder, event);
4306 #ifdef EF_USE_ASYNEQ
4307 case eaten_myself_event:
4308 /* try to find the worker in the workers dllist and pop it */
4310 /* since this affects garbage collection, we better lock that
4313 WITH_DLLIST_TRAVERSE(
4315 if (ev->event.eaten_myself.worker == dllist_item) {
4316 dllist_pop_inner(workers, _el);
4320 fini_worker(ev->event.eaten_myself.worker);
4321 EQUEUE_DEBUG_WORKER("Successfully eaten 0x%lx\n",
4323 ev->event.eaten_myself.worker);
4325 case work_started_event: {
4326 Lisp_Object ljob = ev->event.work_started.job;
4327 worker_job_t job = XWORKER_JOB(ljob);
4328 work_handler_t hdl = XWORKER_JOB_HANDLER(ljob);
4329 if (hdl && work_started(hdl))
4330 work_started(hdl)(job);
4333 case work_finished_event: {
4334 Lisp_Object ljob = ev->event.work_finished.job;
4335 worker_job_t job = XWORKER_JOB(ljob);
4336 work_handler_t hdl = XWORKER_JOB_HANDLER(ljob);
4337 if (hdl && work_finished(hdl))
4338 work_finished(hdl)(job);
4345 case pointer_motion_event:
4349 case magic_eval_event:
4353 execute_internal_event(event);
4359 DEFUN("read-key-sequence", Fread_key_sequence, 1, 3, 0, /*
4360 Read a sequence of keystrokes or mouse clicks.
4361 Returns a vector of the event objects read. The vector and the event
4362 objects it contains are freshly created (and so will not be side-effected
4363 by subsequent calls to this function).
4365 The sequence read is sufficient to specify a non-prefix command starting
4366 from the current local and global keymaps. A C-g typed while in this
4367 function is treated like any other character, and `quit-flag' is not set.
4369 First arg PROMPT is a prompt string. If nil, do not prompt specially.
4371 Second optional arg CONTINUE-ECHO non-nil means this key echoes as a
4372 continuation of the previous key.
4374 Third optional arg DONT-DOWNCASE-LAST non-nil means do not convert the
4375 last event to lower case. (Normally any upper case event is converted
4376 to lower case if the original event is undefined and the lower case
4377 equivalent is defined.) This argument is provided mostly for FSF
4378 compatibility; the equivalent effect can be achieved more generally by
4379 binding `retry-undefined-key-binding-unshifted' to nil around the call
4380 to `read-key-sequence'.
4382 If the user selects a menu item while we are prompting for a key-sequence,
4383 the returned value will be a vector of a single menu-selection event.
4384 An error will be signalled if you pass this value to `lookup-key' or a
4387 `read-key-sequence' checks `function-key-map' for function key
4388 sequences, where they wouldn't conflict with ordinary bindings.
4389 See `function-key-map' for more details.
4391 (prompt, continue_echo, dont_downcase_last))
4393 /* This function can GC */
4394 struct console *con = XCONSOLE(Vselected_console); /* #### correct?
4398 struct command_builder *command_builder =
4399 XCOMMAND_BUILDER(con->command_builder);
4401 Lisp_Object event = Fmake_event(Qnil, Qnil);
4402 int speccount = specpdl_depth();
4403 struct gcpro gcpro1;
4406 record_unwind_protect(Fset_buffer, Fcurrent_buffer());
4408 CHECK_STRING(prompt);
4409 /* else prompt = Fkeymap_prompt (current_buffer->keymap); may GC */
4412 if (NILP(continue_echo))
4413 reset_this_command_keys(make_console(con), 1);
4415 specbind(Qinhibit_quit, Qt);
4417 if (!NILP(dont_downcase_last))
4418 specbind(Qretry_undefined_key_binding_unshifted, Qnil);
4421 Fnext_event(event, prompt);
4422 /* restore the selected-console damage */
4423 con = event_console_or_selected(event);
4424 command_builder = XCOMMAND_BUILDER(con->command_builder);
4425 if (!command_event_p(event))
4426 execute_internal_event(event);
4428 if (XEVENT(event)->event_type == misc_user_event)
4429 reset_current_events(command_builder);
4431 lookup_command_event(command_builder, event, 1);
4432 if (!KEYMAPP(result)) {
4434 current_events_into_vector(command_builder);
4435 reset_key_echo(command_builder, 0);
4442 Vquit_flag = Qnil; /* In case we read a ^G; do not call
4443 check_quit() here */
4444 Fdeallocate_event(event);
4445 RETURN_UNGCPRO(unbind_to(speccount, result));
4448 DEFUN("this-command-keys", Fthis_command_keys, 0, 0, 0, /*
4449 Return a vector of the keyboard or mouse button events that were used
4450 to invoke this command. This copies the vector and the events; it is safe
4451 to keep and modify them.
4459 if (NILP(Vthis_command_keys))
4460 return make_vector(0, Qnil);
4462 len = event_chain_count(Vthis_command_keys);
4464 result = make_vector(len, Qnil);
4466 EVENT_CHAIN_LOOP(event, Vthis_command_keys)
4467 XVECTOR_DATA(result)[len++] = Fcopy_event(event, Qnil);
4471 DEFUN("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0, /*
4472 Used for complicated reasons in `universal-argument-other-key'.
4474 `universal-argument-other-key' rereads the event just typed.
4475 It then gets translated through `function-key-map'.
4476 The translated event gets included in the echo area and in
4477 the value of `this-command-keys' in addition to the raw original event.
4480 Calling this function directs the translated event to replace
4481 the original event, so that only one version of the event actually
4482 appears in the echo area and in the value of `this-command-keys'.
4486 /* #### I don't understand this at all, so currently it does nothing.
4487 If there is ever a problem, maybe someone should investigate. */
4491 static void dribble_out_event(Lisp_Object event)
4493 if (NILP(Vdribble_file))
4496 if (XEVENT(event)->event_type == key_press_event &&
4497 !XEVENT(event)->event.key.modifiers) {
4498 Lisp_Object keysym = XEVENT(event)->event.key.keysym;
4499 if (CHARP(XEVENT(event)->event.key.keysym)) {
4500 Emchar ch = XCHAR(keysym);
4501 Bufbyte str[MAX_EMCHAR_LEN];
4502 Bytecount len = set_charptr_emchar(str, ch);
4503 Lstream_write(XLSTREAM(Vdribble_file), str, len);
4504 } else if (string_char_length(XSYMBOL(keysym)->name) == 1)
4505 /* one-char key events are printed with just the key name */
4506 Fprinc(keysym, Vdribble_file);
4507 else if (EQ(keysym, Qreturn))
4508 Lstream_putc(XLSTREAM(Vdribble_file), '\n');
4509 else if (EQ(keysym, Qspace))
4510 Lstream_putc(XLSTREAM(Vdribble_file), ' ');
4512 Fprinc(event, Vdribble_file);
4514 Fprinc(event, Vdribble_file);
4515 Lstream_flush(XLSTREAM(Vdribble_file));
4518 DEFUN("open-dribble-file", Fopen_dribble_file, 1, 1, "FOpen dribble file: ", /*
4519 Start writing all keyboard characters to a dribble file called FILENAME.
4520 If FILENAME is nil, close any open dribble file.
4524 /* This function can GC */
4525 /* XEmacs change: always close existing dribble file. */
4526 /* FSFmacs uses FILE *'s here. With lstreams, that's unnecessary. */
4527 if (!NILP(Vdribble_file)) {
4528 Lstream_close(XLSTREAM(Vdribble_file));
4529 Vdribble_file = Qnil;
4531 if (!NILP(filename)) {
4534 filename = Fexpand_file_name(filename, Qnil);
4535 fd = open((char *)XSTRING_DATA(filename),
4536 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4539 error("Unable to create dribble file");
4541 make_filedesc_output_stream(fd, 0, 0, LSTR_CLOSING);
4544 make_encoding_output_stream(XLSTREAM(Vdribble_file),
4552 DEFUN("current-event-timestamp", Fcurrent_event_timestamp, 0, 1, 0, /*
4553 Return the current event timestamp of the window system associated with CONSOLE.
4554 CONSOLE defaults to the selected console if omitted.
4558 struct console *c = decode_console(console);
4559 int tiempo = event_stream_current_event_timestamp(c);
4561 /* This junk is so that timestamps don't get to be negative, but contain
4562 as many bits as this particular emacs will allow.
4564 return make_int(EMACS_INT_MAX & tiempo);
4568 /* generalised asynchronous worker queue */
4569 #if defined(EF_USE_ASYNEQ)
4571 asyneq_handle_event(event_queue_t eq)
4573 if (!eq_queue_empty_p(eq)) {
4574 Lisp_Object eqev = eq_dequeue(eq);
4575 Fdispatch_event(eqev);
4580 asyneq_handle_non_command_event(event_queue_t eq)
4582 Lisp_Object eqev = Qnil;
4584 WITH_DLLIST_TRAVERSE(
4586 if (!command_event_p((Lisp_Object)dllist_item)) {
4587 eqev = (Lisp_Object)dllist_pop_inner(eq_queue(eq), _el);
4592 execute_internal_event(eqev);
4596 /************************************************************************/
4597 /* initialization */
4598 /************************************************************************/
4600 void syms_of_event_stream(void)
4602 INIT_LRECORD_IMPLEMENTATION(command_builder);
4603 INIT_LRECORD_IMPLEMENTATION(timeout);
4605 defsymbol(&Qdisabled, "disabled");
4606 defsymbol(&Qcommand_event_p, "command-event-p");
4608 DEFERROR_STANDARD(Qundefined_keystroke_sequence, Qinvalid_argument);
4610 DEFSUBR(Frecent_keys);
4611 DEFSUBR(Frecent_keys_ring_size);
4612 DEFSUBR(Fset_recent_keys_ring_size);
4613 DEFSUBR(Finput_pending_p);
4614 DEFSUBR(Fenqueue_eval_event);
4615 DEFSUBR(Fnext_event);
4616 DEFSUBR(Fnext_command_event);
4617 DEFSUBR(Fdiscard_input);
4619 DEFSUBR(Fsleep_for);
4620 DEFSUBR(Faccept_process_output);
4621 DEFSUBR(Fadd_timeout);
4622 DEFSUBR(Fdisable_timeout);
4623 DEFSUBR(Fadd_async_timeout);
4624 DEFSUBR(Fdisable_async_timeout);
4625 DEFSUBR(Fdispatch_event);
4626 DEFSUBR(Fdispatch_non_command_events);
4627 DEFSUBR(Fread_key_sequence);
4628 DEFSUBR(Fthis_command_keys);
4629 DEFSUBR(Freset_this_command_lengths);
4630 DEFSUBR(Fopen_dribble_file);
4631 DEFSUBR(Fcurrent_event_timestamp);
4633 defsymbol(&Qpre_command_hook, "pre-command-hook");
4634 defsymbol(&Qpost_command_hook, "post-command-hook");
4635 defsymbol(&Qunread_command_events, "unread-command-events");
4636 defsymbol(&Qunread_command_event, "unread-command-event");
4637 defsymbol(&Qpre_idle_hook, "pre-idle-hook");
4638 defsymbol(&Qhandle_pre_motion_command, "handle-pre-motion-command");
4639 defsymbol(&Qhandle_post_motion_command, "handle-post-motion-command");
4640 defsymbol(&Qretry_undefined_key_binding_unshifted,
4641 "retry-undefined-key-binding-unshifted");
4642 defsymbol(&Qauto_show_make_point_visible,
4643 "auto-show-make-point-visible");
4645 defsymbol(&Qself_insert_defer_undo, "self-insert-defer-undo");
4646 defsymbol(&Qcancel_mode_internal, "cancel-mode-internal");
4649 void reinit_vars_of_event_stream(void)
4651 recent_keys_ring_index = 0;
4652 recent_keys_ring_size = 100;
4653 num_input_chars = 0;
4654 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
4655 Vtimeout_free_list = make_lcrecord_list(sizeof(Lisp_Timeout),
4657 staticpro_nodump(&Vtimeout_free_list);
4659 the_low_level_timeout_blocktype =
4660 Blocktype_new(struct low_level_timeout_blocktype);
4661 something_happened = 0;
4662 recursive_sit_for = Qnil;
4664 #if defined(EF_USE_ASYNEQ)
4665 /* the main event queue */
4666 asyneq = make_event_queue();
4667 XSETEVENT_QUEUE(Vasyneq, asyneq);
4668 staticpro_nodump(&Vasyneq);
4669 #endif /* EF_USE_ASYNEQ */
4672 void vars_of_event_stream(void)
4674 reinit_vars_of_event_stream();
4675 Vrecent_keys_ring = Qnil;
4676 staticpro(&Vrecent_keys_ring);
4678 Vthis_command_keys = Qnil;
4679 staticpro(&Vthis_command_keys);
4680 Vthis_command_keys_tail = Qnil;
4681 dump_add_root_object(&Vthis_command_keys_tail);
4683 #ifndef EF_USE_ASYNEQ
4684 command_event_queue = Qnil;
4685 staticpro(&command_event_queue);
4686 command_event_queue_tail = Qnil;
4687 dump_add_root_object(&command_event_queue_tail);
4690 Vlast_selected_frame = Qnil;
4691 staticpro(&Vlast_selected_frame);
4693 pending_timeout_list = Qnil;
4694 staticpro(&pending_timeout_list);
4696 pending_async_timeout_list = Qnil;
4697 staticpro(&pending_async_timeout_list);
4699 last_point_position_buffer = Qnil;
4700 staticpro(&last_point_position_buffer);
4702 DEFVAR_LISP("echo-keystrokes", &Vecho_keystrokes /*
4703 *Nonzero means echo unfinished commands after this many seconds of pause.
4705 Vecho_keystrokes = make_int(1);
4707 DEFVAR_INT("auto-save-interval", &auto_save_interval /*
4708 *Number of keyboard input characters between auto-saves.
4709 Zero means disable autosaving due to number of characters typed.
4710 See also the variable `auto-save-timeout'.
4712 auto_save_interval = 300;
4714 DEFVAR_LISP("pre-command-hook", &Vpre_command_hook /*
4715 Function or functions to run before every command.
4716 This may examine the `this-command' variable to find out what command
4717 is about to be run, or may change it to cause a different command to run.
4718 Function on this hook must be careful to avoid signalling errors!
4720 Vpre_command_hook = Qnil;
4722 DEFVAR_LISP("post-command-hook", &Vpost_command_hook /*
4723 Function or functions to run after every command.
4724 This may examine the `this-command' variable to find out what command
4727 Vpost_command_hook = Qnil;
4729 DEFVAR_LISP("pre-idle-hook", &Vpre_idle_hook /*
4730 Normal hook run when SXEmacs it about to be idle.
4731 This occurs whenever it is going to block, waiting for an event.
4732 This generally happens as a result of a call to `next-event',
4733 `next-command-event', `sit-for', `sleep-for', `accept-process-output',
4734 or `x-get-selection'.
4736 Errors running the hook are caught and ignored.
4738 Vpre_idle_hook = Qnil;
4740 DEFVAR_BOOL("focus-follows-mouse", &focus_follows_mouse /*
4741 *Variable to control SXEmacs behavior with respect to focus changing.
4742 If this variable is set to t, then SXEmacs will not gratuitously change
4743 the keyboard focus. SXEmacs cannot in general detect when this mode is
4744 used by the window manager, so it is up to the user to set it.
4746 focus_follows_mouse = 0;
4748 DEFVAR_LISP("last-command-event", &Vlast_command_event /*
4749 Last keyboard or mouse button event that was part of a command. This
4750 variable is off limits: you may not set its value or modify the event that
4751 is its value, as it is destructively modified by `read-key-sequence'. If
4752 you want to keep a pointer to this value, you must use `copy-event'.
4754 Vlast_command_event = Qnil;
4756 DEFVAR_LISP("last-command-char", &Vlast_command_char /*
4757 If the value of `last-command-event' is a keyboard event, then
4758 this is the nearest ASCII equivalent to it. This is the value that
4759 `self-insert-command' will put in the buffer. Remember that there is
4760 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
4761 of keyboard events is much larger, so writing code that examines this
4762 variable to determine what key has been typed is bad practice, unless
4763 you are certain that it will be one of a small set of characters.
4765 Vlast_command_char = Qnil;
4767 DEFVAR_LISP("last-input-event", &Vlast_input_event /*
4768 Last keyboard or mouse button event received. This variable is off
4769 limits: you may not set its value or modify the event that is its value, as
4770 it is destructively modified by `next-event'. If you want to keep a pointer
4771 to this value, you must use `copy-event'.
4773 Vlast_input_event = Qnil;
4775 DEFVAR_LISP("current-mouse-event", &Vcurrent_mouse_event /*
4776 The mouse-button event which invoked this command, or nil.
4777 This is usually what `(interactive "e")' returns.
4779 Vcurrent_mouse_event = Qnil;
4781 DEFVAR_LISP("last-input-char", &Vlast_input_char /*
4782 If the value of `last-input-event' is a keyboard event, then
4783 this is the nearest ASCII equivalent to it. Remember that there is
4784 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
4785 of keyboard events is much larger, so writing code that examines this
4786 variable to determine what key has been typed is bad practice, unless
4787 you are certain that it will be one of a small set of characters.
4789 Vlast_input_char = Qnil;
4791 DEFVAR_LISP("last-input-time", &Vlast_input_time /*
4792 The time (in seconds since Jan 1, 1970) of the last-command-event,
4793 represented as a cons of two 16-bit integers. This is destructively
4794 modified, so copy it if you want to keep it.
4796 Vlast_input_time = Qnil;
4798 DEFVAR_LISP("last-command-event-time", &Vlast_command_event_time /*
4799 The time (in seconds since Jan 1, 1970) of the last-command-event,
4800 represented as a list of three integers. The first integer contains
4801 the most significant 16 bits of the number of seconds, and the second
4802 integer contains the least significant 16 bits. The third integer
4803 contains the remainder number of microseconds, if the current system
4804 supports microsecond clock resolution. This list is destructively
4805 modified, so copy it if you want to keep it.
4807 Vlast_command_event_time = Qnil;
4809 DEFVAR_LISP("unread-command-events", &Vunread_command_events /*
4810 List of event objects to be read as next command input events.
4811 This can be used to simulate the receipt of events from the user.
4812 Normally this is nil.
4813 Events are removed from the front of this list.
4815 Vunread_command_events = Qnil;
4817 DEFVAR_LISP("unread-command-event", &Vunread_command_event /*
4818 Obsolete. Use `unread-command-events' instead.
4820 Vunread_command_event = Qnil;
4822 DEFVAR_LISP("last-command", &Vlast_command /*
4823 The last command executed. Normally a symbol with a function definition,
4824 but can be whatever was found in the keymap, or whatever the variable
4825 `this-command' was set to by that command.
4827 Vlast_command = Qnil;
4829 DEFVAR_LISP("this-command", &Vthis_command /*
4830 The command now being executed.
4831 The command can set this variable; whatever is put here
4832 will be in `last-command' during the following command.
4834 Vthis_command = Qnil;
4836 DEFVAR_LISP("last-command-properties", &Vlast_command_properties /*
4837 Value of `this-command-properties' for the last command.
4838 Used by commands to help synchronize consecutive commands, in preference
4839 to looking at `last-command' directly.
4841 Vlast_command_properties = Qnil;
4843 DEFVAR_LISP("this-command-properties", &Vthis_command_properties /*
4844 Properties set by the current command.
4845 At the beginning of each command, the current value of this variable is
4846 copied to `last-command-properties', and then it is set to nil. Use `putf'
4847 to add properties to this variable. Commands should use this to communicate
4848 with pre/post-command hooks, subsequent commands, wrapping commands, etc.
4849 in preference to looking at and/or setting `this-command'.
4851 Vthis_command_properties = Qnil;
4853 DEFVAR_LISP("help-char", &Vhelp_char /*
4854 Character to recognize as meaning Help.
4855 When it is read, do `(eval help-form)', and display result if it's a string.
4856 If the value of `help-form' is nil, this char can be read normally.
4857 This can be any form recognized as a single key specifier.
4858 The help-char cannot be a negative number in SXEmacs.
4860 Vhelp_char = make_char(8); /* C-h */
4862 DEFVAR_LISP("help-form", &Vhelp_form /*
4863 Form to execute when character help-char is read.
4864 If the form returns a string, that string is displayed.
4865 If `help-form' is nil, the help char is not recognized.
4869 DEFVAR_LISP("prefix-help-command", &Vprefix_help_command /*
4870 Command to run when `help-char' character follows a prefix key.
4871 This command is used only when there is no actual binding
4872 for that character after that prefix key.
4874 Vprefix_help_command = Qnil;
4876 DEFVAR_CONST_LISP("keyboard-translate-table", &Vkeyboard_translate_table /*
4877 sh table used as translate table for keyboard input.
4878 e `keyboard-translate' to portably add entries to this table.
4879 ch key-press event is looked up in this table as follows:
4881 -- If an entry maps a symbol to a symbol, then a key-press event whose
4882 keysym is the former symbol (with any modifiers at all) gets its
4883 keysym changed and its modifiers left alone. This is useful for
4884 dealing with non-standard X keyboards, such as the grievous damage
4885 that Sun has inflicted upon the world.
4887 -- If an entry maps a symbol to a character, then a key-press event
4888 whose keysym is the former symbol (with any modifiers at all) gets
4889 changed into a key-press event matching the latter character, and the
4890 resulting modifiers are the union of the original and new modifiers.
4892 -- If an entry maps a character to a character, then a key-press event
4893 matching the former character gets converted to a key-press event
4894 matching the latter character. This is useful on ASCII terminals
4895 for (e.g.) making C-\\ look like C-s, to get around flow-control
4898 -- If an entry maps a character to a symbol, then a key-press event
4899 matching the character gets converted to a key-press event whose
4900 keysym is the given symbol and which has no modifiers.
4902 re's an example: This makes typing parens and braces easier by rerouting
4903 eir positions to eliminate the need to use the Shift key.
4905 (keyboard-translate ?[ ?()
4906 (keyboard-translate ?] ?))
4907 (keyboard-translate ?{ ?[)
4908 (keyboard-translate ?} ?])
4909 (keyboard-translate 'f11 ?{)
4910 (keyboard-translate 'f12 ?})
4913 DEFVAR_LISP("retry-undefined-key-binding-unshifted", &Vretry_undefined_key_binding_unshifted /*
4914 If a key-sequence which ends with a shifted keystroke is undefined
4915 and this variable is non-nil then the command lookup is retried again
4916 with the last key unshifted. (e.g. C-X C-F would be retried as C-X C-f.)
4917 If lookup still fails, a normal error is signalled. In general,
4918 you should *bind* this, not set it.
4920 Vretry_undefined_key_binding_unshifted = Qt;
4922 DEFVAR_BOOL("modifier-keys-are-sticky", &modifier_keys_are_sticky /*
4923 *Non-nil makes modifier keys sticky.
4924 This means that you can release the modifier key before pressing down
4925 the key that you wish to be modified. Although this is non-standard
4926 behavior, it is recommended because it reduces the strain on your hand,
4927 thus reducing the incidence of the dreaded Emacs-pinky syndrome.
4929 Modifier keys are sticky within the inverval specified by
4930 `modifier-keys-sticky-time'.
4932 modifier_keys_are_sticky = 0;
4934 DEFVAR_LISP("modifier-keys-sticky-time",
4935 &Vmodifier_keys_sticky_time /*
4936 *Modifier keys are sticky within this many milliseconds.
4937 If you don't want modifier keys sticking to be bounded, set this to
4940 This variable has no effect when `modifier-keys-are-sticky' is nil.
4941 Currently only implemented under X Window System.
4943 Vmodifier_keys_sticky_time = make_int(500);
4946 DEFVAR_LISP("composed-character-default-binding",
4947 &Vcomposed_character_default_binding /*
4948 The default keybinding to use for key events from composed input.
4949 Window systems frequently have ways to allow the user to compose
4950 single characters in a language using multiple keystrokes.
4951 SXEmacs sees these as single character keypress events.
4953 Vcomposed_character_default_binding = Qself_insert_command;
4954 #endif /* HAVE_XIM */
4956 Vcontrolling_terminal = Qnil;
4957 staticpro(&Vcontrolling_terminal);
4959 Vdribble_file = Qnil;
4960 staticpro(&Vdribble_file);
4962 #ifdef DEBUG_SXEMACS
4963 DEFVAR_INT("debug-emacs-events", &debug_emacs_events /*
4964 o, display debug information about Emacs events that SXEmacs sees.
4965 n is displayed on stderr.
4967 event, the source of the event is displayed in parentheses,
4970 real event from the window system or
4971 rminal driver, as far as SXEmacs can tell.
4973 macro) An event generated from a keyboard macro.
4975 ommand-events) An event taken from `unread-command-events'.
4977 ommand-event) An event taken from `unread-command-event'.
4979 event queue) An event taken from an internal queue.
4980 Events end up on this queue when
4981 `enqueue-eval-event' is called or when
4982 user or eval events are received while
4983 SXEmacs is blocking (e.g. in `sit-for',
4984 `sleep-for', or `accept-process-output',
4985 or while waiting for the reply to an
4988 rd-translate-table) The result of an event translated
4989 through keyboard-translate-table. Note
4990 that in this case, two events are
4991 printed even though only one is really
4994 A faked C-g resulting when SXEmacs receives
4995 a SIGINT (e.g. C-c was pressed in SXEmacs'
4996 controlling terminal or the signal was
4997 explicitly sent to the SXEmacs process).
4999 debug_emacs_events = 0;
5002 DEFVAR_BOOL("inhibit-input-event-recording",
5003 &inhibit_input_event_recording /*
5004 Non-nil inhibits recording of input-events to recent-keys ring.
5006 inhibit_input_event_recording = 0;
5009 void complex_vars_of_event_stream(void)
5011 Vkeyboard_translate_table =
5012 make_lisp_hash_table(100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
5015 void init_event_stream(void)
5018 #ifdef HAVE_UNIXOID_EVENT_LOOP
5019 init_event_unixoid();
5021 #ifdef HAVE_X_WINDOWS
5022 if (!strcmp(display_use, "x"))
5023 init_event_Xt_late();
5027 if (!strcmp(display_use, "gtk"))
5028 init_event_gtk_late();
5032 /* For TTY's, use the Xt event loop if we can; it allows
5033 us to later open an X connection. */
5034 #if defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
5035 init_event_Xt_late();
5036 #elif defined (HAVE_TTY)
5037 init_event_tty_late();
5040 init_interrupts_late();
5045 useful testcases for v18/v19 compatibility:
5049 (setq unread-command-event (character-to-event ?A (allocate-event)))
5050 (setq x (list (read-char)
5051 ; (read-key-sequence "") ; try it with and without this
5052 last-command-char last-input-char
5053 (recent-keys) (this-command-keys))))
5054 (global-set-key "\^Q" 'foo)
5056 without the read-key-sequence:
5057 ^Q ==> (?A ?\^Q ?A [... ^Q] [^Q])
5058 ^U^U^Q ==> (?A ?\^Q ?A [... ^U ^U ^Q] [^U ^U ^Q])
5059 ^U^U^U^G^Q ==> (?A ?\^Q ?A [... ^U ^U ^U ^G ^Q] [^Q])
5061 with the read-key-sequence:
5062 ^Qb ==> (?A [b] ?\^Q ?b [... ^Q b] [b])
5063 ^U^U^Qb ==> (?A [b] ?\^Q ?b [... ^U ^U ^Q b] [b])
5064 ^U^U^U^G^Qb ==> (?A [b] ?\^Q ?b [... ^U ^U ^U ^G ^Q b] [b])
5066 ;the evi-mode command "4dlj.j.j.j.j.j." is also a good testcase (gag)
5068 ;(setq x (list (read-char) quit-flag))^J^G
5069 ;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G
5070 ;for BOTH, x should get set to (7 t), but no result should be printed.
5071 ;; #### According to the doc of quit-flag, second test should return
5072 ;; (?\^G nil). Accidentaly SXEmacs returns correct value. However,
5073 ;; XEmacs 21.1.12 and 21.2.36 both fails on first test.
5075 ;also do this: make two frames, one viewing "*scratch*", the other "foo".
5076 ;in *scratch*, type (sit-for 20)^J
5077 ;wait a couple of seconds, move cursor to foo, type "a"
5078 ;a should be inserted in foo. Cursor highlighting should not change in
5081 ;do it with sleep-for. move cursor into foo, then back into *scratch*
5083 ;repeat also with (accept-process-output nil 20)
5085 ;make sure ^G aborts sit-for, sleep-for and accept-process-output:
5088 (list (condition-case c
5093 (tst)^Ja^G ==> ((quit) ?a) with no signal
5094 (tst)^J^Ga ==> ((quit) ?a) with no signal
5095 (tst)^Jabc^G ==> ((quit) ?a) with no signal, and "bc" inserted in buffer
5097 ; with sit-for only do the 2nd test.
5098 ; Do all 3 tests with (accept-process-output nil 20)
5101 (setq enable-recursive-minibuffers t
5102 minibuffer-max-depth nil)
5103 ESC ESC ESC ESC - there are now two minibuffers active
5104 C-g C-g C-g - there should be active 0, not 1
5106 C-x C-f ~ / ? - wait for "Making completion list..." to display
5107 C-g - wait for "Quit" to display
5108 C-g - minibuffer should not be active
5109 however C-g before "Quit" is displayed should leave minibuffer active.
5111 ;do it all in both v18 and v19 and make sure all results are the same.
5112 ;all of these cases matter a lot, but some in quite subtle ways.
5116 Additional test cases for accept-process-output, sleep-for, sit-for.
5117 Be sure you do all of the above checking for C-g and focus, too!
5119 ; Make sure that timer handlers are run during, not after sit-for:
5120 (defun timer-check ()
5121 (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil)
5123 (message "after sit-for"))
5125 ; The first message should appear after 2 seconds, and the final message
5126 ; 3 seconds after that.
5127 ; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
5129 ; Make sure that process filters are run during, not after sit-for.
5131 (message "sit-for = %s" (sit-for 30)))
5132 (add-hook 'post-command-hook 'fubar)
5134 ; Now type M-x shell RET
5135 ; wait for the shell prompt then send: ls RET
5136 ; the output of ls should fill immediately, and not wait 30 seconds.
5138 ; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
5140 ; Make sure that recursive invocations return immediately:
5141 (defmacro test-diff-time (start end)
5142 `(+ (* (- (car ,end) (car ,start)) 65536.0)
5143 (- (cadr ,end) (cadr ,start))
5144 (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
5146 (defun testee (ignore)
5150 (let ((start (current-time))
5152 (add-timeout 2 'testee nil)
5154 (add-timeout 2 'testee nil)
5156 (add-timeout 2 'testee nil)
5157 (accept-process-output nil 5)
5158 (setq end (current-time))
5159 (test-diff-time start end)))
5161 (test-them) should sit for 15 seconds.
5162 Repeat with testee set to sleep-for and accept-process-output.
5163 These should each delay 36 seconds.