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 /* for extract_float() and CHECK_NUMBER */
98 #include "events-mod.h"
100 #include "event-queue.h"
102 #include "worker-asyneq.h"
105 #include "mule/file-coding.h"
110 /* The number of keystrokes between auto-saves. */
111 static Fixnum auto_save_interval;
113 Lisp_Object Qundefined_keystroke_sequence;
115 Lisp_Object Qcommand_event_p;
117 /* Hooks to run before and after each command. */
118 Lisp_Object Vpre_command_hook, Vpost_command_hook;
119 Lisp_Object Qpre_command_hook, Qpost_command_hook;
122 Lisp_Object Qhandle_pre_motion_command, Qhandle_post_motion_command;
124 /* Hook run when SXEmacs is about to be idle. */
125 Lisp_Object Qpre_idle_hook, Vpre_idle_hook;
127 /* Control gratuitous keyboard focus throwing. */
128 int focus_follows_mouse;
130 /* When true, modifier keys are sticky. */
131 int modifier_keys_are_sticky;
132 /* Modifier keys are sticky for this many milliseconds. */
133 Lisp_Object Vmodifier_keys_sticky_time;
135 /* Here FSF Emacs 20.7 defines Vpost_command_idle_hook,
136 post_command_idle_delay, Vdeferred_action_list, and
137 Vdeferred_action_function, but we don't because that stuff is crap,
138 and we're smarter than them, and their momas are fat. */
140 /* FSF Emacs 20.7 also defines Vinput_method_function,
141 Qinput_method_exit_on_first_char and Qinput_method_use_echo_area.
142 I don't know this should be imported or not. */
144 /* Non-nil disable property on a command means
145 do not execute it; call disabled-command-hook's value instead. */
146 Lisp_Object Qdisabled, Vdisabled_command_hook;
148 EXFUN(Fnext_command_event, 2);
150 static void pre_command_hook(void);
151 static void post_command_hook(void);
153 /* Last keyboard or mouse input event read as a command. */
154 Lisp_Object Vlast_command_event;
156 /* The nearest ASCII equivalent of the above. */
157 Lisp_Object Vlast_command_char;
159 /* Last keyboard or mouse event read for any purpose. */
160 Lisp_Object Vlast_input_event;
162 /* The nearest ASCII equivalent of the above. */
163 Lisp_Object Vlast_input_char;
165 Lisp_Object Vcurrent_mouse_event;
167 /* This is fbound in cmdloop.el, see the commentary there */
168 Lisp_Object Qcancel_mode_internal;
170 /* If not Qnil, event objects to be read as the next command input */
171 Lisp_Object Vunread_command_events;
172 Lisp_Object Vunread_command_event; /* obsoleteness support */
174 static Lisp_Object Qunread_command_events, Qunread_command_event;
176 /* Previous command, represented by a Lisp object.
177 Does not include prefix commands and arg setting commands. */
178 Lisp_Object Vlast_command;
180 /* Contents of this-command-properties for the last command. */
181 Lisp_Object Vlast_command_properties;
183 /* If a command sets this, the value goes into
184 last-command for the next command. */
185 Lisp_Object Vthis_command;
187 /* If a command sets this, the value goes into
188 last-command-properties for the next command. */
189 Lisp_Object Vthis_command_properties;
191 /* The value of point when the last command was executed. */
192 Bufpos last_point_position;
194 /* The frame that was current when the last command was started. */
195 Lisp_Object Vlast_selected_frame;
197 /* The buffer that was current when the last command was started. */
198 Lisp_Object last_point_position_buffer;
200 /* A (16bit . 16bit) representation of the time of the last-command-event. */
201 Lisp_Object Vlast_input_time;
203 /* A (16bit 16bit usec) representation of the time
204 of the last-command-event. */
205 Lisp_Object Vlast_command_event_time;
207 /* Character to recognize as the help char. */
208 Lisp_Object Vhelp_char;
210 /* Form to execute when help char is typed. */
211 Lisp_Object Vhelp_form;
213 /* Command to run when the help character follows a prefix key. */
214 Lisp_Object Vprefix_help_command;
216 /* Flag to tell QUIT that some interesting occurrence (e.g. a keypress)
217 may have happened. */
218 volatile int something_happened;
220 /* Hash table to translate keysyms through */
221 Lisp_Object Vkeyboard_translate_table;
223 /* If control-meta-super-shift-X is undefined, try control-meta-super-x */
224 Lisp_Object Vretry_undefined_key_binding_unshifted;
225 Lisp_Object Qretry_undefined_key_binding_unshifted;
228 /* If composed input is undefined, use self-insert-char */
229 Lisp_Object Vcomposed_character_default_binding;
230 #endif /* HAVE_XIM */
232 /* Console that corresponds to our controlling terminal */
233 Lisp_Object Vcontrolling_terminal;
235 /* An event (actually an event chain linked through event_next) or Qnil.
237 Lisp_Object Vthis_command_keys;
238 Lisp_Object Vthis_command_keys_tail;
241 Lisp_Object Qauto_show_make_point_visible;
243 /* File in which we write all commands we read; an lstream */
244 static Lisp_Object Vdribble_file;
246 /* Recent keys ring location; a vector of events or nil-s */
247 Lisp_Object Vrecent_keys_ring;
248 int recent_keys_ring_size;
249 int recent_keys_ring_index;
251 /* Boolean specifying whether keystrokes should be added to
253 int inhibit_input_event_recording;
255 Lisp_Object Qself_insert_defer_undo;
257 /* this is in keymap.c */
258 extern Lisp_Object Fmake_keymap(Lisp_Object name);
261 Fixnum debug_emacs_events;
264 external_debugging_print_event(char *event_description, Lisp_Object event)
266 write_c_string("(", Qexternal_debugging_output);
267 write_c_string(event_description, Qexternal_debugging_output);
268 write_c_string(") ", Qexternal_debugging_output);
269 print_internal(event, Qexternal_debugging_output, 1);
270 write_c_string("\n", Qexternal_debugging_output);
273 #define DEBUG_PRINT_EMACS_EVENT(event_description, event) do { \
274 if (debug_emacs_events) \
275 external_debugging_print_event (event_description, event); \
278 #define DEBUG_PRINT_EMACS_EVENT(string, event)
281 /* The callback routines for the window system or terminal driver */
282 struct event_stream *event_stream;
284 static void echo_key_event(struct command_builder *, Lisp_Object event);
285 static void maybe_kbd_translate(Lisp_Object event);
287 #if defined(EF_USE_ASYNEQ)
288 /* everybody may use me */
289 event_queue_t asyneq = Qnull_pointer;
290 static Lisp_Object Vasyneq;
291 #define EQ_EMPTY_P() eq_queue_empty_p(asyneq)
292 #define EQ_LARGE_P() (eq_queue_size(asyneq) > 1)
293 #else /* !EF_USE_ASYNEQ */
294 /* This structure is basically a typeahead queue: things like
295 wait-reading-process-output will delay the execution of
296 keyboard and mouse events by pushing them here.
298 Chained through event_next()
299 command_event_queue_tail is a pointer to the last-added element.
301 static Lisp_Object command_event_queue;
302 static Lisp_Object command_event_queue_tail;
303 #define EQ_EMPTY_P() NILP(command_event_queue)
304 #define EQ_LARGE_P() !NILP(command_event_queue_tail)
305 #endif /* EF_USE_ASYNEQ */
307 /* Nonzero means echo unfinished commands after this many seconds of pause. */
308 static Lisp_Object Vecho_keystrokes;
310 /* The number of keystrokes since the last auto-save. */
311 static int keystrokes_since_auto_save;
313 /* Used by the C-g signal handler so that it will never "hard quit"
314 when waiting for an event. Otherwise holding down C-g could
315 cause a suspension back to the shell, which is generally
316 undesirable. (#### This doesn't fully work.) */
318 int emacs_is_blocking;
320 /* Handlers which run during sit-for, sleep-for and accept-process-output
321 are not allowed to recursively call these routines. We record here
322 if we are in that situation. */
324 static Lisp_Object recursive_sit_for;
326 /**********************************************************************/
327 /* Command-builder object */
328 /**********************************************************************/
330 #define XCOMMAND_BUILDER(x) \
331 XRECORD (x, command_builder, struct command_builder)
332 #define XSETCOMMAND_BUILDER(x, p) XSETRECORD (x, p, command_builder)
333 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder)
334 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
337 mark_command_builder(Lisp_Object obj)
339 struct command_builder *builder = XCOMMAND_BUILDER(obj);
340 mark_object(builder->prefix_events);
341 mark_object(builder->current_events);
342 mark_object(builder->most_current_event);
343 mark_object(builder->last_non_munged_event);
344 mark_object(builder->munge_me[0].first_mungeable_event);
345 mark_object(builder->munge_me[1].first_mungeable_event);
346 return builder->console;
350 finalize_command_builder(void *header, int for_disksave)
353 xfree(((struct command_builder *)header)->echo_buf);
354 ((struct command_builder *)header)->echo_buf = 0;
358 DEFINE_LRECORD_IMPLEMENTATION("command-builder", command_builder,
359 mark_command_builder, internal_object_printer,
360 finalize_command_builder, 0, 0, 0,
361 struct command_builder);
363 static void reset_command_builder_event_chain(struct command_builder *builder)
365 builder->prefix_events = Qnil;
366 builder->current_events = Qnil;
367 builder->most_current_event = Qnil;
368 builder->last_non_munged_event = Qnil;
369 builder->munge_me[0].first_mungeable_event = Qnil;
370 builder->munge_me[1].first_mungeable_event = Qnil;
374 allocate_command_builder(Lisp_Object console)
376 Lisp_Object builder_obj;
377 struct command_builder *builder =
379 struct command_builder, &lrecord_command_builder);
381 builder->console = console;
382 reset_command_builder_event_chain(builder);
383 builder->echo_buf_length = 300; /* #### Kludge */
385 xnew_atomic_array(Bufbyte, builder->echo_buf_length);
386 builder->echo_buf[0] = 0;
387 builder->echo_buf_index = -1;
388 builder->echo_buf_index = -1;
389 builder->self_insert_countdown = 0;
391 XSETCOMMAND_BUILDER(builder_obj, builder);
396 command_builder_append_event(struct command_builder *builder, Lisp_Object event)
398 assert(EVENTP(event));
400 if (EVENTP(builder->most_current_event)) {
401 XSET_EVENT_NEXT(builder->most_current_event, event);
403 builder->current_events = event;
406 builder->most_current_event = event;
407 if (NILP(builder->munge_me[0].first_mungeable_event)) {
408 builder->munge_me[0].first_mungeable_event = event;
410 if (NILP(builder->munge_me[1].first_mungeable_event)) {
411 builder->munge_me[1].first_mungeable_event = event;
416 /**********************************************************************/
417 /* Low-level interfaces onto event methods */
418 /**********************************************************************/
420 enum event_stream_operation {
421 EVENT_STREAM_PROCESS,
422 EVENT_STREAM_TIMEOUT,
423 EVENT_STREAM_CONSOLE,
428 check_event_stream_ok(enum event_stream_operation op)
430 if (!event_stream && noninteractive) {
432 case EVENT_STREAM_PROCESS:
433 error("Can't start subprocesses in -batch mode");
434 case EVENT_STREAM_TIMEOUT:
435 error("Can't add timeouts in -batch mode");
436 case EVENT_STREAM_CONSOLE:
437 error("Can't add consoles in -batch mode");
438 case EVENT_STREAM_READ:
439 error("Can't read events in -batch mode");
443 } else if (!event_stream) {
445 ("event-stream callbacks not initialized (internal error?)");
451 event_stream_event_pending_p(int user)
453 return event_stream && event_stream->event_pending_p(user);
457 event_stream_force_event_pending(struct frame *f)
459 if (event_stream->force_event_pending) {
460 event_stream->force_event_pending(f);
466 maybe_read_quit_event(Lisp_Event * event)
468 /* A C-g that came from `sigint_happened' will always come from the
469 controlling terminal. If that doesn't exist, however, then the
470 user manually sent us a SIGINT, and we pretend the C-g came from
471 the selected console. */
474 if (CONSOLEP(Vcontrolling_terminal) &&
475 CONSOLE_LIVE_P(XCONSOLE(Vcontrolling_terminal))) {
476 con = XCONSOLE(Vcontrolling_terminal);
478 Lisp_Object tmp = Fselected_console();
482 if (sigint_happened) {
483 int ch = CONSOLE_QUIT_CHAR(con);
486 character_to_event(ch, event, con, 1, 1);
487 event->channel = make_console(con);
494 event_stream_next_event(Lisp_Event * event)
496 Lisp_Object event_obj;
498 check_event_stream_ok(EVENT_STREAM_READ);
500 XSETEVENT(event_obj, event);
502 /* If C-g was pressed, treat it as a character to be read.
503 Note that if C-g was pressed while we were blocking,
504 the SIGINT signal handler will be called. It will
505 set Vquit_flag and write a byte on our "fake pipe",
506 which will unblock us. */
507 if (maybe_read_quit_event(event)) {
508 DEBUG_PRINT_EMACS_EVENT("SIGINT", event_obj);
512 /* If a longjmp() happens in the callback, we're screwed.
513 Let's hope it doesn't. I think the code here is fairly
514 clean and doesn't do this. */
515 emacs_is_blocking = 1;
516 event_stream->next_event_cb(event);
517 emacs_is_blocking = 0;
520 /* timeout events have more info set later, so
521 print the event out in next_event_internal(). */
522 if (event->event_type != timeout_event) {
523 DEBUG_PRINT_EMACS_EVENT("real", event_obj);
526 maybe_kbd_translate(event_obj);
531 event_stream_handle_magic_event(Lisp_Event * event)
533 check_event_stream_ok(EVENT_STREAM_READ);
534 event_stream->handle_magic_event_cb(event);
539 event_stream_add_timeout(EMACS_TIME timeout)
541 check_event_stream_ok(EVENT_STREAM_TIMEOUT);
542 return event_stream->add_timeout_cb(timeout);
546 event_stream_remove_timeout(int id)
548 check_event_stream_ok(EVENT_STREAM_TIMEOUT);
549 event_stream->remove_timeout_cb(id);
554 event_stream_select_console(struct console *con)
556 check_event_stream_ok(EVENT_STREAM_CONSOLE);
557 if (!con->input_enabled) {
558 event_stream->select_console_cb(con);
559 con->input_enabled = 1;
565 event_stream_unselect_console(struct console *con)
567 check_event_stream_ok(EVENT_STREAM_CONSOLE);
568 if (con->input_enabled) {
569 event_stream->unselect_console_cb(con);
570 con->input_enabled = 0;
576 event_stream_select_process(Lisp_Process * proc)
578 check_event_stream_ok(EVENT_STREAM_PROCESS);
579 if (!get_process_selected_p(proc)) {
580 event_stream->select_process_cb(proc);
581 set_process_selected_p(proc, 1);
587 event_stream_unselect_process(Lisp_Process * proc)
589 check_event_stream_ok(EVENT_STREAM_PROCESS);
590 if (get_process_selected_p(proc)) {
591 event_stream->unselect_process_cb(proc);
592 set_process_selected_p(proc, 0);
598 event_stream_create_stream_pair(
599 void *inhandle, void *outhandle,
600 Lisp_Object * instream, Lisp_Object * outstream,
603 check_event_stream_ok(EVENT_STREAM_PROCESS);
604 return event_stream->create_stream_pair_cb(
605 inhandle, outhandle, instream, outstream, flags);
609 event_stream_delete_stream_pair(Lisp_Object instream, Lisp_Object outstream)
611 check_event_stream_ok(EVENT_STREAM_PROCESS);
612 return event_stream->delete_stream_pair_cb(instream, outstream);
616 event_stream_quit_p(void)
619 event_stream->quit_p_cb();
624 event_stream_current_event_timestamp(struct console *c)
626 if (event_stream && event_stream->current_event_timestamp_cb) {
627 return event_stream->current_event_timestamp_cb(c);
633 /**********************************************************************/
634 /* Character prompting */
635 /**********************************************************************/
638 echo_key_event(struct command_builder *command_builder, Lisp_Object event)
640 /* This function can GC */
642 Bytecount buf_index = command_builder->echo_buf_index;
647 buf_index = 0; /* We're echoing now */
648 clear_echo_area(selected_frame(), Qnil, 0);
651 format_event_object(buf, XEVENT(event), 1);
654 if (len + buf_index + 4 > command_builder->echo_buf_length) {
657 e = command_builder->echo_buf + buf_index;
666 command_builder->echo_buf_index = buf_index + len + 1;
671 regenerate_echo_keys_from_this_command_keys(struct command_builder *builder)
675 builder->echo_buf_index = 0;
677 EVENT_CHAIN_LOOP(event, Vthis_command_keys) {
678 echo_key_event(builder, event);
684 maybe_echo_keys(struct command_builder *command_builder, int no_snooze)
686 /* This function can GC */
687 double echo_keystrokes;
688 struct frame *f = selected_frame();
689 /* Message turns off echoing unless more keystrokes turn it on again. */
690 if (echo_area_active(f) && !EQ(Qcommand, echo_area_status(f))) {
694 if (INTP(Vecho_keystrokes) || FLOATP(Vecho_keystrokes)) {
695 echo_keystrokes = extract_float(Vecho_keystrokes);
700 if (minibuf_level == 0 && echo_keystrokes > 0.0
701 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
702 && !x_kludge_lw_menu_active()
706 /* #### C-g here will cause QUIT.
707 Setting dont_check_for_quit
708 doesn't work. See check_quit. */
709 if (NILP(Fsit_for(Vecho_keystrokes, Qnil))) {
710 /* input came in, so don't echo. */
715 echo_area_message(f, command_builder->echo_buf, Qnil, 0,
716 /* not echo_buf_index. That doesn't include
717 the terminating " - ". */
718 strlen((char *)command_builder->echo_buf),
725 reset_key_echo(struct command_builder *command_builder,
726 int remove_echo_area_echo)
728 /* This function can GC */
729 struct frame *f = selected_frame();
731 if (command_builder) {
732 command_builder->echo_buf_index = -1;
735 if (remove_echo_area_echo) {
736 clear_echo_area(f, Qcommand, 0);
741 /**********************************************************************/
743 /**********************************************************************/
746 maybe_kbd_translate(Lisp_Object event)
749 int did_translate = 0;
751 if (XEVENT_TYPE(event) != key_press_event) {
754 if (!HASH_TABLEP(Vkeyboard_translate_table)) {
757 if (EQ(Fhash_table_count(Vkeyboard_translate_table), Qzero)) {
761 c = event_to_character(XEVENT(event), 0, 0, 0);
763 Lisp_Object traduit = Fgethash(
764 make_char(c), Vkeyboard_translate_table, Qnil);
766 if (!NILP(traduit) && SYMBOLP(traduit)) {
767 XEVENT(event)->event.key.keysym = traduit;
768 XEVENT(event)->event.key.modifiers = 0;
770 } else if (CHARP(traduit)) {
773 /* This used to call Fcharacter_to_event() directly into
774 EVENT, but that can eradicate timestamps and other
775 such stuff. This way is safer. */
778 XCHAR(traduit), &ev2,
779 XCONSOLE(EVENT_CHANNEL(XEVENT(event))), 0, 1);
780 XEVENT(event)->event.key.keysym = ev2.event.key.keysym;
781 XEVENT(event)->event.key.modifiers =
782 ev2.event.key.modifiers;
787 if (!did_translate) {
788 Lisp_Object traduit = Fgethash(
789 XEVENT(event)->event.key.keysym,
790 Vkeyboard_translate_table, Qnil);
791 if (!NILP(traduit) && SYMBOLP(traduit)) {
792 XEVENT(event)->event.key.keysym = traduit;
794 } else if (CHARP(traduit)) {
799 XCHAR(traduit), &ev2,
800 XCONSOLE(EVENT_CHANNEL(XEVENT(event))), 0, 1);
801 XEVENT(event)->event.key.keysym = ev2.event.key.keysym;
802 XEVENT(event)->event.key.modifiers |=
803 ev2.event.key.modifiers;
809 DEBUG_PRINT_EMACS_EVENT("->keyboard-translate-table", event);
811 #endif /* DEBUG_SXEMACS */
815 /* NB: The following auto-save stuff is in keyboard.c in FSFmacs, and
816 keystrokes_since_auto_save is equivalent to the difference between
817 num_nonmacro_input_chars and last_auto_save. */
819 /* When an auto-save happens, record the number of keystrokes, and
820 don't do again soon. */
823 record_auto_save(void)
825 keystrokes_since_auto_save = 0;
829 /* Make an auto save happen as soon as possible at command level. */
832 force_auto_save_soon(void)
834 keystrokes_since_auto_save = 1 + max(auto_save_interval, 20);
839 maybe_do_auto_save(void)
841 /* This function can call lisp */
842 keystrokes_since_auto_save++;
843 if (auto_save_interval > 0 &&
844 keystrokes_since_auto_save > max(auto_save_interval, 20) &&
845 !detect_input_pending()) {
846 Fdo_auto_save(Qnil, Qnil);
853 print_help(Lisp_Object object)
855 Fprinc(object, Qnil);
860 execute_help_form(struct command_builder *command_builder, Lisp_Object event)
862 /* This function can GC */
863 Lisp_Object help = Qnil;
864 int speccount = specpdl_depth();
865 Bytecount buf_index = command_builder->echo_buf_index;
869 : make_string(command_builder->echo_buf, buf_index));
870 struct gcpro gcpro1, gcpro2;
873 record_unwind_protect(save_window_excursion_unwind,
874 Fcurrent_window_configuration(Qnil));
875 reset_key_echo(command_builder, 1);
877 help = Feval(Vhelp_form);
879 internal_with_output_to_temp_buffer(
880 build_string("*Help*"), print_help, help, Qnil);
882 Fnext_command_event(event, Qnil);
883 /* Remove the help from the frame */
884 unbind_to(speccount, Qnil);
885 /* Hmmmm. Tricky. The unbind restores an old window configuration,
886 apparently bypassing any setting of windows_structure_changed.
887 So we need to set it so that things get redrawn properly. */
888 /* #### This is massive overkill. Look at doing it better once the
889 new redisplay is fully in place. */
891 Lisp_Object frmcons, devcons, concons;
892 FRAME_LOOP_NO_BREAK(frmcons, devcons, concons) {
893 struct frame *f = XFRAME(XCAR(frmcons));
894 MARK_FRAME_WINDOWS_STRUCTURE_CHANGED(f);
899 if (event_matches_key_specifier_p(XEVENT(event), make_char(' '))) {
900 /* Discard next key if it is a space */
901 reset_key_echo(command_builder, 1);
902 Fnext_command_event(event, Qnil);
905 command_builder->echo_buf_index = buf_index;
907 memcpy(command_builder->echo_buf,
908 XSTRING_DATA(echo), buf_index + /* terminating 0 */1);
914 /**********************************************************************/
916 /**********************************************************************/
919 detect_input_pending(void)
921 /* Always call the event_pending_p hook even if there's an unread
922 character, because that might do some needed ^G detection (on
923 systems without SIGIO, for example).
925 if (event_stream_event_pending_p(1)) {
928 if (!NILP(Vunread_command_events) || !NILP(Vunread_command_event)) {
934 #if defined(EF_USE_ASYNEQ)
937 if (XEVENT_TYPE(event) != eval_event &&
938 XEVENT_TYPE(event) != magic_eval_event) {
939 RETURN_FROM_EQ_TRAVERSE(asyneq, 1);
941 #else /* !EF_USE_ASYNEQ */
942 EVENT_CHAIN_LOOP(event, command_event_queue) {
943 if (XEVENT_TYPE(event) != eval_event
944 && XEVENT_TYPE(event) != magic_eval_event)
947 #endif /* EF_USE_ASYNEQ */
952 DEFUN("input-pending-p", Finput_pending_p, 0, 0, 0, /*
953 Return t if command input is currently available with no waiting.
954 Actually, the value is nil only if we can be sure that no input is available.
958 return detect_input_pending()? Qt : Qnil;
961 /**********************************************************************/
963 /**********************************************************************/
965 /**** Low-level timeout functions. ****
967 These functions maintain a sorted list of one-shot timeouts (where
968 the timeouts are in absolute time). They are intended for use by
969 functions that need to convert a list of absolute timeouts into a
970 series of intervals to wait for. */
972 /* We ensure that 0 is never a valid ID, so that a value of 0 can be
973 used to indicate an absence of a timer. */
974 static int low_level_timeout_id_tick;
976 static struct low_level_timeout_blocktype {
977 Blocktype_declare(struct low_level_timeout);
978 } *the_low_level_timeout_blocktype;
980 /* Add a one-shot timeout at time TIME to TIMEOUT_LIST. Return
981 a unique ID identifying the timeout. */
984 add_low_level_timeout(struct low_level_timeout **timeout_list, EMACS_TIME thyme)
986 struct low_level_timeout *tm;
987 struct low_level_timeout *t, **tt;
989 /* Allocate a new time struct. */
991 tm = Blocktype_alloc(the_low_level_timeout_blocktype);
993 if (low_level_timeout_id_tick == 0) {
994 low_level_timeout_id_tick++;
996 tm->id = low_level_timeout_id_tick++;
999 /* Add it to the queue. */
1003 while (t && EMACS_TIME_EQUAL_OR_GREATER(tm->time, t->time)) {
1013 /* Remove the low-level timeout identified by ID from TIMEOUT_LIST.
1014 If the timeout is not there, do nothing. */
1017 remove_low_level_timeout(struct low_level_timeout **timeout_list, int id)
1019 struct low_level_timeout *t, *prev;
1023 for (t = *timeout_list, prev = NULL; t && t->id != id; t = t->next) {
1028 /* couldn't find it */
1033 *timeout_list = t->next;
1035 prev->next = t->next;
1037 Blocktype_free(the_low_level_timeout_blocktype, t);
1041 /* If there are timeouts on TIMEOUT_LIST, store the relative time
1042 interval to the first timeout on the list into INTERVAL and
1043 return 1. Otherwise, return 0. */
1046 get_low_level_timeout_interval(
1047 struct low_level_timeout *timeout_list, EMACS_TIME *interval)
1049 if (!timeout_list) {
1050 /* no timer events; block indefinitely */
1053 EMACS_TIME current_time;
1055 /* The time to block is the difference between the first
1056 (earliest) timer on the queue and the current time.
1057 If that is negative, then the timer will fire immediately
1058 but we still have to call select(), with a zero-valued
1059 timeout: user events must have precedence over timer events. */
1060 EMACS_GET_TIME(current_time);
1061 if (EMACS_TIME_GREATER(timeout_list->time, current_time)) {
1062 EMACS_SUB_TIME(*interval, timeout_list->time,
1065 EMACS_SET_SECS_USECS(*interval, 0, 0);
1072 /* Pop the first (i.e. soonest) timeout off of TIMEOUT_LIST and return
1073 its ID. Also, if TIME_OUT is not 0, store the absolute time of the
1074 timeout into TIME_OUT. */
1077 pop_low_level_timeout(
1078 struct low_level_timeout **timeout_list, EMACS_TIME *time_out)
1080 struct low_level_timeout *tm = *timeout_list;
1086 *time_out = tm->time;
1088 *timeout_list = tm->next;
1089 Blocktype_free(the_low_level_timeout_blocktype, tm);
1093 /**** High-level timeout functions. ****/
1095 static int timeout_id_tick;
1097 static Lisp_Object pending_timeout_list, pending_async_timeout_list;
1099 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1100 static Lisp_Object Vtimeout_free_list;
1104 mark_timeout(Lisp_Object obj)
1106 Lisp_Timeout *tm = XTIMEOUT(obj);
1107 mark_object(tm->function);
1111 /* Should never, ever be called. (except by an external debugger) */
1113 print_timeout(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1115 const Lisp_Timeout *t = XTIMEOUT(obj);
1118 "#<INTERNAL OBJECT (SXEmacs bug?) (timeout) 0x%lx>",
1123 static const struct lrecord_description timeout_description[] = {
1124 {XD_LISP_OBJECT, offsetof(Lisp_Timeout, function)},
1125 {XD_LISP_OBJECT, offsetof(Lisp_Timeout, object)},
1129 DEFINE_LRECORD_IMPLEMENTATION("timeout", timeout,
1130 mark_timeout, print_timeout,
1131 0, 0, 0, timeout_description, Lisp_Timeout);
1133 /* Generate a timeout and return its ID. */
1136 event_stream_generate_wakeup(unsigned int milliseconds,
1137 unsigned int vanilliseconds,
1138 Lisp_Object function, Lisp_Object object,
1141 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1142 Lisp_Object op = wrap_object(
1143 alloc_lcrecord(sizeof(Lisp_Timeout), &lrecord_timeout));
1145 Lisp_Object op = allocate_managed_lcrecord(Vtimeout_free_list);
1147 Lisp_Timeout *timeout = XTIMEOUT(op);
1148 EMACS_TIME current_time;
1149 EMACS_TIME interval;
1151 timeout->id = timeout_id_tick++;
1152 timeout->resignal_msecs = vanilliseconds;
1153 timeout->function = function;
1154 timeout->object = object;
1156 EMACS_GET_TIME(current_time);
1157 EMACS_SET_SECS_USECS(interval, milliseconds / 1000,
1158 1000 * (milliseconds % 1000));
1159 EMACS_ADD_TIME(timeout->next_signal_time, current_time, interval);
1162 timeout->interval_id =
1163 event_stream_add_async_timeout(
1164 timeout->next_signal_time);
1165 pending_async_timeout_list = noseeum_cons(
1166 op, pending_async_timeout_list);
1168 timeout->interval_id =
1169 event_stream_add_timeout(timeout->next_signal_time);
1170 pending_timeout_list = noseeum_cons(op, pending_timeout_list);
1175 /* Given the INTERVAL-ID of a timeout just signalled, resignal the timeout
1176 as necessary and return the timeout's ID and function and object slots.
1178 This should be called as a result of receiving notice that a timeout
1179 has fired. INTERVAL-ID is *not* the timeout's ID, but is the ID that
1180 identifies this particular firing of the timeout. INTERVAL-ID's and
1181 timeout ID's are in separate number spaces and bear no relation to
1182 each other. The INTERVAL-ID is all that the event callback routines
1183 work with: they work only with one-shot intervals, not with timeouts
1184 that may fire repeatedly.
1186 NOTE: The returned FUNCTION and OBJECT are *not* GC-protected at all.
1190 event_stream_resignal_wakeup(int interval_id, int async_p,
1191 Lisp_Object * function, Lisp_Object * object)
1193 Lisp_Object op = Qnil, rest;
1194 Lisp_Timeout *timeout;
1195 Lisp_Object *timeout_list;
1196 struct gcpro gcpro1;
1199 /* just in case ... because it's removed from the list for awhile. */
1203 async_p ? &pending_async_timeout_list : &pending_timeout_list;
1205 /* Find the timeout on the list of pending ones. */
1206 LIST_LOOP(rest, *timeout_list) {
1207 timeout = XTIMEOUT(XCAR(rest));
1208 if (timeout->interval_id == interval_id) {
1213 assert(!NILP(rest));
1215 timeout = XTIMEOUT(op);
1216 /* We make sure to snarf the data out of the timeout object before
1217 we free it with free_managed_lcrecord(). */
1219 *function = timeout->function;
1220 *object = timeout->object;
1222 /* Remove this one from the list of pending timeouts */
1223 *timeout_list = delq_no_quit_and_free_cons(op, *timeout_list);
1225 /* If this timeout wants to be resignalled, do it now. */
1226 if (timeout->resignal_msecs) {
1227 EMACS_TIME current_time;
1228 EMACS_TIME interval;
1230 /* Determine the time that the next resignalling should occur.
1231 We do that by adding the interval time to the last signalled
1232 time until we get a time that's current.
1234 (This way, it doesn't matter if the timeout was signalled
1235 exactly when we asked for it, or at some time later.)
1237 EMACS_GET_TIME(current_time);
1238 EMACS_SET_SECS_USECS(interval, timeout->resignal_msecs / 1000,
1239 1000 * (timeout->resignal_msecs % 1000));
1241 EMACS_ADD_TIME(timeout->next_signal_time,
1242 timeout->next_signal_time, interval);
1243 } while (EMACS_TIME_GREATER(
1244 current_time, timeout->next_signal_time));
1247 timeout->interval_id =
1248 event_stream_add_async_timeout(
1249 timeout->next_signal_time);
1251 timeout->interval_id =
1252 event_stream_add_timeout(
1253 timeout->next_signal_time);
1255 /* Add back onto the list. Note that the effect of this
1256 is to move frequently-hit timeouts to the front of the
1257 list, which is a good thing. */
1258 *timeout_list = noseeum_cons(op, *timeout_list);
1260 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1263 free_managed_lcrecord(Vtimeout_free_list, op);
1271 event_stream_disable_wakeup(int id, int async_p)
1273 Lisp_Timeout *timeout = 0;
1275 Lisp_Object *timeout_list;
1278 timeout_list = &pending_async_timeout_list;
1280 timeout_list = &pending_timeout_list;
1282 /* Find the timeout on the list of pending ones, if it's still there. */
1283 LIST_LOOP(rest, *timeout_list) {
1284 timeout = XTIMEOUT(XCAR(rest));
1285 if (timeout->id == id) {
1290 /* If we found it, remove it from the list and disable the pending
1293 Lisp_Object op = XCAR(rest);
1294 *timeout_list = delq_no_quit_and_free_cons(op, *timeout_list);
1296 event_stream_remove_async_timeout(timeout->interval_id);
1298 event_stream_remove_timeout(timeout->interval_id);
1300 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1303 free_managed_lcrecord(Vtimeout_free_list, op);
1310 event_stream_wakeup_pending_p(int id, int async_p)
1312 Lisp_Timeout *timeout;
1314 Lisp_Object timeout_list;
1318 timeout_list = pending_async_timeout_list;
1320 timeout_list = pending_timeout_list;
1323 /* Find the element on the list of pending ones, if it's still there. */
1324 LIST_LOOP(rest, timeout_list) {
1325 timeout = XTIMEOUT(XCAR(rest));
1326 if (timeout->id == id) {
1335 /**** Asynch. timeout functions (see also signal.c) ****/
1337 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1338 extern int poll_for_quit_id;
1341 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1342 extern int poll_for_sigchld_id;
1346 event_stream_deal_with_async_timeout(int interval_id)
1348 /* This function can GC */
1349 Lisp_Object humpty, dumpty;
1350 #if ((!defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)) \
1351 || defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD))
1354 event_stream_resignal_wakeup(interval_id, 1, &humpty, &dumpty);
1356 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1357 if (id == poll_for_quit_id) {
1358 quit_check_signal_happened = 1;
1359 quit_check_signal_tick_count++;
1364 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1365 if (id == poll_for_sigchld_id) {
1366 kick_status_notify();
1371 /* call1 GC-protects its arguments */
1372 call1_trapping_errors("Error in asynchronous timeout callback",
1377 /**** Lisp-level timeout functions. ****/
1379 static unsigned long
1380 lisp_number_to_milliseconds(Lisp_Object secs, int allow_0)
1382 #if defined(WITH_NUMBER_TYPES)
1385 fsecs = extract_float(secs);
1386 #else /* !WITH_NUMBER_TYPES */
1389 CHECK_INT_OR_FLOAT(secs);
1390 fsecs = XFLOATINT(secs);
1395 #endif /* HAVE_FPFLOAT */
1396 #endif /* WITH_NUMBER_TYPES */
1398 signal_simple_error("timeout is negative", secs);
1400 if (!allow_0 && fsecs == 0) {
1401 signal_simple_error("timeout is non-positive", secs);
1403 if (fsecs >= (((unsigned int)0xFFFFFFFF) / 1000)) {
1404 signal_simple_error(
1405 "timeout would exceed 32 bits when "
1406 "represented in milliseconds",
1409 return (unsigned long)(1000 * fsecs);
1412 DEFUN("add-timeout", Fadd_timeout, 3, 4, 0, /*
1413 Add a timeout, to be signaled after the timeout period has elapsed.
1414 SECS is a number of seconds, expressed as an integer or a float.
1415 FUNCTION will be called after that many seconds have elapsed, with one
1416 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1417 then after this timeout expires, `add-timeout' will automatically be called
1418 again with RESIGNAL as the first argument.
1420 This function returns an object which is the id number of this particular
1421 timeout. You can pass that object to `disable-timeout' to turn off the
1422 timeout before it has been signalled.
1424 NOTE: Id numbers as returned by this function are in a distinct namespace
1425 from those returned by `add-async-timeout'. This means that the same id
1426 number could refer to a pending synchronous timeout and a different pending
1427 asynchronous timeout, and that you cannot pass an id from `add-timeout'
1428 to `disable-async-timeout', or vice-versa.
1430 The number of seconds may be expressed as a floating-point number, in which
1431 case some fractional part of a second will be used. Caveat: the usable
1432 timeout granularity will vary from system to system.
1434 Adding a timeout causes a timeout event to be returned by `next-event', and
1435 the function will be invoked by `dispatch-event,' so if emacs is in a tight
1436 loop, the function will not be invoked until the next call to sit-for or
1437 until the return to top-level (the same is true of process filters).
1439 If you need to have a timeout executed even when SXEmacs is in the midst of
1440 running Lisp code, use `add-async-timeout'.
1442 WARNING: if you are thinking of calling add-timeout from inside of a
1443 callback function as a way of resignalling a timeout, think again. There
1444 is a race condition. That's why the RESIGNAL argument exists.
1446 (secs, function, object, resignal))
1448 unsigned long msecs = lisp_number_to_milliseconds(secs, 0);
1449 unsigned long msecs2 = (NILP(resignal) ? 0 :
1450 lisp_number_to_milliseconds(resignal, 0));
1453 id = event_stream_generate_wakeup(msecs, msecs2, function, object, 0);
1455 if (id != XINT(lid)) {
1461 DEFUN("disable-timeout", Fdisable_timeout, 1, 1, 0, /*
1462 Disable a timeout from signalling any more.
1463 ID should be a timeout id number as returned by `add-timeout'. If ID
1464 corresponds to a one-shot timeout that has already signalled, nothing
1467 It will not work to call this function on an id number returned by
1468 `add-async-timeout'. Use `disable-async-timeout' for that.
1473 event_stream_disable_wakeup(XINT(id), 0);
1477 DEFUN("add-async-timeout", Fadd_async_timeout, 3, 4, 0, /*
1478 Add an asynchronous timeout, to be signaled after an interval has elapsed.
1479 SECS is a number of seconds, expressed as an integer or a float.
1480 FUNCTION will be called after that many seconds have elapsed, with one
1481 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1482 then after this timeout expires, `add-async-timeout' will automatically be
1483 called again with RESIGNAL as the first argument.
1485 This function returns an object which is the id number of this particular
1486 timeout. You can pass that object to `disable-async-timeout' to turn off
1487 the timeout before it has been signalled.
1489 NOTE: Id numbers as returned by this function are in a distinct namespace
1490 from those returned by `add-timeout'. This means that the same id number
1491 could refer to a pending synchronous timeout and a different pending
1492 asynchronous timeout, and that you cannot pass an id from
1493 `add-async-timeout' to `disable-timeout', or vice-versa.
1495 The number of seconds may be expressed as a floating-point number, in which
1496 case some fractional part of a second will be used. Caveat: the usable
1497 timeout granularity will vary from system to system.
1499 Adding an asynchronous timeout causes the function to be invoked as soon
1500 as the timeout occurs, even if SXEmacs is in the midst of executing some
1501 other code. (This is unlike the synchronous timeouts added with
1502 `add-timeout', where the timeout will only be signalled when SXEmacs is
1503 waiting for events, i.e. the next return to top-level or invocation of
1504 `sit-for' or related functions.) This means that the function that is
1505 called *must* not signal an error or change any global state (e.g. switch
1506 buffers or windows) except when locking code is in place to make sure
1507 that race conditions don't occur in the interaction between the
1508 asynchronous timeout function and other code.
1510 Under most circumstances, you should use `add-timeout' instead, as it is
1511 much safer. Asynchronous timeouts should only be used when such behavior
1512 is really necessary.
1514 Asynchronous timeouts are blocked and will not occur when `inhibit-quit'
1515 is non-nil. As soon as `inhibit-quit' becomes nil again, any pending
1516 asynchronous timeouts will get called immediately. (Multiple occurrences
1517 of the same asynchronous timeout are not queued, however.) While the
1518 callback function of an asynchronous timeout is invoked, `inhibit-quit'
1519 is automatically bound to non-nil, and thus other asynchronous timeouts
1520 will be blocked unless the callback function explicitly sets `inhibit-quit'
1523 WARNING: if you are thinking of calling `add-async-timeout' from inside of a
1524 callback function as a way of resignalling a timeout, think again. There
1525 is a race condition. That's why the RESIGNAL argument exists.
1527 (secs, function, object, resignal))
1529 unsigned long msecs = lisp_number_to_milliseconds(secs, 0);
1530 unsigned long msecs2 = (NILP(resignal) ? 0 :
1531 lisp_number_to_milliseconds(resignal, 0));
1534 id = event_stream_generate_wakeup(msecs, msecs2, function, object, 1);
1536 if (id != XINT(lid)) {
1542 DEFUN("disable-async-timeout", Fdisable_async_timeout, 1, 1, 0, /*
1543 Disable an asynchronous timeout from signalling any more.
1544 ID should be a timeout id number as returned by `add-async-timeout'. If ID
1545 corresponds to a one-shot timeout that has already signalled, nothing
1548 It will not work to call this function on an id number returned by
1549 `add-timeout'. Use `disable-timeout' for that.
1554 event_stream_disable_wakeup(XINT(id), 1);
1558 /**********************************************************************/
1559 /* enqueuing and dequeuing events */
1560 /**********************************************************************/
1562 /* Add an event to the back of the command-event queue: it will be the next
1563 event read after all pending events. This only works on keyboard,
1564 mouse-click, misc-user, and eval events.
1567 enqueue_command_event(Lisp_Object event)
1569 #ifdef EF_USE_ASYNEQ
1570 eq_enqueue(asyneq, event);
1572 enqueue_event(event, &command_event_queue, &command_event_queue_tail);
1577 dequeue_command_event(void)
1579 #ifdef EF_USE_ASYNEQ
1580 return eq_dequeue(asyneq);
1582 return dequeue_event(&command_event_queue, &command_event_queue_tail);
1586 /* put the event on the typeahead queue, unless
1587 the event is the quit char, in which case the `QUIT'
1588 which will occur on the next trip through this loop is
1589 all the processing we should do - leaving it on the queue
1590 would cause the quit to be processed twice.
1593 enqueue_command_event_1(Lisp_Object event_to_copy)
1595 /* do not call check_quit() here. Vquit_flag was set in
1596 next_event_internal. */
1597 if (NILP(Vquit_flag)) {
1598 enqueue_command_event(Fcopy_event(event_to_copy, Qnil));
1604 enqueue_magic_eval_event(void (*fun) (Lisp_Object), Lisp_Object object)
1606 Lisp_Object event = Fmake_event(Qnil, Qnil);
1608 XEVENT(event)->event_type = magic_eval_event;
1609 /* channel for magic_eval events is nil */
1610 XEVENT(event)->event.magic_eval.internal_function = fun;
1611 XEVENT(event)->event.magic_eval.object = object;
1612 enqueue_command_event(event);
1616 DEFUN("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0, /*
1617 Add an eval event to the back of the eval event queue.
1618 When this event is dispatched, FUNCTION (which should be a function
1619 of one argument) will be called with OBJECT as its argument.
1620 See `next-event' for a description of event types and how events
1625 Lisp_Object event = Fmake_event(Qnil, Qnil);
1627 XEVENT(event)->event_type = eval_event;
1628 /* channel for eval events is nil */
1629 XEVENT(event)->event.eval.function = function;
1630 XEVENT(event)->event.eval.object = object;
1631 enqueue_command_event(event);
1637 enqueue_misc_user_event(Lisp_Object channel, Lisp_Object function,
1640 Lisp_Object event = Fmake_event(Qnil, Qnil);
1642 XEVENT(event)->event_type = misc_user_event;
1643 XEVENT(event)->channel = channel;
1644 XEVENT(event)->event.misc.function = function;
1645 XEVENT(event)->event.misc.object = object;
1646 XEVENT(event)->event.misc.button = 0;
1647 XEVENT(event)->event.misc.modifiers = 0;
1648 XEVENT(event)->event.misc.x = -1;
1649 XEVENT(event)->event.misc.y = -1;
1650 enqueue_command_event(event);
1656 enqueue_misc_user_event_pos(Lisp_Object channel, Lisp_Object function,
1658 int button, int modifiers, int x, int y)
1660 Lisp_Object event = Fmake_event(Qnil, Qnil);
1662 XEVENT(event)->event_type = misc_user_event;
1663 XEVENT(event)->channel = channel;
1664 XEVENT(event)->event.misc.function = function;
1665 XEVENT(event)->event.misc.object = object;
1666 XEVENT(event)->event.misc.button = button;
1667 XEVENT(event)->event.misc.modifiers = modifiers;
1668 XEVENT(event)->event.misc.x = x;
1669 XEVENT(event)->event.misc.y = y;
1670 enqueue_command_event(event);
1675 /**********************************************************************/
1676 /* focus-event handling */
1677 /**********************************************************************/
1681 Ben's capsule lecture on focus:
1683 In FSFmacs `select-frame' never changes the window-manager frame
1684 focus. All it does is change the "selected frame". This is similar
1685 to what happens when we call `select-device' or `select-console'.
1686 Whenever an event comes in (including a keyboard event), its frame is
1687 selected; therefore, evaluating `select-frame' in *scratch* won't
1688 cause any effects because the next received event (in the same frame)
1689 will cause a switch back to the frame displaying *scratch*.
1691 Whenever a focus-change event is received from the window manager, it
1692 generates a `switch-frame' event, which causes the Lisp function
1693 `handle-switch-frame' to get run. This basically just runs
1694 `select-frame' (see below, however).
1696 In FSFmacs, if you want to have an operation run when a frame is
1697 selected, you supply an event binding for `switch-frame' (and then
1698 maybe call `handle-switch-frame', or something ...).
1700 In SXEmacs, we *do* change the window-manager frame focus as a result
1701 of `select-frame', but not until the next time an event is received,
1702 so that a function that momentarily changes the selected frame won't
1703 cause WM focus flashing. (#### There's something not quite right here;
1704 this is causing the wrong-cursor-focus problems that you occasionally
1705 see. But the general idea is correct.) This approach is winning for
1706 people who use the explicit-focus model, but is trickier to implement.
1708 We also don't make the `switch-frame' event visible but instead have
1709 `select-frame-hook', which is a better approach.
1711 There is the problem of surrogate minibuffers, where when we enter the
1712 minibuffer, you essentially want to temporarily switch the WM focus to
1713 the frame with the minibuffer, and switch it back when you exit the
1716 FSFmacs solves this with the crockish `redirect-frame-focus', which
1717 says "for keyboard events received from FRAME, act like they're
1718 coming from FOCUS-FRAME". I think what this means is that, when
1719 a keyboard event comes in and the event manager is about to select the
1720 event's frame, if that frame has its focus redirected, the redirected-to
1721 frame is selected instead. That way, if you're in a minibufferless
1722 frame and enter the minibuffer, then all Lisp functions that run see
1723 the selected frame as the minibuffer's frame rather than the minibufferless
1724 frame you came from, so that (e.g.) your typing actually appears in
1725 the minibuffer's frame and things behave sanely.
1727 There's also some weird logic that switches the redirected frame focus
1728 from one frame to another if Lisp code explicitly calls `select-frame'
1729 \(but not if `handle-switch-frame' is called), and saves and restores
1730 the frame focus in window configurations, etc. etc. All of this logic
1731 is heavily #if 0'd, with lots of comments saying "No, this approach
1732 doesn't seem to work, so I'm trying this ... is it reasonable?
1733 Well, I'm not sure ..." that are a red flag indicating crockishness.
1735 Because of our way of doing things, we can avoid all this crock.
1736 Keyboard events never cause a select-frame (who cares what frame
1737 they're associated with? They come from a console, only). We change
1738 the actual WM focus to a surrogate minibuffer frame, so we don't have
1739 to do any internal redirection. In order to get the focus back,
1740 I took the approach in minibuf.el of just checking to see if the
1741 frame we moved to is still the selected frame, and move back to the
1742 old one if so. Conceivably we might have to do the weird "tracking"
1743 that FSFmacs does when `select-frame' is called, but I don't think
1744 so. If the selected frame moved from the minibuffer frame, then
1745 we just leave it there, figuring that someone knows what they're
1746 doing. Because we don't have any redirection recorded anywhere,
1747 it's safe to do this, and we don't end up with unwanted redirection.
1752 run_select_frame_hook(void)
1754 run_hook(Qselect_frame_hook);
1759 run_deselect_frame_hook(void)
1761 run_hook(Qdeselect_frame_hook);
1765 /* When select-frame is called and focus_follows_mouse is false, we want
1766 to tell the window system that the focus should be changed to point to
1767 the new frame. However,
1768 sometimes Lisp functions will temporarily change the selected frame
1769 (e.g. to call a function that operates on the selected frame),
1770 and it's annoying if this focus-change happens exactly when
1771 select-frame is called, because then you get some flickering of the
1772 window-manager border and perhaps other undesirable results. We
1773 really only want to change the focus when we're about to retrieve
1774 an event from the user. To do this, we keep track of the frame
1775 where the window-manager focus lies on, and just before waiting
1776 for user events, check the currently selected frame and change
1777 the focus as necessary.
1779 On the other hand, if focus_follows_mouse is true, we need to switch the
1780 selected frame back to the frame with window manager focus just before we
1781 execute the next command in Fcommand_loop_1, just as the selected buffer is
1782 reverted after a set-buffer.
1784 Both cases are handled by this function. It must be called as appropriate
1785 from these two places, depending on the value of focus_follows_mouse. */
1788 investigate_frame_change_dev(struct device *d, Lisp_Object sel_frame)
1790 /* You'd think that maybe we should use FRAME_WITH_FOCUS_REAL,
1791 but that can cause us to end up in an infinite loop focusing
1792 between two frames. It seems that since the call to
1793 `select-frame' in emacs_handle_focus_change_final() is based
1794 on the _FOR_HOOKS value, we need to do so too. */
1795 #define DEVICE_FRAME_TOTHF DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS
1796 #define DEVICE_FRAME_WFFH DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS
1797 if (!NILP(sel_frame) &&
1798 !EQ(DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d), sel_frame) &&
1799 !NILP(DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d)) &&
1800 !EQ(DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d), sel_frame)) {
1801 /* At this point, we know that the frame has been
1802 * changed. Now, if focus_follows_mouse is not set, we
1803 * finish off the frame change, so that user events will
1804 * now come from the new frame. Otherwise, if
1805 * focus_follows_mouse is set, no gratuitous frame
1806 * changing should take place. Set the focus back to
1807 * the frame which was originally selected for user
1809 if (!focus_follows_mouse) {
1810 /* prevent us from issuing the same request more
1812 DEVICE_FRAME_TOTHF(d) = sel_frame;
1813 MAYBE_DEVMETH(d, focus_on_frame, (XFRAME(sel_frame)));
1815 Lisp_Object old_frame = Qnil;
1817 /* #### Do we really want to check OUGHT ??
1818 * It seems to make sense, though I have never
1819 * seen us get here and have it be non-nil. */
1820 if (FRAMEP(DEVICE_FRAME_TOTHF(d))) {
1821 old_frame = DEVICE_FRAME_TOTHF(d);
1822 } else if (FRAMEP(DEVICE_FRAME_WFFH(d))) {
1823 old_frame = DEVICE_FRAME_WFFH(d);
1826 /* #### Can old_frame ever be NIL? play it safe.. */
1827 if (!NILP(old_frame)) {
1828 /* Fselect_frame is not really the right thing:
1829 * it frobs the buffer stack. But there's no
1830 * easy way to do the right thing, and this code
1831 * already had this problem anyway. */
1832 Fselect_frame(old_frame);
1836 #undef DEVICE_FRAME_TOTHF
1837 #undef DEVICE_FRAME_WFFH
1842 investigate_frame_change(void)
1844 Lisp_Object devcons, concons;
1846 /* if the selected frame was changed, change the window-system
1847 focus to the new frame. We don't do it when select-frame was
1848 called, to avoid flickering and other unwanted side effects when
1849 the frame is just changed temporarily. */
1850 DEVICE_LOOP_NO_BREAK(devcons, concons) {
1851 struct device *d = XDEVICE(XCAR(devcons));
1852 Lisp_Object sel_frame = DEVICE_SELECTED_FRAME(d);
1854 investigate_frame_change_dev(d, sel_frame);
1860 cleanup_after_missed_defocusing(Lisp_Object frame)
1862 if (FRAMEP(frame) && FRAME_LIVE_P(XFRAME(frame))) {
1863 Fselect_frame(frame);
1869 emacs_handle_focus_change_preliminary(Lisp_Object frame_inp_and_dev)
1871 Lisp_Object frame = Fcar(frame_inp_and_dev);
1872 Lisp_Object device = Fcar(Fcdr(frame_inp_and_dev));
1873 int in_p = !NILP(Fcdr(Fcdr(frame_inp_and_dev)));
1876 if (!DEVICE_LIVE_P(XDEVICE(device))) {
1879 d = XDEVICE(device);
1882 /* Any received focus-change notifications render invalid any
1883 pending focus-change requests. */
1884 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d) = Qnil;
1886 Lisp_Object focus_frame;
1888 if (!FRAME_LIVE_P(XFRAME(frame))) {
1891 focus_frame = DEVICE_FRAME_WITH_FOCUS_REAL(d);
1894 /* Mark the minibuffer as changed to make sure it gets updated
1895 properly if the echo area is active. */
1898 XWINDOW(FRAME_MINIBUF_WINDOW(XFRAME(frame)));
1899 MARK_WINDOWS_CHANGED(w);
1902 if (FRAMEP(focus_frame) && FRAME_LIVE_P(XFRAME(focus_frame)) &&
1903 !EQ(frame, focus_frame)) {
1904 /* Oops, we missed a focus-out event. */
1905 DEVICE_FRAME_WITH_FOCUS_REAL(d) = Qnil;
1906 redisplay_redraw_cursor(XFRAME(focus_frame), 1);
1908 DEVICE_FRAME_WITH_FOCUS_REAL(d) = frame;
1909 if (!EQ(frame, focus_frame)) {
1910 redisplay_redraw_cursor(XFRAME(frame), 1);
1913 /* We ignore the frame reported in the event. If it's different
1914 from where we think the focus was, oh well -- we messed up.
1915 Nonetheless, we pretend we were right, for sensible
1917 frame = DEVICE_FRAME_WITH_FOCUS_REAL(d);
1919 DEVICE_FRAME_WITH_FOCUS_REAL(d) = Qnil;
1921 if (FRAME_LIVE_P(XFRAME(frame))) {
1922 redisplay_redraw_cursor(XFRAME(frame), 1);
1929 /* Called from the window-system-specific code when we receive a
1930 notification that the focus lies on a particular frame.
1931 Argument is a cons: (frame . (device . in-p)) where in-p is non-nil
1935 emacs_handle_focus_change_final(Lisp_Object frame_inp_and_dev)
1937 Lisp_Object frame = Fcar(frame_inp_and_dev);
1938 Lisp_Object device = Fcar(Fcdr(frame_inp_and_dev));
1939 int in_p = !NILP(Fcdr(Fcdr(frame_inp_and_dev)));
1943 if (!DEVICE_LIVE_P(XDEVICE(device))) {
1946 d = XDEVICE(device);
1950 Lisp_Object focus_frame;
1952 if (!FRAME_LIVE_P(XFRAME(frame))) {
1955 focus_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d);
1958 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d) = frame;
1959 if (FRAMEP(focus_frame) && !EQ(frame, focus_frame)) {
1960 /* Oops, we missed a focus-out event. */
1961 Fselect_frame(focus_frame);
1962 /* Do an unwind-protect in case an error occurs in
1963 the deselect-frame-hook */
1964 count = specpdl_depth();
1965 record_unwind_protect(
1966 cleanup_after_missed_defocusing, frame);
1967 run_deselect_frame_hook();
1968 unbind_to(count, Qnil);
1969 /* the cleanup method changed the focus frame to nil, so
1970 we need to reflect this */
1973 Fselect_frame(frame);
1975 if (!EQ(frame, focus_frame)) {
1976 run_select_frame_hook();
1979 /* We ignore the frame reported in the event. If it's different
1980 from where we think the focus was, oh well -- we messed up.
1981 Nonetheless, we pretend we were right, for sensible
1983 frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d);
1985 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d) = Qnil;
1986 run_deselect_frame_hook();
1992 /**********************************************************************/
1993 /* retrieving the next event */
1994 /**********************************************************************/
1996 static int in_single_console;
1998 /* #### These functions don't currently do anything. */
2000 single_console_state(void)
2002 in_single_console = 1;
2007 any_console_state(void)
2009 in_single_console = 0;
2014 in_single_console_state(void)
2016 return in_single_console;
2019 static inline Lisp_Object
2020 make_con_quit_char(Lisp_Event *e)
2022 return make_char(CONSOLE_QUIT_CHAR(XCONSOLE(EVENT_CHANNEL(e))));
2025 /* the number of keyboard characters read. callint.c wants this. */
2026 Charcount num_input_chars;
2029 next_event_internal(Lisp_Object target_event, int allow_queued)
2031 struct gcpro gcpro1;
2032 /* QUIT; This is incorrect - the caller must do this because some
2033 callers (ie, Fnext_event()) do not want to QUIT. */
2035 assert(NILP(XEVENT_NEXT(target_event)));
2037 GCPRO1(target_event);
2039 /* When focus_follows_mouse is nil, if a frame change took place, we
2040 * need to actually switch window manager focus to the selected
2042 if (!focus_follows_mouse) {
2043 investigate_frame_change();
2046 if (allow_queued && !EQ_EMPTY_P()) {
2047 Lisp_Object event = dequeue_command_event();
2048 Fcopy_event(event, target_event);
2049 Fdeallocate_event(event);
2050 DEBUG_PRINT_EMACS_EVENT("command event queue", target_event);
2052 Lisp_Event *e = XEVENT(target_event);
2054 /* The command_event_queue was empty. Wait for an event. */
2055 event_stream_next_event(e);
2056 /* If this was a timeout, then we need to extract some data
2057 out of the returned closure and might need to resignal
2059 if (e->event_type == timeout_event) {
2060 Lisp_Object tristan, isolde;
2062 e->event.timeout.id_number =
2063 event_stream_resignal_wakeup(
2064 e->event.timeout.interval_id,
2065 0, &tristan, &isolde);
2067 e->event.timeout.function = tristan;
2068 e->event.timeout.object = isolde;
2069 /* next_event_internal() doesn't print out timeout
2070 events because of the extra info we just set. */
2071 DEBUG_PRINT_EMACS_EVENT("real, timeout", target_event);
2074 /* If we read a ^G, then set quit-flag but do not discard the
2075 ^G. The callers of next_event_internal() will do one of two
2078 -- set Vquit_flag to Qnil. (next-event does this.) This will
2079 cause the ^G to be treated as a normal keystroke.
2080 -- not change Vquit_flag but attempt to enqueue the ^G, at
2081 which point it will be discarded. The next time QUIT is
2082 called, it will notice that Vquit_flag was set.
2085 if (e->event_type == key_press_event &&
2086 event_matches_key_specifier_p(e, make_con_quit_char(e))) {
2096 run_pre_idle_hook(void)
2098 if (!NILP(Vpre_idle_hook)
2099 && !detect_input_pending()) {
2100 safe_run_hook_trapping_errors
2101 ("Error in `pre-idle-hook' (setting hook to nil)",
2107 static void push_this_command_keys(Lisp_Object event);
2108 static void push_recent_keys(Lisp_Object event);
2109 static void dribble_out_event(Lisp_Object event);
2110 static void execute_internal_event(Lisp_Object event);
2111 static int is_scrollbar_event(Lisp_Object event);
2113 DEFUN("next-event", Fnext_event, 0, 2, 0, /*
2114 Return the next available event.
2115 Pass this object to `dispatch-event' to handle it.
2116 In most cases, you will want to use `next-command-event', which returns
2117 the next available "user" event (i.e. keypress, button-press,
2118 button-release, or menu selection) instead of this function.
2120 If EVENT is non-nil, it should be an event object and will be filled in
2121 and returned; otherwise a new event object will be created and returned.
2122 If PROMPT is non-nil, it should be a string and will be displayed in the
2123 echo area while this function is waiting for an event.
2125 The next available event will be
2127 -- any events in `unread-command-events' or `unread-command-event'; else
2128 -- the next event in the currently executing keyboard macro, if any; else
2129 -- an event queued by `enqueue-eval-event', if any, or any similar event
2130 queued internally, such as a misc-user event. (For example, when an item
2131 is selected from a menu or from a `question'-type dialog box, the item's
2132 callback is not immediately executed, but instead a misc-user event
2133 is generated and placed onto this queue; when it is dispatched, the
2134 callback is executed.) Else
2135 -- the next available event from the window system or terminal driver.
2137 In the last case, this function will block until an event is available.
2139 The returned event will be one of the following types:
2141 -- a key-press event.
2142 -- a button-press or button-release event.
2143 -- a misc-user-event, meaning the user selected an item on a menu or used
2145 -- a process event, meaning that output from a subprocess is available.
2146 -- a timeout event, meaning that a timeout has elapsed.
2147 -- an eval event, which simply causes a function to be executed when the
2148 event is dispatched. Eval events are generated by `enqueue-eval-event'
2149 or by certain other conditions happening.
2150 -- a magic event, indicating that some window-system-specific event
2151 happened (such as a focus-change notification) that must be handled
2152 synchronously with other events. `dispatch-event' knows what to do with
2157 /* This function can call lisp */
2158 /* #### We start out using the selected console before an event
2159 is received, for echoing the partially completed command.
2160 This is most definitely wrong -- there needs to be a separate
2161 echo area for each console! */
2162 struct console *con = XCONSOLE(Vselected_console);
2163 struct command_builder *command_builder =
2164 XCOMMAND_BUILDER(con->command_builder);
2165 int store_this_key = 0;
2166 struct gcpro gcpro1;
2169 /* DO NOT do QUIT anywhere within this function or the functions it
2170 calls. We want to read the ^G as an event. */
2172 #ifdef LWLIB_MENUBARS_LUCID
2174 * #### Fix the menu code so this isn't necessary.
2176 * We cannot allow the lwmenu code to be reentered, because the
2177 * code is not written to be reentrant and will crash. Therefore
2178 * paths from the menu callbacks back into the menu code have to
2179 * be blocked. Fnext_event is the normal path into the menu code,
2180 * so we signal an error here.
2182 if (in_menu_callback) {
2183 error("Attempt to call next-event inside menu callback");
2185 #endif /* LWLIB_MENUBARS_LUCID */
2188 event = Fmake_event(Qnil, Qnil);
2190 CHECK_LIVE_EVENT(event);
2193 if (!NILP(prompt)) {
2195 CHECK_STRING(prompt);
2197 len = XSTRING_LENGTH(prompt);
2198 if (command_builder->echo_buf_length < len) {
2199 len = command_builder->echo_buf_length - 1;
2201 memcpy(command_builder->echo_buf, XSTRING_DATA(prompt), len);
2202 command_builder->echo_buf[len] = 0;
2203 command_builder->echo_buf_index = len;
2204 echo_area_message(XFRAME(CONSOLE_SELECTED_FRAME(con)),
2205 command_builder->echo_buf,
2207 command_builder->echo_buf_index, Qcommand);
2210 start_over_and_avoid_hosage:
2211 /* If there is something in unread-command-events, simply return it.
2212 But do some error checking to make sure the user hasn't put something
2213 in the unread-command-events that they shouldn't have. This does not
2214 update this-command-keys and recent-keys.
2216 if (!NILP(Vunread_command_events)) {
2217 if (!CONSP(Vunread_command_events)) {
2218 Vunread_command_events = Qnil;
2219 signal_error(Qwrong_type_argument,
2220 list3(Qconsp, Vunread_command_events,
2221 Qunread_command_events));
2223 Lisp_Object e = XCAR(Vunread_command_events);
2224 Vunread_command_events = XCDR(Vunread_command_events);
2225 if (!EVENTP(e) || !command_event_p(e)) {
2226 signal_error(Qwrong_type_argument,
2227 list3(Qcommand_event_p, e,
2228 Qunread_command_events));
2231 if (!EQ(e, event)) {
2232 Fcopy_event(e, event);
2234 DEBUG_PRINT_EMACS_EVENT("unread-command-events", event);
2237 } else if (!NILP(Vunread_command_event)) {
2238 /* Do similar for unread-command-event
2239 * (obsoleteness support). */
2240 Lisp_Object e = Vunread_command_event;
2241 Vunread_command_event = Qnil;
2243 if (!EVENTP(e) || !command_event_p(e)) {
2244 signal_error(Qwrong_type_argument,
2245 list3(Qeventp, e, Qunread_command_event));
2247 if (!EQ(e, event)) {
2248 Fcopy_event(e, event);
2251 DEBUG_PRINT_EMACS_EVENT("unread-command-event", event);
2254 /* If we're executing a keyboard macro, take the next event from
2255 * that, and update this-command-keys and recent-keys. Note
2256 * that the unread-command-events take precedence over kbd
2258 if (!NILP(Vexecuting_macro)) {
2260 /* This throws past us at end-of-macro. */
2261 pop_kbd_macro_event(event);
2263 DEBUG_PRINT_EMACS_EVENT("keyboard macro", event);
2266 /* Otherwise, read a real event, possibly from the
2267 * command_event_queue, and update this-command-keys and
2269 run_pre_idle_hook();
2271 next_event_internal(event, 1);
2272 /* Read C-g as an event. */
2278 /* Notice process change */
2282 /* Cause a garbage collection now */
2284 /* Since we can free the most stuff here
2285 * (since this is typically called from
2286 * the command-loop top-level). */
2287 #endif /* C_ALLOCA */
2289 if (object_dead_p(XEVENT(event)->channel)) {
2290 /* event_console_or_selected may crash if the channel is dead.
2291 Best just to eat it and get the next event. */
2292 goto start_over_and_avoid_hosage;
2295 /* OK, now we can stop the selected-console kludge and use the
2296 actual console from the event. */
2297 con = event_console_or_selected(event);
2298 command_builder = XCOMMAND_BUILDER(con->command_builder);
2300 switch (XEVENT_TYPE(event)) {
2301 case button_release_event:
2302 case misc_user_event:
2303 /* don't echo menu accelerator keys */
2304 reset_key_echo(command_builder, 1);
2306 case button_press_event:
2307 /* key or mouse input can trigger prompting */
2308 goto STORE_AND_EXECUTE_KEY;
2309 case key_press_event:
2310 /* any key input can trigger autosave */
2313 /* just list the other events here */
2315 case pointer_motion_event:
2319 case magic_eval_event:
2321 #ifdef EF_USE_ASYNEQ
2322 case eaten_myself_event:
2323 case work_started_event:
2324 case work_finished_event:
2325 #endif /* EF_USE_ASYNEQ */
2331 maybe_do_auto_save();
2333 STORE_AND_EXECUTE_KEY:
2334 if (store_this_key) {
2335 echo_key_event(command_builder, event);
2339 /* Store the last-input-event. The semantics of this is that it is
2340 the thing most recently returned by next-command-event. It need
2341 not have come from the keyboard or a keyboard macro, it may have
2342 come from unread-command-events. It's always a command-event (a
2343 key, click, or menu selection), never a motion or process event.
2345 if (!EVENTP(Vlast_input_event)) {
2346 Vlast_input_event = Fmake_event(Qnil, Qnil);
2348 if (XEVENT_TYPE(Vlast_input_event) == dead_event) {
2349 Vlast_input_event = Fmake_event(Qnil, Qnil);
2350 error("Someone deallocated last-input-event!");
2352 if (!EQ(event, Vlast_input_event)) {
2353 Fcopy_event(event, Vlast_input_event);
2356 /* last-input-char and last-input-time are derived from
2358 Note that last-input-char will never have its high-bit set, in an
2359 effort to sidestep the ambiguity between M-x and oslash.
2361 Vlast_input_char = Fevent_to_character(
2362 Vlast_input_event, Qnil, Qnil, Qnil);
2367 if (!CONSP(Vlast_input_time)) {
2368 Vlast_input_time = Fcons(Qnil, Qnil);
2370 XCAR(Vlast_input_time) =
2371 make_int((EMACS_SECS(t) >> 16) & 0xffff);
2372 XCDR(Vlast_input_time) =
2373 make_int((EMACS_SECS(t) >> 0) & 0xffff);
2374 if (!CONSP(Vlast_command_event_time)) {
2375 Vlast_command_event_time = list3(Qnil, Qnil, Qnil);
2377 XCAR(Vlast_command_event_time) =
2378 make_int((EMACS_SECS(t) >> 16) & 0xffff);
2379 XCAR(XCDR(Vlast_command_event_time)) =
2380 make_int((EMACS_SECS(t) >> 0) & 0xffff);
2381 XCAR(XCDR(XCDR(Vlast_command_event_time))) =
2382 make_int(EMACS_USECS(t));
2384 /* If this key came from the keyboard or from a keyboard macro, then
2385 it goes into the recent-keys and this-command-keys vectors.
2386 If this key came from the keyboard, and we're defining a keyboard
2387 macro, then it goes into the macro.
2389 if (store_this_key) {
2390 if (!is_scrollbar_event(event)) {
2391 /* #### not quite right, see
2392 comment in execute_command_event */
2393 push_this_command_keys(event);
2395 if (!inhibit_input_event_recording) {
2396 push_recent_keys(event);
2398 dribble_out_event(event);
2399 if (!NILP(con->defining_kbd_macro) && NILP(Vexecuting_macro)) {
2400 if (!EVENTP(command_builder->current_events)) {
2401 finalize_kbd_macro_chars(con);
2403 store_kbd_macro_event(event);
2406 /* If this is the help char and there is a help form, then execute the
2407 help form and swallow this character. This is the only place where
2408 calling Fnext_event() can cause arbitrary lisp code to run. Note
2409 that execute_help_form() calls Fnext_command_event(), which calls
2410 this function, as well as Fdispatch_event.
2412 if (!NILP(Vhelp_form) &&
2413 event_matches_key_specifier_p(XEVENT(event), Vhelp_char)) {
2414 execute_help_form(command_builder, event);
2421 DEFUN("next-command-event", Fnext_command_event, 0, 2, 0, /*
2422 Return the next available "user" event.
2423 Pass this object to `dispatch-event' to handle it.
2425 If EVENT is non-nil, it should be an event object and will be filled in
2426 and returned; otherwise a new event object will be created and returned.
2427 If PROMPT is non-nil, it should be a string and will be displayed in the
2428 echo area while this function is waiting for an event.
2430 The event returned will be a keyboard, mouse press, or mouse release event.
2431 If there are non-command events available (mouse motion, sub-process output,
2432 etc) then these will be executed (with `dispatch-event') and discarded. This
2433 function is provided as a convenience; it is roughly equivalent to the lisp code
2436 (next-event event prompt)
2437 (not (or (key-press-event-p event)
2438 (button-press-event-p event)
2439 (button-release-event-p event)
2440 (misc-user-event-p event))))
2441 (dispatch-event event))
2443 but it also makes a provision for displaying keystrokes in the echo area.
2447 /* This function can GC */
2448 struct gcpro gcpro1;
2452 /* #### This sucks bigtime */
2455 XCONSOLE(Vselected_console)->command_builder), 0);
2458 event = Fnext_event(event, prompt);
2459 if (command_event_p(event)) {
2462 execute_internal_event(event);
2469 DEFUN("dispatch-non-command-events", Fdispatch_non_command_events, 0, 0, 0, /*
2470 Dispatch any pending "magic" events.
2472 This function is useful for forcing the redisplay of native
2473 widgets. Normally these are redisplayed through a native window-system
2474 event encoded as magic event, rather than by the redisplay code. This
2475 function does not call redisplay or do any of the other things that
2480 /* This function can GC */
2481 Lisp_Object event = Qnil;
2482 struct gcpro gcpro1;
2485 event = Fmake_event(Qnil, Qnil);
2487 /* Make sure that there will be something in the native event queue
2488 so that externally managed things (e.g. widgets) get some CPU
2490 event_stream_force_event_pending(selected_frame());
2492 while (event_stream_event_pending_p(0)) {
2493 /* next_event_internal() does not QUIT. */
2496 /* We're a generator of the command_event_queue, so we can't be
2497 a consumer as well. Also, we have no reason to consult the
2498 command_event_queue; there are only user and eval-events
2499 there, and we'd just have to put them back anyway.
2502 next_event_internal(event, 0);
2503 /* See the comment in accept-process-output about Vquit_flag */
2504 if (XEVENT_TYPE(event) == magic_event ||
2505 XEVENT_TYPE(event) == timeout_event ||
2506 XEVENT_TYPE(event) == process_event ||
2507 XEVENT_TYPE(event) == pointer_motion_event) {
2508 execute_internal_event(event);
2510 enqueue_command_event_1(event);
2515 Fdeallocate_event(event);
2521 reset_current_events(struct command_builder *command_builder)
2523 Lisp_Object event = command_builder->current_events;
2524 reset_command_builder_event_chain(command_builder);
2525 if (EVENTP(event)) {
2526 deallocate_event_chain(event);
2531 DEFUN("discard-input", Fdiscard_input, 0, 0, 0, /*
2532 Discard any pending "user" events.
2533 Also cancel any kbd macro being defined.
2534 A user event is a key press, button press, button release, or
2535 "misc-user" event (menu selection or scrollbar action).
2539 /* This throws away user-input on the queue, but doesn't process any
2540 events. Calling dispatch_event() here leads to a race condition.
2542 Lisp_Object event = Fmake_event(Qnil, Qnil);
2543 #ifndef EF_USE_ASYNEQ
2544 Lisp_Object head = Qnil;
2545 Lisp_Object tail = Qnil;
2547 Lisp_Object oiq = Vinhibit_quit;
2548 struct gcpro gcpro1, gcpro2;
2549 /* #### not correct here with Vselected_console? Should
2550 discard-input take a console argument, or maybe map over
2552 struct console *con = XCONSOLE(Vselected_console);
2554 /* next_event_internal() can cause arbitrary Lisp code to be evalled */
2557 /* If a macro was being defined then we have to mark the modeline
2558 has changed to ensure that it gets updated correctly. */
2559 if (!NILP(con->defining_kbd_macro)) {
2560 MARK_MODELINE_CHANGED;
2562 con->defining_kbd_macro = Qnil;
2563 reset_current_events(XCOMMAND_BUILDER(con->command_builder));
2565 #ifdef EF_USE_ASYNEQ
2567 WITH_DLLIST_TRAVERSE(
2569 sxe_event_t *ev = dllist_item;
2570 if (command_event_p((Lisp_Object)ev)) {
2571 dllist_pop_inner(eq_queue(asyneq), _el);
2574 while (!EQ_EMPTY_P() || event_stream_event_pending_p(1)) {
2575 /* This will take stuff off the command_event_queue, or read it
2576 from the event_stream, but it will not block. */
2577 next_event_internal(event, 1);
2579 /* Treat C-g as a user event (ignore it). It is vitally
2580 important that we reset Vquit_flag here. Otherwise, if we're
2581 reading from a TTY console, maybe_read_quit_event() will
2582 notice that C-g has been set and send us another C-g. That
2583 will cause us to get right back here, and read another C-g,
2587 /* If the event is a user event, ignore it. */
2588 if (!command_event_p(event)) {
2589 /* Otherwise, chain the event onto our list of events
2590 not to ignore, and keep reading until the queue is
2591 empty. This does not mean that if a subprocess is
2592 generating an infinite amount of output, we will
2593 never terminate (*provided* that the behavior of
2594 next_event_cb() is correct -- see the comment in
2595 events.h), because this loop ends as soon as there
2596 are no more user events on the command_event_queue or
2599 enqueue_event(Fcopy_event(event, Qnil), &head, &tail);
2603 if (!EQ_EMPTY_P() || EQ_LARGE_P()) {
2607 /* Now tack our chain of events back on to the front of the queue.
2608 Actually, since the queue is now drained, we can just replace it.
2609 The effect of this will be that we have deleted all user events
2610 from the input stream without changing the relative ordering of
2611 any other events. (Some events may have been taken from the
2612 event_stream and added to the command_event_queue, however.)
2614 At this time, the command_event_queue will contain only eval_events.
2616 command_event_queue = head;
2617 command_event_queue_tail = tail;
2620 Fdeallocate_event(event);
2623 Vinhibit_quit = oiq;
2627 /**********************************************************************/
2628 /* pausing until an action occurs */
2629 /**********************************************************************/
2631 /* This is used in accept-process-output, sleep-for and sit-for.
2632 Before running any process_events in these routines, we set
2633 recursive_sit_for to Qt, and use this unwind protect to reset it to
2634 Qnil upon exit. When recursive_sit_for is Qt, calling sit-for will
2635 cause it to return immediately.
2637 All of these routines install timeouts, so we clear the installed
2640 Note: It's very easy to break the desired behaviors of these
2641 3 routines. If you make any changes to anything in this area, run
2642 the regression tests at the bottom of the file. -- dmoore */
2644 static Lisp_Object sit_for_unwind(Lisp_Object timeout_id)
2646 if (!NILP(timeout_id)) {
2647 Fdisable_timeout(timeout_id);
2650 recursive_sit_for = Qnil;
2654 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)?
2657 DEFUN("accept-process-output", Faccept_process_output, 0, 3, 0, /*
2658 Allow any pending output from subprocesses to be read by Emacs.
2659 It is read into the process' buffers or given to their filter functions.
2660 Non-nil arg PROCESS means do not return until some output has been received
2661 from PROCESS. Nil arg PROCESS means do not return until some output has
2662 been received from any process.
2664 If the second arg is non-nil, it is the maximum number of seconds to wait:
2665 this function will return after that much time even if no input has arrived
2666 from PROCESS. This argument may be a float, meaning wait some fractional
2669 If the third arg is non-nil, it is a number of milliseconds that is added
2670 to the second arg. (This exists only for compatibility.)
2671 Return non-nil iff we received any output before the timeout expired.
2673 (process, timeout_secs, timeout_msecs))
2675 /* This function can GC */
2676 struct gcpro gcpro1, gcpro2;
2677 Lisp_Object event = Qnil;
2678 Lisp_Object result = Qnil;
2679 int timeout_id = -1;
2680 int timeout_enabled = 0;
2682 struct buffer *old_buffer = current_buffer;
2685 /* We preserve the current buffer but nothing else. If a focus
2686 change alters the selected window then the top level event loop
2687 will eventually alter current_buffer to match. In the mean time
2688 we don't want to mess up whatever called this function. */
2690 if (!NILP(process)) {
2691 CHECK_PROCESS(process);
2694 GCPRO2(event, process);
2696 if (!NILP(timeout_secs) || !NILP(timeout_msecs)) {
2697 unsigned long msecs = 0;
2699 if (!NILP(timeout_secs)) {
2700 msecs = lisp_number_to_milliseconds(timeout_secs, 1);
2702 if (!NILP(timeout_msecs)) {
2703 CHECK_NATNUM(timeout_msecs);
2704 msecs += XINT(timeout_msecs);
2708 event_stream_generate_wakeup(
2709 msecs, 0, Qnil, Qnil, 0);
2710 timeout_enabled = 1;
2714 event = Fmake_event(Qnil, Qnil);
2716 count = specpdl_depth();
2717 record_unwind_protect(
2718 sit_for_unwind, timeout_enabled ? make_int(timeout_id) : Qnil);
2719 recursive_sit_for = Qt;
2722 ((NILP(process) && timeout_enabled) ||
2723 (NILP(process) && event_stream_event_pending_p(0)) ||
2724 (!NILP(process)))) {
2725 /* Calling detect_input_pending() is the wrong thing here,
2726 because that considers the Vunread_command_events and
2727 command_event_queue. We don't need to look at the
2728 command_event_queue because we are only interested in process
2729 events, which don't go on that. In fact, we can't read from
2730 it anyway, because we put stuff on it.
2732 Note that event_stream->event_pending_p must be called in
2733 such a way that it says whether any events *of any kind* are
2734 ready, not just user events, or (accept-process-output nil)
2735 will fail to dispatch any process events that may be on the
2736 queue. It is not clear to me that this is important, because
2737 the top-level loop will process it, and I don't think that
2738 there is ever a time when one calls accept-process-output
2739 with a nil argument and really need the processes to be
2742 /* If our timeout has arrived, we move along. */
2744 && !event_stream_wakeup_pending_p(timeout_id, 0)) {
2745 timeout_enabled = 0;
2747 /* Don't call next_event_internal */
2751 /* next_event_internal() does not QUIT, so check
2752 for ^G before reading output from the process
2753 - this makes it less likely that the filter
2754 will actually be aborted. */
2757 next_event_internal(event, 0);
2758 /* If C-g was pressed while we were waiting, Vquit_flag got set
2759 and next_event_internal() also returns C-g. When we enqueue
2760 the C-g below, it will get discarded. The next time through,
2761 QUIT will be called and will signal a quit. */
2762 switch (XEVENT_TYPE(event)) {
2764 if (NILP(process) ||
2765 EQ(XEVENT(event)->event.process.process,
2768 /* RMS's version always returns nil when
2769 proc is nil, and only returns t if
2770 input ever arrived on proc. */
2774 execute_internal_event(event);
2778 /* We execute the event even if it's ours, and notice
2779 that it's happened above. */
2780 case pointer_motion_event:
2782 execute_internal_event(event);
2785 /* just list the other events here */
2787 case key_press_event:
2788 case button_press_event:
2789 case button_release_event:
2790 case misc_user_event:
2791 case magic_eval_event:
2793 #ifdef EF_USE_ASYNEQ
2794 case eaten_myself_event:
2795 case work_started_event:
2796 case work_finished_event:
2797 #endif /* EF_USE_ASYNEQ */
2800 enqueue_command_event_1(event);
2805 unbind_to(count, timeout_enabled ? make_int(timeout_id) : Qnil);
2807 Fdeallocate_event(event);
2809 current_buffer = old_buffer;
2813 DEFUN("sleep-for", Fsleep_for, 1, 1, 0, /*
2814 Pause, without updating display, for SECONDS seconds.
2815 SECONDS may be a float, allowing pauses for fractional parts of a second.
2817 It is recommended that you never call sleep-for from inside of a process
2818 filter function or timer event (either synchronous or asynchronous).
2822 /* This function can GC */
2823 unsigned long msecs = lisp_number_to_milliseconds(seconds, 1);
2825 Lisp_Object event = Qnil;
2827 struct gcpro gcpro1;
2831 id = event_stream_generate_wakeup(msecs, 0, Qnil, Qnil, 0);
2832 event = Fmake_event(Qnil, Qnil);
2834 count = specpdl_depth();
2835 record_unwind_protect(sit_for_unwind, make_int(id));
2836 recursive_sit_for = Qt;
2839 /* If our timeout has arrived, we move along. */
2840 if (!event_stream_wakeup_pending_p(id, 0)) {
2844 /* next_event_internal() does not QUIT, so check for ^G before
2845 reading output from the process - this makes it less likely
2846 that the filter will actually be aborted.
2850 /* We're a generator of the command_event_queue, so we can't be
2851 a consumer as well. We don't care about command and
2854 next_event_internal(event, 0); /* blocks */
2855 /* See the comment in accept-process-output about Vquit_flag */
2856 switch (XEVENT_TYPE(event)) {
2858 /* We execute the event even if it's ours, and notice
2859 that it's happened above. */
2861 case pointer_motion_event:
2863 execute_internal_event(event);
2866 /* just list the other events here */
2868 case key_press_event:
2869 case button_press_event:
2870 case button_release_event:
2871 case magic_eval_event:
2873 case misc_user_event:
2874 #ifdef EF_USE_ASYNEQ
2875 case eaten_myself_event:
2876 case work_started_event:
2877 case work_finished_event:
2878 #endif /* EF_USE_ASYNEQ */
2881 enqueue_command_event_1(event);
2886 unbind_to(count, make_int(id));
2887 Fdeallocate_event(event);
2892 DEFUN("sit-for", Fsit_for, 1, 2, 0, /*
2893 Perform redisplay, then wait SECONDS seconds or until user input is available.
2894 SECONDS may be a float, meaning a fractional part of a second.
2895 Optional second arg NODISPLAY non-nil means don't redisplay; just wait.
2896 Redisplay is preempted as always if user input arrives, and does not
2897 happen if input is available before it starts.
2898 Value is t if waited the full time with no input arriving.
2900 If sit-for is called from within a process filter function or timer
2901 event (either synchronous or asynchronous) it will return immediately.
2903 (seconds, nodisplay))
2905 /* This function can GC */
2906 unsigned long msecs = lisp_number_to_milliseconds(seconds, 1);
2907 Lisp_Object event, result;
2908 struct gcpro gcpro1;
2912 /* The unread-command-events count as pending input */
2913 if (!NILP(Vunread_command_events) || !NILP(Vunread_command_event)) {
2917 /* If the command-builder already has user-input on it (not eval events)
2918 then that means we're done too.
2920 if (!EQ_EMPTY_P()) {
2921 #if defined(EF_USE_ASYNEQ)
2924 if (command_event_p(event)) {
2925 RETURN_FROM_EQ_TRAVERSE(asyneq, Qnil);
2928 EVENT_CHAIN_LOOP(event, command_event_queue) {
2929 if (command_event_p(event))
2935 /* If we're in a macro, or noninteractive, or early in temacs, then
2937 if (noninteractive || !NILP(Vexecuting_macro)) {
2941 /* Recursive call from a filter function or timeout handler. */
2942 if (!NILP(recursive_sit_for)) {
2943 if (!event_stream_event_pending_p(1) && NILP(nodisplay)) {
2944 run_pre_idle_hook();
2950 /* Otherwise, start reading events from the event_stream.
2951 Do this loop at least once even if (sit-for 0) so that we
2952 redisplay when no input pending.
2955 event = Fmake_event(Qnil, Qnil);
2957 /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc.
2958 events get processed. The old (pre-19.12) code special-cased this
2959 and didn't generate a wakeup, but the resulting behavior was less
2960 than ideal; viz. the occurrence of (sit-for 0.001) scattered
2961 throughout the E-Lisp universe. */
2963 id = event_stream_generate_wakeup(msecs, 0, Qnil, Qnil, 0);
2965 count = specpdl_depth();
2966 record_unwind_protect(sit_for_unwind, make_int(id));
2967 recursive_sit_for = Qt;
2970 /* If there is no user input pending, then redisplay. */
2971 if (!event_stream_event_pending_p(1) && NILP(nodisplay)) {
2972 run_pre_idle_hook();
2976 /* If our timeout has arrived, we move along. */
2977 if (!event_stream_wakeup_pending_p(id, 0)) {
2982 /* next_event_internal() does not QUIT, so check for ^G
2983 before reading output from the process - this makes it
2984 less likely that the filter will actually be aborted. */
2987 /* We're a generator of the command_event_queue, so we can't be
2988 a consumer as well. In fact, we know there's nothing on the
2989 command_event_queue that we didn't just put there. */
2990 next_event_internal(event, 0); /* blocks */
2991 /* See the comment in accept-process-output about Vquit_flag */
2993 if (command_event_p(event)) {
2994 QUIT; /* If the command was C-g check it here
2995 so that we abort out of the sit-for,
2996 not the next command. sleep-for and
2997 accept-process-output continue looping
2998 so they check QUIT again implicitly. */
3003 switch (XEVENT_TYPE(event)) {
3005 /* eval-events get delayed until later. */
3006 enqueue_command_event(Fcopy_event(event, Qnil));
3010 /* We execute the event even if it's ours, and notice
3011 that it's happened above. */
3013 /* just list the rest here too */
3015 case key_press_event:
3016 case button_press_event:
3017 case button_release_event:
3018 case pointer_motion_event:
3021 case magic_eval_event:
3022 case misc_user_event:
3023 #ifdef EF_USE_ASYNEQ
3024 case eaten_myself_event:
3025 case work_started_event:
3026 case work_finished_event:
3027 #endif /* EF_USE_ASYNEQ */
3030 execute_internal_event(event);
3036 unbind_to(count, make_int(id));
3038 /* Put back the event (if any) that made Fsit_for() exit before the
3039 timeout. Note that it is being added to the back of the queue, which
3040 would be inappropriate if there were any user events on the queue
3041 already: we would be misordering them. But we know that there are
3042 no user-events on the queue, or else we would not have reached this
3046 enqueue_command_event(event);
3048 Fdeallocate_event(event);
3055 /* This handy little function is used by select-x.c to wait for replies
3056 from processes that aren't really processes (e.g. the X server) */
3058 wait_delaying_user_input(int (*predicate) (void *arg), void *predicate_arg)
3060 /* This function can GC */
3061 Lisp_Object event = Fmake_event(Qnil, Qnil);
3062 struct gcpro gcpro1;
3065 while (!(*predicate) (predicate_arg)) {
3066 /* next_event_internal() does not QUIT. */
3069 /* We're a generator of the command_event_queue, so we can't be
3070 a consumer as well. Also, we have no reason to consult the
3071 command_event_queue; there are only user and eval-events
3072 there, and we'd just have to put them back anyway.
3074 next_event_internal(event, 0);
3075 /* See the comment in accept-process-output about Vquit_flag */
3076 if (command_event_p(event)
3077 || (XEVENT_TYPE(event) == eval_event)
3078 || (XEVENT_TYPE(event) == magic_eval_event)) {
3079 enqueue_command_event_1(event);
3081 execute_internal_event(event);
3088 /**********************************************************************/
3089 /* dispatching events; command builder */
3090 /**********************************************************************/
3093 execute_internal_event(Lisp_Object event)
3095 /* events on dead channels get silently eaten */
3096 if (object_dead_p(XEVENT(event)->channel)) {
3100 /* This function can GC */
3101 switch (XEVENT_TYPE(event)) {
3106 call1(XEVENT(event)->event.eval.function,
3107 XEVENT(event)->event.eval.object);
3110 case magic_eval_event:
3111 (XEVENT(event)->event.magic_eval.internal_function)
3112 (XEVENT(event)->event.magic_eval.object);
3115 case pointer_motion_event:
3116 if (!NILP(Vmouse_motion_handler)) {
3117 call1(Vmouse_motion_handler, event);
3121 case process_event: {
3122 Lisp_Object p = XEVENT(event)->event.process.process;
3123 Charcount readstatus;
3125 assert(PROCESSP(p));
3126 while ((readstatus = read_process_output(p)) > 0) ;
3127 /* this clause never gets executed but allows the
3128 #ifdefs to work cleanly. */
3129 if (readstatus > 0) {
3132 } else if (readstatus == -1 && errno == EWOULDBLOCK) {
3134 #endif /* EWOULDBLOCK */
3136 } else if (readstatus == -1 && errno == EAGAIN) {
3139 } else if ((readstatus == 0 &&
3140 /* Note that we cannot distinguish between no
3141 input available now and a closed pipe.
3142 With luck, a closed pipe will be
3143 accompanied by subprocess termination and
3145 (!network_connection_p(p) ||
3147 When connected to ToolTalk (i.e.
3148 connected_via_filedesc_p()), it's not
3149 possible to reliably determine whether
3150 there is a message waiting for ToolTalk to
3151 receive. ToolTalk expects to have
3152 tt_message_receive() called exactly once
3153 every time the file descriptor becomes
3154 active, so the filter function forces this
3155 by returning 0. Emacs must not interpret
3156 this as a closed pipe.
3158 We don't do ToolTalk anymore, but come
3159 back and revisit this for D-Bus */
3160 connected_via_filedesc_p(XPROCESS(p))))
3162 /* On some OSs with ptys, when the process on
3163 one end of a pty exits, the other end gets
3164 an error reading with errno = EIO instead of
3165 getting an EOF (0 bytes read). Therefore,
3166 if we get an error reading and errno = EIO,
3167 just continue, because the child process has
3168 exited and should clean itself up soon
3169 (e.g. when we get a SIGCHLD). */
3170 || (readstatus == -1 && errno == EIO)
3173 /* Currently, we rely on SIGCHLD to indicate
3174 that the process has terminated.
3175 Unfortunately, on some systems the SIGCHLD
3176 gets missed some of the time. So we put an
3177 additional check in status_notify() to see
3178 whether a process has terminated. We must
3179 tell status_notify() to enable that check,
3180 and we do so now. */
3181 kick_status_notify();
3184 /* Deactivate network connection */
3185 Lisp_Object status = Fprocess_status(p);
3186 if (EQ(status, Qopen)
3187 /* In case somebody changes the theory of
3188 whether to return open as opposed to run
3189 for network connection "processes"... */
3190 || EQ(status, Qrun)) {
3191 update_process_status(p, Qexit, 256, 0);
3193 deactivate_process(p);
3196 /* We must call status_notify here to allow the
3197 event_stream->unselect_process_cb to be run if appropriate.
3198 Otherwise, dead fds may be selected for, and we will get a
3199 continuous stream of process events for them. Since we don't
3200 return until all process events have been flushed, we would
3201 get stuck here, processing events on a process whose status
3202 was 'exit. Call this after dispatch-event, or the fds will
3203 have been closed before we read the last data from them.
3204 It's safe for the filter to signal an error because
3205 status_notify() will be called on return to top-level.
3211 case timeout_event: {
3212 Lisp_Event *e = XEVENT(event);
3213 if (!NILP(e->event.timeout.function)) {
3214 call1(e->event.timeout.function,
3215 e->event.timeout.object);
3221 event_stream_handle_magic_event(XEVENT(event));
3224 #ifdef EF_USE_ASYNEQ
3225 case eaten_myself_event: {
3226 /* try to find the worker in the workers dllist and pop it */
3228 Lisp_Event *ev = XEVENT(event);
3230 /* since this affects garbage collection, we better lock that
3233 WITH_DLLIST_TRAVERSE(
3235 if (ev->event.eaten_myself.worker == dllist_item) {
3236 dllist_pop_inner(workers, _el);
3240 fini_worker(ev->event.eaten_myself.worker);
3241 EQUEUE_DEBUG_WORKER("Successfully eaten 0x%lx\n",
3243 ev->event.eaten_myself.worker);
3246 case work_started_event: {
3247 Lisp_Event *ev = XEVENT(event);
3248 Lisp_Object ljob = ev->event.work_started.job;
3249 worker_job_t job = XWORKER_JOB(ljob);
3250 work_handler_t hdl = XWORKER_JOB_HANDLER(ljob);
3251 if (hdl && work_started(hdl)) {
3252 work_started(hdl)(job);
3256 case work_finished_event: {
3257 Lisp_Event *ev = XEVENT(event);
3258 Lisp_Object ljob = ev->event.work_finished.job;
3259 worker_job_t job = XWORKER_JOB(ljob);
3260 work_handler_t hdl = XWORKER_JOB_HANDLER(ljob);
3261 if (hdl && work_finished(hdl)) {
3262 work_finished(hdl)(job);
3266 #endif /* EF_USE_ASYNEQ */
3268 /* not sure about the next ones, but they've
3269 * always been unhandled and so be they ... */
3270 case key_press_event:
3271 case button_press_event:
3272 case button_release_event:
3273 case misc_user_event:
3274 /* and now the ones i'm quite sure about */
3284 this_command_keys_replace_suffix(Lisp_Object suffix, Lisp_Object chain)
3286 Lisp_Object first_before_suffix =
3287 event_chain_find_previous(Vthis_command_keys, suffix);
3289 if (NILP(first_before_suffix)) {
3290 Vthis_command_keys = chain;
3292 XSET_EVENT_NEXT(first_before_suffix, chain);
3294 deallocate_event_chain(suffix);
3295 Vthis_command_keys_tail = event_chain_tail(chain);
3300 command_builder_replace_suffix(struct command_builder *builder,
3301 Lisp_Object suffix, Lisp_Object chain)
3303 Lisp_Object first_before_suffix =
3304 event_chain_find_previous(builder->current_events, suffix);
3306 if (NILP(first_before_suffix)) {
3307 builder->current_events = chain;
3309 XSET_EVENT_NEXT(first_before_suffix, chain);
3311 deallocate_event_chain(suffix);
3312 builder->most_current_event = event_chain_tail(chain);
3317 command_builder_find_leaf_1(struct command_builder *builder)
3319 Lisp_Object event0 = builder->current_events;
3324 return event_binding(event0, 1);
3327 /* See if we can do function-key-map or key-translation-map translation
3328 on the current events in the command builder. If so, do this, and
3329 return the resulting binding, if any. */
3332 munge_keymap_translate(struct command_builder *builder,
3333 enum munge_me_out_the_door munge,
3334 int has_normal_binding_p)
3339 suffix, builder->munge_me[munge].first_mungeable_event) {
3340 Lisp_Object result =
3341 munging_key_map_event_binding(suffix, munge);
3347 if (KEYMAPP(result)) {
3348 if (NILP(builder->last_non_munged_event) &&
3349 !has_normal_binding_p) {
3350 builder->last_non_munged_event =
3351 builder->most_current_event;
3354 builder->last_non_munged_event = Qnil;
3357 if (!KEYMAPP(result) && !VECTORP(result) && !STRINGP(result)) {
3358 struct gcpro gcpro1;
3360 result = call1(result, Qnil);
3367 if (KEYMAPP(result)) {
3371 if (VECTORP(result) || STRINGP(result)) {
3372 Lisp_Object new_chain =
3373 key_sequence_to_event_chain(result);
3377 /* If the first_mungeable_event of the other munger is
3378 within the events we're munging, then it will point
3379 to deallocated events afterwards, which is bad -- so
3380 make it point at the beginning of the munged
3382 EVENT_CHAIN_LOOP(tempev, suffix) {
3383 Lisp_Object *mungeable_event =
3384 &builder->munge_me[1 - munge].
3385 first_mungeable_event;
3386 if (EQ(tempev, *mungeable_event)) {
3387 *mungeable_event = new_chain;
3392 n = event_chain_count(suffix);
3393 command_builder_replace_suffix(
3394 builder, suffix, new_chain);
3395 builder->munge_me[munge].first_mungeable_event = Qnil;
3396 /* Now hork this-command-keys as well. */
3398 /* We just assume that the events we just replaced are
3399 sitting in copied form at the end of
3400 this-command-keys. If the user did weird things with
3401 `dispatch-event' this may not be the case, but at
3402 least we make sure we won't crash. */
3403 new_chain = copy_event_chain(new_chain);
3404 tckn = event_chain_count(Vthis_command_keys);
3406 this_command_keys_replace_suffix(
3408 Vthis_command_keys, tckn - n),
3412 result = command_builder_find_leaf_1(builder);
3416 signal_simple_error((munge == MUNGE_ME_FUNCTION_KEY ?
3417 "Invalid binding in function-key-map" :
3418 "Invalid binding in key-translation-map"),
3425 /* Compare the current state of the command builder against the local and
3426 global keymaps, and return the binding. If there is no match, try again,
3427 case-insensitively. The return value will be one of:
3428 -- nil (there is no binding)
3429 -- a keymap (part of a command has been specified)
3430 -- a command (anything that satisfies `commandp'; this includes
3431 some symbols, lists, subrs, strings, vectors, and
3432 compiled-function objects)
3435 command_builder_find_leaf(struct command_builder *builder,
3436 int allow_misc_user_events_p)
3438 /* This function can GC */
3440 Lisp_Object evee = builder->current_events;
3442 if (XEVENT_TYPE(evee) == misc_user_event) {
3443 if (allow_misc_user_events_p && (NILP(XEVENT_NEXT(evee)))) {
3444 return list2(XEVENT(evee)->event.eval.function,
3445 XEVENT(evee)->event.eval.object);
3451 /* if we're currently in a menu accelerator, check there for further
3453 /* #### fuck me! who wrote this crap? think "abstraction", baby. */
3454 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3455 if (x_kludge_lw_menu_active()) {
3456 return command_builder_operate_menu_accelerator(builder);
3459 if (EQ(Vmenu_accelerator_enabled, Qmenu_force)) {
3460 result = command_builder_find_menu_accelerator(builder);
3463 #endif /* X_WINDOWS && LWLIB_MENUBARS_LUCID */
3464 result = command_builder_find_leaf_1(builder);
3465 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3468 EQ(Vmenu_accelerator_enabled, Qmenu_fallback)) {
3469 result = command_builder_find_menu_accelerator(builder);
3472 #endif /* X_WINDOWS && LWLIB_MENUBARS_LUCID */
3474 /* Check to see if we have a potential function-key-map match. */
3477 munge_keymap_translate(builder, MUNGE_ME_FUNCTION_KEY, 0);
3478 regenerate_echo_keys_from_this_command_keys(builder);
3480 /* Check to see if we have a potential key-translation-map match. */
3482 Lisp_Object key_translate_result =
3483 munge_keymap_translate(builder, MUNGE_ME_KEY_TRANSLATION,
3485 if (!NILP(key_translate_result)) {
3486 result = key_translate_result;
3487 regenerate_echo_keys_from_this_command_keys(builder);
3491 if (!NILP(result)) {
3495 /* If key-sequence wasn't bound, we'll try some fallbacks. */
3497 /* If we didn't find a binding, and the last event in the sequence is
3498 a shifted character, then try again with the lowercase version. */
3500 if (XEVENT_TYPE(builder->most_current_event) == key_press_event
3501 && !NILP(Vretry_undefined_key_binding_unshifted)) {
3502 Lisp_Object terminal = builder->most_current_event;
3503 struct key_data *key = &XEVENT(terminal)->event.key;
3505 if ((key->modifiers & XEMACS_MOD_SHIFT) ||
3506 (CHAR_OR_CHAR_INTP(key->keysym) &&
3507 ((c = XCHAR_OR_CHAR_INT(key->keysym)),
3508 (c >= 'A' && c <= 'Z')))) {
3509 Lisp_Event terminal_copy = *XEVENT(terminal);
3511 if (key->modifiers & XEMACS_MOD_SHIFT) {
3512 key->modifiers &= (~XEMACS_MOD_SHIFT);
3514 key->keysym = make_char(c + 'a' - 'A');
3516 result = command_builder_find_leaf(
3517 builder, allow_misc_user_events_p);
3519 if (!NILP(result)) {
3522 /* If there was no match with the lower-case version
3523 either, then put back the upper-case event for the
3524 error message. But make sure that function-key-map
3525 didn't change things out from under us. */
3526 if (EQ(terminal, builder->most_current_event)) {
3527 *XEVENT(terminal) = terminal_copy;
3532 /* help-char is `auto-bound' in every keymap */
3533 if (!NILP(Vprefix_help_command) &&
3534 event_matches_key_specifier_p(
3535 XEVENT(builder->most_current_event), Vhelp_char)) {
3536 return Vprefix_help_command;
3540 /* If keysym is a non-ASCII char, bind it to self-insert-char by
3542 if (XEVENT_TYPE(builder->most_current_event) == key_press_event &&
3543 !NILP(Vcomposed_character_default_binding)) {
3544 Lisp_Object keysym =
3545 XEVENT(builder->most_current_event)->event.key.keysym;
3546 if (CHARP(keysym) && !CHAR_ASCII_P(XCHAR(keysym))) {
3547 return Vcomposed_character_default_binding;
3550 #endif /* HAVE_XIM */
3552 /* If we read extra events attempting to match a function key but end
3553 up failing, then we release those events back to the command loop
3554 and fail on the original lookup. The released events will then be
3555 reprocessed in the context of the first part having failed. */
3556 if (!NILP(builder->last_non_munged_event)) {
3557 Lisp_Object event0 = builder->last_non_munged_event;
3559 /* Put the commands back on the event queue. */
3560 #ifdef EF_USE_ASYNEQ
3561 eq_enqueue_event_chain(asyneq, XEVENT_NEXT(event0));
3563 enqueue_event_chain(XEVENT_NEXT(event0),
3564 &command_event_queue,
3565 &command_event_queue_tail);
3567 /* Then remove them from the command builder. */
3568 XSET_EVENT_NEXT(event0, Qnil);
3569 builder->most_current_event = event0;
3570 builder->last_non_munged_event = Qnil;
3576 /* Every time a command-event (a key, button, or menu selection) is read by
3577 Fnext_event(), it is stored in the recent_keys_ring, in Vlast_input_event,
3578 and in Vthis_command_keys. (Eval-events are not stored there.)
3580 Every time a command is invoked, Vlast_command_event is set to the last
3581 event in the sequence.
3583 This means that Vthis_command_keys is really about "input read since the
3584 last command was executed" rather than about "what keys invoked this
3585 command." This is a little counterintuitive, but that's the way it
3588 As an extra kink, the function read-key-sequence resets/updates the
3589 last-command-event and this-command-keys. It doesn't append to the
3590 command-keys as read-char does. Such are the pitfalls of having to
3591 maintain compatibility with a program for which the only specification
3594 (We could implement recent_keys_ring and Vthis_command_keys as the same
3598 DEFUN("recent-keys", Frecent_keys, 0, 1, 0, /*
3599 Return a vector of recent keyboard or mouse button events read.
3600 If NUMBER is non-nil, not more than NUMBER events will be returned.
3601 Change number of events stored using `set-recent-keys-ring-size'.
3603 This copies the event objects into a new vector; it is safe to keep and
3608 struct gcpro gcpro1;
3609 Lisp_Object val = Qnil;
3611 int start, nkeys, i, j;
3615 nwanted = recent_keys_ring_size;
3617 CHECK_NATNUM(number);
3618 nwanted = XINT(number);
3621 /* Create the keys ring vector, if none present. */
3622 if (NILP(Vrecent_keys_ring)) {
3623 Vrecent_keys_ring = make_vector(recent_keys_ring_size, Qnil);
3624 /* And return nothing in particular. */
3625 RETURN_UNGCPRO(make_vector(0, Qnil));
3628 if (NILP(XVECTOR_DATA(Vrecent_keys_ring)[recent_keys_ring_index])) {
3629 /* This means the vector has not yet wrapped */
3630 nkeys = recent_keys_ring_index;
3633 nkeys = recent_keys_ring_size;
3634 start = ((recent_keys_ring_index == nkeys)
3635 ? 0 : recent_keys_ring_index);
3638 if (nwanted < nkeys) {
3639 start += nkeys - nwanted;
3640 if (start >= recent_keys_ring_size) {
3641 start -= recent_keys_ring_size;
3648 val = make_vector(nwanted, Qnil);
3650 for (i = 0, j = start; i < nkeys; i++) {
3651 Lisp_Object e = XVECTOR_DATA(Vrecent_keys_ring)[j];
3656 XVECTOR_DATA(val)[i] = Fcopy_event(e, Qnil);
3657 if (++j >= recent_keys_ring_size) {
3665 DEFUN("recent-keys-ring-size", Frecent_keys_ring_size, 0, 0, 0, /*
3666 The maximum number of events `recent-keys' can return.
3670 return make_int(recent_keys_ring_size);
3673 DEFUN("set-recent-keys-ring-size", Fset_recent_keys_ring_size, 1, 1, 0, /*
3674 Set the maximum number of events to be stored internally.
3678 Lisp_Object new_vector = Qnil;
3679 int i, j, nkeys, start, min;
3680 struct gcpro gcpro1;
3683 if (XINT(size) <= 0) {
3684 error("Recent keys ring size must be positive");
3686 if (XINT(size) == recent_keys_ring_size) {
3691 new_vector = make_vector(XINT(size), Qnil);
3693 if (NILP(Vrecent_keys_ring)) {
3694 Vrecent_keys_ring = new_vector;
3695 RETURN_UNGCPRO(size);
3698 if (NILP(XVECTOR_DATA(Vrecent_keys_ring)[recent_keys_ring_index])) {
3699 /* This means the vector has not yet wrapped */
3700 nkeys = recent_keys_ring_index;
3703 nkeys = recent_keys_ring_size;
3704 start = ((recent_keys_ring_index == nkeys)
3705 ? 0 : recent_keys_ring_index);
3708 if (XINT(size) > nkeys) {
3714 for (i = 0, j = start; i < min; i++) {
3715 XVECTOR_DATA(new_vector)[i] =
3716 XVECTOR_DATA(Vrecent_keys_ring)[j];
3717 if (++j >= recent_keys_ring_size) {
3721 recent_keys_ring_size = XINT(size);
3722 recent_keys_ring_index = (i < recent_keys_ring_size) ? i : 0;
3724 Vrecent_keys_ring = new_vector;
3730 /* Vthis_command_keys having value Qnil means that the next time
3731 push_this_command_keys is called, it should start over.
3732 The times at which the command-keys are reset
3733 (instead of merely being augmented) are pretty counterintuitive.
3736 -- We do not reset this-command-keys when we finish reading a
3737 command. This is because some commands (e.g. C-u) act
3738 like command prefixes; they signal this by setting prefix-arg
3740 -- Therefore, we reset this-command-keys when we finish
3741 executing a command, unless prefix-arg is set.
3742 -- However, if we ever do a non-local exit out of a command
3743 loop (e.g. an error in a command), we need to reset
3744 this-command-keys. We do this by calling reset_this_command_keys()
3745 from cmdloop.c, whenever an error causes an invocation of the
3746 default error handler, and whenever there's a throw to top-level.)
3750 reset_this_command_keys(Lisp_Object console, int clear_echo_area_p)
3752 if (!NILP(console)) {
3753 /* console is nil if we just deleted the console as a result of
3754 C-x 5 0. Unfortunately things are currently in a messy
3755 situation where some stuff is console-local and other stuff
3756 isn't, so we need to do everything that's not
3758 struct command_builder *command_builder =
3759 XCOMMAND_BUILDER(XCONSOLE(console)->command_builder);
3761 reset_key_echo(command_builder, clear_echo_area_p);
3762 reset_current_events(command_builder);
3764 reset_key_echo(0, clear_echo_area_p);
3767 deallocate_event_chain(Vthis_command_keys);
3768 Vthis_command_keys = Qnil;
3769 Vthis_command_keys_tail = Qnil;
3773 static void push_this_command_keys(Lisp_Object event)
3775 Lisp_Object new = Fmake_event(Qnil, Qnil);
3777 Fcopy_event(event, new);
3778 enqueue_event(new, &Vthis_command_keys, &Vthis_command_keys_tail);
3782 /* The following two functions are used in call-interactively,
3783 for the @ and e specifications. We used to just use
3784 `current-mouse-event' (i.e. the last mouse event in this-command-keys),
3785 but FSF does it more generally so we follow their lead. */
3787 Lisp_Object extract_this_command_keys_nth_mouse_event(int n)
3791 EVENT_CHAIN_LOOP(event, Vthis_command_keys) {
3793 && (XEVENT_TYPE(event) == button_press_event
3794 || XEVENT_TYPE(event) == button_release_event
3795 || XEVENT_TYPE(event) == misc_user_event)) {
3797 /* must copy to avoid an abort() in
3798 next_event_internal() */
3799 if (!NILP(XEVENT_NEXT(event))) {
3800 return Fcopy_event(event, Qnil);
3813 extract_vector_nth_mouse_event(Lisp_Object vector, int n)
3816 int len = XVECTOR_LENGTH(vector);
3818 for (i = 0; i < len; i++) {
3819 Lisp_Object event = XVECTOR_DATA(vector)[i];
3820 if (EVENTP(event)) {
3821 switch (XEVENT_TYPE(event)) {
3822 case button_press_event:
3823 case button_release_event:
3824 case misc_user_event:
3831 /* the rest of 'em cases */
3833 case key_press_event:
3834 case pointer_motion_event:
3838 case magic_eval_event:
3840 #ifdef EF_USE_ASYNEQ
3841 case eaten_myself_event:
3842 case work_started_event:
3843 case work_finished_event:
3844 #endif /* EF_USE_ASYNEQ */
3856 push_recent_keys(Lisp_Object event)
3860 if (NILP(Vrecent_keys_ring)) {
3861 Vrecent_keys_ring = make_vector(recent_keys_ring_size, Qnil);
3864 e = XVECTOR_DATA(Vrecent_keys_ring)[recent_keys_ring_index];
3867 e = Fmake_event(Qnil, Qnil);
3868 XVECTOR_DATA(Vrecent_keys_ring)[recent_keys_ring_index] = e;
3870 Fcopy_event(event, e);
3871 if (++recent_keys_ring_index == recent_keys_ring_size) {
3872 recent_keys_ring_index = 0;
3878 current_events_into_vector(struct command_builder *command_builder)
3882 int n = event_chain_count(command_builder->current_events);
3884 /* Copy the vector and the events in it. */
3885 /* No need to copy the events, since they're already copies, and
3886 nobody other than the command-builder has pointers to them */
3887 vector = make_vector(n, Qnil);
3889 EVENT_CHAIN_LOOP(event, command_builder->current_events) {
3890 XVECTOR_DATA(vector)[n++] = event;
3892 reset_command_builder_event_chain(command_builder);
3897 Given the current state of the command builder and a new command event
3898 that has just been dispatched:
3900 -- add the event to the event chain forming the current command
3901 (doing meta-translation as necessary)
3902 -- return the binding of this event chain; this will be one of:
3903 -- nil (there is no binding)
3904 -- a keymap (part of a command has been specified)
3905 -- a command (anything that satisfies `commandp'; this includes
3906 some symbols, lists, subrs, strings, vectors, and
3907 compiled-function objects)
3910 lookup_command_event(struct command_builder *command_builder,
3911 Lisp_Object event, int allow_misc_user_events_p)
3913 /* This function can GC */
3914 struct frame *f = selected_frame();
3915 /* Clear output from previous command execution */
3916 if (!EQ(Qcommand, echo_area_status(f))
3917 /* but don't let mouse-up clear what mouse-down just printed */
3918 && (XEVENT(event)->event_type != button_release_event)) {
3919 clear_echo_area(f, Qnil, 0);
3922 /* Add the given event to the command builder.
3923 Extra hack: this also updates the recent_keys_ring and
3924 Vthis_command_keys vectors to translate
3925 "ESC x" to "M-x" (for any "x" of course).
3928 Lisp_Object recent = command_builder->most_current_event;
3930 if (EVENTP(recent) &&
3931 event_matches_key_specifier_p(
3932 XEVENT(recent), Vmeta_prefix_char)) {
3934 /* When we see a sequence like "ESC x", pretend we
3935 really saw "M-x". DoubleThink the recent-keys and
3936 this-command-keys as well. */
3937 /* Modify the previous most-recently-pushed event on the
3938 command builder to be a copy of this one with the
3939 meta-bit set instead of pushing a new event.
3941 Fcopy_event(event, recent);
3943 if (e->event_type == key_press_event) {
3944 e->event.key.modifiers |= XEMACS_MOD_META;
3945 } else if (e->event_type == button_press_event ||
3946 e->event_type == button_release_event) {
3947 e->event.button.modifiers |= XEMACS_MOD_META;
3954 event_chain_count(Vthis_command_keys);
3956 /* ??? very strange if it's < 2. */
3957 this_command_keys_replace_suffix(
3961 Fcopy_event(recent, Qnil));
3965 regenerate_echo_keys_from_this_command_keys(
3968 event = Fcopy_event(event, Fmake_event(Qnil, Qnil));
3969 command_builder_append_event(command_builder, event);
3974 Lisp_Object leaf = command_builder_find_leaf(
3975 command_builder, allow_misc_user_events_p);
3976 struct gcpro gcpro1;
3979 if (KEYMAPP(leaf)) {
3980 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
3981 if (!x_kludge_lw_menu_active())
3986 Lisp_Object prompt = Fkeymap_prompt(leaf, Qt);
3987 if (STRINGP(prompt)) {
3988 /* Append keymap prompt to key echo
3991 command_builder->echo_buf_index;
3992 Bytecount len = XSTRING_LENGTH(prompt);
3994 if (len + buf_index + 1 <=
3995 command_builder->echo_buf_length) {
4001 XSTRING_DATA(prompt),
4005 maybe_echo_keys(command_builder, 1);
4007 maybe_echo_keys(command_builder, 0);
4009 } else if (!NILP(Vquit_flag)) {
4010 Lisp_Object quit_event =
4011 Fmake_event(Qnil, Qnil);
4012 Lisp_Event *e = XEVENT(quit_event);
4013 /* if quit happened during menu acceleration,
4014 pretend we read it */
4015 Lisp_Object tmp = Fselected_console();
4016 struct console *con = XCONSOLE(tmp);
4017 int ch = CONSOLE_QUIT_CHAR(con);
4019 character_to_event(ch, e, con, 1, 1);
4020 e->channel = make_console(con);
4022 enqueue_command_event(quit_event);
4025 } else if (!NILP(leaf)) {
4026 if (EQ(Qcommand, echo_area_status(f)) &&
4027 command_builder->echo_buf_index > 0) {
4028 /* If we had been echoing keys, echo the last
4029 one (without the trailing dash) and redisplay
4030 before executing the command. */
4031 command_builder->echo_buf[command_builder->
4032 echo_buf_index] = 0;
4033 maybe_echo_keys(command_builder, 1);
4034 Fsit_for(Qzero, Qt);
4037 RETURN_UNGCPRO(leaf);
4042 static int is_scrollbar_event(Lisp_Object event)
4044 #ifdef HAVE_SCROLLBARS
4047 if (!EVENTP(event)) {
4050 if (XEVENT(event)->event_type != misc_user_event) {
4053 fun = XEVENT(event)->event.misc.function;
4055 return (EQ(fun, Qscrollbar_line_up) ||
4056 EQ(fun, Qscrollbar_line_down) ||
4057 EQ(fun, Qscrollbar_page_up) ||
4058 EQ(fun, Qscrollbar_page_down) ||
4059 EQ(fun, Qscrollbar_to_top) ||
4060 EQ(fun, Qscrollbar_to_bottom) ||
4061 EQ(fun, Qscrollbar_vertical_drag) ||
4062 EQ(fun, Qscrollbar_char_left) ||
4063 EQ(fun, Qscrollbar_char_right) ||
4064 EQ(fun, Qscrollbar_page_left) ||
4065 EQ(fun, Qscrollbar_page_right) ||
4066 EQ(fun, Qscrollbar_to_left) ||
4067 EQ(fun, Qscrollbar_to_right) ||
4068 EQ(fun, Qscrollbar_horizontal_drag));
4069 #else /* !HAVE_SCROLLBARS */
4071 #endif /* HAVE_SCROLLBARS */
4075 execute_command_event(struct command_builder *cmd_builder, Lisp_Object event)
4077 /* This function can GC */
4078 struct console *con = XCONSOLE(cmd_builder->console);
4079 struct gcpro gcpro1;
4081 /* event may be freshly created */
4084 /* #### This call to is_scrollbar_event() isn't quite right, but
4085 fixing properly it requires more work than can go into 21.4.
4086 (We really need to split out menu, scrollbar, dialog, and other
4087 types of events from misc-user, and put the remaining ones in a
4088 new `user-eval' type that behaves like an eval event but is a
4089 user event and thus has all of its semantics -- e.g. being
4090 delayed during `accept-process-output' and similar wait states.)
4092 The real issue here is that "user events" and "command events"
4093 are not the same thing, but are very much confused in
4094 event-stream.c. User events are, essentially, any event that
4095 should be delayed by accept-process-output, should terminate a
4096 sit-for, etc. -- basically, any event that needs to be processed
4097 synchronously with key and mouse events. Command events are
4098 those that participate in command building; scrollbar events
4099 clearly don't belong because they should be transparent in a
4100 sequence like C-x @ h <scrollbar-drag> x, which used to cause a
4101 crash before checks similar to the is_scrollbar_event() call were
4102 added. Do other events belong with scrollbar events? I'm not
4103 sure; we need to categorize all misc-user events and see what
4104 their semantics are.
4106 (You might ask, why do scrollbar events need to be user events?
4107 That's a good question. The answer seems to be that they can
4108 change point, and having this happen asynchronously would be a
4109 very bad idea. According to the "proper" functioning of
4110 scrollbars, this should not happen, but SXEmacs does not allow
4111 point to go outside of the window.)
4113 Scrollbar events and similar non-command events should obviously
4114 not be recorded in this-command-keys, so we need to check for
4117 #### We call reset_current_events() twice in this function --
4118 #### here, and later as a result of reset_this_command_keys().
4119 #### This is almost certainly wrong; need to figure out what's
4122 #### We need to figure out what's really correct w.r.t. scrollbar
4123 #### events. With these new fixes in, it actually works to do
4124 #### C-x <scrollbar-drag> 5 2, but the key echo gets messed up
4125 #### (starts over at 5). We really need to be special-casing
4126 #### scrollbar events at a lower level, and not really passing
4127 #### them through the command builder at all. (e.g. do scrollbar
4128 #### events belong in macros??? doubtful; probably only the
4129 #### point movement, if any, belongs, special-cased as a
4130 #### pseudo-issued M-x goto-char command). #### Need more work
4131 #### here. Do this when separating out scrollbar events.
4134 if (!is_scrollbar_event(event)) {
4135 reset_current_events(cmd_builder);
4138 switch (XEVENT(event)->event_type) {
4139 case key_press_event:
4140 Vcurrent_mouse_event = Qnil;
4142 case button_press_event:
4143 case button_release_event:
4144 case misc_user_event:
4145 Vcurrent_mouse_event = Fcopy_event(event, Qnil);
4148 /* just list the other cases here */
4150 case pointer_motion_event:
4154 case magic_eval_event:
4156 #ifdef EF_USE_ASYNEQ
4157 case eaten_myself_event:
4158 case work_started_event:
4159 case work_finished_event:
4160 #endif /* EF_USE_ASYNEQ */
4166 /* Store the last-command-event. The semantics of this is that it
4167 is the last event most recently involved in command-lookup. */
4168 if (!EVENTP(Vlast_command_event)) {
4169 Vlast_command_event = Fmake_event(Qnil, Qnil);
4171 if (XEVENT(Vlast_command_event)->event_type == dead_event) {
4172 Vlast_command_event = Fmake_event(Qnil, Qnil);
4173 error("Someone deallocated the last-command-event!");
4176 if (!EQ(event, Vlast_command_event)) {
4177 Fcopy_event(event, Vlast_command_event);
4180 /* Note that last-command-char will never have its high-bit set, in
4181 an effort to sidestep the ambiguity between M-x and oslash. */
4182 Vlast_command_char = Fevent_to_character(
4183 Vlast_command_event, Qnil, Qnil, Qnil);
4185 /* Actually call the command, with all sorts of hair to preserve or clear
4186 the echo-area and region as appropriate and call the pre- and post-
4189 int old_kbd_macro = con->kbd_macro_end;
4190 Lisp_Object tmp = Fselected_window(Qnil);
4191 struct window *w = XWINDOW(tmp);
4193 /* We're executing a new command, so the old value is
4195 zmacs_region_stays = 0;
4197 /* If the previous command tried to force a specific
4198 window-start, reset the flag in case this command moves point
4199 far away from that position. Also, reset the window's
4200 buffer's change information so that we don't trigger an
4201 incremental update. */
4202 if (w->force_start) {
4204 buffer_reset_changes(XBUFFER(w->buffer));
4209 if (XEVENT(event)->event_type == misc_user_event) {
4210 call1(XEVENT(event)->event.eval.function,
4211 XEVENT(event)->event.eval.object);
4213 Fcommand_execute(Vthis_command, Qnil, Qnil);
4216 post_command_hook();
4218 /* Console might have been deleted by command */
4219 if (CONSOLE_LIVE_P(con) && !NILP(con->prefix_arg)) {
4220 /* Commands that set the prefix arg don't update
4221 last-command, don't reset the echoing state, and
4222 don't go into keyboard macros unless followed by
4223 another command. Also don't quit here. */
4224 int speccount = specpdl_depth();
4225 specbind(Qinhibit_quit, Qt);
4226 maybe_echo_keys(cmd_builder, 0);
4227 unbind_to(speccount, Qnil);
4229 /* If we're recording a keyboard macro, and the last
4230 command executed set a prefix argument, then
4231 decrement the pointer to the "last character really
4232 in the macro" to be just before this command. This
4233 is so that the ^U in "^U ^X )" doesn't go onto the
4235 if (!NILP(con->defining_kbd_macro)) {
4236 con->kbd_macro_end = old_kbd_macro;
4239 /* Start a new command next time */
4240 Vlast_command = Vthis_command;
4241 Vlast_command_properties = Vthis_command_properties;
4242 Vthis_command_properties = Qnil;
4244 /* Emacs 18 doesn't unconditionally clear the echoed
4245 keystrokes, so we don't either */
4246 /* who cares about RMSmacs 18? */
4247 if (!is_scrollbar_event(event)) {
4248 reset_this_command_keys(
4259 /* Run the pre command hook. */
4262 pre_command_hook(void)
4264 last_point_position = BUF_PT(current_buffer);
4265 XSETBUFFER(last_point_position_buffer, current_buffer);
4266 /* This function can GC */
4267 safe_run_hook_trapping_errors(
4268 "Error in `pre-command-hook' (setting hook to nil)",
4269 Qpre_command_hook, 1);
4271 /* This is a kludge, but necessary; see simple.el */
4272 call0(Qhandle_pre_motion_command);
4276 /* Run the post command hook. */
4279 post_command_hook(void)
4281 /* This function can GC */
4282 /* Turn off region highlighting unless this command requested that
4283 it be left on, or we're in the minibuffer. We don't turn it off
4284 when we're in the minibuffer so that things like M-x write-region
4287 This could be done via a function on the post-command-hook, but
4288 we don't want the user to accidentally remove it.
4291 Lisp_Object win = Fselected_window(Qnil);
4293 /* If the last command deleted the frame, `win' might be nil.
4294 It seems safest to do nothing in this case. */
4295 /* Note: Someone added the following comment and put #if 0's around
4296 this code, not realizing that doing this invites a crash in the
4298 /* #### This doesn't really fix the problem,
4299 if delete-frame is called by some hook */
4304 /* This is a kludge, but necessary; see simple.el */
4305 call0(Qhandle_post_motion_command);
4307 if (!zmacs_region_stays &&
4308 (!MINI_WINDOW_P(XWINDOW(win)) ||
4309 EQ(zmacs_region_buffer(), WINDOW_BUFFER(XWINDOW(win))))) {
4310 zmacs_deactivate_region();
4312 zmacs_update_region();
4315 safe_run_hook_trapping_errors(
4316 "Error in `post-command-hook' (setting hook to nil)",
4317 Qpost_command_hook, 1);
4319 /* #### Kludge!!! This is necessary to make sure that things
4320 are properly positioned even if post-command-hook moves point.
4321 #### There should be a cleaner way of handling this. */
4322 call0(Qauto_show_make_point_visible);
4326 DEFUN("dispatch-event", Fdispatch_event, 1, 1, 0, /*
4327 Given an event object EVENT as returned by `next-event', execute it.
4329 Key-press, button-press, and button-release events get accumulated
4330 until a complete key sequence (see `read-key-sequence') is reached,
4331 at which point the sequence is looked up in the current keymaps and
4334 Mouse motion events cause the low-level handling function stored in
4335 `mouse-motion-handler' to be called. (There are very few circumstances
4336 under which you should change this handler. Use `mode-motion-hook'
4339 Menu, timeout, and eval events cause the associated function or handler
4342 Process events cause the subprocess's output to be read and acted upon
4343 appropriately (see `start-process').
4345 Magic events are handled as necessary.
4349 /* This function can GC */
4350 struct command_builder *command_builder;
4352 Lisp_Object console;
4353 Lisp_Object channel;
4355 CHECK_LIVE_EVENT(event);
4358 /* events on dead channels get silently eaten */
4359 channel = EVENT_CHANNEL(ev);
4360 if (object_dead_p(channel)) {
4364 /* Some events don't have channels (e.g. eval events). */
4365 console = CDFW_CONSOLE(channel);
4366 if (NILP(console)) {
4367 console = Vselected_console;
4368 } else if (!EQ(console, Vselected_console)) {
4369 Fselect_console(console);
4372 command_builder = XCOMMAND_BUILDER(XCONSOLE(console)->command_builder);
4374 switch (XEVENT(event)->event_type) {
4375 case button_press_event:
4376 case button_release_event:
4377 case key_press_event: {
4379 lookup_command_event(command_builder, event, 1);
4381 if (KEYMAPP(leaf)) {
4382 /* Incomplete key sequence */
4386 /* At this point, we know that the sequence is
4387 not bound to a command. Normally, we beep
4388 and print a message informing the user of
4389 this. But we do not beep or print a message
4392 o the last event in this sequence is a
4394 o the last event in this sequence is a
4395 mouse-down event and there is a binding
4396 for the mouse-up version.
4398 That is, if the sequence ``C-x button1'' is
4399 typed, and is not bound to a command, but the
4400 sequence ``C-x button1up'' is bound to a
4401 command, we do not complain about the ``C-x
4402 button1'' sequence. If neither ``C-x
4403 button1'' nor ``C-x button1up'' is bound to a
4404 command, then we complain about the ``C-x
4405 button1'' sequence, but later will *not*
4406 complain about the ``C-x button1up''
4407 sequence, which would be redundant.
4409 This is pretty hairy, but I think it's the
4410 most intuitive behavior.
4412 Lisp_Object terminal =
4413 command_builder->most_current_event;
4415 if (XEVENT_TYPE(terminal) == button_press_event) {
4417 /* Temporarily pretend the last event
4418 was an "up" instead of a "down", and
4419 look up its binding. */
4420 XEVENT_TYPE(terminal) =
4421 button_release_event;
4422 /* If the "up" version is bound, don't
4425 !NILP(command_builder_find_leaf
4426 (command_builder, 0));
4427 /* Undo the temporary changes we just made. */
4428 XEVENT_TYPE(terminal) =
4431 /* Pretend this press was not
4432 seen (treat as a prefix) */
4437 reset_current_events
4455 most_current_event);
4456 XSET_EVENT_NEXT(eve, Qnil);
4458 most_current_event =
4461 maybe_echo_keys(command_builder, 1);
4466 /* Complain that the typed sequence is not
4467 defined, if this is the kind of sequence that
4468 warrants a complaint. */
4469 XCONSOLE(console)->defining_kbd_macro = Qnil;
4470 XCONSOLE(console)->prefix_arg = Qnil;
4471 /* Don't complain about undefined button-release
4473 if (XEVENT_TYPE(terminal) !=
4474 button_release_event) {
4476 current_events_into_vector(
4478 struct gcpro gcpro1;
4480 /* Run the pre-command-hook before
4481 barfing about an undefined key. */
4482 Vthis_command = Qnil;
4486 /* The post-command-hook doesn't run. */
4487 Fsignal(Qundefined_keystroke_sequence,
4490 /* Reset the command builder for reading the
4492 reset_this_command_keys(console, 1);
4494 /* key sequence is bound to a command */
4497 int magic_undo_count = 20;
4499 Vthis_command = leaf;
4501 /* Don't push an undo boundary if the command
4502 set the prefix arg, or if we are executing a
4503 keyboard macro, or if in the minibuffer. If
4504 the command we are about to execute is
4505 self-insert, it's tricky: up to 20
4506 consecutive self-inserts may be done without
4507 an undo boundary. This counter is reset as
4508 soon as a command other than
4509 self-insert-command is executed.
4511 Programmers can also use the
4512 `self-insert-defer-undo' property to install
4513 that behavior on functions other than
4514 `self-insert-command', or to change the magic
4515 number 20 to something else. #### DOCUMENT
4518 if (SYMBOLP(leaf)) {
4520 Fget(leaf, Qself_insert_defer_undo,
4522 if (NATNUMP(prop)) {
4524 1, magic_undo_count =
4526 } else if (!NILP(prop)) {
4528 } else if (EQ(leaf, Qself_insert_command)) {
4534 command_builder->self_insert_countdown = 0;
4536 if (NILP(XCONSOLE(console)->prefix_arg) &&
4537 NILP(Vexecuting_macro) &&
4538 command_builder->self_insert_countdown == 0) {
4543 if (--command_builder->
4544 self_insert_countdown < 0) {
4546 self_insert_countdown =
4550 execute_command_event
4552 internal_equal(event,
4554 most_current_event, 0)
4556 /* Use the translated event that was most
4557 recently seen. This way,
4558 last-command-event becomes f1 instead of
4559 the P from ESC O P. But we must copy
4560 it, else we'll lose when the
4561 command-builder events are
4563 : Fcopy_event(command_builder->
4564 most_current_event, Qnil));
4568 case misc_user_event: {
4571 We could just always use the menu item entry,
4572 whatever it is, but this might break some Lisp code
4573 that expects `this-command' to always contain a
4574 symbol. So only store it if this is a simple
4575 `call-interactively' sort of menu item.
4577 But this is bogus. `this-command' could be a string
4578 or vector anyway (for keyboard macros). There's even
4579 one instance (in pending-del.el) of `this-command'
4580 getting set to a cons (a lambda expression). So in
4581 the `eval' case I'll just convert it into a lambda
4585 (XEVENT(event)->event.eval.function,
4586 Qcall_interactively)
4587 && SYMBOLP(XEVENT(event)->event.eval.object)) {
4589 XEVENT(event)->event.eval.object;
4590 } else if (EQ(XEVENT(event)->event.eval.function, Qeval)) {
4594 XEVENT(event)->event.eval.
4596 } else if (SYMBOLP(XEVENT(event)->event.eval.function)) {
4597 /* A scrollbar command or the like. */
4599 XEVENT(event)->event.eval.function;
4602 Vthis_command = Qnil;
4605 /* clear the echo area */
4606 reset_key_echo(command_builder, 1);
4608 command_builder->self_insert_countdown = 0;
4609 if (NILP(XCONSOLE(console)->prefix_arg) &&
4610 NILP(Vexecuting_macro) &&
4611 !EQ(minibuf_window, Fselected_window(Qnil))) {
4614 execute_command_event(command_builder, event);
4617 #ifdef EF_USE_ASYNEQ
4618 case eaten_myself_event:
4619 case work_started_event:
4620 case work_finished_event:
4621 /* fall through, should land in a execute_internal_event() */
4626 case pointer_motion_event:
4630 case magic_eval_event:
4634 execute_internal_event(event);
4640 DEFUN("read-key-sequence", Fread_key_sequence, 1, 3, 0, /*
4641 Read a sequence of keystrokes or mouse clicks.
4642 Returns a vector of the event objects read. The vector and the event
4643 objects it contains are freshly created (and so will not be side-effected
4644 by subsequent calls to this function).
4646 The sequence read is sufficient to specify a non-prefix command starting
4647 from the current local and global keymaps. A C-g typed while in this
4648 function is treated like any other character, and `quit-flag' is not set.
4650 First arg PROMPT is a prompt string. If nil, do not prompt specially.
4652 Second optional arg CONTINUE-ECHO non-nil means this key echoes as a
4653 continuation of the previous key.
4655 Third optional arg DONT-DOWNCASE-LAST non-nil means do not convert the
4656 last event to lower case. (Normally any upper case event is converted
4657 to lower case if the original event is undefined and the lower case
4658 equivalent is defined.) This argument is provided mostly for FSF
4659 compatibility; the equivalent effect can be achieved more generally by
4660 binding `retry-undefined-key-binding-unshifted' to nil around the call
4661 to `read-key-sequence'.
4663 If the user selects a menu item while we are prompting for a key-sequence,
4664 the returned value will be a vector of a single menu-selection event.
4665 An error will be signalled if you pass this value to `lookup-key' or a
4668 `read-key-sequence' checks `function-key-map' for function key
4669 sequences, where they wouldn't conflict with ordinary bindings.
4670 See `function-key-map' for more details.
4672 (prompt, continue_echo, dont_downcase_last))
4674 /* This function can GC */
4676 Probably not -- see comment in next-event */
4677 struct console *con = XCONSOLE(Vselected_console);
4678 struct command_builder *command_builder;
4680 Lisp_Object event = Fmake_event(Qnil, Qnil);
4681 int speccount = specpdl_depth();
4682 struct gcpro gcpro1;
4685 record_unwind_protect(Fset_buffer, Fcurrent_buffer());
4686 if (!NILP(prompt)) {
4687 CHECK_STRING(prompt);
4689 /* else prompt = Fkeymap_prompt (current_buffer->keymap); may GC */
4692 if (NILP(continue_echo)) {
4693 reset_this_command_keys(make_console(con), 1);
4696 specbind(Qinhibit_quit, Qt);
4698 if (!NILP(dont_downcase_last)) {
4699 specbind(Qretry_undefined_key_binding_unshifted, Qnil);
4703 Fnext_event(event, prompt);
4704 /* restore the selected-console damage */
4705 con = event_console_or_selected(event);
4706 command_builder = XCOMMAND_BUILDER(con->command_builder);
4707 if (!command_event_p(event)) {
4708 execute_internal_event(event);
4710 if (XEVENT(event)->event_type == misc_user_event) {
4711 reset_current_events(command_builder);
4714 lookup_command_event(command_builder, event, 1);
4715 if (!KEYMAPP(result)) {
4717 current_events_into_vector(
4719 reset_key_echo(command_builder, 0);
4726 /* In case we read a ^G; do not call check_quit() here */
4729 Fdeallocate_event(event);
4730 RETURN_UNGCPRO(unbind_to(speccount, result));
4733 DEFUN("this-command-keys", Fthis_command_keys, 0, 0, 0, /*
4734 Return a vector of the keyboard or mouse button events that were used
4735 to invoke this command. This copies the vector and the events; it is safe
4736 to keep and modify them.
4744 if (NILP(Vthis_command_keys)) {
4745 return make_vector(0, Qnil);
4748 len = event_chain_count(Vthis_command_keys);
4750 result = make_vector(len, Qnil);
4752 EVENT_CHAIN_LOOP(event, Vthis_command_keys) {
4753 XVECTOR_DATA(result)[len++] = Fcopy_event(event, Qnil);
4758 DEFUN("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0, /*
4759 Used for complicated reasons in `universal-argument-other-key'.
4761 `universal-argument-other-key' rereads the event just typed.
4762 It then gets translated through `function-key-map'.
4763 The translated event gets included in the echo area and in
4764 the value of `this-command-keys' in addition to the raw original event.
4767 Calling this function directs the translated event to replace
4768 the original event, so that only one version of the event actually
4769 appears in the echo area and in the value of `this-command-keys'.
4773 /* #### I don't understand this at all, so currently it does nothing.
4774 If there is ever a problem, maybe someone should investigate. */
4779 dribble_out_event(Lisp_Object event)
4781 if (NILP(Vdribble_file)) {
4785 if (XEVENT(event)->event_type == key_press_event &&
4786 !XEVENT(event)->event.key.modifiers) {
4787 Lisp_Object keysym = XEVENT(event)->event.key.keysym;
4788 if (CHARP(XEVENT(event)->event.key.keysym)) {
4789 Emchar ch = XCHAR(keysym);
4790 Bufbyte str[MAX_EMCHAR_LEN];
4791 Bytecount len = set_charptr_emchar(str, ch);
4792 Lstream_write(XLSTREAM(Vdribble_file), str, len);
4793 } else if (string_char_length(XSYMBOL(keysym)->name) == 1) {
4794 /* one-char key events are printed with just the key
4796 Fprinc(keysym, Vdribble_file);
4797 } else if (EQ(keysym, Qreturn)) {
4798 Lstream_putc(XLSTREAM(Vdribble_file), '\n');
4799 } else if (EQ(keysym, Qspace)) {
4800 Lstream_putc(XLSTREAM(Vdribble_file), ' ');
4802 Fprinc(event, Vdribble_file);
4805 Fprinc(event, Vdribble_file);
4806 Lstream_flush(XLSTREAM(Vdribble_file));
4810 DEFUN("open-dribble-file", Fopen_dribble_file, 1, 1, "FOpen dribble file: ", /*
4811 Start writing all keyboard characters to a dribble file called FILENAME.
4812 If FILENAME is nil, close any open dribble file.
4816 /* This function can GC */
4817 /* XEmacs change: always close existing dribble file. */
4818 /* FSFmacs uses FILE *'s here. With lstreams, that's unnecessary. */
4819 if (!NILP(Vdribble_file)) {
4820 Lstream_close(XLSTREAM(Vdribble_file));
4821 Vdribble_file = Qnil;
4823 if (!NILP(filename)) {
4826 filename = Fexpand_file_name(filename, Qnil);
4827 fd = open((char *)XSTRING_DATA(filename),
4828 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4831 error("Unable to create dribble file");
4834 make_filedesc_output_stream(fd, 0, 0, LSTR_CLOSING);
4837 make_encoding_output_stream(
4838 XLSTREAM(Vdribble_file),
4839 Fget_coding_system(Qescape_quoted));
4845 DEFUN("current-event-timestamp", Fcurrent_event_timestamp, 0, 1, 0, /*
4846 Return the current event timestamp of the window system associated with CONSOLE.
4847 CONSOLE defaults to the selected console if omitted.
4851 struct console *c = decode_console(console);
4852 int tiempo = event_stream_current_event_timestamp(c);
4854 /* This junk is so that timestamps don't get to be negative, but contain
4855 as many bits as this particular emacs will allow.
4857 return make_int(EMACS_INT_MAX & tiempo);
4861 /* generalised asynchronous worker queue */
4862 #if defined(EF_USE_ASYNEQ)
4864 asyneq_handle_event(event_queue_t eq)
4866 if (!eq_queue_empty_p(eq)) {
4867 Lisp_Object eqev = eq_dequeue(eq);
4868 Fdispatch_event(eqev);
4874 asyneq_handle_non_command_event(event_queue_t eq)
4876 Lisp_Object eqev = Qnil;
4878 WITH_DLLIST_TRAVERSE(
4880 if (!command_event_p((Lisp_Object)dllist_item)) {
4881 eqev = (Lisp_Object)dllist_pop_inner(eq_queue(eq), _el);
4886 execute_internal_event(eqev);
4890 #endif /* EF_USE_ASYNEQ */
4892 /************************************************************************/
4893 /* initialization */
4894 /************************************************************************/
4896 void syms_of_event_stream(void)
4898 INIT_LRECORD_IMPLEMENTATION(command_builder);
4899 INIT_LRECORD_IMPLEMENTATION(timeout);
4901 defsymbol(&Qdisabled, "disabled");
4902 defsymbol(&Qcommand_event_p, "command-event-p");
4904 DEFERROR_STANDARD(Qundefined_keystroke_sequence, Qinvalid_argument);
4906 DEFSUBR(Frecent_keys);
4907 DEFSUBR(Frecent_keys_ring_size);
4908 DEFSUBR(Fset_recent_keys_ring_size);
4909 DEFSUBR(Finput_pending_p);
4910 DEFSUBR(Fenqueue_eval_event);
4911 DEFSUBR(Fnext_event);
4912 DEFSUBR(Fnext_command_event);
4913 DEFSUBR(Fdiscard_input);
4915 DEFSUBR(Fsleep_for);
4916 DEFSUBR(Faccept_process_output);
4917 DEFSUBR(Fadd_timeout);
4918 DEFSUBR(Fdisable_timeout);
4919 DEFSUBR(Fadd_async_timeout);
4920 DEFSUBR(Fdisable_async_timeout);
4921 DEFSUBR(Fdispatch_event);
4922 DEFSUBR(Fdispatch_non_command_events);
4923 DEFSUBR(Fread_key_sequence);
4924 DEFSUBR(Fthis_command_keys);
4925 DEFSUBR(Freset_this_command_lengths);
4926 DEFSUBR(Fopen_dribble_file);
4927 DEFSUBR(Fcurrent_event_timestamp);
4929 defsymbol(&Qpre_command_hook, "pre-command-hook");
4930 defsymbol(&Qpost_command_hook, "post-command-hook");
4931 defsymbol(&Qunread_command_events, "unread-command-events");
4932 defsymbol(&Qunread_command_event, "unread-command-event");
4933 defsymbol(&Qpre_idle_hook, "pre-idle-hook");
4934 defsymbol(&Qhandle_pre_motion_command, "handle-pre-motion-command");
4935 defsymbol(&Qhandle_post_motion_command, "handle-post-motion-command");
4936 defsymbol(&Qretry_undefined_key_binding_unshifted,
4937 "retry-undefined-key-binding-unshifted");
4938 defsymbol(&Qauto_show_make_point_visible,
4939 "auto-show-make-point-visible");
4941 defsymbol(&Qself_insert_defer_undo, "self-insert-defer-undo");
4942 defsymbol(&Qcancel_mode_internal, "cancel-mode-internal");
4945 void reinit_vars_of_event_stream(void)
4947 recent_keys_ring_index = 0;
4948 recent_keys_ring_size = 100;
4949 num_input_chars = 0;
4950 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
4951 Vtimeout_free_list = make_lcrecord_list(sizeof(Lisp_Timeout),
4953 staticpro_nodump(&Vtimeout_free_list);
4955 the_low_level_timeout_blocktype =
4956 Blocktype_new(struct low_level_timeout_blocktype);
4957 something_happened = 0;
4958 recursive_sit_for = Qnil;
4960 #if defined(EF_USE_ASYNEQ)
4961 /* the main event queue */
4962 asyneq = make_event_queue();
4963 XSETEVENT_QUEUE(Vasyneq, asyneq);
4964 staticpro_nodump(&Vasyneq);
4965 #endif /* EF_USE_ASYNEQ */
4968 void vars_of_event_stream(void)
4970 reinit_vars_of_event_stream();
4971 Vrecent_keys_ring = Qnil;
4972 staticpro(&Vrecent_keys_ring);
4974 Vthis_command_keys = Qnil;
4975 staticpro(&Vthis_command_keys);
4976 Vthis_command_keys_tail = Qnil;
4977 dump_add_root_object(&Vthis_command_keys_tail);
4979 #ifndef EF_USE_ASYNEQ
4980 command_event_queue = Qnil;
4981 staticpro(&command_event_queue);
4982 command_event_queue_tail = Qnil;
4983 dump_add_root_object(&command_event_queue_tail);
4986 Vlast_selected_frame = Qnil;
4987 staticpro(&Vlast_selected_frame);
4989 pending_timeout_list = Qnil;
4990 staticpro(&pending_timeout_list);
4992 pending_async_timeout_list = Qnil;
4993 staticpro(&pending_async_timeout_list);
4995 last_point_position_buffer = Qnil;
4996 staticpro(&last_point_position_buffer);
4998 DEFVAR_LISP("echo-keystrokes", &Vecho_keystrokes /*
4999 *Nonzero means echo unfinished commands after this many seconds of pause.
5001 Vecho_keystrokes = make_int(1);
5003 DEFVAR_INT("auto-save-interval", &auto_save_interval /*
5004 *Number of keyboard input characters between auto-saves.
5005 Zero means disable autosaving due to number of characters typed.
5006 See also the variable `auto-save-timeout'.
5008 auto_save_interval = 300;
5010 DEFVAR_LISP("pre-command-hook", &Vpre_command_hook /*
5011 Function or functions to run before every command.
5012 This may examine the `this-command' variable to find out what command
5013 is about to be run, or may change it to cause a different command to run.
5014 Function on this hook must be careful to avoid signalling errors!
5016 Vpre_command_hook = Qnil;
5018 DEFVAR_LISP("post-command-hook", &Vpost_command_hook /*
5019 Function or functions to run after every command.
5020 This may examine the `this-command' variable to find out what command
5023 Vpost_command_hook = Qnil;
5025 DEFVAR_LISP("pre-idle-hook", &Vpre_idle_hook /*
5026 Normal hook run when SXEmacs it about to be idle.
5027 This occurs whenever it is going to block, waiting for an event.
5028 This generally happens as a result of a call to `next-event',
5029 `next-command-event', `sit-for', `sleep-for', `accept-process-output',
5030 or `x-get-selection'.
5032 Errors running the hook are caught and ignored.
5034 Vpre_idle_hook = Qnil;
5036 DEFVAR_BOOL("focus-follows-mouse", &focus_follows_mouse /*
5037 *Variable to control SXEmacs behavior with respect to focus changing.
5038 If this variable is set to t, then SXEmacs will not gratuitously change
5039 the keyboard focus. SXEmacs cannot in general detect when this mode is
5040 used by the window manager, so it is up to the user to set it.
5042 focus_follows_mouse = 0;
5044 DEFVAR_LISP("last-command-event", &Vlast_command_event /*
5045 Last keyboard or mouse button event that was part of a command. This
5046 variable is off limits: you may not set its value or modify the event that
5047 is its value, as it is destructively modified by `read-key-sequence'. If
5048 you want to keep a pointer to this value, you must use `copy-event'.
5050 Vlast_command_event = Qnil;
5052 DEFVAR_LISP("last-command-char", &Vlast_command_char /*
5053 If the value of `last-command-event' is a keyboard event, then
5054 this is the nearest ASCII equivalent to it. This is the value that
5055 `self-insert-command' will put in the buffer. Remember that there is
5056 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
5057 of keyboard events is much larger, so writing code that examines this
5058 variable to determine what key has been typed is bad practice, unless
5059 you are certain that it will be one of a small set of characters.
5061 Vlast_command_char = Qnil;
5063 DEFVAR_LISP("last-input-event", &Vlast_input_event /*
5064 Last keyboard or mouse button event received. This variable is off
5065 limits: you may not set its value or modify the event that is its value, as
5066 it is destructively modified by `next-event'. If you want to keep a pointer
5067 to this value, you must use `copy-event'.
5069 Vlast_input_event = Qnil;
5071 DEFVAR_LISP("current-mouse-event", &Vcurrent_mouse_event /*
5072 The mouse-button event which invoked this command, or nil.
5073 This is usually what `(interactive "e")' returns.
5075 Vcurrent_mouse_event = Qnil;
5077 DEFVAR_LISP("last-input-char", &Vlast_input_char /*
5078 If the value of `last-input-event' is a keyboard event, then
5079 this is the nearest ASCII equivalent to it. Remember that there is
5080 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
5081 of keyboard events is much larger, so writing code that examines this
5082 variable to determine what key has been typed is bad practice, unless
5083 you are certain that it will be one of a small set of characters.
5085 Vlast_input_char = Qnil;
5087 DEFVAR_LISP("last-input-time", &Vlast_input_time /*
5088 The time (in seconds since Jan 1, 1970) of the last-command-event,
5089 represented as a cons of two 16-bit integers. This is destructively
5090 modified, so copy it if you want to keep it.
5092 Vlast_input_time = Qnil;
5094 DEFVAR_LISP("last-command-event-time", &Vlast_command_event_time /*
5095 The time (in seconds since Jan 1, 1970) of the last-command-event,
5096 represented as a list of three integers. The first integer contains
5097 the most significant 16 bits of the number of seconds, and the second
5098 integer contains the least significant 16 bits. The third integer
5099 contains the remainder number of microseconds, if the current system
5100 supports microsecond clock resolution. This list is destructively
5101 modified, so copy it if you want to keep it.
5103 Vlast_command_event_time = Qnil;
5105 DEFVAR_LISP("unread-command-events", &Vunread_command_events /*
5106 List of event objects to be read as next command input events.
5107 This can be used to simulate the receipt of events from the user.
5108 Normally this is nil.
5109 Events are removed from the front of this list.
5111 Vunread_command_events = Qnil;
5113 DEFVAR_LISP("unread-command-event", &Vunread_command_event /*
5114 Obsolete. Use `unread-command-events' instead.
5116 Vunread_command_event = Qnil;
5118 DEFVAR_LISP("last-command", &Vlast_command /*
5119 The last command executed. Normally a symbol with a function definition,
5120 but can be whatever was found in the keymap, or whatever the variable
5121 `this-command' was set to by that command.
5123 Vlast_command = Qnil;
5125 DEFVAR_LISP("this-command", &Vthis_command /*
5126 The command now being executed.
5127 The command can set this variable; whatever is put here
5128 will be in `last-command' during the following command.
5130 Vthis_command = Qnil;
5132 DEFVAR_LISP("last-command-properties", &Vlast_command_properties /*
5133 Value of `this-command-properties' for the last command.
5134 Used by commands to help synchronize consecutive commands, in preference
5135 to looking at `last-command' directly.
5137 Vlast_command_properties = Qnil;
5139 DEFVAR_LISP("this-command-properties", &Vthis_command_properties /*
5140 Properties set by the current command.
5141 At the beginning of each command, the current value of this variable is
5142 copied to `last-command-properties', and then it is set to nil. Use `putf'
5143 to add properties to this variable. Commands should use this to communicate
5144 with pre/post-command hooks, subsequent commands, wrapping commands, etc.
5145 in preference to looking at and/or setting `this-command'.
5147 Vthis_command_properties = Qnil;
5149 DEFVAR_LISP("help-char", &Vhelp_char /*
5150 Character to recognize as meaning Help.
5151 When it is read, do `(eval help-form)', and display result if it's a string.
5152 If the value of `help-form' is nil, this char can be read normally.
5153 This can be any form recognized as a single key specifier.
5154 The help-char cannot be a negative number in SXEmacs.
5157 Vhelp_char = make_char(8);
5159 DEFVAR_LISP("help-form", &Vhelp_form /*
5160 Form to execute when character help-char is read.
5161 If the form returns a string, that string is displayed.
5162 If `help-form' is nil, the help char is not recognized.
5166 DEFVAR_LISP("prefix-help-command", &Vprefix_help_command /*
5167 Command to run when `help-char' character follows a prefix key.
5168 This command is used only when there is no actual binding
5169 for that character after that prefix key.
5171 Vprefix_help_command = Qnil;
5173 DEFVAR_CONST_LISP("keyboard-translate-table",
5174 &Vkeyboard_translate_table /*
5175 sh table used as translate table for keyboard input.
5176 e `keyboard-translate' to portably add entries to this table.
5177 ch key-press event is looked up in this table as follows:
5179 -- If an entry maps a symbol to a symbol, then a key-press event whose
5180 keysym is the former symbol (with any modifiers at all) gets its
5181 keysym changed and its modifiers left alone. This is useful for
5182 dealing with non-standard X keyboards, such as the grievous damage
5183 that Sun has inflicted upon the world.
5185 -- If an entry maps a symbol to a character, then a key-press event
5186 whose keysym is the former symbol (with any modifiers at all) gets
5187 changed into a key-press event matching the latter character, and the
5188 resulting modifiers are the union of the original and new modifiers.
5190 -- If an entry maps a character to a character, then a key-press event
5191 matching the former character gets converted to a key-press event
5192 matching the latter character. This is useful on ASCII terminals
5193 for (e.g.) making C-\\ look like C-s, to get around flow-control
5196 -- If an entry maps a character to a symbol, then a key-press event
5197 matching the character gets converted to a key-press event whose
5198 keysym is the given symbol and which has no modifiers.
5200 re's an example: This makes typing parens and braces easier by rerouting
5201 eir positions to eliminate the need to use the Shift key.
5203 (keyboard-translate ?[ ?()
5204 (keyboard-translate ?] ?))
5205 (keyboard-translate ?{ ?[)
5206 (keyboard-translate ?} ?])
5207 (keyboard-translate 'f11 ?{)
5208 (keyboard-translate 'f12 ?})
5211 DEFVAR_LISP("retry-undefined-key-binding-unshifted",
5212 &Vretry_undefined_key_binding_unshifted /*
5213 If a key-sequence which ends with a shifted keystroke is undefined
5214 and this variable is non-nil then the command lookup is retried again
5215 with the last key unshifted. (e.g. C-X C-F would be retried as C-X C-f.)
5216 If lookup still fails, a normal error is signalled. In general,
5217 you should *bind* this, not set it.
5219 Vretry_undefined_key_binding_unshifted = Qt;
5221 DEFVAR_BOOL("modifier-keys-are-sticky", &modifier_keys_are_sticky /*
5222 *Non-nil makes modifier keys sticky.
5223 This means that you can release the modifier key before pressing down
5224 the key that you wish to be modified. Although this is non-standard
5225 behavior, it is recommended because it reduces the strain on your hand,
5226 thus reducing the incidence of the dreaded Emacs-pinky syndrome.
5228 Modifier keys are sticky within the inverval specified by
5229 `modifier-keys-sticky-time'.
5231 modifier_keys_are_sticky = 0;
5233 DEFVAR_LISP("modifier-keys-sticky-time",
5234 &Vmodifier_keys_sticky_time /*
5235 *Modifier keys are sticky within this many milliseconds.
5236 If you don't want modifier keys sticking to be bounded, set this to
5239 This variable has no effect when `modifier-keys-are-sticky' is nil.
5240 Currently only implemented under X Window System.
5242 Vmodifier_keys_sticky_time = make_int(500);
5245 DEFVAR_LISP("composed-character-default-binding",
5246 &Vcomposed_character_default_binding /*
5247 The default keybinding to use for key events from composed input.
5248 Window systems frequently have ways to allow the user to compose
5249 single characters in a language using multiple keystrokes.
5250 SXEmacs sees these as single character keypress events.
5252 Vcomposed_character_default_binding = Qself_insert_command;
5253 #endif /* HAVE_XIM */
5255 Vcontrolling_terminal = Qnil;
5256 staticpro(&Vcontrolling_terminal);
5258 Vdribble_file = Qnil;
5259 staticpro(&Vdribble_file);
5261 #ifdef DEBUG_SXEMACS
5262 DEFVAR_INT("debug-emacs-events", &debug_emacs_events /*
5263 o, display debug information about Emacs events that SXEmacs sees.
5264 n is displayed on stderr.
5266 event, the source of the event is displayed in parentheses,
5269 real event from the window system or
5270 rminal driver, as far as SXEmacs can tell.
5272 macro) An event generated from a keyboard macro.
5274 ommand-events) An event taken from `unread-command-events'.
5276 ommand-event) An event taken from `unread-command-event'.
5278 event queue) An event taken from an internal queue.
5279 Events end up on this queue when
5280 `enqueue-eval-event' is called or when
5281 user or eval events are received while
5282 SXEmacs is blocking (e.g. in `sit-for',
5283 `sleep-for', or `accept-process-output',
5284 or while waiting for the reply to an
5287 rd-translate-table) The result of an event translated
5288 through keyboard-translate-table. Note
5289 that in this case, two events are
5290 printed even though only one is really
5293 A faked C-g resulting when SXEmacs receives
5294 a SIGINT (e.g. C-c was pressed in SXEmacs'
5295 controlling terminal or the signal was
5296 explicitly sent to the SXEmacs process).
5298 debug_emacs_events = 0;
5301 DEFVAR_BOOL("inhibit-input-event-recording",
5302 &inhibit_input_event_recording /*
5303 Non-nil inhibits recording of input-events to recent-keys ring.
5305 inhibit_input_event_recording = 0;
5308 void complex_vars_of_event_stream(void)
5310 Vkeyboard_translate_table =
5311 make_lisp_hash_table(100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
5314 void init_event_stream(void)
5317 #ifdef HAVE_UNIXOID_EVENT_LOOP
5318 init_event_unixoid();
5320 #ifdef HAVE_X_WINDOWS
5321 if (!strcmp(display_use, "x"))
5322 init_event_Xt_late();
5326 /* For TTY's, use the Xt event loop if we can; it allows
5327 us to later open an X connection. */
5328 #if defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
5329 init_event_Xt_late();
5330 #elif defined (HAVE_TTY)
5331 init_event_tty_late();
5334 init_interrupts_late();
5339 useful testcases for v18/v19 compatibility:
5343 (setq unread-command-event (character-to-event ?A (allocate-event)))
5344 (setq x (list (read-char)
5345 ; (read-key-sequence "") ; try it with and without this
5346 last-command-char last-input-char
5347 (recent-keys) (this-command-keys))))
5348 (global-set-key "\^Q" 'foo)
5350 without the read-key-sequence:
5351 ^Q ==> (?A ?\^Q ?A [... ^Q] [^Q])
5352 ^U^U^Q ==> (?A ?\^Q ?A [... ^U ^U ^Q] [^U ^U ^Q])
5353 ^U^U^U^G^Q ==> (?A ?\^Q ?A [... ^U ^U ^U ^G ^Q] [^Q])
5355 with the read-key-sequence:
5356 ^Qb ==> (?A [b] ?\^Q ?b [... ^Q b] [b])
5357 ^U^U^Qb ==> (?A [b] ?\^Q ?b [... ^U ^U ^Q b] [b])
5358 ^U^U^U^G^Qb ==> (?A [b] ?\^Q ?b [... ^U ^U ^U ^G ^Q b] [b])
5360 ;the evi-mode command "4dlj.j.j.j.j.j." is also a good testcase (gag)
5362 ;(setq x (list (read-char) quit-flag))^J^G
5363 ;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G
5364 ;for BOTH, x should get set to (7 t), but no result should be printed.
5365 ;; #### According to the doc of quit-flag, second test should return
5366 ;; (?\^G nil). Accidentaly SXEmacs returns correct value. However,
5367 ;; XEmacs 21.1.12 and 21.2.36 both fails on first test.
5369 ;also do this: make two frames, one viewing "*scratch*", the other "foo".
5370 ;in *scratch*, type (sit-for 20)^J
5371 ;wait a couple of seconds, move cursor to foo, type "a"
5372 ;a should be inserted in foo. Cursor highlighting should not change in
5375 ;do it with sleep-for. move cursor into foo, then back into *scratch*
5377 ;repeat also with (accept-process-output nil 20)
5379 ;make sure ^G aborts sit-for, sleep-for and accept-process-output:
5382 (list (condition-case c
5387 (tst)^Ja^G ==> ((quit) ?a) with no signal
5388 (tst)^J^Ga ==> ((quit) ?a) with no signal
5389 (tst)^Jabc^G ==> ((quit) ?a) with no signal, and "bc" inserted in buffer
5391 ; with sit-for only do the 2nd test.
5392 ; Do all 3 tests with (accept-process-output nil 20)
5395 (setq enable-recursive-minibuffers t
5396 minibuffer-max-depth nil)
5397 ESC ESC ESC ESC - there are now two minibuffers active
5398 C-g C-g C-g - there should be active 0, not 1
5400 C-x C-f ~ / ? - wait for "Making completion list..." to display
5401 C-g - wait for "Quit" to display
5402 C-g - minibuffer should not be active
5403 however C-g before "Quit" is displayed should leave minibuffer active.
5405 ;do it all in both v18 and v19 and make sure all results are the same.
5406 ;all of these cases matter a lot, but some in quite subtle ways.
5410 Additional test cases for accept-process-output, sleep-for, sit-for.
5411 Be sure you do all of the above checking for C-g and focus, too!
5413 ; Make sure that timer handlers are run during, not after sit-for:
5414 (defun timer-check ()
5415 (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil)
5417 (message "after sit-for"))
5419 ; The first message should appear after 2 seconds, and the final message
5420 ; 3 seconds after that.
5421 ; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
5423 ; Make sure that process filters are run during, not after sit-for.
5425 (message "sit-for = %s" (sit-for 30)))
5426 (add-hook 'post-command-hook 'fubar)
5428 ; Now type M-x shell RET
5429 ; wait for the shell prompt then send: ls RET
5430 ; the output of ls should fill immediately, and not wait 30 seconds.
5432 ; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
5434 ; Make sure that recursive invocations return immediately:
5435 (defmacro test-diff-time (start end)
5436 `(+ (* (- (car ,end) (car ,start)) 65536.0)
5437 (- (cadr ,end) (cadr ,start))
5438 (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
5440 (defun testee (ignore)
5444 (let ((start (current-time))
5446 (add-timeout 2 'testee nil)
5448 (add-timeout 2 'testee nil)
5450 (add-timeout 2 'testee nil)
5451 (accept-process-output nil 5)
5452 (setq end (current-time))
5453 (test-diff-time start end)))
5455 (test-them) should sit for 15 seconds.
5456 Repeat with testee set to sleep-for and accept-process-output.
5457 These should each delay 36 seconds.