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);
1033 write_fmt_string(printcharfun, "#<INTERNAL OBJECT (SXEmacs bug?) (timeout) 0x%lx>",
1037 static const struct lrecord_description timeout_description[] = {
1038 {XD_LISP_OBJECT, offsetof(Lisp_Timeout, function)},
1039 {XD_LISP_OBJECT, offsetof(Lisp_Timeout, object)},
1043 DEFINE_LRECORD_IMPLEMENTATION("timeout", timeout,
1044 mark_timeout, print_timeout,
1045 0, 0, 0, timeout_description, Lisp_Timeout);
1047 /* Generate a timeout and return its ID. */
1050 event_stream_generate_wakeup(unsigned int milliseconds,
1051 unsigned int vanilliseconds,
1052 Lisp_Object function, Lisp_Object object,
1055 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1056 Lisp_Object op = wrap_object(
1057 alloc_lcrecord(sizeof(Lisp_Timeout), &lrecord_timeout));
1059 Lisp_Object op = allocate_managed_lcrecord(Vtimeout_free_list);
1061 Lisp_Timeout *timeout = XTIMEOUT(op);
1062 EMACS_TIME current_time;
1063 EMACS_TIME interval;
1065 timeout->id = timeout_id_tick++;
1066 timeout->resignal_msecs = vanilliseconds;
1067 timeout->function = function;
1068 timeout->object = object;
1070 EMACS_GET_TIME(current_time);
1071 EMACS_SET_SECS_USECS(interval, milliseconds / 1000,
1072 1000 * (milliseconds % 1000));
1073 EMACS_ADD_TIME(timeout->next_signal_time, current_time, interval);
1076 timeout->interval_id =
1077 event_stream_add_async_timeout(timeout->next_signal_time);
1078 pending_async_timeout_list = noseeum_cons(op,
1079 pending_async_timeout_list);
1081 timeout->interval_id =
1082 event_stream_add_timeout(timeout->next_signal_time);
1083 pending_timeout_list = noseeum_cons(op, pending_timeout_list);
1088 /* Given the INTERVAL-ID of a timeout just signalled, resignal the timeout
1089 as necessary and return the timeout's ID and function and object slots.
1091 This should be called as a result of receiving notice that a timeout
1092 has fired. INTERVAL-ID is *not* the timeout's ID, but is the ID that
1093 identifies this particular firing of the timeout. INTERVAL-ID's and
1094 timeout ID's are in separate number spaces and bear no relation to
1095 each other. The INTERVAL-ID is all that the event callback routines
1096 work with: they work only with one-shot intervals, not with timeouts
1097 that may fire repeatedly.
1099 NOTE: The returned FUNCTION and OBJECT are *not* GC-protected at all.
1103 event_stream_resignal_wakeup(int interval_id, int async_p,
1104 Lisp_Object * function, Lisp_Object * object)
1106 Lisp_Object op = Qnil, rest;
1107 Lisp_Timeout *timeout;
1108 Lisp_Object *timeout_list;
1109 struct gcpro gcpro1;
1112 GCPRO1(op); /* just in case ... because it's removed from the list
1116 async_p ? &pending_async_timeout_list : &pending_timeout_list;
1118 /* Find the timeout on the list of pending ones. */
1119 LIST_LOOP(rest, *timeout_list) {
1120 timeout = XTIMEOUT(XCAR(rest));
1121 if (timeout->interval_id == interval_id)
1125 assert(!NILP(rest));
1127 timeout = XTIMEOUT(op);
1128 /* We make sure to snarf the data out of the timeout object before
1129 we free it with free_managed_lcrecord(). */
1131 *function = timeout->function;
1132 *object = timeout->object;
1134 /* Remove this one from the list of pending timeouts */
1135 *timeout_list = delq_no_quit_and_free_cons(op, *timeout_list);
1137 /* If this timeout wants to be resignalled, do it now. */
1138 if (timeout->resignal_msecs) {
1139 EMACS_TIME current_time;
1140 EMACS_TIME interval;
1142 /* Determine the time that the next resignalling should occur.
1143 We do that by adding the interval time to the last signalled
1144 time until we get a time that's current.
1146 (This way, it doesn't matter if the timeout was signalled
1147 exactly when we asked for it, or at some time later.)
1149 EMACS_GET_TIME(current_time);
1150 EMACS_SET_SECS_USECS(interval, timeout->resignal_msecs / 1000,
1151 1000 * (timeout->resignal_msecs % 1000));
1153 EMACS_ADD_TIME(timeout->next_signal_time,
1154 timeout->next_signal_time, interval);
1155 } while (EMACS_TIME_GREATER
1156 (current_time, timeout->next_signal_time));
1159 timeout->interval_id =
1160 event_stream_add_async_timeout(
1161 timeout->next_signal_time);
1163 timeout->interval_id =
1164 event_stream_add_timeout(
1165 timeout->next_signal_time);
1167 /* Add back onto the list. Note that the effect of this
1168 is to move frequently-hit timeouts to the front of the
1169 list, which is a good thing. */
1170 *timeout_list = noseeum_cons(op, *timeout_list);
1172 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1175 free_managed_lcrecord(Vtimeout_free_list, op);
1182 void event_stream_disable_wakeup(int id, int async_p)
1184 Lisp_Timeout *timeout = 0;
1186 Lisp_Object *timeout_list;
1189 timeout_list = &pending_async_timeout_list;
1191 timeout_list = &pending_timeout_list;
1193 /* Find the timeout on the list of pending ones, if it's still there. */
1194 LIST_LOOP(rest, *timeout_list) {
1195 timeout = XTIMEOUT(XCAR(rest));
1196 if (timeout->id == id) {
1201 /* If we found it, remove it from the list and disable the pending
1204 Lisp_Object op = XCAR(rest);
1205 *timeout_list = delq_no_quit_and_free_cons(op, *timeout_list);
1207 event_stream_remove_async_timeout(timeout->interval_id);
1209 event_stream_remove_timeout(timeout->interval_id);
1211 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1214 free_managed_lcrecord(Vtimeout_free_list, op);
1219 static int event_stream_wakeup_pending_p(int id, int async_p)
1221 Lisp_Timeout *timeout;
1223 Lisp_Object timeout_list;
1227 timeout_list = pending_async_timeout_list;
1229 timeout_list = pending_timeout_list;
1231 /* Find the element on the list of pending ones, if it's still there. */
1232 LIST_LOOP(rest, timeout_list) {
1233 timeout = XTIMEOUT(XCAR(rest));
1234 if (timeout->id == id) {
1243 /**** Asynch. timeout functions (see also signal.c) ****/
1245 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1246 extern int poll_for_quit_id;
1249 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1250 extern int poll_for_sigchld_id;
1253 void event_stream_deal_with_async_timeout(int interval_id)
1255 /* This function can GC */
1256 Lisp_Object humpty, dumpty;
1257 #if ((!defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)) \
1258 || defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD))
1261 event_stream_resignal_wakeup(interval_id, 1, &humpty, &dumpty);
1263 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1264 if (id == poll_for_quit_id) {
1265 quit_check_signal_happened = 1;
1266 quit_check_signal_tick_count++;
1271 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1272 if (id == poll_for_sigchld_id) {
1273 kick_status_notify();
1278 /* call1 GC-protects its arguments */
1279 call1_trapping_errors("Error in asynchronous timeout callback",
1283 /**** Lisp-level timeout functions. ****/
1285 static unsigned long lisp_number_to_milliseconds(Lisp_Object secs, int allow_0)
1287 #if defined(WITH_NUMBER_TYPES)
1290 fsecs = extract_float(secs);
1291 #else /* !WITH_NUMBER_TYPES */
1294 CHECK_INT_OR_FLOAT(secs);
1295 fsecs = XFLOATINT(secs);
1300 #endif /* HAVE_FPFLOAT */
1301 #endif /* WITH_NUMBER_TYPES */
1303 signal_simple_error("timeout is negative", secs);
1304 if (!allow_0 && fsecs == 0)
1305 signal_simple_error("timeout is non-positive", secs);
1306 if (fsecs >= (((unsigned int)0xFFFFFFFF) / 1000))
1308 ("timeout would exceed 32 bits when represented in milliseconds",
1311 return (unsigned long)(1000 * fsecs);
1314 DEFUN("add-timeout", Fadd_timeout, 3, 4, 0, /*
1315 Add a timeout, to be signaled after the timeout period has elapsed.
1316 SECS is a number of seconds, expressed as an integer or a float.
1317 FUNCTION will be called after that many seconds have elapsed, with one
1318 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1319 then after this timeout expires, `add-timeout' will automatically be called
1320 again with RESIGNAL as the first argument.
1322 This function returns an object which is the id number of this particular
1323 timeout. You can pass that object to `disable-timeout' to turn off the
1324 timeout before it has been signalled.
1326 NOTE: Id numbers as returned by this function are in a distinct namespace
1327 from those returned by `add-async-timeout'. This means that the same id
1328 number could refer to a pending synchronous timeout and a different pending
1329 asynchronous timeout, and that you cannot pass an id from `add-timeout'
1330 to `disable-async-timeout', or vice-versa.
1332 The number of seconds may be expressed as a floating-point number, in which
1333 case some fractional part of a second will be used. Caveat: the usable
1334 timeout granularity will vary from system to system.
1336 Adding a timeout causes a timeout event to be returned by `next-event', and
1337 the function will be invoked by `dispatch-event,' so if emacs is in a tight
1338 loop, the function will not be invoked until the next call to sit-for or
1339 until the return to top-level (the same is true of process filters).
1341 If you need to have a timeout executed even when SXEmacs is in the midst of
1342 running Lisp code, use `add-async-timeout'.
1344 WARNING: if you are thinking of calling add-timeout from inside of a
1345 callback function as a way of resignalling a timeout, think again. There
1346 is a race condition. That's why the RESIGNAL argument exists.
1348 (secs, function, object, resignal))
1350 unsigned long msecs = lisp_number_to_milliseconds(secs, 0);
1351 unsigned long msecs2 = (NILP(resignal) ? 0 :
1352 lisp_number_to_milliseconds(resignal, 0));
1355 id = event_stream_generate_wakeup(msecs, msecs2, function, object, 0);
1357 if (id != XINT(lid))
1362 DEFUN("disable-timeout", Fdisable_timeout, 1, 1, 0, /*
1363 Disable a timeout from signalling any more.
1364 ID should be a timeout id number as returned by `add-timeout'. If ID
1365 corresponds to a one-shot timeout that has already signalled, nothing
1368 It will not work to call this function on an id number returned by
1369 `add-async-timeout'. Use `disable-async-timeout' for that.
1374 event_stream_disable_wakeup(XINT(id), 0);
1378 DEFUN("add-async-timeout", Fadd_async_timeout, 3, 4, 0, /*
1379 Add an asynchronous timeout, to be signaled after an interval has elapsed.
1380 SECS is a number of seconds, expressed as an integer or a float.
1381 FUNCTION will be called after that many seconds have elapsed, with one
1382 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1383 then after this timeout expires, `add-async-timeout' will automatically be
1384 called again with RESIGNAL as the first argument.
1386 This function returns an object which is the id number of this particular
1387 timeout. You can pass that object to `disable-async-timeout' to turn off
1388 the timeout before it has been signalled.
1390 NOTE: Id numbers as returned by this function are in a distinct namespace
1391 from those returned by `add-timeout'. This means that the same id number
1392 could refer to a pending synchronous timeout and a different pending
1393 asynchronous timeout, and that you cannot pass an id from
1394 `add-async-timeout' to `disable-timeout', or vice-versa.
1396 The number of seconds may be expressed as a floating-point number, in which
1397 case some fractional part of a second will be used. Caveat: the usable
1398 timeout granularity will vary from system to system.
1400 Adding an asynchronous timeout causes the function to be invoked as soon
1401 as the timeout occurs, even if SXEmacs is in the midst of executing some
1402 other code. (This is unlike the synchronous timeouts added with
1403 `add-timeout', where the timeout will only be signalled when SXEmacs is
1404 waiting for events, i.e. the next return to top-level or invocation of
1405 `sit-for' or related functions.) This means that the function that is
1406 called *must* not signal an error or change any global state (e.g. switch
1407 buffers or windows) except when locking code is in place to make sure
1408 that race conditions don't occur in the interaction between the
1409 asynchronous timeout function and other code.
1411 Under most circumstances, you should use `add-timeout' instead, as it is
1412 much safer. Asynchronous timeouts should only be used when such behavior
1413 is really necessary.
1415 Asynchronous timeouts are blocked and will not occur when `inhibit-quit'
1416 is non-nil. As soon as `inhibit-quit' becomes nil again, any pending
1417 asynchronous timeouts will get called immediately. (Multiple occurrences
1418 of the same asynchronous timeout are not queued, however.) While the
1419 callback function of an asynchronous timeout is invoked, `inhibit-quit'
1420 is automatically bound to non-nil, and thus other asynchronous timeouts
1421 will be blocked unless the callback function explicitly sets `inhibit-quit'
1424 WARNING: if you are thinking of calling `add-async-timeout' from inside of a
1425 callback function as a way of resignalling a timeout, think again. There
1426 is a race condition. That's why the RESIGNAL argument exists.
1428 (secs, function, object, resignal))
1430 unsigned long msecs = lisp_number_to_milliseconds(secs, 0);
1431 unsigned long msecs2 = (NILP(resignal) ? 0 :
1432 lisp_number_to_milliseconds(resignal, 0));
1435 id = event_stream_generate_wakeup(msecs, msecs2, function, object, 1);
1437 if (id != XINT(lid))
1442 DEFUN("disable-async-timeout", Fdisable_async_timeout, 1, 1, 0, /*
1443 Disable an asynchronous timeout from signalling any more.
1444 ID should be a timeout id number as returned by `add-async-timeout'. If ID
1445 corresponds to a one-shot timeout that has already signalled, nothing
1448 It will not work to call this function on an id number returned by
1449 `add-timeout'. Use `disable-timeout' for that.
1454 event_stream_disable_wakeup(XINT(id), 1);
1458 /**********************************************************************/
1459 /* enqueuing and dequeuing events */
1460 /**********************************************************************/
1462 /* Add an event to the back of the command-event queue: it will be the next
1463 event read after all pending events. This only works on keyboard,
1464 mouse-click, misc-user, and eval events.
1466 static void enqueue_command_event(Lisp_Object event)
1468 #ifdef EF_USE_ASYNEQ
1469 eq_enqueue(asyneq, event);
1471 enqueue_event(event, &command_event_queue, &command_event_queue_tail);
1475 static Lisp_Object dequeue_command_event(void)
1477 #ifdef EF_USE_ASYNEQ
1478 return eq_dequeue(asyneq);
1480 return dequeue_event(&command_event_queue, &command_event_queue_tail);
1484 /* put the event on the typeahead queue, unless
1485 the event is the quit char, in which case the `QUIT'
1486 which will occur on the next trip through this loop is
1487 all the processing we should do - leaving it on the queue
1488 would cause the quit to be processed twice.
1490 static void enqueue_command_event_1(Lisp_Object event_to_copy)
1492 /* do not call check_quit() here. Vquit_flag was set in
1493 next_event_internal. */
1494 if (NILP(Vquit_flag))
1495 enqueue_command_event(Fcopy_event(event_to_copy, Qnil));
1498 void enqueue_magic_eval_event(void (*fun) (Lisp_Object), Lisp_Object object)
1500 Lisp_Object event = Fmake_event(Qnil, Qnil);
1502 XEVENT(event)->event_type = magic_eval_event;
1503 /* channel for magic_eval events is nil */
1504 XEVENT(event)->event.magic_eval.internal_function = fun;
1505 XEVENT(event)->event.magic_eval.object = object;
1506 enqueue_command_event(event);
1509 DEFUN("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0, /*
1510 Add an eval event to the back of the eval event queue.
1511 When this event is dispatched, FUNCTION (which should be a function
1512 of one argument) will be called with OBJECT as its argument.
1513 See `next-event' for a description of event types and how events
1518 Lisp_Object event = Fmake_event(Qnil, Qnil);
1520 XEVENT(event)->event_type = eval_event;
1521 /* channel for eval events is nil */
1522 XEVENT(event)->event.eval.function = function;
1523 XEVENT(event)->event.eval.object = object;
1524 enqueue_command_event(event);
1530 enqueue_misc_user_event(Lisp_Object channel, Lisp_Object function,
1533 Lisp_Object event = Fmake_event(Qnil, Qnil);
1535 XEVENT(event)->event_type = misc_user_event;
1536 XEVENT(event)->channel = channel;
1537 XEVENT(event)->event.misc.function = function;
1538 XEVENT(event)->event.misc.object = object;
1539 XEVENT(event)->event.misc.button = 0;
1540 XEVENT(event)->event.misc.modifiers = 0;
1541 XEVENT(event)->event.misc.x = -1;
1542 XEVENT(event)->event.misc.y = -1;
1543 enqueue_command_event(event);
1549 enqueue_misc_user_event_pos(Lisp_Object channel, Lisp_Object function,
1551 int button, int modifiers, int x, int y)
1553 Lisp_Object event = Fmake_event(Qnil, Qnil);
1555 XEVENT(event)->event_type = misc_user_event;
1556 XEVENT(event)->channel = channel;
1557 XEVENT(event)->event.misc.function = function;
1558 XEVENT(event)->event.misc.object = object;
1559 XEVENT(event)->event.misc.button = button;
1560 XEVENT(event)->event.misc.modifiers = modifiers;
1561 XEVENT(event)->event.misc.x = x;
1562 XEVENT(event)->event.misc.y = y;
1563 enqueue_command_event(event);
1568 /**********************************************************************/
1569 /* focus-event handling */
1570 /**********************************************************************/
1574 Ben's capsule lecture on focus:
1576 In FSFmacs `select-frame' never changes the window-manager frame
1577 focus. All it does is change the "selected frame". This is similar
1578 to what happens when we call `select-device' or `select-console'.
1579 Whenever an event comes in (including a keyboard event), its frame is
1580 selected; therefore, evaluating `select-frame' in *scratch* won't
1581 cause any effects because the next received event (in the same frame)
1582 will cause a switch back to the frame displaying *scratch*.
1584 Whenever a focus-change event is received from the window manager, it
1585 generates a `switch-frame' event, which causes the Lisp function
1586 `handle-switch-frame' to get run. This basically just runs
1587 `select-frame' (see below, however).
1589 In FSFmacs, if you want to have an operation run when a frame is
1590 selected, you supply an event binding for `switch-frame' (and then
1591 maybe call `handle-switch-frame', or something ...).
1593 In SXEmacs, we *do* change the window-manager frame focus as a result
1594 of `select-frame', but not until the next time an event is received,
1595 so that a function that momentarily changes the selected frame won't
1596 cause WM focus flashing. (#### There's something not quite right here;
1597 this is causing the wrong-cursor-focus problems that you occasionally
1598 see. But the general idea is correct.) This approach is winning for
1599 people who use the explicit-focus model, but is trickier to implement.
1601 We also don't make the `switch-frame' event visible but instead have
1602 `select-frame-hook', which is a better approach.
1604 There is the problem of surrogate minibuffers, where when we enter the
1605 minibuffer, you essentially want to temporarily switch the WM focus to
1606 the frame with the minibuffer, and switch it back when you exit the
1609 FSFmacs solves this with the crockish `redirect-frame-focus', which
1610 says "for keyboard events received from FRAME, act like they're
1611 coming from FOCUS-FRAME". I think what this means is that, when
1612 a keyboard event comes in and the event manager is about to select the
1613 event's frame, if that frame has its focus redirected, the redirected-to
1614 frame is selected instead. That way, if you're in a minibufferless
1615 frame and enter the minibuffer, then all Lisp functions that run see
1616 the selected frame as the minibuffer's frame rather than the minibufferless
1617 frame you came from, so that (e.g.) your typing actually appears in
1618 the minibuffer's frame and things behave sanely.
1620 There's also some weird logic that switches the redirected frame focus
1621 from one frame to another if Lisp code explicitly calls `select-frame'
1622 \(but not if `handle-switch-frame' is called), and saves and restores
1623 the frame focus in window configurations, etc. etc. All of this logic
1624 is heavily #if 0'd, with lots of comments saying "No, this approach
1625 doesn't seem to work, so I'm trying this ... is it reasonable?
1626 Well, I'm not sure ..." that are a red flag indicating crockishness.
1628 Because of our way of doing things, we can avoid all this crock.
1629 Keyboard events never cause a select-frame (who cares what frame
1630 they're associated with? They come from a console, only). We change
1631 the actual WM focus to a surrogate minibuffer frame, so we don't have
1632 to do any internal redirection. In order to get the focus back,
1633 I took the approach in minibuf.el of just checking to see if the
1634 frame we moved to is still the selected frame, and move back to the
1635 old one if so. Conceivably we might have to do the weird "tracking"
1636 that FSFmacs does when `select-frame' is called, but I don't think
1637 so. If the selected frame moved from the minibuffer frame, then
1638 we just leave it there, figuring that someone knows what they're
1639 doing. Because we don't have any redirection recorded anywhere,
1640 it's safe to do this, and we don't end up with unwanted redirection.
1644 static void run_select_frame_hook(void)
1646 run_hook(Qselect_frame_hook);
1649 static void run_deselect_frame_hook(void)
1651 run_hook(Qdeselect_frame_hook);
1654 /* When select-frame is called and focus_follows_mouse is false, we want
1655 to tell the window system that the focus should be changed to point to
1656 the new frame. However,
1657 sometimes Lisp functions will temporarily change the selected frame
1658 (e.g. to call a function that operates on the selected frame),
1659 and it's annoying if this focus-change happens exactly when
1660 select-frame is called, because then you get some flickering of the
1661 window-manager border and perhaps other undesirable results. We
1662 really only want to change the focus when we're about to retrieve
1663 an event from the user. To do this, we keep track of the frame
1664 where the window-manager focus lies on, and just before waiting
1665 for user events, check the currently selected frame and change
1666 the focus as necessary.
1668 On the other hand, if focus_follows_mouse is true, we need to switch the
1669 selected frame back to the frame with window manager focus just before we
1670 execute the next command in Fcommand_loop_1, just as the selected buffer is
1671 reverted after a set-buffer.
1673 Both cases are handled by this function. It must be called as appropriate
1674 from these two places, depending on the value of focus_follows_mouse. */
1676 void investigate_frame_change(void)
1678 Lisp_Object devcons, concons;
1680 /* if the selected frame was changed, change the window-system
1681 focus to the new frame. We don't do it when select-frame was
1682 called, to avoid flickering and other unwanted side effects when
1683 the frame is just changed temporarily. */
1684 DEVICE_LOOP_NO_BREAK(devcons, concons) {
1685 struct device *d = XDEVICE(XCAR(devcons));
1686 Lisp_Object sel_frame = DEVICE_SELECTED_FRAME(d);
1688 /* You'd think that maybe we should use FRAME_WITH_FOCUS_REAL,
1689 but that can cause us to end up in an infinite loop focusing
1690 between two frames. It seems that since the call to `select-frame'
1691 in emacs_handle_focus_change_final() is based on the _FOR_HOOKS
1692 value, we need to do so too. */
1693 if (!NILP(sel_frame) &&
1694 !EQ(DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d), sel_frame) &&
1695 !NILP(DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d)) &&
1696 !EQ(DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d), sel_frame)) {
1697 /* At this point, we know that the frame has been changed. Now, if
1698 * focus_follows_mouse is not set, we finish off the frame change,
1699 * so that user events will now come from the new frame. Otherwise,
1700 * if focus_follows_mouse is set, no gratuitous frame changing
1701 * should take place. Set the focus back to the frame which was
1702 * originally selected for user input.
1704 if (!focus_follows_mouse) {
1705 /* prevent us from issuing the same request more than once */
1706 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d) =
1708 MAYBE_DEVMETH(d, focus_on_frame,
1709 (XFRAME(sel_frame)));
1711 Lisp_Object old_frame = Qnil;
1713 /* #### Do we really want to check OUGHT ??
1714 * It seems to make sense, though I have never seen us
1715 * get here and have it be non-nil.
1718 (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d)))
1720 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS
1723 (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d)))
1725 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS
1728 /* #### Can old_frame ever be NIL? play it safe.. */
1729 if (!NILP(old_frame)) {
1730 /* Fselect_frame is not really the right thing: it frobs the
1731 * buffer stack. But there's no easy way to do the right
1732 * thing, and this code already had this problem anyway.
1734 Fselect_frame(old_frame);
1741 static Lisp_Object cleanup_after_missed_defocusing(Lisp_Object frame)
1743 if (FRAMEP(frame) && FRAME_LIVE_P(XFRAME(frame)))
1744 Fselect_frame(frame);
1748 void emacs_handle_focus_change_preliminary(Lisp_Object frame_inp_and_dev)
1750 Lisp_Object frame = Fcar(frame_inp_and_dev);
1751 Lisp_Object device = Fcar(Fcdr(frame_inp_and_dev));
1752 int in_p = !NILP(Fcdr(Fcdr(frame_inp_and_dev)));
1755 if (!DEVICE_LIVE_P(XDEVICE(device)))
1758 d = XDEVICE(device);
1760 /* Any received focus-change notifications render invalid any
1761 pending focus-change requests. */
1762 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d) = Qnil;
1764 Lisp_Object focus_frame;
1766 if (!FRAME_LIVE_P(XFRAME(frame)))
1769 focus_frame = DEVICE_FRAME_WITH_FOCUS_REAL(d);
1771 /* Mark the minibuffer as changed to make sure it gets updated
1772 properly if the echo area is active. */
1775 XWINDOW(FRAME_MINIBUF_WINDOW(XFRAME(frame)));
1776 MARK_WINDOWS_CHANGED(w);
1779 if (FRAMEP(focus_frame) && FRAME_LIVE_P(XFRAME(focus_frame))
1780 && !EQ(frame, focus_frame)) {
1781 /* Oops, we missed a focus-out event. */
1782 DEVICE_FRAME_WITH_FOCUS_REAL(d) = Qnil;
1783 redisplay_redraw_cursor(XFRAME(focus_frame), 1);
1785 DEVICE_FRAME_WITH_FOCUS_REAL(d) = frame;
1786 if (!EQ(frame, focus_frame)) {
1787 redisplay_redraw_cursor(XFRAME(frame), 1);
1790 /* We ignore the frame reported in the event. If it's different
1791 from where we think the focus was, oh well -- we messed up.
1792 Nonetheless, we pretend we were right, for sensible behavior. */
1793 frame = DEVICE_FRAME_WITH_FOCUS_REAL(d);
1795 DEVICE_FRAME_WITH_FOCUS_REAL(d) = Qnil;
1797 if (FRAME_LIVE_P(XFRAME(frame)))
1798 redisplay_redraw_cursor(XFRAME(frame), 1);
1803 /* Called from the window-system-specific code when we receive a
1804 notification that the focus lies on a particular frame.
1805 Argument is a cons: (frame . (device . in-p)) where in-p is non-nil
1808 void emacs_handle_focus_change_final(Lisp_Object frame_inp_and_dev)
1810 Lisp_Object frame = Fcar(frame_inp_and_dev);
1811 Lisp_Object device = Fcar(Fcdr(frame_inp_and_dev));
1812 int in_p = !NILP(Fcdr(Fcdr(frame_inp_and_dev)));
1816 if (!DEVICE_LIVE_P(XDEVICE(device)))
1819 d = XDEVICE(device);
1822 Lisp_Object focus_frame;
1824 if (!FRAME_LIVE_P(XFRAME(frame)))
1827 focus_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d);
1829 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d) = frame;
1830 if (FRAMEP(focus_frame) && !EQ(frame, focus_frame)) {
1831 /* Oops, we missed a focus-out event. */
1832 Fselect_frame(focus_frame);
1833 /* Do an unwind-protect in case an error occurs in
1834 the deselect-frame-hook */
1835 count = specpdl_depth();
1836 record_unwind_protect(cleanup_after_missed_defocusing,
1838 run_deselect_frame_hook();
1839 unbind_to(count, Qnil);
1840 /* the cleanup method changed the focus frame to nil, so
1841 we need to reflect this */
1844 Fselect_frame(frame);
1845 if (!EQ(frame, focus_frame))
1846 run_select_frame_hook();
1848 /* We ignore the frame reported in the event. If it's different
1849 from where we think the focus was, oh well -- we messed up.
1850 Nonetheless, we pretend we were right, for sensible behavior. */
1851 frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d);
1853 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d) = Qnil;
1854 run_deselect_frame_hook();
1859 /**********************************************************************/
1860 /* retrieving the next event */
1861 /**********************************************************************/
1863 static int in_single_console;
1865 /* #### These functions don't currently do anything. */
1866 void single_console_state(void)
1868 in_single_console = 1;
1871 void any_console_state(void)
1873 in_single_console = 0;
1876 int in_single_console_state(void)
1878 return in_single_console;
1881 /* the number of keyboard characters read. callint.c wants this. */
1882 Charcount num_input_chars;
1884 static void next_event_internal(Lisp_Object target_event, int allow_queued)
1886 struct gcpro gcpro1;
1887 /* QUIT; This is incorrect - the caller must do this because some
1888 callers (ie, Fnext_event()) do not want to QUIT. */
1890 assert(NILP(XEVENT_NEXT(target_event)));
1892 GCPRO1(target_event);
1894 /* When focus_follows_mouse is nil, if a frame change took place, we need
1895 * to actually switch window manager focus to the selected window now.
1897 if (!focus_follows_mouse)
1898 investigate_frame_change();
1900 if (allow_queued && !EQ_EMPTY_P()) {
1901 Lisp_Object event = dequeue_command_event();
1902 Fcopy_event(event, target_event);
1903 Fdeallocate_event(event);
1904 DEBUG_PRINT_EMACS_EVENT("command event queue", target_event);
1906 Lisp_Event *e = XEVENT(target_event);
1908 /* The command_event_queue was empty. Wait for an event. */
1909 event_stream_next_event(e);
1910 /* If this was a timeout, then we need to extract some data
1911 out of the returned closure and might need to resignal
1913 if (e->event_type == timeout_event) {
1914 Lisp_Object tristan, isolde;
1916 e->event.timeout.id_number =
1917 event_stream_resignal_wakeup(e->event.timeout.
1921 e->event.timeout.function = tristan;
1922 e->event.timeout.object = isolde;
1923 /* next_event_internal() doesn't print out timeout events
1924 because of the extra info we just set. */
1925 DEBUG_PRINT_EMACS_EVENT("real, timeout", target_event);
1928 /* If we read a ^G, then set quit-flag but do not discard the ^G.
1929 The callers of next_event_internal() will do one of two things:
1931 -- set Vquit_flag to Qnil. (next-event does this.) This will
1932 cause the ^G to be treated as a normal keystroke.
1933 -- not change Vquit_flag but attempt to enqueue the ^G, at
1934 which point it will be discarded. The next time QUIT is
1935 called, it will notice that Vquit_flag was set.
1938 if (e->event_type == key_press_event &&
1939 event_matches_key_specifier_p
1941 make_char(CONSOLE_QUIT_CHAR(XCONSOLE(EVENT_CHANNEL(e))))))
1950 static void run_pre_idle_hook(void)
1952 if (!NILP(Vpre_idle_hook)
1953 && !detect_input_pending())
1954 safe_run_hook_trapping_errors
1955 ("Error in `pre-idle-hook' (setting hook to nil)",
1959 static void push_this_command_keys(Lisp_Object event);
1960 static void push_recent_keys(Lisp_Object event);
1961 static void dribble_out_event(Lisp_Object event);
1962 static void execute_internal_event(Lisp_Object event);
1963 static int is_scrollbar_event(Lisp_Object event);
1965 DEFUN("next-event", Fnext_event, 0, 2, 0, /*
1966 Return the next available event.
1967 Pass this object to `dispatch-event' to handle it.
1968 In most cases, you will want to use `next-command-event', which returns
1969 the next available "user" event (i.e. keypress, button-press,
1970 button-release, or menu selection) instead of this function.
1972 If EVENT is non-nil, it should be an event object and will be filled in
1973 and returned; otherwise a new event object will be created and returned.
1974 If PROMPT is non-nil, it should be a string and will be displayed in the
1975 echo area while this function is waiting for an event.
1977 The next available event will be
1979 -- any events in `unread-command-events' or `unread-command-event'; else
1980 -- the next event in the currently executing keyboard macro, if any; else
1981 -- an event queued by `enqueue-eval-event', if any, or any similar event
1982 queued internally, such as a misc-user event. (For example, when an item
1983 is selected from a menu or from a `question'-type dialog box, the item's
1984 callback is not immediately executed, but instead a misc-user event
1985 is generated and placed onto this queue; when it is dispatched, the
1986 callback is executed.) Else
1987 -- the next available event from the window system or terminal driver.
1989 In the last case, this function will block until an event is available.
1991 The returned event will be one of the following types:
1993 -- a key-press event.
1994 -- a button-press or button-release event.
1995 -- a misc-user-event, meaning the user selected an item on a menu or used
1997 -- a process event, meaning that output from a subprocess is available.
1998 -- a timeout event, meaning that a timeout has elapsed.
1999 -- an eval event, which simply causes a function to be executed when the
2000 event is dispatched. Eval events are generated by `enqueue-eval-event'
2001 or by certain other conditions happening.
2002 -- a magic event, indicating that some window-system-specific event
2003 happened (such as a focus-change notification) that must be handled
2004 synchronously with other events. `dispatch-event' knows what to do with
2009 /* This function can call lisp */
2010 /* #### We start out using the selected console before an event
2011 is received, for echoing the partially completed command.
2012 This is most definitely wrong -- there needs to be a separate
2013 echo area for each console! */
2014 struct console *con = XCONSOLE(Vselected_console);
2015 struct command_builder *command_builder =
2016 XCOMMAND_BUILDER(con->command_builder);
2017 int store_this_key = 0;
2018 struct gcpro gcpro1;
2021 /* DO NOT do QUIT anywhere within this function or the functions it calls.
2022 We want to read the ^G as an event. */
2024 #ifdef LWLIB_MENUBARS_LUCID
2026 * #### Fix the menu code so this isn't necessary.
2028 * We cannot allow the lwmenu code to be reentered, because the
2029 * code is not written to be reentrant and will crash. Therefore
2030 * paths from the menu callbacks back into the menu code have to
2031 * be blocked. Fnext_event is the normal path into the menu code,
2032 * so we signal an error here.
2034 if (in_menu_callback)
2035 error("Attempt to call next-event inside menu callback");
2036 #endif /* LWLIB_MENUBARS_LUCID */
2039 event = Fmake_event(Qnil, Qnil);
2041 CHECK_LIVE_EVENT(event);
2043 if (!NILP(prompt)) {
2045 CHECK_STRING(prompt);
2047 len = XSTRING_LENGTH(prompt);
2048 if (command_builder->echo_buf_length < len)
2049 len = command_builder->echo_buf_length - 1;
2050 memcpy(command_builder->echo_buf, XSTRING_DATA(prompt), len);
2051 command_builder->echo_buf[len] = 0;
2052 command_builder->echo_buf_index = len;
2053 echo_area_message(XFRAME(CONSOLE_SELECTED_FRAME(con)),
2054 command_builder->echo_buf,
2056 command_builder->echo_buf_index, Qcommand);
2059 start_over_and_avoid_hosage:
2060 /* If there is something in unread-command-events, simply return it.
2061 But do some error checking to make sure the user hasn't put something
2062 in the unread-command-events that they shouldn't have.
2063 This does not update this-command-keys and recent-keys.
2065 if (!NILP(Vunread_command_events)) {
2066 if (!CONSP(Vunread_command_events)) {
2067 Vunread_command_events = Qnil;
2068 signal_error(Qwrong_type_argument,
2069 list3(Qconsp, Vunread_command_events,
2070 Qunread_command_events));
2072 Lisp_Object e = XCAR(Vunread_command_events);
2073 Vunread_command_events = XCDR(Vunread_command_events);
2074 if (!EVENTP(e) || !command_event_p(e))
2075 signal_error(Qwrong_type_argument,
2076 list3(Qcommand_event_p, e,
2077 Qunread_command_events));
2080 Fcopy_event(e, event);
2081 DEBUG_PRINT_EMACS_EVENT("unread-command-events", event);
2085 /* Do similar for unread-command-event (obsoleteness support). */
2086 else if (!NILP(Vunread_command_event)) {
2087 Lisp_Object e = Vunread_command_event;
2088 Vunread_command_event = Qnil;
2090 if (!EVENTP(e) || !command_event_p(e)) {
2091 signal_error(Qwrong_type_argument,
2092 list3(Qeventp, e, Qunread_command_event));
2095 Fcopy_event(e, event);
2097 DEBUG_PRINT_EMACS_EVENT("unread-command-event", event);
2100 /* If we're executing a keyboard macro, take the next event from that,
2101 and update this-command-keys and recent-keys.
2102 Note that the unread-command-events take precedence over kbd macros.
2105 if (!NILP(Vexecuting_macro)) {
2107 pop_kbd_macro_event(event); /* This throws past us at
2110 DEBUG_PRINT_EMACS_EVENT("keyboard macro", event);
2112 /* Otherwise, read a real event, possibly from the
2113 command_event_queue, and update this-command-keys and
2116 run_pre_idle_hook();
2118 next_event_internal(event, 1);
2119 Vquit_flag = Qnil; /* Read C-g as an event. */
2124 status_notify(); /* Notice process change */
2127 alloca(0); /* Cause a garbage collection now */
2128 /* Since we can free the most stuff here
2129 * (since this is typically called from
2130 * the command-loop top-level). */
2131 #endif /* C_ALLOCA */
2133 if (object_dead_p(XEVENT(event)->channel)) {
2134 /* event_console_or_selected may crash if the channel is dead.
2135 Best just to eat it and get the next event. */
2136 goto start_over_and_avoid_hosage;
2139 /* OK, now we can stop the selected-console kludge and use the
2140 actual console from the event. */
2141 con = event_console_or_selected(event);
2142 command_builder = XCOMMAND_BUILDER(con->command_builder);
2144 switch (XEVENT_TYPE(event)) {
2145 case button_release_event:
2146 case misc_user_event:
2147 /* don't echo menu accelerator keys */
2148 reset_key_echo(command_builder, 1);
2150 case button_press_event:
2151 /* key or mouse input can trigger prompting */
2152 goto STORE_AND_EXECUTE_KEY;
2153 case key_press_event:
2154 /* any key input can trigger autosave */
2157 /* just list the other events here */
2159 case pointer_motion_event:
2163 case magic_eval_event:
2165 #ifdef EF_USE_ASYNEQ
2166 case eaten_myself_event:
2167 case work_started_event:
2168 case work_finished_event:
2169 #endif /* EF_USE_ASYNEQ */
2175 maybe_do_auto_save();
2177 STORE_AND_EXECUTE_KEY:
2178 if (store_this_key) {
2179 echo_key_event(command_builder, event);
2183 /* Store the last-input-event. The semantics of this is that it is
2184 the thing most recently returned by next-command-event. It need
2185 not have come from the keyboard or a keyboard macro, it may have
2186 come from unread-command-events. It's always a command-event (a
2187 key, click, or menu selection), never a motion or process event.
2189 if (!EVENTP(Vlast_input_event))
2190 Vlast_input_event = Fmake_event(Qnil, Qnil);
2191 if (XEVENT_TYPE(Vlast_input_event) == dead_event) {
2192 Vlast_input_event = Fmake_event(Qnil, Qnil);
2193 error("Someone deallocated last-input-event!");
2195 if (!EQ(event, Vlast_input_event))
2196 Fcopy_event(event, Vlast_input_event);
2198 /* last-input-char and last-input-time are derived from
2200 Note that last-input-char will never have its high-bit set, in an
2201 effort to sidestep the ambiguity between M-x and oslash.
2203 Vlast_input_char = Fevent_to_character(Vlast_input_event,
2208 if (!CONSP(Vlast_input_time))
2209 Vlast_input_time = Fcons(Qnil, Qnil);
2210 XCAR(Vlast_input_time) =
2211 make_int((EMACS_SECS(t) >> 16) & 0xffff);
2212 XCDR(Vlast_input_time) =
2213 make_int((EMACS_SECS(t) >> 0) & 0xffff);
2214 if (!CONSP(Vlast_command_event_time))
2215 Vlast_command_event_time = list3(Qnil, Qnil, Qnil);
2216 XCAR(Vlast_command_event_time) =
2217 make_int((EMACS_SECS(t) >> 16) & 0xffff);
2218 XCAR(XCDR(Vlast_command_event_time)) =
2219 make_int((EMACS_SECS(t) >> 0) & 0xffff);
2220 XCAR(XCDR(XCDR(Vlast_command_event_time)))
2221 = make_int(EMACS_USECS(t));
2223 /* If this key came from the keyboard or from a keyboard macro, then
2224 it goes into the recent-keys and this-command-keys vectors.
2225 If this key came from the keyboard, and we're defining a keyboard
2226 macro, then it goes into the macro.
2228 if (store_this_key) {
2229 if (!is_scrollbar_event(event)) /* #### not quite right, see
2230 comment in execute_command_event */
2231 push_this_command_keys(event);
2232 if (!inhibit_input_event_recording)
2233 push_recent_keys(event);
2234 dribble_out_event(event);
2235 if (!NILP(con->defining_kbd_macro) && NILP(Vexecuting_macro)) {
2236 if (!EVENTP(command_builder->current_events))
2237 finalize_kbd_macro_chars(con);
2238 store_kbd_macro_event(event);
2241 /* If this is the help char and there is a help form, then execute the
2242 help form and swallow this character. This is the only place where
2243 calling Fnext_event() can cause arbitrary lisp code to run. Note
2244 that execute_help_form() calls Fnext_command_event(), which calls
2245 this function, as well as Fdispatch_event.
2247 if (!NILP(Vhelp_form) &&
2248 event_matches_key_specifier_p(XEVENT(event), Vhelp_char))
2249 execute_help_form(command_builder, event);
2256 DEFUN("next-command-event", Fnext_command_event, 0, 2, 0, /*
2257 Return the next available "user" event.
2258 Pass this object to `dispatch-event' to handle it.
2260 If EVENT is non-nil, it should be an event object and will be filled in
2261 and returned; otherwise a new event object will be created and returned.
2262 If PROMPT is non-nil, it should be a string and will be displayed in the
2263 echo area while this function is waiting for an event.
2265 The event returned will be a keyboard, mouse press, or mouse release event.
2266 If there are non-command events available (mouse motion, sub-process output,
2267 etc) then these will be executed (with `dispatch-event') and discarded. This
2268 function is provided as a convenience; it is roughly equivalent to the lisp code
2271 (next-event event prompt)
2272 (not (or (key-press-event-p event)
2273 (button-press-event-p event)
2274 (button-release-event-p event)
2275 (misc-user-event-p event))))
2276 (dispatch-event event))
2278 but it also makes a provision for displaying keystrokes in the echo area.
2282 /* This function can GC */
2283 struct gcpro gcpro1;
2285 maybe_echo_keys(XCOMMAND_BUILDER(XCONSOLE(Vselected_console)->command_builder), 0); /* #### This sucks bigtime */
2287 event = Fnext_event(event, prompt);
2288 if (command_event_p(event))
2291 execute_internal_event(event);
2297 DEFUN("dispatch-non-command-events", Fdispatch_non_command_events, 0, 0, 0, /*
2298 Dispatch any pending "magic" events.
2300 This function is useful for forcing the redisplay of native
2301 widgets. Normally these are redisplayed through a native window-system
2302 event encoded as magic event, rather than by the redisplay code. This
2303 function does not call redisplay or do any of the other things that
2308 /* This function can GC */
2309 Lisp_Object event = Qnil;
2310 struct gcpro gcpro1;
2312 event = Fmake_event(Qnil, Qnil);
2314 /* Make sure that there will be something in the native event queue
2315 so that externally managed things (e.g. widgets) get some CPU
2317 event_stream_force_event_pending(selected_frame());
2319 while (event_stream_event_pending_p(0)) {
2320 QUIT; /* next_event_internal() does not QUIT. */
2322 /* We're a generator of the command_event_queue, so we can't be a
2323 consumer as well. Also, we have no reason to consult the
2324 command_event_queue; there are only user and eval-events there,
2325 and we'd just have to put them back anyway.
2327 next_event_internal(event, 0); /* blocks */
2328 /* See the comment in accept-process-output about Vquit_flag */
2329 if (XEVENT_TYPE(event) == magic_event ||
2330 XEVENT_TYPE(event) == timeout_event ||
2331 XEVENT_TYPE(event) == process_event ||
2332 XEVENT_TYPE(event) == pointer_motion_event)
2333 execute_internal_event(event);
2335 enqueue_command_event_1(event);
2340 Fdeallocate_event(event);
2345 static void reset_current_events(struct command_builder *command_builder)
2347 Lisp_Object event = command_builder->current_events;
2348 reset_command_builder_event_chain(command_builder);
2350 deallocate_event_chain(event);
2353 DEFUN("discard-input", Fdiscard_input, 0, 0, 0, /*
2354 Discard any pending "user" events.
2355 Also cancel any kbd macro being defined.
2356 A user event is a key press, button press, button release, or
2357 "misc-user" event (menu selection or scrollbar action).
2361 /* This throws away user-input on the queue, but doesn't process any
2362 events. Calling dispatch_event() here leads to a race condition.
2364 Lisp_Object event = Fmake_event(Qnil, Qnil);
2365 #ifndef EF_USE_ASYNEQ
2366 Lisp_Object head = Qnil, tail = Qnil;
2368 Lisp_Object oiq = Vinhibit_quit;
2369 struct gcpro gcpro1, gcpro2;
2370 /* #### not correct here with Vselected_console? Should
2371 discard-input take a console argument, or maybe map over
2373 struct console *con = XCONSOLE(Vselected_console);
2375 /* next_event_internal() can cause arbitrary Lisp code to be evalled */
2378 /* If a macro was being defined then we have to mark the modeline
2379 has changed to ensure that it gets updated correctly. */
2380 if (!NILP(con->defining_kbd_macro))
2381 MARK_MODELINE_CHANGED;
2382 con->defining_kbd_macro = Qnil;
2383 reset_current_events(XCOMMAND_BUILDER(con->command_builder));
2385 #ifdef EF_USE_ASYNEQ
2387 WITH_DLLIST_TRAVERSE(
2389 sxe_event_t *ev = dllist_item;
2390 if (command_event_p((Lisp_Object)ev)) {
2391 dllist_pop_inner(eq_queue(asyneq), _el);
2394 while (!EQ_EMPTY_P() || event_stream_event_pending_p(1)) {
2395 /* This will take stuff off the command_event_queue, or read it
2396 from the event_stream, but it will not block.
2398 next_event_internal(event, 1);
2399 Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it).
2400 It is vitally important that we reset
2401 Vquit_flag here. Otherwise, if we're
2402 reading from a TTY console,
2403 maybe_read_quit_event() will notice
2404 that C-g has been set and send us
2405 another C-g. That will cause us
2406 to get right back here, and read
2407 another C-g, ad infinitum ... */
2409 /* If the event is a user event, ignore it. */
2410 if (!command_event_p(event)) {
2411 /* Otherwise, chain the event onto our list of events
2412 not to ignore, and keep reading until the queue is
2413 empty. This does not mean that if a subprocess is
2414 generating an infinite amount of output, we will
2415 never terminate (*provided* that the behavior of
2416 next_event_cb() is correct -- see the comment in
2417 events.h), because this loop ends as soon as there
2418 are no more user events on the command_event_queue or
2421 enqueue_event(Fcopy_event(event, Qnil), &head, &tail);
2425 if (!EQ_EMPTY_P() || EQ_LARGE_P())
2428 /* Now tack our chain of events back on to the front of the queue.
2429 Actually, since the queue is now drained, we can just replace it.
2430 The effect of this will be that we have deleted all user events
2431 from the input stream without changing the relative ordering of
2432 any other events. (Some events may have been taken from the
2433 event_stream and added to the command_event_queue, however.)
2435 At this time, the command_event_queue will contain only eval_events.
2437 command_event_queue = head;
2438 command_event_queue_tail = tail;
2441 Fdeallocate_event(event);
2444 Vinhibit_quit = oiq;
2448 /**********************************************************************/
2449 /* pausing until an action occurs */
2450 /**********************************************************************/
2452 /* This is used in accept-process-output, sleep-for and sit-for.
2453 Before running any process_events in these routines, we set
2454 recursive_sit_for to Qt, and use this unwind protect to reset it to
2455 Qnil upon exit. When recursive_sit_for is Qt, calling sit-for will
2456 cause it to return immediately.
2458 All of these routines install timeouts, so we clear the installed
2461 Note: It's very easy to break the desired behaviors of these
2462 3 routines. If you make any changes to anything in this area, run
2463 the regression tests at the bottom of the file. -- dmoore */
2465 static Lisp_Object sit_for_unwind(Lisp_Object timeout_id)
2467 if (!NILP(timeout_id))
2468 Fdisable_timeout(timeout_id);
2470 recursive_sit_for = Qnil;
2474 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)?
2477 DEFUN("accept-process-output", Faccept_process_output, 0, 3, 0, /*
2478 Allow any pending output from subprocesses to be read by Emacs.
2479 It is read into the process' buffers or given to their filter functions.
2480 Non-nil arg PROCESS means do not return until some output has been received
2481 from PROCESS. Nil arg PROCESS means do not return until some output has
2482 been received from any process.
2484 If the second arg is non-nil, it is the maximum number of seconds to wait:
2485 this function will return after that much time even if no input has arrived
2486 from PROCESS. This argument may be a float, meaning wait some fractional
2489 If the third arg is non-nil, it is a number of milliseconds that is added
2490 to the second arg. (This exists only for compatibility.)
2491 Return non-nil iff we received any output before the timeout expired.
2493 (process, timeout_secs, timeout_msecs))
2495 /* This function can GC */
2496 struct gcpro gcpro1, gcpro2;
2497 Lisp_Object event = Qnil;
2498 Lisp_Object result = Qnil;
2499 int timeout_id = -1;
2500 int timeout_enabled = 0;
2502 struct buffer *old_buffer = current_buffer;
2505 /* We preserve the current buffer but nothing else. If a focus
2506 change alters the selected window then the top level event loop
2507 will eventually alter current_buffer to match. In the mean time
2508 we don't want to mess up whatever called this function. */
2511 CHECK_PROCESS(process);
2513 GCPRO2(event, process);
2515 if (!NILP(timeout_secs) || !NILP(timeout_msecs)) {
2516 unsigned long msecs = 0;
2517 if (!NILP(timeout_secs))
2518 msecs = lisp_number_to_milliseconds(timeout_secs, 1);
2519 if (!NILP(timeout_msecs)) {
2520 CHECK_NATNUM(timeout_msecs);
2521 msecs += XINT(timeout_msecs);
2525 event_stream_generate_wakeup(msecs, 0, Qnil, Qnil,
2527 timeout_enabled = 1;
2531 event = Fmake_event(Qnil, Qnil);
2533 count = specpdl_depth();
2534 record_unwind_protect(sit_for_unwind,
2535 timeout_enabled ? make_int(timeout_id) : Qnil);
2536 recursive_sit_for = Qt;
2539 ((NILP(process) && timeout_enabled) ||
2540 (NILP(process) && event_stream_event_pending_p(0)) ||
2542 /* Calling detect_input_pending() is the wrong thing here, because
2543 that considers the Vunread_command_events and command_event_queue.
2544 We don't need to look at the command_event_queue because we are
2545 only interested in process events, which don't go on that. In
2546 fact, we can't read from it anyway, because we put stuff on it.
2548 Note that event_stream->event_pending_p must be called in such
2549 a way that it says whether any events *of any kind* are ready,
2550 not just user events, or (accept-process-output nil) will fail
2551 to dispatch any process events that may be on the queue. It is
2552 not clear to me that this is important, because the top-level
2553 loop will process it, and I don't think that there is ever a
2554 time when one calls accept-process-output with a nil argument
2555 and really need the processes to be handled. */
2557 /* If our timeout has arrived, we move along. */
2559 && !event_stream_wakeup_pending_p(timeout_id, 0)) {
2560 timeout_enabled = 0;
2561 done = 1; /* We're done. */
2562 continue; /* Don't call next_event_internal */
2565 QUIT; /* next_event_internal() does not QUIT, so check
2566 for ^G before reading output from the process
2567 - this makes it less likely that the filter
2568 will actually be aborted.
2571 next_event_internal(event, 0);
2572 /* If C-g was pressed while we were waiting, Vquit_flag got
2573 set and next_event_internal() also returns C-g. When
2574 we enqueue the C-g below, it will get discarded. The
2575 next time through, QUIT will be called and will signal a quit. */
2576 switch (XEVENT_TYPE(event)) {
2578 if (NILP(process) ||
2579 EQ(XEVENT(event)->event.process.process,
2582 /* RMS's version always returns nil when
2583 proc is nil, and only returns t if
2584 input ever arrived on proc. */
2588 execute_internal_event(event);
2592 /* We execute the event even if it's ours, and notice
2593 that it's happened above. */
2594 case pointer_motion_event:
2596 execute_internal_event(event);
2599 /* just list the other events here */
2601 case key_press_event:
2602 case button_press_event:
2603 case button_release_event:
2604 case misc_user_event:
2605 case magic_eval_event:
2607 #ifdef EF_USE_ASYNEQ
2608 case eaten_myself_event:
2609 case work_started_event:
2610 case work_finished_event:
2611 #endif /* EF_USE_ASYNEQ */
2614 enqueue_command_event_1(event);
2619 unbind_to(count, timeout_enabled ? make_int(timeout_id) : Qnil);
2621 Fdeallocate_event(event);
2623 current_buffer = old_buffer;
2627 DEFUN("sleep-for", Fsleep_for, 1, 1, 0, /*
2628 Pause, without updating display, for SECONDS seconds.
2629 SECONDS may be a float, allowing pauses for fractional parts of a second.
2631 It is recommended that you never call sleep-for from inside of a process
2632 filter function or timer event (either synchronous or asynchronous).
2636 /* This function can GC */
2637 unsigned long msecs = lisp_number_to_milliseconds(seconds, 1);
2639 Lisp_Object event = Qnil;
2641 struct gcpro gcpro1;
2645 id = event_stream_generate_wakeup(msecs, 0, Qnil, Qnil, 0);
2646 event = Fmake_event(Qnil, Qnil);
2648 count = specpdl_depth();
2649 record_unwind_protect(sit_for_unwind, make_int(id));
2650 recursive_sit_for = Qt;
2653 /* If our timeout has arrived, we move along. */
2654 if (!event_stream_wakeup_pending_p(id, 0))
2657 /* next_event_internal() does not QUIT, so check for ^G before
2658 reading output from the process - this makes it less likely
2659 that the filter will actually be aborted.
2663 /* We're a generator of the command_event_queue, so we can't be
2664 a consumer as well. We don't care about command and
2667 next_event_internal(event, 0); /* blocks */
2668 /* See the comment in accept-process-output about Vquit_flag */
2669 switch (XEVENT_TYPE(event)) {
2671 /* We execute the event even if it's ours, and notice
2672 that it's happened above. */
2674 case pointer_motion_event:
2676 execute_internal_event(event);
2679 /* just list the other events here */
2681 case key_press_event:
2682 case button_press_event:
2683 case button_release_event:
2684 case magic_eval_event:
2686 case misc_user_event:
2687 #ifdef EF_USE_ASYNEQ
2688 case eaten_myself_event:
2689 case work_started_event:
2690 case work_finished_event:
2691 #endif /* EF_USE_ASYNEQ */
2694 enqueue_command_event_1(event);
2699 unbind_to(count, make_int(id));
2700 Fdeallocate_event(event);
2705 DEFUN("sit-for", Fsit_for, 1, 2, 0, /*
2706 Perform redisplay, then wait SECONDS seconds or until user input is available.
2707 SECONDS may be a float, meaning a fractional part of a second.
2708 Optional second arg NODISPLAY non-nil means don't redisplay; just wait.
2709 Redisplay is preempted as always if user input arrives, and does not
2710 happen if input is available before it starts.
2711 Value is t if waited the full time with no input arriving.
2713 If sit-for is called from within a process filter function or timer
2714 event (either synchronous or asynchronous) it will return immediately.
2716 (seconds, nodisplay))
2718 /* This function can GC */
2719 unsigned long msecs = lisp_number_to_milliseconds(seconds, 1);
2720 Lisp_Object event, result;
2721 struct gcpro gcpro1;
2725 /* The unread-command-events count as pending input */
2726 if (!NILP(Vunread_command_events) || !NILP(Vunread_command_event))
2729 /* If the command-builder already has user-input on it (not eval events)
2730 then that means we're done too.
2732 if (!EQ_EMPTY_P()) {
2733 #if defined(EF_USE_ASYNEQ)
2736 if (command_event_p(event)) {
2737 RETURN_FROM_EQ_TRAVERSE(asyneq, Qnil);
2740 EVENT_CHAIN_LOOP(event, command_event_queue) {
2741 if (command_event_p(event))
2747 /* If we're in a macro, or noninteractive, or early in temacs, then
2749 if (noninteractive || !NILP(Vexecuting_macro))
2752 /* Recursive call from a filter function or timeout handler. */
2753 if (!NILP(recursive_sit_for)) {
2754 if (!event_stream_event_pending_p(1) && NILP(nodisplay)) {
2755 run_pre_idle_hook();
2761 /* Otherwise, start reading events from the event_stream.
2762 Do this loop at least once even if (sit-for 0) so that we
2763 redisplay when no input pending.
2766 event = Fmake_event(Qnil, Qnil);
2768 /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc.
2769 events get processed. The old (pre-19.12) code special-cased this
2770 and didn't generate a wakeup, but the resulting behavior was less than
2771 ideal; viz. the occurrence of (sit-for 0.001) scattered throughout
2772 the E-Lisp universe. */
2774 id = event_stream_generate_wakeup(msecs, 0, Qnil, Qnil, 0);
2776 count = specpdl_depth();
2777 record_unwind_protect(sit_for_unwind, make_int(id));
2778 recursive_sit_for = Qt;
2781 /* If there is no user input pending, then redisplay.
2783 if (!event_stream_event_pending_p(1) && NILP(nodisplay)) {
2784 run_pre_idle_hook();
2788 /* If our timeout has arrived, we move along. */
2789 if (!event_stream_wakeup_pending_p(id, 0)) {
2794 /* next_event_internal() does not QUIT, so check for ^G
2795 before reading output from the process - this makes it
2796 less likely that the filter will actually be aborted.
2800 /* We're a generator of the command_event_queue, so we can't be
2801 a consumer as well. In fact, we know there's nothing on the
2802 command_event_queue that we didn't just put there.
2804 next_event_internal(event, 0); /* blocks */
2805 /* See the comment in accept-process-output about Vquit_flag */
2807 if (command_event_p(event)) {
2808 QUIT; /* If the command was C-g check it here
2809 so that we abort out of the sit-for,
2810 not the next command. sleep-for and
2811 accept-process-output continue looping
2812 so they check QUIT again implicitly. */
2817 switch (XEVENT_TYPE(event)) {
2819 /* eval-events get delayed until later. */
2820 enqueue_command_event(Fcopy_event(event, Qnil));
2824 /* We execute the event even if it's ours, and notice
2825 that it's happened above. */
2827 /* just list the rest here too */
2829 case key_press_event:
2830 case button_press_event:
2831 case button_release_event:
2832 case pointer_motion_event:
2835 case magic_eval_event:
2836 case misc_user_event:
2837 #ifdef EF_USE_ASYNEQ
2838 case eaten_myself_event:
2839 case work_started_event:
2840 case work_finished_event:
2841 #endif /* EF_USE_ASYNEQ */
2844 execute_internal_event(event);
2850 unbind_to(count, make_int(id));
2852 /* Put back the event (if any) that made Fsit_for() exit before the
2853 timeout. Note that it is being added to the back of the queue, which
2854 would be inappropriate if there were any user events on the queue
2855 already: we would be misordering them. But we know that there are
2856 no user-events on the queue, or else we would not have reached this
2860 enqueue_command_event(event);
2862 Fdeallocate_event(event);
2868 /* This handy little function is used by select-x.c to wait for replies
2869 from processes that aren't really processes (e.g. the X server) */
2870 void wait_delaying_user_input(int (*predicate) (void *arg), void *predicate_arg)
2872 /* This function can GC */
2873 Lisp_Object event = Fmake_event(Qnil, Qnil);
2874 struct gcpro gcpro1;
2877 while (!(*predicate) (predicate_arg)) {
2878 QUIT; /* next_event_internal() does not QUIT. */
2880 /* We're a generator of the command_event_queue, so we can't be a
2881 consumer as well. Also, we have no reason to consult the
2882 command_event_queue; there are only user and eval-events there,
2883 and we'd just have to put them back anyway.
2885 next_event_internal(event, 0);
2886 /* See the comment in accept-process-output about Vquit_flag */
2887 if (command_event_p(event)
2888 || (XEVENT_TYPE(event) == eval_event)
2889 || (XEVENT_TYPE(event) == magic_eval_event))
2890 enqueue_command_event_1(event);
2892 execute_internal_event(event);
2897 /**********************************************************************/
2898 /* dispatching events; command builder */
2899 /**********************************************************************/
2902 execute_internal_event(Lisp_Object event)
2904 /* events on dead channels get silently eaten */
2905 if (object_dead_p(XEVENT(event)->channel)) {
2909 /* This function can GC */
2910 switch (XEVENT_TYPE(event)) {
2915 call1(XEVENT(event)->event.eval.function,
2916 XEVENT(event)->event.eval.object);
2919 case magic_eval_event:
2920 (XEVENT(event)->event.magic_eval.internal_function)
2921 (XEVENT(event)->event.magic_eval.object);
2924 case pointer_motion_event:
2925 if (!NILP(Vmouse_motion_handler))
2926 call1(Vmouse_motion_handler, event);
2929 case process_event: {
2930 Lisp_Object p = XEVENT(event)->event.process.process;
2931 Charcount readstatus;
2933 assert(PROCESSP(p));
2934 while ((readstatus = read_process_output(p)) > 0) ;
2935 if (readstatus > 0) ; /* this clauses never gets
2936 executed but allows the
2937 #ifdefs to work cleanly. */
2939 else if (readstatus == -1 && errno == EWOULDBLOCK) ;
2940 #endif /* EWOULDBLOCK */
2942 else if (readstatus == -1 && errno == EAGAIN) ;
2944 else if ((readstatus == 0 &&
2945 /* Note that we cannot distinguish between no
2946 input available now and a closed pipe.
2947 With luck, a closed pipe will be
2948 accompanied by subprocess termination and
2950 (!network_connection_p(p) ||
2952 When connected to ToolTalk (i.e.
2953 connected_via_filedesc_p()), it's not
2954 possible to reliably determine whether
2955 there is a message waiting for ToolTalk to
2956 receive. ToolTalk expects to have
2957 tt_message_receive() called exactly once
2958 every time the file descriptor becomes
2959 active, so the filter function forces this
2960 by returning 0. Emacs must not interpret
2961 this as a closed pipe.
2963 We don't do ToolTalk anymore, but come
2964 back and revisit this for D-Bus */
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
3765 if (XEVENT(event)->event_type != misc_user_event)
3767 fun = XEVENT(event)->event.misc.function;
3769 return (EQ(fun, Qscrollbar_line_up) ||
3770 EQ(fun, Qscrollbar_line_down) ||
3771 EQ(fun, Qscrollbar_page_up) ||
3772 EQ(fun, Qscrollbar_page_down) ||
3773 EQ(fun, Qscrollbar_to_top) ||
3774 EQ(fun, Qscrollbar_to_bottom) ||
3775 EQ(fun, Qscrollbar_vertical_drag) ||
3776 EQ(fun, Qscrollbar_char_left) ||
3777 EQ(fun, Qscrollbar_char_right) ||
3778 EQ(fun, Qscrollbar_page_left) ||
3779 EQ(fun, Qscrollbar_page_right) ||
3780 EQ(fun, Qscrollbar_to_left) ||
3781 EQ(fun, Qscrollbar_to_right) ||
3782 EQ(fun, Qscrollbar_horizontal_drag));
3785 #endif /* HAVE_SCROLLBARS */
3789 execute_command_event(struct command_builder *cmd_builder, Lisp_Object event)
3791 /* This function can GC */
3792 struct console *con = XCONSOLE(cmd_builder->console);
3793 struct gcpro gcpro1;
3795 GCPRO1(event); /* event may be freshly created */
3797 /* #### This call to is_scrollbar_event() isn't quite right, but
3798 fixing properly it requires more work than can go into 21.4.
3799 (We really need to split out menu, scrollbar, dialog, and other
3800 types of events from misc-user, and put the remaining ones in a
3801 new `user-eval' type that behaves like an eval event but is a
3802 user event and thus has all of its semantics -- e.g. being
3803 delayed during `accept-process-output' and similar wait states.)
3805 The real issue here is that "user events" and "command events"
3806 are not the same thing, but are very much confused in
3807 event-stream.c. User events are, essentially, any event that
3808 should be delayed by accept-process-output, should terminate a
3809 sit-for, etc. -- basically, any event that needs to be processed
3810 synchronously with key and mouse events. Command events are
3811 those that participate in command building; scrollbar events
3812 clearly don't belong because they should be transparent in a
3813 sequence like C-x @ h <scrollbar-drag> x, which used to cause a
3814 crash before checks similar to the is_scrollbar_event() call were
3815 added. Do other events belong with scrollbar events? I'm not
3816 sure; we need to categorize all misc-user events and see what
3817 their semantics are.
3819 (You might ask, why do scrollbar events need to be user events?
3820 That's a good question. The answer seems to be that they can
3821 change point, and having this happen asynchronously would be a
3822 very bad idea. According to the "proper" functioning of
3823 scrollbars, this should not happen, but SXEmacs does not allow
3824 point to go outside of the window.)
3826 Scrollbar events and similar non-command events should obviously
3827 not be recorded in this-command-keys, so we need to check for
3830 #### We call reset_current_events() twice in this function --
3831 #### here, and later as a result of reset_this_command_keys().
3832 #### This is almost certainly wrong; need to figure out what's
3835 #### We need to figure out what's really correct w.r.t. scrollbar
3836 #### events. With these new fixes in, it actually works to do
3837 #### C-x <scrollbar-drag> 5 2, but the key echo gets messed up
3838 #### (starts over at 5). We really need to be special-casing
3839 #### scrollbar events at a lower level, and not really passing
3840 #### them through the command builder at all. (e.g. do scrollbar
3841 #### events belong in macros??? doubtful; probably only the
3842 #### point movement, if any, belongs, special-cased as a
3843 #### pseudo-issued M-x goto-char command). #### Need more work
3844 #### here. Do this when separating out scrollbar events.
3847 if (!is_scrollbar_event(event))
3848 reset_current_events(cmd_builder);
3850 switch (XEVENT(event)->event_type) {
3851 case key_press_event:
3852 Vcurrent_mouse_event = Qnil;
3854 case button_press_event:
3855 case button_release_event:
3856 case misc_user_event:
3857 Vcurrent_mouse_event = Fcopy_event(event, Qnil);
3860 /* just list the other cases here */
3862 case pointer_motion_event:
3866 case magic_eval_event:
3868 #ifdef EF_USE_ASYNEQ
3869 case eaten_myself_event:
3870 case work_started_event:
3871 case work_finished_event:
3872 #endif /* EF_USE_ASYNEQ */
3878 /* Store the last-command-event. The semantics of this is that it
3879 is the last event most recently involved in command-lookup. */
3880 if (!EVENTP(Vlast_command_event))
3881 Vlast_command_event = Fmake_event(Qnil, Qnil);
3882 if (XEVENT(Vlast_command_event)->event_type == dead_event) {
3883 Vlast_command_event = Fmake_event(Qnil, Qnil);
3884 error("Someone deallocated the last-command-event!");
3887 if (!EQ(event, Vlast_command_event))
3888 Fcopy_event(event, Vlast_command_event);
3890 /* Note that last-command-char will never have its high-bit set, in
3891 an effort to sidestep the ambiguity between M-x and oslash. */
3892 Vlast_command_char = Fevent_to_character(Vlast_command_event,
3895 /* Actually call the command, with all sorts of hair to preserve or clear
3896 the echo-area and region as appropriate and call the pre- and post-
3899 int old_kbd_macro = con->kbd_macro_end;
3900 Lisp_Object tmp = Fselected_window(Qnil);
3901 struct window *w = XWINDOW(tmp);
3903 /* We're executing a new command, so the old value is irrelevant. */
3904 zmacs_region_stays = 0;
3906 /* If the previous command tried to force a specific window-start,
3907 reset the flag in case this command moves point far away from
3908 that position. Also, reset the window's buffer's change
3909 information so that we don't trigger an incremental update. */
3910 if (w->force_start) {
3912 buffer_reset_changes(XBUFFER(w->buffer));
3917 if (XEVENT(event)->event_type == misc_user_event) {
3918 call1(XEVENT(event)->event.eval.function,
3919 XEVENT(event)->event.eval.object);
3921 Fcommand_execute(Vthis_command, Qnil, Qnil);
3924 post_command_hook();
3926 /* Console might have been deleted by command */
3927 if (CONSOLE_LIVE_P(con) && !NILP(con->prefix_arg)) {
3928 /* Commands that set the prefix arg don't update
3929 last-command, don't reset the echoing state, and
3930 don't go into keyboard macros unless followed by
3931 another command. Also don't quit here. */
3932 int speccount = specpdl_depth();
3933 specbind(Qinhibit_quit, Qt);
3934 maybe_echo_keys(cmd_builder, 0);
3935 unbind_to(speccount, Qnil);
3937 /* If we're recording a keyboard macro, and the last
3938 command executed set a prefix argument, then
3939 decrement the pointer to the "last character really
3940 in the macro" to be just before this command. This
3941 is so that the ^U in "^U ^X )" doesn't go onto the
3943 if (!NILP(con->defining_kbd_macro))
3944 con->kbd_macro_end = old_kbd_macro;
3946 /* Start a new command next time */
3947 Vlast_command = Vthis_command;
3948 Vlast_command_properties = Vthis_command_properties;
3949 Vthis_command_properties = Qnil;
3951 /* Emacs 18 doesn't unconditionally clear the echoed
3952 keystrokes, so we don't either */
3953 /* who cares about RMSmacs 18? */
3954 if (!is_scrollbar_event(event))
3955 reset_this_command_keys(CONSOLE_LIVE_P(con) ?
3963 /* Run the pre command hook. */
3965 static void pre_command_hook(void)
3967 last_point_position = BUF_PT(current_buffer);
3968 XSETBUFFER(last_point_position_buffer, current_buffer);
3969 /* This function can GC */
3970 safe_run_hook_trapping_errors
3971 ("Error in `pre-command-hook' (setting hook to nil)",
3972 Qpre_command_hook, 1);
3974 /* This is a kludge, but necessary; see simple.el */
3975 call0(Qhandle_pre_motion_command);
3978 /* Run the post command hook. */
3980 static void post_command_hook(void)
3982 /* This function can GC */
3983 /* Turn off region highlighting unless this command requested that
3984 it be left on, or we're in the minibuffer. We don't turn it off
3985 when we're in the minibuffer so that things like M-x write-region
3988 This could be done via a function on the post-command-hook, but
3989 we don't want the user to accidentally remove it.
3992 Lisp_Object win = Fselected_window(Qnil);
3994 /* If the last command deleted the frame, `win' might be nil.
3995 It seems safest to do nothing in this case. */
3996 /* Note: Someone added the following comment and put #if 0's around
3997 this code, not realizing that doing this invites a crash in the
3999 /* #### This doesn't really fix the problem,
4000 if delete-frame is called by some hook */
4004 /* This is a kludge, but necessary; see simple.el */
4005 call0(Qhandle_post_motion_command);
4007 if (!zmacs_region_stays && (!MINI_WINDOW_P(XWINDOW(win))
4008 || EQ(zmacs_region_buffer(),
4009 WINDOW_BUFFER(XWINDOW(win)))))
4010 zmacs_deactivate_region();
4012 zmacs_update_region();
4014 safe_run_hook_trapping_errors
4015 ("Error in `post-command-hook' (setting hook to nil)",
4016 Qpost_command_hook, 1);
4018 /* #### Kludge!!! This is necessary to make sure that things
4019 are properly positioned even if post-command-hook moves point.
4020 #### There should be a cleaner way of handling this. */
4021 call0(Qauto_show_make_point_visible);
4024 DEFUN("dispatch-event", Fdispatch_event, 1, 1, 0, /*
4025 Given an event object EVENT as returned by `next-event', execute it.
4027 Key-press, button-press, and button-release events get accumulated
4028 until a complete key sequence (see `read-key-sequence') is reached,
4029 at which point the sequence is looked up in the current keymaps and
4032 Mouse motion events cause the low-level handling function stored in
4033 `mouse-motion-handler' to be called. (There are very few circumstances
4034 under which you should change this handler. Use `mode-motion-hook'
4037 Menu, timeout, and eval events cause the associated function or handler
4040 Process events cause the subprocess's output to be read and acted upon
4041 appropriately (see `start-process').
4043 Magic events are handled as necessary.
4047 /* This function can GC */
4048 struct command_builder *command_builder;
4050 Lisp_Object console;
4051 Lisp_Object channel;
4053 CHECK_LIVE_EVENT(event);
4056 /* events on dead channels get silently eaten */
4057 channel = EVENT_CHANNEL(ev);
4058 if (object_dead_p(channel))
4061 /* Some events don't have channels (e.g. eval events). */
4062 console = CDFW_CONSOLE(channel);
4064 console = Vselected_console;
4065 else if (!EQ(console, Vselected_console))
4066 Fselect_console(console);
4068 command_builder = XCOMMAND_BUILDER(XCONSOLE(console)->command_builder);
4069 switch (XEVENT(event)->event_type) {
4070 case button_press_event:
4071 case button_release_event:
4072 case key_press_event: {
4074 lookup_command_event(command_builder, event, 1);
4077 /* Incomplete key sequence */
4080 /* At this point, we know that the sequence is
4081 not bound to a command. Normally, we beep
4082 and print a message informing the user of
4083 this. But we do not beep or print a message
4086 o the last event in this sequence is a
4088 o the last event in this sequence is a
4089 mouse-down event and there is a binding
4090 for the mouse-up version.
4092 That is, if the sequence ``C-x button1'' is
4093 typed, and is not bound to a command, but the
4094 sequence ``C-x button1up'' is bound to a
4095 command, we do not complain about the ``C-x
4096 button1'' sequence. If neither ``C-x
4097 button1'' nor ``C-x button1up'' is bound to a
4098 command, then we complain about the ``C-x
4099 button1'' sequence, but later will *not*
4100 complain about the ``C-x button1up''
4101 sequence, which would be redundant.
4103 This is pretty hairy, but I think it's the
4104 most intuitive behavior.
4106 Lisp_Object terminal =
4107 command_builder->most_current_event;
4109 if (XEVENT_TYPE(terminal) == button_press_event) {
4111 /* Temporarily pretend the last event
4112 was an "up" instead of a "down", and
4113 look up its binding. */
4114 XEVENT_TYPE(terminal) =
4115 button_release_event;
4116 /* If the "up" version is bound, don't
4120 !NILP(command_builder_find_leaf
4121 (command_builder, 0));
4122 /* Undo the temporary changes we just made. */
4123 XEVENT_TYPE(terminal) =
4126 /* Pretend this press was not
4127 seen (treat as a prefix) */
4132 reset_current_events
4137 EVENT_CHAIN_LOOP(eve,
4148 most_current_event);
4149 XSET_EVENT_NEXT(eve,
4152 most_current_event =
4155 maybe_echo_keys(command_builder,
4161 /* Complain that the typed sequence is not
4162 defined, if this is the kind of sequence that
4163 warrants a complaint. */
4164 XCONSOLE(console)->defining_kbd_macro = Qnil;
4165 XCONSOLE(console)->prefix_arg = Qnil;
4166 /* Don't complain about undefined button-release
4168 if (XEVENT_TYPE(terminal) !=
4169 button_release_event) {
4171 current_events_into_vector
4173 struct gcpro gcpro1;
4175 /* Run the pre-command-hook before
4176 barfing about an undefined key. */
4177 Vthis_command = Qnil;
4181 /* The post-command-hook doesn't run. */
4182 Fsignal(Qundefined_keystroke_sequence,
4185 /* Reset the command builder for reading the
4187 reset_this_command_keys(console, 1);
4188 } else { /* key sequence is bound to a command */
4191 int magic_undo_count = 20;
4193 Vthis_command = leaf;
4195 /* Don't push an undo boundary if the command
4196 set the prefix arg, or if we are executing a
4197 keyboard macro, or if in the minibuffer. If
4198 the command we are about to execute is
4199 self-insert, it's tricky: up to 20
4200 consecutive self-inserts may be done without
4201 an undo boundary. This counter is reset as
4202 soon as a command other than
4203 self-insert-command is executed.
4205 Programmers can also use the
4206 `self-insert-defer-undo' property to install
4207 that behavior on functions other than
4208 `self-insert-command', or to change the magic
4209 number 20 to something else. #### DOCUMENT
4212 if (SYMBOLP(leaf)) {
4214 Fget(leaf, Qself_insert_defer_undo,
4218 1, magic_undo_count =
4220 else if (!NILP(prop))
4222 else if (EQ(leaf, Qself_insert_command))
4227 command_builder->self_insert_countdown =
4229 if (NILP(XCONSOLE(console)->prefix_arg)
4230 && NILP(Vexecuting_macro)
4231 && command_builder->self_insert_countdown ==
4236 if (--command_builder->
4237 self_insert_countdown < 0)
4239 self_insert_countdown =
4242 execute_command_event
4244 internal_equal(event,
4246 most_current_event, 0)
4248 /* Use the translated event that was most
4249 recently seen. This way,
4250 last-command-event becomes f1 instead of
4251 the P from ESC O P. But we must copy
4252 it, else we'll lose when the
4253 command-builder events are
4255 : Fcopy_event(command_builder->
4256 most_current_event, Qnil));
4260 case misc_user_event: {
4263 We could just always use the menu item entry,
4264 whatever it is, but this might break some Lisp code
4265 that expects `this-command' to always contain a
4266 symbol. So only store it if this is a simple
4267 `call-interactively' sort of menu item.
4269 But this is bogus. `this-command' could be a string
4270 or vector anyway (for keyboard macros). There's even
4271 one instance (in pending-del.el) of `this-command'
4272 getting set to a cons (a lambda expression). So in
4273 the `eval' case I'll just convert it into a lambda
4277 (XEVENT(event)->event.eval.function,
4278 Qcall_interactively)
4279 && SYMBOLP(XEVENT(event)->event.eval.object)) {
4281 XEVENT(event)->event.eval.object;
4282 } else if (EQ(XEVENT(event)->event.eval.function, Qeval)) {
4286 XEVENT(event)->event.eval.
4288 } else if (SYMBOLP(XEVENT(event)->event.eval.function)) {
4289 /* A scrollbar command or the like. */
4291 XEVENT(event)->event.eval.function;
4294 Vthis_command = Qnil;
4297 /* clear the echo area */
4298 reset_key_echo(command_builder, 1);
4300 command_builder->self_insert_countdown = 0;
4301 if (NILP(XCONSOLE(console)->prefix_arg)
4302 && NILP(Vexecuting_macro)
4303 && !EQ(minibuf_window, Fselected_window(Qnil)))
4305 execute_command_event(command_builder, event);
4308 #ifdef EF_USE_ASYNEQ
4309 case eaten_myself_event:
4310 /* try to find the worker in the workers dllist and pop it */
4312 /* since this affects garbage collection, we better lock that
4315 WITH_DLLIST_TRAVERSE(
4317 if (ev->event.eaten_myself.worker == dllist_item) {
4318 dllist_pop_inner(workers, _el);
4322 fini_worker(ev->event.eaten_myself.worker);
4323 EQUEUE_DEBUG_WORKER("Successfully eaten 0x%lx\n",
4325 ev->event.eaten_myself.worker);
4327 case work_started_event: {
4328 Lisp_Object ljob = ev->event.work_started.job;
4329 worker_job_t job = XWORKER_JOB(ljob);
4330 work_handler_t hdl = XWORKER_JOB_HANDLER(ljob);
4331 if (hdl && work_started(hdl))
4332 work_started(hdl)(job);
4335 case work_finished_event: {
4336 Lisp_Object ljob = ev->event.work_finished.job;
4337 worker_job_t job = XWORKER_JOB(ljob);
4338 work_handler_t hdl = XWORKER_JOB_HANDLER(ljob);
4339 if (hdl && work_finished(hdl))
4340 work_finished(hdl)(job);
4347 case pointer_motion_event:
4351 case magic_eval_event:
4355 execute_internal_event(event);
4361 DEFUN("read-key-sequence", Fread_key_sequence, 1, 3, 0, /*
4362 Read a sequence of keystrokes or mouse clicks.
4363 Returns a vector of the event objects read. The vector and the event
4364 objects it contains are freshly created (and so will not be side-effected
4365 by subsequent calls to this function).
4367 The sequence read is sufficient to specify a non-prefix command starting
4368 from the current local and global keymaps. A C-g typed while in this
4369 function is treated like any other character, and `quit-flag' is not set.
4371 First arg PROMPT is a prompt string. If nil, do not prompt specially.
4373 Second optional arg CONTINUE-ECHO non-nil means this key echoes as a
4374 continuation of the previous key.
4376 Third optional arg DONT-DOWNCASE-LAST non-nil means do not convert the
4377 last event to lower case. (Normally any upper case event is converted
4378 to lower case if the original event is undefined and the lower case
4379 equivalent is defined.) This argument is provided mostly for FSF
4380 compatibility; the equivalent effect can be achieved more generally by
4381 binding `retry-undefined-key-binding-unshifted' to nil around the call
4382 to `read-key-sequence'.
4384 If the user selects a menu item while we are prompting for a key-sequence,
4385 the returned value will be a vector of a single menu-selection event.
4386 An error will be signalled if you pass this value to `lookup-key' or a
4389 `read-key-sequence' checks `function-key-map' for function key
4390 sequences, where they wouldn't conflict with ordinary bindings.
4391 See `function-key-map' for more details.
4393 (prompt, continue_echo, dont_downcase_last))
4395 /* This function can GC */
4396 struct console *con = XCONSOLE(Vselected_console); /* #### correct?
4400 struct command_builder *command_builder;
4402 Lisp_Object event = Fmake_event(Qnil, Qnil);
4403 int speccount = specpdl_depth();
4404 struct gcpro gcpro1;
4407 record_unwind_protect(Fset_buffer, Fcurrent_buffer());
4409 CHECK_STRING(prompt);
4410 /* else prompt = Fkeymap_prompt (current_buffer->keymap); may GC */
4413 if (NILP(continue_echo))
4414 reset_this_command_keys(make_console(con), 1);
4416 specbind(Qinhibit_quit, Qt);
4418 if (!NILP(dont_downcase_last))
4419 specbind(Qretry_undefined_key_binding_unshifted, Qnil);
4422 Fnext_event(event, prompt);
4423 /* restore the selected-console damage */
4424 con = event_console_or_selected(event);
4425 command_builder = XCOMMAND_BUILDER(con->command_builder);
4426 if (!command_event_p(event))
4427 execute_internal_event(event);
4429 if (XEVENT(event)->event_type == misc_user_event)
4430 reset_current_events(command_builder);
4432 lookup_command_event(command_builder, event, 1);
4433 if (!KEYMAPP(result)) {
4435 current_events_into_vector(command_builder);
4436 reset_key_echo(command_builder, 0);
4443 Vquit_flag = Qnil; /* In case we read a ^G; do not call
4444 check_quit() here */
4445 Fdeallocate_event(event);
4446 RETURN_UNGCPRO(unbind_to(speccount, result));
4449 DEFUN("this-command-keys", Fthis_command_keys, 0, 0, 0, /*
4450 Return a vector of the keyboard or mouse button events that were used
4451 to invoke this command. This copies the vector and the events; it is safe
4452 to keep and modify them.
4460 if (NILP(Vthis_command_keys))
4461 return make_vector(0, Qnil);
4463 len = event_chain_count(Vthis_command_keys);
4465 result = make_vector(len, Qnil);
4467 EVENT_CHAIN_LOOP(event, Vthis_command_keys)
4468 XVECTOR_DATA(result)[len++] = Fcopy_event(event, Qnil);
4472 DEFUN("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0, /*
4473 Used for complicated reasons in `universal-argument-other-key'.
4475 `universal-argument-other-key' rereads the event just typed.
4476 It then gets translated through `function-key-map'.
4477 The translated event gets included in the echo area and in
4478 the value of `this-command-keys' in addition to the raw original event.
4481 Calling this function directs the translated event to replace
4482 the original event, so that only one version of the event actually
4483 appears in the echo area and in the value of `this-command-keys'.
4487 /* #### I don't understand this at all, so currently it does nothing.
4488 If there is ever a problem, maybe someone should investigate. */
4492 static void dribble_out_event(Lisp_Object event)
4494 if (NILP(Vdribble_file))
4497 if (XEVENT(event)->event_type == key_press_event &&
4498 !XEVENT(event)->event.key.modifiers) {
4499 Lisp_Object keysym = XEVENT(event)->event.key.keysym;
4500 if (CHARP(XEVENT(event)->event.key.keysym)) {
4501 Emchar ch = XCHAR(keysym);
4502 Bufbyte str[MAX_EMCHAR_LEN];
4503 Bytecount len = set_charptr_emchar(str, ch);
4504 Lstream_write(XLSTREAM(Vdribble_file), str, len);
4505 } else if (string_char_length(XSYMBOL(keysym)->name) == 1)
4506 /* one-char key events are printed with just the key name */
4507 Fprinc(keysym, Vdribble_file);
4508 else if (EQ(keysym, Qreturn))
4509 Lstream_putc(XLSTREAM(Vdribble_file), '\n');
4510 else if (EQ(keysym, Qspace))
4511 Lstream_putc(XLSTREAM(Vdribble_file), ' ');
4513 Fprinc(event, Vdribble_file);
4515 Fprinc(event, Vdribble_file);
4516 Lstream_flush(XLSTREAM(Vdribble_file));
4519 DEFUN("open-dribble-file", Fopen_dribble_file, 1, 1, "FOpen dribble file: ", /*
4520 Start writing all keyboard characters to a dribble file called FILENAME.
4521 If FILENAME is nil, close any open dribble file.
4525 /* This function can GC */
4526 /* XEmacs change: always close existing dribble file. */
4527 /* FSFmacs uses FILE *'s here. With lstreams, that's unnecessary. */
4528 if (!NILP(Vdribble_file)) {
4529 Lstream_close(XLSTREAM(Vdribble_file));
4530 Vdribble_file = Qnil;
4532 if (!NILP(filename)) {
4535 filename = Fexpand_file_name(filename, Qnil);
4536 fd = open((char *)XSTRING_DATA(filename),
4537 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4540 error("Unable to create dribble file");
4542 make_filedesc_output_stream(fd, 0, 0, LSTR_CLOSING);
4545 make_encoding_output_stream(XLSTREAM(Vdribble_file),
4553 DEFUN("current-event-timestamp", Fcurrent_event_timestamp, 0, 1, 0, /*
4554 Return the current event timestamp of the window system associated with CONSOLE.
4555 CONSOLE defaults to the selected console if omitted.
4559 struct console *c = decode_console(console);
4560 int tiempo = event_stream_current_event_timestamp(c);
4562 /* This junk is so that timestamps don't get to be negative, but contain
4563 as many bits as this particular emacs will allow.
4565 return make_int(EMACS_INT_MAX & tiempo);
4569 /* generalised asynchronous worker queue */
4570 #if defined(EF_USE_ASYNEQ)
4572 asyneq_handle_event(event_queue_t eq)
4574 if (!eq_queue_empty_p(eq)) {
4575 Lisp_Object eqev = eq_dequeue(eq);
4576 Fdispatch_event(eqev);
4581 asyneq_handle_non_command_event(event_queue_t eq)
4583 Lisp_Object eqev = Qnil;
4585 WITH_DLLIST_TRAVERSE(
4587 if (!command_event_p((Lisp_Object)dllist_item)) {
4588 eqev = (Lisp_Object)dllist_pop_inner(eq_queue(eq), _el);
4593 execute_internal_event(eqev);
4597 /************************************************************************/
4598 /* initialization */
4599 /************************************************************************/
4601 void syms_of_event_stream(void)
4603 INIT_LRECORD_IMPLEMENTATION(command_builder);
4604 INIT_LRECORD_IMPLEMENTATION(timeout);
4606 defsymbol(&Qdisabled, "disabled");
4607 defsymbol(&Qcommand_event_p, "command-event-p");
4609 DEFERROR_STANDARD(Qundefined_keystroke_sequence, Qinvalid_argument);
4611 DEFSUBR(Frecent_keys);
4612 DEFSUBR(Frecent_keys_ring_size);
4613 DEFSUBR(Fset_recent_keys_ring_size);
4614 DEFSUBR(Finput_pending_p);
4615 DEFSUBR(Fenqueue_eval_event);
4616 DEFSUBR(Fnext_event);
4617 DEFSUBR(Fnext_command_event);
4618 DEFSUBR(Fdiscard_input);
4620 DEFSUBR(Fsleep_for);
4621 DEFSUBR(Faccept_process_output);
4622 DEFSUBR(Fadd_timeout);
4623 DEFSUBR(Fdisable_timeout);
4624 DEFSUBR(Fadd_async_timeout);
4625 DEFSUBR(Fdisable_async_timeout);
4626 DEFSUBR(Fdispatch_event);
4627 DEFSUBR(Fdispatch_non_command_events);
4628 DEFSUBR(Fread_key_sequence);
4629 DEFSUBR(Fthis_command_keys);
4630 DEFSUBR(Freset_this_command_lengths);
4631 DEFSUBR(Fopen_dribble_file);
4632 DEFSUBR(Fcurrent_event_timestamp);
4634 defsymbol(&Qpre_command_hook, "pre-command-hook");
4635 defsymbol(&Qpost_command_hook, "post-command-hook");
4636 defsymbol(&Qunread_command_events, "unread-command-events");
4637 defsymbol(&Qunread_command_event, "unread-command-event");
4638 defsymbol(&Qpre_idle_hook, "pre-idle-hook");
4639 defsymbol(&Qhandle_pre_motion_command, "handle-pre-motion-command");
4640 defsymbol(&Qhandle_post_motion_command, "handle-post-motion-command");
4641 defsymbol(&Qretry_undefined_key_binding_unshifted,
4642 "retry-undefined-key-binding-unshifted");
4643 defsymbol(&Qauto_show_make_point_visible,
4644 "auto-show-make-point-visible");
4646 defsymbol(&Qself_insert_defer_undo, "self-insert-defer-undo");
4647 defsymbol(&Qcancel_mode_internal, "cancel-mode-internal");
4650 void reinit_vars_of_event_stream(void)
4652 recent_keys_ring_index = 0;
4653 recent_keys_ring_size = 100;
4654 num_input_chars = 0;
4655 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
4656 Vtimeout_free_list = make_lcrecord_list(sizeof(Lisp_Timeout),
4658 staticpro_nodump(&Vtimeout_free_list);
4660 the_low_level_timeout_blocktype =
4661 Blocktype_new(struct low_level_timeout_blocktype);
4662 something_happened = 0;
4663 recursive_sit_for = Qnil;
4665 #if defined(EF_USE_ASYNEQ)
4666 /* the main event queue */
4667 asyneq = make_event_queue();
4668 XSETEVENT_QUEUE(Vasyneq, asyneq);
4669 staticpro_nodump(&Vasyneq);
4670 #endif /* EF_USE_ASYNEQ */
4673 void vars_of_event_stream(void)
4675 reinit_vars_of_event_stream();
4676 Vrecent_keys_ring = Qnil;
4677 staticpro(&Vrecent_keys_ring);
4679 Vthis_command_keys = Qnil;
4680 staticpro(&Vthis_command_keys);
4681 Vthis_command_keys_tail = Qnil;
4682 dump_add_root_object(&Vthis_command_keys_tail);
4684 #ifndef EF_USE_ASYNEQ
4685 command_event_queue = Qnil;
4686 staticpro(&command_event_queue);
4687 command_event_queue_tail = Qnil;
4688 dump_add_root_object(&command_event_queue_tail);
4691 Vlast_selected_frame = Qnil;
4692 staticpro(&Vlast_selected_frame);
4694 pending_timeout_list = Qnil;
4695 staticpro(&pending_timeout_list);
4697 pending_async_timeout_list = Qnil;
4698 staticpro(&pending_async_timeout_list);
4700 last_point_position_buffer = Qnil;
4701 staticpro(&last_point_position_buffer);
4703 DEFVAR_LISP("echo-keystrokes", &Vecho_keystrokes /*
4704 *Nonzero means echo unfinished commands after this many seconds of pause.
4706 Vecho_keystrokes = make_int(1);
4708 DEFVAR_INT("auto-save-interval", &auto_save_interval /*
4709 *Number of keyboard input characters between auto-saves.
4710 Zero means disable autosaving due to number of characters typed.
4711 See also the variable `auto-save-timeout'.
4713 auto_save_interval = 300;
4715 DEFVAR_LISP("pre-command-hook", &Vpre_command_hook /*
4716 Function or functions to run before every command.
4717 This may examine the `this-command' variable to find out what command
4718 is about to be run, or may change it to cause a different command to run.
4719 Function on this hook must be careful to avoid signalling errors!
4721 Vpre_command_hook = Qnil;
4723 DEFVAR_LISP("post-command-hook", &Vpost_command_hook /*
4724 Function or functions to run after every command.
4725 This may examine the `this-command' variable to find out what command
4728 Vpost_command_hook = Qnil;
4730 DEFVAR_LISP("pre-idle-hook", &Vpre_idle_hook /*
4731 Normal hook run when SXEmacs it about to be idle.
4732 This occurs whenever it is going to block, waiting for an event.
4733 This generally happens as a result of a call to `next-event',
4734 `next-command-event', `sit-for', `sleep-for', `accept-process-output',
4735 or `x-get-selection'.
4737 Errors running the hook are caught and ignored.
4739 Vpre_idle_hook = Qnil;
4741 DEFVAR_BOOL("focus-follows-mouse", &focus_follows_mouse /*
4742 *Variable to control SXEmacs behavior with respect to focus changing.
4743 If this variable is set to t, then SXEmacs will not gratuitously change
4744 the keyboard focus. SXEmacs cannot in general detect when this mode is
4745 used by the window manager, so it is up to the user to set it.
4747 focus_follows_mouse = 0;
4749 DEFVAR_LISP("last-command-event", &Vlast_command_event /*
4750 Last keyboard or mouse button event that was part of a command. This
4751 variable is off limits: you may not set its value or modify the event that
4752 is its value, as it is destructively modified by `read-key-sequence'. If
4753 you want to keep a pointer to this value, you must use `copy-event'.
4755 Vlast_command_event = Qnil;
4757 DEFVAR_LISP("last-command-char", &Vlast_command_char /*
4758 If the value of `last-command-event' is a keyboard event, then
4759 this is the nearest ASCII equivalent to it. This is the value that
4760 `self-insert-command' will put in the buffer. Remember that there is
4761 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
4762 of keyboard events is much larger, so writing code that examines this
4763 variable to determine what key has been typed is bad practice, unless
4764 you are certain that it will be one of a small set of characters.
4766 Vlast_command_char = Qnil;
4768 DEFVAR_LISP("last-input-event", &Vlast_input_event /*
4769 Last keyboard or mouse button event received. This variable is off
4770 limits: you may not set its value or modify the event that is its value, as
4771 it is destructively modified by `next-event'. If you want to keep a pointer
4772 to this value, you must use `copy-event'.
4774 Vlast_input_event = Qnil;
4776 DEFVAR_LISP("current-mouse-event", &Vcurrent_mouse_event /*
4777 The mouse-button event which invoked this command, or nil.
4778 This is usually what `(interactive "e")' returns.
4780 Vcurrent_mouse_event = Qnil;
4782 DEFVAR_LISP("last-input-char", &Vlast_input_char /*
4783 If the value of `last-input-event' is a keyboard event, then
4784 this is the nearest ASCII equivalent to it. Remember that there is
4785 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
4786 of keyboard events is much larger, so writing code that examines this
4787 variable to determine what key has been typed is bad practice, unless
4788 you are certain that it will be one of a small set of characters.
4790 Vlast_input_char = Qnil;
4792 DEFVAR_LISP("last-input-time", &Vlast_input_time /*
4793 The time (in seconds since Jan 1, 1970) of the last-command-event,
4794 represented as a cons of two 16-bit integers. This is destructively
4795 modified, so copy it if you want to keep it.
4797 Vlast_input_time = Qnil;
4799 DEFVAR_LISP("last-command-event-time", &Vlast_command_event_time /*
4800 The time (in seconds since Jan 1, 1970) of the last-command-event,
4801 represented as a list of three integers. The first integer contains
4802 the most significant 16 bits of the number of seconds, and the second
4803 integer contains the least significant 16 bits. The third integer
4804 contains the remainder number of microseconds, if the current system
4805 supports microsecond clock resolution. This list is destructively
4806 modified, so copy it if you want to keep it.
4808 Vlast_command_event_time = Qnil;
4810 DEFVAR_LISP("unread-command-events", &Vunread_command_events /*
4811 List of event objects to be read as next command input events.
4812 This can be used to simulate the receipt of events from the user.
4813 Normally this is nil.
4814 Events are removed from the front of this list.
4816 Vunread_command_events = Qnil;
4818 DEFVAR_LISP("unread-command-event", &Vunread_command_event /*
4819 Obsolete. Use `unread-command-events' instead.
4821 Vunread_command_event = Qnil;
4823 DEFVAR_LISP("last-command", &Vlast_command /*
4824 The last command executed. Normally a symbol with a function definition,
4825 but can be whatever was found in the keymap, or whatever the variable
4826 `this-command' was set to by that command.
4828 Vlast_command = Qnil;
4830 DEFVAR_LISP("this-command", &Vthis_command /*
4831 The command now being executed.
4832 The command can set this variable; whatever is put here
4833 will be in `last-command' during the following command.
4835 Vthis_command = Qnil;
4837 DEFVAR_LISP("last-command-properties", &Vlast_command_properties /*
4838 Value of `this-command-properties' for the last command.
4839 Used by commands to help synchronize consecutive commands, in preference
4840 to looking at `last-command' directly.
4842 Vlast_command_properties = Qnil;
4844 DEFVAR_LISP("this-command-properties", &Vthis_command_properties /*
4845 Properties set by the current command.
4846 At the beginning of each command, the current value of this variable is
4847 copied to `last-command-properties', and then it is set to nil. Use `putf'
4848 to add properties to this variable. Commands should use this to communicate
4849 with pre/post-command hooks, subsequent commands, wrapping commands, etc.
4850 in preference to looking at and/or setting `this-command'.
4852 Vthis_command_properties = Qnil;
4854 DEFVAR_LISP("help-char", &Vhelp_char /*
4855 Character to recognize as meaning Help.
4856 When it is read, do `(eval help-form)', and display result if it's a string.
4857 If the value of `help-form' is nil, this char can be read normally.
4858 This can be any form recognized as a single key specifier.
4859 The help-char cannot be a negative number in SXEmacs.
4861 Vhelp_char = make_char(8); /* C-h */
4863 DEFVAR_LISP("help-form", &Vhelp_form /*
4864 Form to execute when character help-char is read.
4865 If the form returns a string, that string is displayed.
4866 If `help-form' is nil, the help char is not recognized.
4870 DEFVAR_LISP("prefix-help-command", &Vprefix_help_command /*
4871 Command to run when `help-char' character follows a prefix key.
4872 This command is used only when there is no actual binding
4873 for that character after that prefix key.
4875 Vprefix_help_command = Qnil;
4877 DEFVAR_CONST_LISP("keyboard-translate-table", &Vkeyboard_translate_table /*
4878 sh table used as translate table for keyboard input.
4879 e `keyboard-translate' to portably add entries to this table.
4880 ch key-press event is looked up in this table as follows:
4882 -- If an entry maps a symbol to a symbol, then a key-press event whose
4883 keysym is the former symbol (with any modifiers at all) gets its
4884 keysym changed and its modifiers left alone. This is useful for
4885 dealing with non-standard X keyboards, such as the grievous damage
4886 that Sun has inflicted upon the world.
4888 -- If an entry maps a symbol to a character, then a key-press event
4889 whose keysym is the former symbol (with any modifiers at all) gets
4890 changed into a key-press event matching the latter character, and the
4891 resulting modifiers are the union of the original and new modifiers.
4893 -- If an entry maps a character to a character, then a key-press event
4894 matching the former character gets converted to a key-press event
4895 matching the latter character. This is useful on ASCII terminals
4896 for (e.g.) making C-\\ look like C-s, to get around flow-control
4899 -- If an entry maps a character to a symbol, then a key-press event
4900 matching the character gets converted to a key-press event whose
4901 keysym is the given symbol and which has no modifiers.
4903 re's an example: This makes typing parens and braces easier by rerouting
4904 eir positions to eliminate the need to use the Shift key.
4906 (keyboard-translate ?[ ?()
4907 (keyboard-translate ?] ?))
4908 (keyboard-translate ?{ ?[)
4909 (keyboard-translate ?} ?])
4910 (keyboard-translate 'f11 ?{)
4911 (keyboard-translate 'f12 ?})
4914 DEFVAR_LISP("retry-undefined-key-binding-unshifted", &Vretry_undefined_key_binding_unshifted /*
4915 If a key-sequence which ends with a shifted keystroke is undefined
4916 and this variable is non-nil then the command lookup is retried again
4917 with the last key unshifted. (e.g. C-X C-F would be retried as C-X C-f.)
4918 If lookup still fails, a normal error is signalled. In general,
4919 you should *bind* this, not set it.
4921 Vretry_undefined_key_binding_unshifted = Qt;
4923 DEFVAR_BOOL("modifier-keys-are-sticky", &modifier_keys_are_sticky /*
4924 *Non-nil makes modifier keys sticky.
4925 This means that you can release the modifier key before pressing down
4926 the key that you wish to be modified. Although this is non-standard
4927 behavior, it is recommended because it reduces the strain on your hand,
4928 thus reducing the incidence of the dreaded Emacs-pinky syndrome.
4930 Modifier keys are sticky within the inverval specified by
4931 `modifier-keys-sticky-time'.
4933 modifier_keys_are_sticky = 0;
4935 DEFVAR_LISP("modifier-keys-sticky-time",
4936 &Vmodifier_keys_sticky_time /*
4937 *Modifier keys are sticky within this many milliseconds.
4938 If you don't want modifier keys sticking to be bounded, set this to
4941 This variable has no effect when `modifier-keys-are-sticky' is nil.
4942 Currently only implemented under X Window System.
4944 Vmodifier_keys_sticky_time = make_int(500);
4947 DEFVAR_LISP("composed-character-default-binding",
4948 &Vcomposed_character_default_binding /*
4949 The default keybinding to use for key events from composed input.
4950 Window systems frequently have ways to allow the user to compose
4951 single characters in a language using multiple keystrokes.
4952 SXEmacs sees these as single character keypress events.
4954 Vcomposed_character_default_binding = Qself_insert_command;
4955 #endif /* HAVE_XIM */
4957 Vcontrolling_terminal = Qnil;
4958 staticpro(&Vcontrolling_terminal);
4960 Vdribble_file = Qnil;
4961 staticpro(&Vdribble_file);
4963 #ifdef DEBUG_SXEMACS
4964 DEFVAR_INT("debug-emacs-events", &debug_emacs_events /*
4965 o, display debug information about Emacs events that SXEmacs sees.
4966 n is displayed on stderr.
4968 event, the source of the event is displayed in parentheses,
4971 real event from the window system or
4972 rminal driver, as far as SXEmacs can tell.
4974 macro) An event generated from a keyboard macro.
4976 ommand-events) An event taken from `unread-command-events'.
4978 ommand-event) An event taken from `unread-command-event'.
4980 event queue) An event taken from an internal queue.
4981 Events end up on this queue when
4982 `enqueue-eval-event' is called or when
4983 user or eval events are received while
4984 SXEmacs is blocking (e.g. in `sit-for',
4985 `sleep-for', or `accept-process-output',
4986 or while waiting for the reply to an
4989 rd-translate-table) The result of an event translated
4990 through keyboard-translate-table. Note
4991 that in this case, two events are
4992 printed even though only one is really
4995 A faked C-g resulting when SXEmacs receives
4996 a SIGINT (e.g. C-c was pressed in SXEmacs'
4997 controlling terminal or the signal was
4998 explicitly sent to the SXEmacs process).
5000 debug_emacs_events = 0;
5003 DEFVAR_BOOL("inhibit-input-event-recording",
5004 &inhibit_input_event_recording /*
5005 Non-nil inhibits recording of input-events to recent-keys ring.
5007 inhibit_input_event_recording = 0;
5010 void complex_vars_of_event_stream(void)
5012 Vkeyboard_translate_table =
5013 make_lisp_hash_table(100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
5016 void init_event_stream(void)
5019 #ifdef HAVE_UNIXOID_EVENT_LOOP
5020 init_event_unixoid();
5022 #ifdef HAVE_X_WINDOWS
5023 if (!strcmp(display_use, "x"))
5024 init_event_Xt_late();
5028 if (!strcmp(display_use, "gtk"))
5029 init_event_gtk_late();
5033 /* For TTY's, use the Xt event loop if we can; it allows
5034 us to later open an X connection. */
5035 #if defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
5036 init_event_Xt_late();
5037 #elif defined (HAVE_TTY)
5038 init_event_tty_late();
5041 init_interrupts_late();
5046 useful testcases for v18/v19 compatibility:
5050 (setq unread-command-event (character-to-event ?A (allocate-event)))
5051 (setq x (list (read-char)
5052 ; (read-key-sequence "") ; try it with and without this
5053 last-command-char last-input-char
5054 (recent-keys) (this-command-keys))))
5055 (global-set-key "\^Q" 'foo)
5057 without the read-key-sequence:
5058 ^Q ==> (?A ?\^Q ?A [... ^Q] [^Q])
5059 ^U^U^Q ==> (?A ?\^Q ?A [... ^U ^U ^Q] [^U ^U ^Q])
5060 ^U^U^U^G^Q ==> (?A ?\^Q ?A [... ^U ^U ^U ^G ^Q] [^Q])
5062 with the read-key-sequence:
5063 ^Qb ==> (?A [b] ?\^Q ?b [... ^Q b] [b])
5064 ^U^U^Qb ==> (?A [b] ?\^Q ?b [... ^U ^U ^Q b] [b])
5065 ^U^U^U^G^Qb ==> (?A [b] ?\^Q ?b [... ^U ^U ^U ^G ^Q b] [b])
5067 ;the evi-mode command "4dlj.j.j.j.j.j." is also a good testcase (gag)
5069 ;(setq x (list (read-char) quit-flag))^J^G
5070 ;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G
5071 ;for BOTH, x should get set to (7 t), but no result should be printed.
5072 ;; #### According to the doc of quit-flag, second test should return
5073 ;; (?\^G nil). Accidentaly SXEmacs returns correct value. However,
5074 ;; XEmacs 21.1.12 and 21.2.36 both fails on first test.
5076 ;also do this: make two frames, one viewing "*scratch*", the other "foo".
5077 ;in *scratch*, type (sit-for 20)^J
5078 ;wait a couple of seconds, move cursor to foo, type "a"
5079 ;a should be inserted in foo. Cursor highlighting should not change in
5082 ;do it with sleep-for. move cursor into foo, then back into *scratch*
5084 ;repeat also with (accept-process-output nil 20)
5086 ;make sure ^G aborts sit-for, sleep-for and accept-process-output:
5089 (list (condition-case c
5094 (tst)^Ja^G ==> ((quit) ?a) with no signal
5095 (tst)^J^Ga ==> ((quit) ?a) with no signal
5096 (tst)^Jabc^G ==> ((quit) ?a) with no signal, and "bc" inserted in buffer
5098 ; with sit-for only do the 2nd test.
5099 ; Do all 3 tests with (accept-process-output nil 20)
5102 (setq enable-recursive-minibuffers t
5103 minibuffer-max-depth nil)
5104 ESC ESC ESC ESC - there are now two minibuffers active
5105 C-g C-g C-g - there should be active 0, not 1
5107 C-x C-f ~ / ? - wait for "Making completion list..." to display
5108 C-g - wait for "Quit" to display
5109 C-g - minibuffer should not be active
5110 however C-g before "Quit" is displayed should leave minibuffer active.
5112 ;do it all in both v18 and v19 and make sure all results are the same.
5113 ;all of these cases matter a lot, but some in quite subtle ways.
5117 Additional test cases for accept-process-output, sleep-for, sit-for.
5118 Be sure you do all of the above checking for C-g and focus, too!
5120 ; Make sure that timer handlers are run during, not after sit-for:
5121 (defun timer-check ()
5122 (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil)
5124 (message "after sit-for"))
5126 ; The first message should appear after 2 seconds, and the final message
5127 ; 3 seconds after that.
5128 ; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
5130 ; Make sure that process filters are run during, not after sit-for.
5132 (message "sit-for = %s" (sit-for 30)))
5133 (add-hook 'post-command-hook 'fubar)
5135 ; Now type M-x shell RET
5136 ; wait for the shell prompt then send: ls RET
5137 ; the output of ls should fill immediately, and not wait 30 seconds.
5139 ; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
5141 ; Make sure that recursive invocations return immediately:
5142 (defmacro test-diff-time (start end)
5143 `(+ (* (- (car ,end) (car ,start)) 65536.0)
5144 (- (cadr ,end) (cadr ,start))
5145 (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
5147 (defun testee (ignore)
5151 (let ((start (current-time))
5153 (add-timeout 2 'testee nil)
5155 (add-timeout 2 'testee nil)
5157 (add-timeout 2 'testee nil)
5158 (accept-process-output nil 5)
5159 (setq end (current-time))
5160 (test-diff-time start end)))
5162 (test-them) should sit for 15 seconds.
5163 Repeat with testee set to sleep-for and accept-process-output.
5164 These should each delay 36 seconds.