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 XEmacs.
9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */
24 /* Synched up with: Not in FSF. */
26 /* This file has been Mule-ized. */
31 * If you ever change ANYTHING in this file, you MUST run the
32 * testcases at the end to make sure that you haven't changed
33 * the semantics of recent-keys, last-input-char, or keyboard
34 * macros. You'd be surprised how easy it is to break this.
39 This stuff is way too hard to maintain - needs rework.
41 (global-set-key "\C-p" global-map) causes a crash - need recursion check.
43 C-x @ h <scrollbar-drag> x causes a crash.
45 The command builder should deal only with key and button events.
46 Other command events should be able to come in the MIDDLE of a key
47 sequence, without disturbing the key sequence composition, or the
48 command builder structure representing it.
50 Someone should rethink universal-argument and figure out how an
51 arbitrary command can influence the next command (universal-argument
52 or universal-coding-system-argument) or the next key (hyperify).
54 Both C-h and Help in the middle of a key sequence should trigger
55 prefix-help-command. help-char is stupid. Maybe we need
56 keymap-of-last-resort?
58 After prefix-help is run, one should be able to CONTINUE TYPING,
59 instead of RETYPING, the key sequence.
66 #include "console-x.h" /* for menu accelerators ... */
68 #include "../lwlib/lwlib.h"
70 #define lw_menu_active 0
73 #include "blocktype.h"
80 #include "insdel.h" /* for buffer_reset_changes */
83 #include "macros.h" /* for defining_keyboard_macro */
87 #include "sysdep.h" /* init_poll_for_quit() */
88 #include "syssignal.h" /* SIGCHLD, etc. */
90 #include "systime.h" /* to set Vlast_input_time */
92 #include "events-mod.h"
94 #include "file-coding.h"
99 /* The number of keystrokes between auto-saves. */
100 static int auto_save_interval;
102 Lisp_Object Qundefined_keystroke_sequence;
104 Lisp_Object Qcommand_event_p;
106 /* Hooks to run before and after each command. */
107 Lisp_Object Vpre_command_hook, Vpost_command_hook;
108 Lisp_Object Qpre_command_hook, Qpost_command_hook;
110 /* Hook run when XEmacs is about to be idle. */
111 Lisp_Object Qpre_idle_hook, Vpre_idle_hook;
113 /* Control gratuitous keyboard focus throwing. */
114 int focus_follows_mouse;
116 #ifdef ILL_CONCEIVED_HOOK
117 /* Hook run after a command if there's no more input soon. */
118 Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
120 /* Delay time in microseconds before running post-command-idle-hook. */
121 int post_command_idle_delay;
122 #endif /* ILL_CONCEIVED_HOOK */
124 #ifdef DEFERRED_ACTION_CRAP
125 /* List of deferred actions to be performed at a later time.
126 The precise format isn't relevant here; we just check whether it is nil. */
127 Lisp_Object Vdeferred_action_list;
129 /* Function to call to handle deferred actions, when there are any. */
130 Lisp_Object Vdeferred_action_function;
131 Lisp_Object Qdeferred_action_function;
132 #endif /* DEFERRED_ACTION_CRAP */
134 /* Non-nil disable property on a command means
135 do not execute it; call disabled-command-hook's value instead. */
136 Lisp_Object Qdisabled, Vdisabled_command_hook;
138 EXFUN (Fnext_command_event, 2);
140 static void pre_command_hook (void);
141 static void post_command_hook (void);
143 /* Last keyboard or mouse input event read as a command. */
144 Lisp_Object Vlast_command_event;
146 /* The nearest ASCII equivalent of the above. */
147 Lisp_Object Vlast_command_char;
149 /* Last keyboard or mouse event read for any purpose. */
150 Lisp_Object Vlast_input_event;
152 /* The nearest ASCII equivalent of the above. */
153 Lisp_Object Vlast_input_char;
155 Lisp_Object Vcurrent_mouse_event;
157 /* This is fbound in cmdloop.el, see the commentary there */
158 Lisp_Object Qcancel_mode_internal;
160 /* If not Qnil, event objects to be read as the next command input */
161 Lisp_Object Vunread_command_events;
162 Lisp_Object Vunread_command_event; /* obsoleteness support */
164 static Lisp_Object Qunread_command_events, Qunread_command_event;
166 /* Previous command, represented by a Lisp object.
167 Does not include prefix commands and arg setting commands */
168 Lisp_Object Vlast_command;
170 /* If a command sets this, the value goes into
171 previous-command for the next command. */
172 Lisp_Object Vthis_command;
174 /* The value of point when the last command was executed. */
175 Bufpos last_point_position;
177 /* The frame that was current when the last command was started. */
178 Lisp_Object Vlast_selected_frame;
180 /* The buffer that was current when the last command was started. */
181 Lisp_Object last_point_position_buffer;
183 /* A (16bit . 16bit) representation of the time of the last-command-event. */
184 Lisp_Object Vlast_input_time;
186 /* A (16bit 16bit usec) representation of the time
187 of the last-command-event. */
188 Lisp_Object Vlast_command_event_time;
190 /* Character to recognize as the help char. */
191 Lisp_Object Vhelp_char;
193 /* Form to execute when help char is typed. */
194 Lisp_Object Vhelp_form;
196 /* Command to run when the help character follows a prefix key. */
197 Lisp_Object Vprefix_help_command;
199 /* Flag to tell QUIT that some interesting occurrence (e.g. a keypress)
200 may have happened. */
201 volatile int something_happened;
203 /* Hash table to translate keysyms through */
204 Lisp_Object Vkeyboard_translate_table;
206 /* If control-meta-super-shift-X is undefined, try control-meta-super-x */
207 Lisp_Object Vretry_undefined_key_binding_unshifted;
208 Lisp_Object Qretry_undefined_key_binding_unshifted;
211 /* If composed input is undefined, use self-insert-char */
212 Lisp_Object Vcomposed_character_default_binding;
213 #endif /* HAVE_XIM */
215 /* Console that corresponds to our controlling terminal */
216 Lisp_Object Vcontrolling_terminal;
218 /* An event (actually an event chain linked through event_next) or Qnil.
220 Lisp_Object Vthis_command_keys;
221 Lisp_Object Vthis_command_keys_tail;
224 Lisp_Object Qauto_show_make_point_visible;
226 /* File in which we write all commands we read; an lstream */
227 static Lisp_Object Vdribble_file;
229 /* Recent keys ring location; a vector of events or nil-s */
230 Lisp_Object Vrecent_keys_ring;
231 int recent_keys_ring_size;
232 int recent_keys_ring_index;
234 /* Boolean specifying whether keystrokes should be added to
236 int inhibit_input_event_recording;
238 /* prefix key(s) that must match in order to activate menu.
239 This is ugly. fix me.
241 Lisp_Object Vmenu_accelerator_prefix;
243 /* list of modifier keys to match accelerator for top level menus */
244 Lisp_Object Vmenu_accelerator_modifiers;
246 /* whether menu accelerators are enabled */
247 Lisp_Object Vmenu_accelerator_enabled;
249 /* keymap for auxiliary menu accelerator functions */
250 Lisp_Object Vmenu_accelerator_map;
252 Lisp_Object Qmenu_force;
253 Lisp_Object Qmenu_fallback;
254 Lisp_Object Qmenu_quit;
255 Lisp_Object Qmenu_up;
256 Lisp_Object Qmenu_down;
257 Lisp_Object Qmenu_left;
258 Lisp_Object Qmenu_right;
259 Lisp_Object Qmenu_select;
260 Lisp_Object Qmenu_escape;
262 Lisp_Object Qself_insert_defer_undo;
264 /* this is in keymap.c */
265 extern Lisp_Object Fmake_keymap (Lisp_Object name);
268 int debug_emacs_events;
271 external_debugging_print_event (char *event_description, Lisp_Object event)
273 write_c_string ("(", Qexternal_debugging_output);
274 write_c_string (event_description, Qexternal_debugging_output);
275 write_c_string (") ", Qexternal_debugging_output);
276 print_internal (event, Qexternal_debugging_output, 1);
277 write_c_string ("\n", Qexternal_debugging_output);
279 #define DEBUG_PRINT_EMACS_EVENT(event_description, event) do { \
280 if (debug_emacs_events) \
281 external_debugging_print_event (event_description, event); \
284 #define DEBUG_PRINT_EMACS_EVENT(string, event)
288 /* The callback routines for the window system or terminal driver */
289 struct event_stream *event_stream;
291 /* This structure is what we use to encapsulate the state of a command sequence
292 being composed; key events are executed by adding themselves to the command
293 builder; if the command builder is then complete (does not still represent
294 a prefix key sequence) it executes the corresponding command.
296 struct command_builder
298 struct lcrecord_header header;
299 Lisp_Object console; /* back pointer to the console this command
301 /* Qnil, or a Lisp_Event representing the first event read
302 * after the last command completed. Threaded. */
304 Lisp_Object prefix_events;
305 /* Qnil, or a Lisp_Event representing event in the current
306 * keymap-lookup sequence. Subsequent events are threaded via
307 * the event's next slot */
308 Lisp_Object current_events;
309 /* Last elt of above */
310 Lisp_Object most_current_event;
311 /* Last elt before function map code took over. What this means is:
312 All prefixes up to (but not including) this event have non-nil
313 bindings, but the prefix including this event has a nil binding.
314 Any events in the chain after this one were read solely because
315 we're part of a possible function key. If we end up with
316 something that's not part of a possible function key, we have to
317 unread all of those events. */
318 Lisp_Object last_non_munged_event;
319 /* One set of values for function-key-map, one for key-translation-map */
320 struct munging_key_translation
322 /* First event that can begin a possible function key sequence
323 (to be translated according to function-key-map). Normally
324 this is the first event in the chain. However, once we've
325 translated a sequence through function-key-map, this will point
326 to the first event after the translated sequence: we don't ever
327 want to translate any events twice through function-key-map, or
328 things could get really screwed up (e.g. if the user created a
329 translation loop). If this is nil, then the next-read event is
330 the first that can begin a function key sequence. */
331 Lisp_Object first_mungeable_event;
335 Bytecount echo_buf_length; /* size of echo_buf */
336 Bytecount echo_buf_index; /* index into echo_buf
337 * -1 before doing echoing for new cmd */
338 /* Self-insert-command is magic in that it doesn't always push an undo-
339 boundary: up to 20 consecutive self-inserts can happen before an undo-
340 boundary is pushed. This variable is that counter.
342 int self_insert_countdown;
345 static void echo_key_event (struct command_builder *, Lisp_Object event);
346 static void maybe_kbd_translate (Lisp_Object event);
348 /* This structure is basically a typeahead queue: things like
349 wait-reading-process-output will delay the execution of
350 keyboard and mouse events by pushing them here.
352 Chained through event_next()
353 command_event_queue_tail is a pointer to the last-added element.
355 static Lisp_Object command_event_queue;
356 static Lisp_Object command_event_queue_tail;
358 /* Nonzero means echo unfinished commands after this many seconds of pause. */
359 static Lisp_Object Vecho_keystrokes;
361 /* The number of keystrokes since the last auto-save. */
362 static int keystrokes_since_auto_save;
364 /* Used by the C-g signal handler so that it will never "hard quit"
365 when waiting for an event. Otherwise holding down C-g could
366 cause a suspension back to the shell, which is generally
367 undesirable. (#### This doesn't fully work.) */
369 int emacs_is_blocking;
371 /* Handlers which run during sit-for, sleep-for and accept-process-output
372 are not allowed to recursively call these routines. We record here
373 if we are in that situation. */
375 static Lisp_Object recursive_sit_for;
379 /**********************************************************************/
380 /* Command-builder object */
381 /**********************************************************************/
383 #define XCOMMAND_BUILDER(x) \
384 XRECORD (x, command_builder, struct command_builder)
385 #define XSETCOMMAND_BUILDER(x, p) XSETRECORD (x, p, command_builder)
386 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder)
387 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
390 mark_command_builder (Lisp_Object obj)
392 struct command_builder *builder = XCOMMAND_BUILDER (obj);
393 mark_object (builder->prefix_events);
394 mark_object (builder->current_events);
395 mark_object (builder->most_current_event);
396 mark_object (builder->last_non_munged_event);
397 mark_object (builder->munge_me[0].first_mungeable_event);
398 mark_object (builder->munge_me[1].first_mungeable_event);
399 return builder->console;
403 finalize_command_builder (void *header, int for_disksave)
407 xfree (((struct command_builder *) header)->echo_buf);
408 ((struct command_builder *) header)->echo_buf = 0;
412 DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder,
413 mark_command_builder, internal_object_printer,
414 finalize_command_builder, 0, 0, 0,
415 struct command_builder);
418 reset_command_builder_event_chain (struct command_builder *builder)
420 builder->prefix_events = Qnil;
421 builder->current_events = Qnil;
422 builder->most_current_event = Qnil;
423 builder->last_non_munged_event = Qnil;
424 builder->munge_me[0].first_mungeable_event = Qnil;
425 builder->munge_me[1].first_mungeable_event = Qnil;
429 allocate_command_builder (Lisp_Object console)
431 Lisp_Object builder_obj;
432 struct command_builder *builder =
433 alloc_lcrecord_type (struct command_builder, &lrecord_command_builder);
435 builder->console = console;
436 reset_command_builder_event_chain (builder);
437 builder->echo_buf_length = 300; /* #### Kludge */
438 builder->echo_buf = xnew_array (Bufbyte, builder->echo_buf_length);
439 builder->echo_buf[0] = 0;
440 builder->echo_buf_index = -1;
441 builder->echo_buf_index = -1;
442 builder->self_insert_countdown = 0;
444 XSETCOMMAND_BUILDER (builder_obj, builder);
449 command_builder_append_event (struct command_builder *builder,
452 assert (EVENTP (event));
454 if (EVENTP (builder->most_current_event))
455 XSET_EVENT_NEXT (builder->most_current_event, event);
457 builder->current_events = event;
459 builder->most_current_event = event;
460 if (NILP (builder->munge_me[0].first_mungeable_event))
461 builder->munge_me[0].first_mungeable_event = event;
462 if (NILP (builder->munge_me[1].first_mungeable_event))
463 builder->munge_me[1].first_mungeable_event = event;
467 /**********************************************************************/
468 /* Low-level interfaces onto event methods */
469 /**********************************************************************/
471 enum event_stream_operation
473 EVENT_STREAM_PROCESS,
474 EVENT_STREAM_TIMEOUT,
475 EVENT_STREAM_CONSOLE,
480 check_event_stream_ok (enum event_stream_operation op)
482 if (!event_stream && noninteractive)
486 case EVENT_STREAM_PROCESS:
487 error ("Can't start subprocesses in -batch mode");
488 case EVENT_STREAM_TIMEOUT:
489 error ("Can't add timeouts in -batch mode");
490 case EVENT_STREAM_CONSOLE:
491 error ("Can't add consoles in -batch mode");
492 case EVENT_STREAM_READ:
493 error ("Can't read events in -batch mode");
498 else if (!event_stream)
500 error ("event-stream callbacks not initialized (internal error?)");
505 event_stream_event_pending_p (int user)
507 return event_stream && event_stream->event_pending_p (user);
511 maybe_read_quit_event (Lisp_Event *event)
513 /* A C-g that came from `sigint_happened' will always come from the
514 controlling terminal. If that doesn't exist, however, then the
515 user manually sent us a SIGINT, and we pretend the C-g came from
516 the selected console. */
519 if (CONSOLEP (Vcontrolling_terminal) &&
520 CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal)))
521 con = XCONSOLE (Vcontrolling_terminal);
523 con = XCONSOLE (Fselected_console ());
527 int ch = CONSOLE_QUIT_CHAR (con);
530 character_to_event (ch, event, con, 1, 1);
531 event->channel = make_console (con);
538 event_stream_next_event (Lisp_Event *event)
540 Lisp_Object event_obj;
542 check_event_stream_ok (EVENT_STREAM_READ);
544 XSETEVENT (event_obj, event);
546 /* If C-g was pressed, treat it as a character to be read.
547 Note that if C-g was pressed while we were blocking,
548 the SIGINT signal handler will be called. It will
549 set Vquit_flag and write a byte on our "fake pipe",
550 which will unblock us. */
551 if (maybe_read_quit_event (event))
553 DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj);
557 /* If a longjmp() happens in the callback, we're screwed.
558 Let's hope it doesn't. I think the code here is fairly
559 clean and doesn't do this. */
560 emacs_is_blocking = 1;
562 /* Do this if the poll-for-quit timer seems to be taking too
563 much CPU time when idle ... */
564 reset_poll_for_quit ();
566 event_stream->next_event_cb (event);
568 init_poll_for_quit ();
570 emacs_is_blocking = 0;
573 /* timeout events have more info set later, so
574 print the event out in next_event_internal(). */
575 if (event->event_type != timeout_event)
576 DEBUG_PRINT_EMACS_EVENT ("real", event_obj);
578 maybe_kbd_translate (event_obj);
582 event_stream_handle_magic_event (Lisp_Event *event)
584 check_event_stream_ok (EVENT_STREAM_READ);
585 event_stream->handle_magic_event_cb (event);
589 event_stream_add_timeout (EMACS_TIME timeout)
591 check_event_stream_ok (EVENT_STREAM_TIMEOUT);
592 return event_stream->add_timeout_cb (timeout);
596 event_stream_remove_timeout (int id)
598 check_event_stream_ok (EVENT_STREAM_TIMEOUT);
599 event_stream->remove_timeout_cb (id);
603 event_stream_select_console (struct console *con)
605 check_event_stream_ok (EVENT_STREAM_CONSOLE);
606 if (!con->input_enabled)
608 event_stream->select_console_cb (con);
609 con->input_enabled = 1;
614 event_stream_unselect_console (struct console *con)
616 check_event_stream_ok (EVENT_STREAM_CONSOLE);
617 if (con->input_enabled)
619 event_stream->unselect_console_cb (con);
620 con->input_enabled = 0;
625 event_stream_select_process (Lisp_Process *proc)
627 check_event_stream_ok (EVENT_STREAM_PROCESS);
628 if (!get_process_selected_p (proc))
630 event_stream->select_process_cb (proc);
631 set_process_selected_p (proc, 1);
636 event_stream_unselect_process (Lisp_Process *proc)
638 check_event_stream_ok (EVENT_STREAM_PROCESS);
639 if (get_process_selected_p (proc))
641 event_stream->unselect_process_cb (proc);
642 set_process_selected_p (proc, 0);
647 event_stream_create_stream_pair (void* inhandle, void* outhandle,
648 Lisp_Object* instream, Lisp_Object* outstream, int flags)
650 check_event_stream_ok (EVENT_STREAM_PROCESS);
651 return event_stream->create_stream_pair_cb
652 (inhandle, outhandle, instream, outstream, flags);
656 event_stream_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream)
658 check_event_stream_ok (EVENT_STREAM_PROCESS);
659 return event_stream->delete_stream_pair_cb (instream, outstream);
663 event_stream_quit_p (void)
666 event_stream->quit_p_cb ();
671 /**********************************************************************/
672 /* Character prompting */
673 /**********************************************************************/
676 echo_key_event (struct command_builder *command_builder,
679 /* This function can GC */
681 Bytecount buf_index = command_builder->echo_buf_index;
687 buf_index = 0; /* We're echoing now */
688 clear_echo_area (selected_frame (), Qnil, 0);
691 format_event_object (buf, XEVENT (event), 1);
694 if (len + buf_index + 4 > command_builder->echo_buf_length)
696 e = command_builder->echo_buf + buf_index;
697 memcpy (e, buf, len);
705 command_builder->echo_buf_index = buf_index + len + 1;
709 regenerate_echo_keys_from_this_command_keys (struct command_builder *
714 builder->echo_buf_index = 0;
716 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
717 echo_key_event (builder, event);
721 maybe_echo_keys (struct command_builder *command_builder, int no_snooze)
723 /* This function can GC */
724 double echo_keystrokes;
725 struct frame *f = selected_frame ();
726 /* Message turns off echoing unless more keystrokes turn it on again. */
727 if (echo_area_active (f) && !EQ (Qcommand, echo_area_status (f)))
730 if (INTP (Vecho_keystrokes) || FLOATP (Vecho_keystrokes))
731 echo_keystrokes = extract_float (Vecho_keystrokes);
735 if (minibuf_level == 0
736 && echo_keystrokes > 0.0
741 /* #### C-g here will cause QUIT. Setting dont_check_for_quit
742 doesn't work. See check_quit. */
743 if (NILP (Fsit_for (Vecho_keystrokes, Qnil)))
744 /* input came in, so don't echo. */
748 echo_area_message (f, command_builder->echo_buf, Qnil, 0,
749 /* not echo_buf_index. That doesn't include
750 the terminating " - ". */
751 strlen ((char *) command_builder->echo_buf),
757 reset_key_echo (struct command_builder *command_builder,
758 int remove_echo_area_echo)
760 /* This function can GC */
761 struct frame *f = selected_frame ();
763 command_builder->echo_buf_index = -1;
765 if (remove_echo_area_echo)
766 clear_echo_area (f, Qcommand, 0);
770 /**********************************************************************/
772 /**********************************************************************/
775 maybe_kbd_translate (Lisp_Object event)
778 int did_translate = 0;
780 if (XEVENT_TYPE (event) != key_press_event)
782 if (!HASH_TABLEP (Vkeyboard_translate_table))
784 if (EQ (Fhash_table_count (Vkeyboard_translate_table), Qzero))
787 c = event_to_character (XEVENT (event), 0, 0, 0);
790 Lisp_Object traduit = Fgethash (make_char (c), Vkeyboard_translate_table,
792 if (!NILP (traduit) && SYMBOLP (traduit))
794 XEVENT (event)->event.key.keysym = traduit;
795 XEVENT (event)->event.key.modifiers = 0;
798 else if (CHARP (traduit))
802 /* This used to call Fcharacter_to_event() directly into EVENT,
803 but that can eradicate timestamps and other such stuff.
804 This way is safer. */
806 character_to_event (XCHAR (traduit), &ev2,
807 XCONSOLE (EVENT_CHANNEL (XEVENT (event))), 1, 1);
808 XEVENT (event)->event.key.keysym = ev2.event.key.keysym;
809 XEVENT (event)->event.key.modifiers = ev2.event.key.modifiers;
816 Lisp_Object traduit = Fgethash (XEVENT (event)->event.key.keysym,
817 Vkeyboard_translate_table, Qnil);
818 if (!NILP (traduit) && SYMBOLP (traduit))
820 XEVENT (event)->event.key.keysym = traduit;
827 DEBUG_PRINT_EMACS_EVENT ("->keyboard-translate-table", event);
831 /* NB: The following auto-save stuff is in keyboard.c in FSFmacs, and
832 keystrokes_since_auto_save is equivalent to the difference between
833 num_nonmacro_input_chars and last_auto_save. */
835 /* When an auto-save happens, record the "time", and don't do again soon. */
838 record_auto_save (void)
840 keystrokes_since_auto_save = 0;
843 /* Make an auto save happen as soon as possible at command level. */
846 force_auto_save_soon (void)
848 keystrokes_since_auto_save = 1 + max (auto_save_interval, 20);
851 record_asynch_buffer_change ();
856 maybe_do_auto_save (void)
858 /* This function can call lisp */
859 keystrokes_since_auto_save++;
860 if (auto_save_interval > 0 &&
861 keystrokes_since_auto_save > max (auto_save_interval, 20) &&
862 !detect_input_pending ())
864 Fdo_auto_save (Qnil, Qnil);
870 print_help (Lisp_Object object)
872 Fprinc (object, Qnil);
877 execute_help_form (struct command_builder *command_builder,
880 /* This function can GC */
881 Lisp_Object help = Qnil;
882 int speccount = specpdl_depth ();
883 Bytecount buf_index = command_builder->echo_buf_index;
884 Lisp_Object echo = ((buf_index <= 0)
886 : make_string (command_builder->echo_buf,
888 struct gcpro gcpro1, gcpro2;
891 record_unwind_protect (save_window_excursion_unwind,
892 Fcurrent_window_configuration (Qnil));
893 reset_key_echo (command_builder, 1);
895 help = Feval (Vhelp_form);
897 internal_with_output_to_temp_buffer (build_string ("*Help*"),
898 print_help, help, Qnil);
899 Fnext_command_event (event, Qnil);
900 /* Remove the help from the frame */
901 unbind_to (speccount, Qnil);
902 /* Hmmmm. Tricky. The unbind restores an old window configuration,
903 apparently bypassing any setting of windows_structure_changed.
904 So we need to set it so that things get redrawn properly. */
905 /* #### This is massive overkill. Look at doing it better once the
906 new redisplay is fully in place. */
908 Lisp_Object frmcons, devcons, concons;
909 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
911 struct frame *f = XFRAME (XCAR (frmcons));
912 MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f);
917 if (event_matches_key_specifier_p (XEVENT (event), make_char (' ')))
919 /* Discard next key if it is a space */
920 reset_key_echo (command_builder, 1);
921 Fnext_command_event (event, Qnil);
924 command_builder->echo_buf_index = buf_index;
926 memcpy (command_builder->echo_buf,
927 XSTRING_DATA (echo), buf_index + 1); /* terminating 0 */
932 /**********************************************************************/
934 /**********************************************************************/
937 detect_input_pending (void)
939 /* Always call the event_pending_p hook even if there's an unread
940 character, because that might do some needed ^G detection (on
941 systems without SIGIO, for example).
943 if (event_stream_event_pending_p (1))
945 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
947 if (!NILP (command_event_queue))
951 EVENT_CHAIN_LOOP (event, command_event_queue)
953 if (XEVENT_TYPE (event) != eval_event
954 && XEVENT_TYPE (event) != magic_eval_event)
961 DEFUN ("input-pending-p", Finput_pending_p, 0, 0, 0, /*
962 Return t if command input is currently available with no waiting.
963 Actually, the value is nil only if we can be sure that no input is available.
967 return detect_input_pending () ? Qt : Qnil;
971 /**********************************************************************/
973 /**********************************************************************/
975 /**** Low-level timeout functions. ****
977 These functions maintain a sorted list of one-shot timeouts (where
978 the timeouts are in absolute time). They are intended for use by
979 functions that need to convert a list of absolute timeouts into a
980 series of intervals to wait for. */
982 /* We ensure that 0 is never a valid ID, so that a value of 0 can be
983 used to indicate an absence of a timer. */
984 static int low_level_timeout_id_tick;
986 static struct low_level_timeout_blocktype
988 Blocktype_declare (struct low_level_timeout);
989 } *the_low_level_timeout_blocktype;
991 /* Add a one-shot timeout at time TIME to TIMEOUT_LIST. Return
992 a unique ID identifying the timeout. */
995 add_low_level_timeout (struct low_level_timeout **timeout_list,
998 struct low_level_timeout *tm;
999 struct low_level_timeout *t, **tt;
1001 /* Allocate a new time struct. */
1003 tm = Blocktype_alloc (the_low_level_timeout_blocktype);
1005 if (low_level_timeout_id_tick == 0)
1006 low_level_timeout_id_tick++;
1007 tm->id = low_level_timeout_id_tick++;
1010 /* Add it to the queue. */
1014 while (t && EMACS_TIME_EQUAL_OR_GREATER (tm->time, t->time))
1025 /* Remove the low-level timeout identified by ID from TIMEOUT_LIST.
1026 If the timeout is not there, do nothing. */
1029 remove_low_level_timeout (struct low_level_timeout **timeout_list, int id)
1031 struct low_level_timeout *t, *prev;
1035 for (t = *timeout_list, prev = NULL; t && t->id != id; t = t->next)
1039 return; /* couldn't find it */
1042 *timeout_list = t->next;
1043 else prev->next = t->next;
1045 Blocktype_free (the_low_level_timeout_blocktype, t);
1048 /* If there are timeouts on TIMEOUT_LIST, store the relative time
1049 interval to the first timeout on the list into INTERVAL and
1050 return 1. Otherwise, return 0. */
1053 get_low_level_timeout_interval (struct low_level_timeout *timeout_list,
1054 EMACS_TIME *interval)
1056 if (!timeout_list) /* no timer events; block indefinitely */
1060 EMACS_TIME current_time;
1062 /* The time to block is the difference between the first
1063 (earliest) timer on the queue and the current time.
1064 If that is negative, then the timer will fire immediately
1065 but we still have to call select(), with a zero-valued
1066 timeout: user events must have precedence over timer events. */
1067 EMACS_GET_TIME (current_time);
1068 if (EMACS_TIME_GREATER (timeout_list->time, current_time))
1069 EMACS_SUB_TIME (*interval, timeout_list->time,
1072 EMACS_SET_SECS_USECS (*interval, 0, 0);
1077 /* Pop the first (i.e. soonest) timeout off of TIMEOUT_LIST and return
1078 its ID. Also, if TIME_OUT is not 0, store the absolute time of the
1079 timeout into TIME_OUT. */
1082 pop_low_level_timeout (struct low_level_timeout **timeout_list,
1083 EMACS_TIME *time_out)
1085 struct low_level_timeout *tm = *timeout_list;
1091 *time_out = tm->time;
1092 *timeout_list = tm->next;
1093 Blocktype_free (the_low_level_timeout_blocktype, tm);
1098 /**** High-level timeout functions. ****/
1100 static int timeout_id_tick;
1102 static Lisp_Object pending_timeout_list, pending_async_timeout_list;
1104 static Lisp_Object Vtimeout_free_list;
1107 mark_timeout (Lisp_Object obj)
1109 Lisp_Timeout *tm = XTIMEOUT (obj);
1110 mark_object (tm->function);
1114 /* Should never, ever be called. (except by an external debugger) */
1116 print_timeout (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1118 CONST Lisp_Timeout *t = XTIMEOUT (obj);
1121 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (timeout) 0x%lx>",
1123 write_c_string (buf, printcharfun);
1126 static const struct lrecord_description timeout_description[] = {
1127 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, function) },
1128 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, object) },
1132 DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout,
1133 mark_timeout, print_timeout,
1134 0, 0, 0, timeout_description, Lisp_Timeout);
1136 /* Generate a timeout and return its ID. */
1139 event_stream_generate_wakeup (unsigned int milliseconds,
1140 unsigned int vanilliseconds,
1141 Lisp_Object function, Lisp_Object object,
1144 Lisp_Object op = allocate_managed_lcrecord (Vtimeout_free_list);
1145 Lisp_Timeout *timeout = XTIMEOUT (op);
1146 EMACS_TIME current_time;
1147 EMACS_TIME interval;
1149 timeout->id = timeout_id_tick++;
1150 timeout->resignal_msecs = vanilliseconds;
1151 timeout->function = function;
1152 timeout->object = object;
1154 EMACS_GET_TIME (current_time);
1155 EMACS_SET_SECS_USECS (interval, milliseconds / 1000,
1156 1000 * (milliseconds % 1000));
1157 EMACS_ADD_TIME (timeout->next_signal_time, current_time, interval);
1161 timeout->interval_id =
1162 event_stream_add_async_timeout (timeout->next_signal_time);
1163 pending_async_timeout_list = noseeum_cons (op,
1164 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 GCPRO1 (op); /* just in case ... because it's removed from the list
1202 timeout_list = async_p ? &pending_async_timeout_list : &pending_timeout_list;
1204 /* Find the timeout on the list of pending ones. */
1205 LIST_LOOP (rest, *timeout_list)
1207 timeout = XTIMEOUT (XCAR (rest));
1208 if (timeout->interval_id == interval_id)
1212 assert (!NILP (rest));
1214 timeout = XTIMEOUT (op);
1215 /* We make sure to snarf the data out of the timeout object before
1216 we free it with free_managed_lcrecord(). */
1218 *function = timeout->function;
1219 *object = timeout->object;
1221 /* Remove this one from the list of pending timeouts */
1222 *timeout_list = delq_no_quit_and_free_cons (op, *timeout_list);
1224 /* If this timeout wants to be resignalled, do it now. */
1225 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));
1242 EMACS_ADD_TIME (timeout->next_signal_time, timeout->next_signal_time,
1244 } while (EMACS_TIME_GREATER (current_time, timeout->next_signal_time));
1247 timeout->interval_id =
1248 event_stream_add_async_timeout (timeout->next_signal_time);
1250 timeout->interval_id =
1251 event_stream_add_timeout (timeout->next_signal_time);
1252 /* Add back onto the list. Note that the effect of this
1253 is to move frequently-hit timeouts to the front of the
1254 list, which is a good thing. */
1255 *timeout_list = noseeum_cons (op, *timeout_list);
1258 free_managed_lcrecord (Vtimeout_free_list, op);
1265 event_stream_disable_wakeup (int id, int async_p)
1267 Lisp_Timeout *timeout = 0;
1269 Lisp_Object *timeout_list;
1272 timeout_list = &pending_async_timeout_list;
1274 timeout_list = &pending_timeout_list;
1276 /* Find the timeout on the list of pending ones, if it's still there. */
1277 LIST_LOOP (rest, *timeout_list)
1279 timeout = XTIMEOUT (XCAR (rest));
1280 if (timeout->id == id)
1284 /* If we found it, remove it from the list and disable the pending
1288 Lisp_Object op = XCAR (rest);
1290 delq_no_quit_and_free_cons (op, *timeout_list);
1292 event_stream_remove_async_timeout (timeout->interval_id);
1294 event_stream_remove_timeout (timeout->interval_id);
1295 free_managed_lcrecord (Vtimeout_free_list, op);
1300 event_stream_wakeup_pending_p (int id, int async_p)
1302 Lisp_Timeout *timeout;
1304 Lisp_Object timeout_list;
1309 timeout_list = pending_async_timeout_list;
1311 timeout_list = pending_timeout_list;
1313 /* Find the element on the list of pending ones, if it's still there. */
1314 LIST_LOOP (rest, timeout_list)
1316 timeout = XTIMEOUT (XCAR (rest));
1317 if (timeout->id == id)
1328 /**** Asynch. timeout functions (see also signal.c) ****/
1330 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1331 extern int poll_for_quit_id;
1334 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1335 extern int poll_for_sigchld_id;
1339 event_stream_deal_with_async_timeout (int interval_id)
1341 /* This function can GC */
1342 Lisp_Object humpty, dumpty;
1343 #if ((!defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)) \
1344 || defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD))
1347 event_stream_resignal_wakeup (interval_id, 1, &humpty, &dumpty);
1349 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1350 if (id == poll_for_quit_id)
1352 quit_check_signal_happened = 1;
1353 quit_check_signal_tick_count++;
1358 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1359 if (id == poll_for_sigchld_id)
1361 kick_status_notify ();
1366 /* call1 GC-protects its arguments */
1367 call1_trapping_errors ("Error in asynchronous timeout callback",
1372 /**** Lisp-level timeout functions. ****/
1374 static unsigned long
1375 lisp_number_to_milliseconds (Lisp_Object secs, int allow_0)
1377 #ifdef LISP_FLOAT_TYPE
1379 CHECK_INT_OR_FLOAT (secs);
1380 fsecs = XFLOATINT (secs);
1384 fsecs = XINT (secs);
1387 signal_simple_error ("timeout is negative", secs);
1388 if (!allow_0 && fsecs == 0)
1389 signal_simple_error ("timeout is non-positive", secs);
1390 if (fsecs >= (((unsigned int) 0xFFFFFFFF) / 1000))
1392 ("timeout would exceed 32 bits when represented in milliseconds", secs);
1394 return (unsigned long) (1000 * fsecs);
1397 DEFUN ("add-timeout", Fadd_timeout, 3, 4, 0, /*
1398 Add a timeout, to be signaled after the timeout period has elapsed.
1399 SECS is a number of seconds, expressed as an integer or a float.
1400 FUNCTION will be called after that many seconds have elapsed, with one
1401 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1402 then after this timeout expires, `add-timeout' will automatically be called
1403 again with RESIGNAL as the first argument.
1405 This function returns an object which is the id number of this particular
1406 timeout. You can pass that object to `disable-timeout' to turn off the
1407 timeout before it has been signalled.
1409 NOTE: Id numbers as returned by this function are in a distinct namespace
1410 from those returned by `add-async-timeout'. This means that the same id
1411 number could refer to a pending synchronous timeout and a different pending
1412 asynchronous timeout, and that you cannot pass an id from `add-timeout'
1413 to `disable-async-timeout', or vice-versa.
1415 The number of seconds may be expressed as a floating-point number, in which
1416 case some fractional part of a second will be used. Caveat: the usable
1417 timeout granularity will vary from system to system.
1419 Adding a timeout causes a timeout event to be returned by `next-event', and
1420 the function will be invoked by `dispatch-event,' so if emacs is in a tight
1421 loop, the function will not be invoked until the next call to sit-for or
1422 until the return to top-level (the same is true of process filters).
1424 If you need to have a timeout executed even when XEmacs is in the midst of
1425 running Lisp code, use `add-async-timeout'.
1427 WARNING: if you are thinking of calling add-timeout from inside of a
1428 callback function as a way of resignalling a timeout, think again. There
1429 is a race condition. That's why the RESIGNAL argument exists.
1431 (secs, function, object, resignal))
1433 unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
1434 unsigned long msecs2 = (NILP (resignal) ? 0 :
1435 lisp_number_to_milliseconds (resignal, 0));
1438 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 0);
1439 lid = make_int (id);
1440 if (id != XINT (lid)) abort ();
1444 DEFUN ("disable-timeout", Fdisable_timeout, 1, 1, 0, /*
1445 Disable a timeout from signalling any more.
1446 ID should be a timeout id number as returned by `add-timeout'. If ID
1447 corresponds to a one-shot timeout that has already signalled, nothing
1450 It will not work to call this function on an id number returned by
1451 `add-async-timeout'. Use `disable-async-timeout' for that.
1456 event_stream_disable_wakeup (XINT (id), 0);
1460 DEFUN ("add-async-timeout", Fadd_async_timeout, 3, 4, 0, /*
1461 Add an asynchronous timeout, to be signaled after an interval has elapsed.
1462 SECS is a number of seconds, expressed as an integer or a float.
1463 FUNCTION will be called after that many seconds have elapsed, with one
1464 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1465 then after this timeout expires, `add-async-timeout' will automatically be
1466 called again with RESIGNAL as the first argument.
1468 This function returns an object which is the id number of this particular
1469 timeout. You can pass that object to `disable-async-timeout' to turn off
1470 the timeout before it has been signalled.
1472 NOTE: Id numbers as returned by this function are in a distinct namespace
1473 from those returned by `add-timeout'. This means that the same id number
1474 could refer to a pending synchronous timeout and a different pending
1475 asynchronous timeout, and that you cannot pass an id from
1476 `add-async-timeout' to `disable-timeout', or vice-versa.
1478 The number of seconds may be expressed as a floating-point number, in which
1479 case some fractional part of a second will be used. Caveat: the usable
1480 timeout granularity will vary from system to system.
1482 Adding an asynchronous timeout causes the function to be invoked as soon
1483 as the timeout occurs, even if XEmacs is in the midst of executing some
1484 other code. (This is unlike the synchronous timeouts added with
1485 `add-timeout', where the timeout will only be signalled when XEmacs is
1486 waiting for events, i.e. the next return to top-level or invocation of
1487 `sit-for' or related functions.) This means that the function that is
1488 called *must* not signal an error or change any global state (e.g. switch
1489 buffers or windows) except when locking code is in place to make sure
1490 that race conditions don't occur in the interaction between the
1491 asynchronous timeout function and other code.
1493 Under most circumstances, you should use `add-timeout' instead, as it is
1494 much safer. Asynchronous timeouts should only be used when such behavior
1495 is really necessary.
1497 Asynchronous timeouts are blocked and will not occur when `inhibit-quit'
1498 is non-nil. As soon as `inhibit-quit' becomes nil again, any pending
1499 asynchronous timeouts will get called immediately. (Multiple occurrences
1500 of the same asynchronous timeout are not queued, however.) While the
1501 callback function of an asynchronous timeout is invoked, `inhibit-quit'
1502 is automatically bound to non-nil, and thus other asynchronous timeouts
1503 will be blocked unless the callback function explicitly sets `inhibit-quit'
1506 WARNING: if you are thinking of calling `add-async-timeout' from inside of a
1507 callback function as a way of resignalling a timeout, think again. There
1508 is a race condition. That's why the RESIGNAL argument exists.
1510 (secs, function, object, resignal))
1512 unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
1513 unsigned long msecs2 = (NILP (resignal) ? 0 :
1514 lisp_number_to_milliseconds (resignal, 0));
1517 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 1);
1518 lid = make_int (id);
1519 if (id != XINT (lid)) abort ();
1523 DEFUN ("disable-async-timeout", Fdisable_async_timeout, 1, 1, 0, /*
1524 Disable an asynchronous timeout from signalling any more.
1525 ID should be a timeout id number as returned by `add-async-timeout'. If ID
1526 corresponds to a one-shot timeout that has already signalled, nothing
1529 It will not work to call this function on an id number returned by
1530 `add-timeout'. Use `disable-timeout' for that.
1535 event_stream_disable_wakeup (XINT (id), 1);
1540 /**********************************************************************/
1541 /* enqueuing and dequeuing events */
1542 /**********************************************************************/
1544 /* Add an event to the back of the command-event queue: it will be the next
1545 event read after all pending events. This only works on keyboard,
1546 mouse-click, misc-user, and eval events.
1549 enqueue_command_event (Lisp_Object event)
1551 enqueue_event (event, &command_event_queue, &command_event_queue_tail);
1555 dequeue_command_event (void)
1557 return dequeue_event (&command_event_queue, &command_event_queue_tail);
1560 /* put the event on the typeahead queue, unless
1561 the event is the quit char, in which case the `QUIT'
1562 which will occur on the next trip through this loop is
1563 all the processing we should do - leaving it on the queue
1564 would cause the quit to be processed twice.
1567 enqueue_command_event_1 (Lisp_Object event_to_copy)
1569 /* do not call check_quit() here. Vquit_flag was set in
1570 next_event_internal. */
1571 if (NILP (Vquit_flag))
1572 enqueue_command_event (Fcopy_event (event_to_copy, Qnil));
1576 enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object)
1578 Lisp_Object event = Fmake_event (Qnil, Qnil);
1580 XEVENT (event)->event_type = magic_eval_event;
1581 /* channel for magic_eval events is nil */
1582 XEVENT (event)->event.magic_eval.internal_function = fun;
1583 XEVENT (event)->event.magic_eval.object = object;
1584 enqueue_command_event (event);
1587 DEFUN ("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0, /*
1588 Add an eval event to the back of the eval event queue.
1589 When this event is dispatched, FUNCTION (which should be a function
1590 of one argument) will be called with OBJECT as its argument.
1591 See `next-event' for a description of event types and how events
1596 Lisp_Object event = Fmake_event (Qnil, Qnil);
1598 XEVENT (event)->event_type = eval_event;
1599 /* channel for eval events is nil */
1600 XEVENT (event)->event.eval.function = function;
1601 XEVENT (event)->event.eval.object = object;
1602 enqueue_command_event (event);
1608 enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function,
1611 Lisp_Object event = Fmake_event (Qnil, Qnil);
1613 XEVENT (event)->event_type = misc_user_event;
1614 XEVENT (event)->channel = channel;
1615 XEVENT (event)->event.misc.function = function;
1616 XEVENT (event)->event.misc.object = object;
1617 XEVENT (event)->event.misc.button = 0;
1618 XEVENT (event)->event.misc.modifiers = 0;
1619 XEVENT (event)->event.misc.x = -1;
1620 XEVENT (event)->event.misc.y = -1;
1621 enqueue_command_event (event);
1627 enqueue_misc_user_event_pos (Lisp_Object channel, Lisp_Object function,
1629 int button, int modifiers, int x, int y)
1631 Lisp_Object event = Fmake_event (Qnil, Qnil);
1633 XEVENT (event)->event_type = misc_user_event;
1634 XEVENT (event)->channel = channel;
1635 XEVENT (event)->event.misc.function = function;
1636 XEVENT (event)->event.misc.object = object;
1637 XEVENT (event)->event.misc.button = button;
1638 XEVENT (event)->event.misc.modifiers = modifiers;
1639 XEVENT (event)->event.misc.x = x;
1640 XEVENT (event)->event.misc.y = y;
1641 enqueue_command_event (event);
1647 /**********************************************************************/
1648 /* focus-event handling */
1649 /**********************************************************************/
1653 Ben's capsule lecture on focus:
1655 In FSFmacs `select-frame' never changes the window-manager frame
1656 focus. All it does is change the "selected frame". This is similar
1657 to what happens when we call `select-device' or `select-console'.
1658 Whenever an event comes in (including a keyboard event), its frame is
1659 selected; therefore, evaluating `select-frame' in *scratch* won't
1660 cause any effects because the next received event (in the same frame)
1661 will cause a switch back to the frame displaying *scratch*.
1663 Whenever a focus-change event is received from the window manager, it
1664 generates a `switch-frame' event, which causes the Lisp function
1665 `handle-switch-frame' to get run. This basically just runs
1666 `select-frame' (see below, however).
1668 In FSFmacs, if you want to have an operation run when a frame is
1669 selected, you supply an event binding for `switch-frame' (and then
1670 maybe call `handle-switch-frame', or something ...).
1672 In XEmacs, we *do* change the window-manager frame focus as a result
1673 of `select-frame', but not until the next time an event is received,
1674 so that a function that momentarily changes the selected frame won't
1675 cause WM focus flashing. (#### There's something not quite right here;
1676 this is causing the wrong-cursor-focus problems that you occasionally
1677 see. But the general idea is correct.) This approach is winning for
1678 people who use the explicit-focus model, but is trickier to implement.
1680 We also don't make the `switch-frame' event visible but instead have
1681 `select-frame-hook', which is a better approach.
1683 There is the problem of surrogate minibuffers, where when we enter the
1684 minibuffer, you essentially want to temporarily switch the WM focus to
1685 the frame with the minibuffer, and switch it back when you exit the
1688 FSFmacs solves this with the crockish `redirect-frame-focus', which
1689 says "for keyboard events received from FRAME, act like they're
1690 coming from FOCUS-FRAME". I think what this means is that, when
1691 a keyboard event comes in and the event manager is about to select the
1692 event's frame, if that frame has its focus redirected, the redirected-to
1693 frame is selected instead. That way, if you're in a minibufferless
1694 frame and enter the minibuffer, then all Lisp functions that run see
1695 the selected frame as the minibuffer's frame rather than the minibufferless
1696 frame you came from, so that (e.g.) your typing actually appears in
1697 the minibuffer's frame and things behave sanely.
1699 There's also some weird logic that switches the redirected frame focus
1700 from one frame to another if Lisp code explicitly calls `select-frame'
1701 \(but not if `handle-switch-frame' is called), and saves and restores
1702 the frame focus in window configurations, etc. etc. All of this logic
1703 is heavily #if 0'd, with lots of comments saying "No, this approach
1704 doesn't seem to work, so I'm trying this ... is it reasonable?
1705 Well, I'm not sure ..." that are a red flag indicating crockishness.
1707 Because of our way of doing things, we can avoid all this crock.
1708 Keyboard events never cause a select-frame (who cares what frame
1709 they're associated with? They come from a console, only). We change
1710 the actual WM focus to a surrogate minibuffer frame, so we don't have
1711 to do any internal redirection. In order to get the focus back,
1712 I took the approach in minibuf.el of just checking to see if the
1713 frame we moved to is still the selected frame, and move back to the
1714 old one if so. Conceivably we might have to do the weird "tracking"
1715 that FSFmacs does when `select-frame' is called, but I don't think
1716 so. If the selected frame moved from the minibuffer frame, then
1717 we just leave it there, figuring that someone knows what they're
1718 doing. Because we don't have any redirection recorded anywhere,
1719 it's safe to do this, and we don't end up with unwanted redirection.
1724 run_select_frame_hook (void)
1726 run_hook (Qselect_frame_hook);
1730 run_deselect_frame_hook (void)
1732 #if 0 /* unclean! FSF calls this at all sorts of random places,
1733 including a bunch of places in their mouse.el. If this
1734 is implemented, it has to be done cleanly. */
1735 run_hook (Qmouse_leave_buffer_hook); /* #### Correct? It's also
1736 called in `call-interactively'.
1737 Does this mean it will be
1738 called twice? Oh well, FSF
1739 bug -- FSF calls it in
1740 `handle-switch-frame',
1741 which is approximately the
1742 same as the caller of this
1745 run_hook (Qdeselect_frame_hook);
1748 /* When select-frame is called and focus_follows_mouse is false, we want
1749 to tell the window system that the focus should be changed to point to
1750 the new frame. However,
1751 sometimes Lisp functions will temporarily change the selected frame
1752 (e.g. to call a function that operates on the selected frame),
1753 and it's annoying if this focus-change happens exactly when
1754 select-frame is called, because then you get some flickering of the
1755 window-manager border and perhaps other undesirable results. We
1756 really only want to change the focus when we're about to retrieve
1757 an event from the user. To do this, we keep track of the frame
1758 where the window-manager focus lies on, and just before waiting
1759 for user events, check the currently selected frame and change
1760 the focus as necessary.
1762 On the other hand, if focus_follows_mouse is true, we need to switch the
1763 selected frame back to the frame with window manager focus just before we
1764 execute the next command in Fcommand_loop_1, just as the selected buffer is
1765 reverted after a set-buffer.
1767 Both cases are handled by this function. It must be called as appropriate
1768 from these two places, depending on the value of focus_follows_mouse. */
1771 investigate_frame_change (void)
1773 Lisp_Object devcons, concons;
1775 /* if the selected frame was changed, change the window-system
1776 focus to the new frame. We don't do it when select-frame was
1777 called, to avoid flickering and other unwanted side effects when
1778 the frame is just changed temporarily. */
1779 DEVICE_LOOP_NO_BREAK (devcons, concons)
1781 struct device *d = XDEVICE (XCAR (devcons));
1782 Lisp_Object sel_frame = DEVICE_SELECTED_FRAME (d);
1784 /* You'd think that maybe we should use FRAME_WITH_FOCUS_REAL,
1785 but that can cause us to end up in an infinite loop focusing
1786 between two frames. It seems that since the call to `select-frame'
1787 in emacs_handle_focus_change_final() is based on the _FOR_HOOKS
1788 value, we need to do so too. */
1789 if (!NILP (sel_frame) &&
1790 !EQ (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d), sel_frame) &&
1791 !NILP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)) &&
1792 !EQ (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d), sel_frame))
1794 /* At this point, we know that the frame has been changed. Now, if
1795 * focus_follows_mouse is not set, we finish off the frame change,
1796 * so that user events will now come from the new frame. Otherwise,
1797 * if focus_follows_mouse is set, no gratuitous frame changing
1798 * should take place. Set the focus back to the frame which was
1799 * originally selected for user input.
1801 if (!focus_follows_mouse)
1803 /* prevent us from issuing the same request more than once */
1804 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = sel_frame;
1805 MAYBE_DEVMETH (d, focus_on_frame, (XFRAME (sel_frame)));
1809 Lisp_Object old_frame = Qnil;
1811 /* #### Do we really want to check OUGHT ??
1812 * It seems to make sense, though I have never seen us
1813 * get here and have it be non-nil.
1815 if (FRAMEP (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d)))
1816 old_frame = DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d);
1817 else if (FRAMEP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)))
1818 old_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1820 /* #### Can old_frame ever be NIL? play it safe.. */
1821 if (!NILP (old_frame))
1823 /* Fselect_frame is not really the right thing: it frobs the
1824 * buffer stack. But there's no easy way to do the right
1825 * thing, and this code already had this problem anyway.
1827 Fselect_frame (old_frame);
1835 cleanup_after_missed_defocusing (Lisp_Object frame)
1837 if (FRAMEP (frame) && FRAME_LIVE_P (XFRAME (frame)))
1838 Fselect_frame (frame);
1843 emacs_handle_focus_change_preliminary (Lisp_Object frame_inp_and_dev)
1845 Lisp_Object frame = Fcar (frame_inp_and_dev);
1846 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev));
1847 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev)));
1850 if (!DEVICE_LIVE_P (XDEVICE (device)))
1853 d = XDEVICE (device);
1855 /* Any received focus-change notifications render invalid any
1856 pending focus-change requests. */
1857 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = Qnil;
1860 Lisp_Object focus_frame;
1862 if (!FRAME_LIVE_P (XFRAME (frame)))
1865 focus_frame = DEVICE_FRAME_WITH_FOCUS_REAL (d);
1867 /* Mark the minibuffer as changed to make sure it gets updated
1868 properly if the echo area is active. */
1870 struct window *w = XWINDOW (FRAME_MINIBUF_WINDOW (XFRAME (frame)));
1871 MARK_WINDOWS_CHANGED (w);
1874 if (FRAMEP (focus_frame) && !EQ (frame, focus_frame))
1876 /* Oops, we missed a focus-out event. */
1877 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
1878 redisplay_redraw_cursor (XFRAME (focus_frame), 1);
1880 DEVICE_FRAME_WITH_FOCUS_REAL (d) = frame;
1881 if (!EQ (frame, focus_frame))
1883 redisplay_redraw_cursor (XFRAME (frame), 1);
1888 /* We ignore the frame reported in the event. If it's different
1889 from where we think the focus was, oh well -- we messed up.
1890 Nonetheless, we pretend we were right, for sensible behavior. */
1891 frame = DEVICE_FRAME_WITH_FOCUS_REAL (d);
1894 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
1896 if (FRAME_LIVE_P (XFRAME (frame)))
1897 redisplay_redraw_cursor (XFRAME (frame), 1);
1902 /* Called from the window-system-specific code when we receive a
1903 notification that the focus lies on a particular frame.
1904 Argument is a cons: (frame . (device . in-p)) where in-p is non-nil
1908 emacs_handle_focus_change_final (Lisp_Object frame_inp_and_dev)
1910 Lisp_Object frame = Fcar (frame_inp_and_dev);
1911 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev));
1912 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev)));
1916 if (!DEVICE_LIVE_P (XDEVICE (device)))
1919 d = XDEVICE (device);
1923 Lisp_Object focus_frame;
1925 if (!FRAME_LIVE_P (XFRAME (frame)))
1928 focus_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1930 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = frame;
1931 if (FRAMEP (focus_frame) && !EQ (frame, focus_frame))
1933 /* Oops, we missed a focus-out event. */
1934 Fselect_frame (focus_frame);
1935 /* Do an unwind-protect in case an error occurs in
1936 the deselect-frame-hook */
1937 count = specpdl_depth ();
1938 record_unwind_protect (cleanup_after_missed_defocusing, frame);
1939 run_deselect_frame_hook ();
1940 unbind_to (count, Qnil);
1941 /* the cleanup method changed the focus frame to nil, so
1942 we need to reflect this */
1946 Fselect_frame (frame);
1947 if (!EQ (frame, focus_frame))
1948 run_select_frame_hook ();
1952 /* We ignore the frame reported in the event. If it's different
1953 from where we think the focus was, oh well -- we messed up.
1954 Nonetheless, we pretend we were right, for sensible behavior. */
1955 frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1958 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = Qnil;
1959 run_deselect_frame_hook ();
1965 /**********************************************************************/
1966 /* retrieving the next event */
1967 /**********************************************************************/
1969 static int in_single_console;
1971 /* #### These functions don't currently do anything. */
1973 single_console_state (void)
1975 in_single_console = 1;
1979 any_console_state (void)
1981 in_single_console = 0;
1985 in_single_console_state (void)
1987 return in_single_console;
1990 /* the number of keyboard characters read. callint.c wants this. */
1991 Charcount num_input_chars;
1994 next_event_internal (Lisp_Object target_event, int allow_queued)
1996 struct gcpro gcpro1;
1997 /* QUIT; This is incorrect - the caller must do this because some
1998 callers (ie, Fnext_event()) do not want to QUIT. */
2000 assert (NILP (XEVENT_NEXT (target_event)));
2002 GCPRO1 (target_event);
2004 /* When focus_follows_mouse is nil, if a frame change took place, we need
2005 * to actually switch window manager focus to the selected window now.
2007 if (!focus_follows_mouse)
2008 investigate_frame_change ();
2010 if (allow_queued && !NILP (command_event_queue))
2012 Lisp_Object event = dequeue_command_event ();
2013 Fcopy_event (event, target_event);
2014 Fdeallocate_event (event);
2015 DEBUG_PRINT_EMACS_EVENT ("command event queue", target_event);
2019 Lisp_Event *e = XEVENT (target_event);
2021 /* The command_event_queue was empty. Wait for an event. */
2022 event_stream_next_event (e);
2023 /* If this was a timeout, then we need to extract some data
2024 out of the returned closure and might need to resignal
2026 if (e->event_type == timeout_event)
2028 Lisp_Object tristan, isolde;
2030 e->event.timeout.id_number =
2031 event_stream_resignal_wakeup (e->event.timeout.interval_id, 0,
2034 e->event.timeout.function = tristan;
2035 e->event.timeout.object = isolde;
2036 /* next_event_internal() doesn't print out timeout events
2037 because of the extra info we just set. */
2038 DEBUG_PRINT_EMACS_EVENT ("real, timeout", target_event);
2041 /* If we read a ^G, then set quit-flag but do not discard the ^G.
2042 The callers of next_event_internal() will do one of two things:
2044 -- set Vquit_flag to Qnil. (next-event does this.) This will
2045 cause the ^G to be treated as a normal keystroke.
2046 -- not change Vquit_flag but attempt to enqueue the ^G, at
2047 which point it will be discarded. The next time QUIT is
2048 called, it will notice that Vquit_flag was set.
2051 if (e->event_type == key_press_event &&
2052 event_matches_key_specifier_p
2053 (e, make_char (CONSOLE_QUIT_CHAR (XCONSOLE (EVENT_CHANNEL (e))))))
2063 run_pre_idle_hook (void)
2065 if (!NILP (Vpre_idle_hook)
2066 && !detect_input_pending ())
2067 safe_run_hook_trapping_errors
2068 ("Error in `pre-idle-hook' (setting hook to nil)",
2072 static void push_this_command_keys (Lisp_Object event);
2073 static void push_recent_keys (Lisp_Object event);
2074 static void dribble_out_event (Lisp_Object event);
2075 static void execute_internal_event (Lisp_Object event);
2077 DEFUN ("next-event", Fnext_event, 0, 2, 0, /*
2078 Return the next available event.
2079 Pass this object to `dispatch-event' to handle it.
2080 In most cases, you will want to use `next-command-event', which returns
2081 the next available "user" event (i.e. keypress, button-press,
2082 button-release, or menu selection) instead of this function.
2084 If EVENT is non-nil, it should be an event object and will be filled in
2085 and returned; otherwise a new event object will be created and returned.
2086 If PROMPT is non-nil, it should be a string and will be displayed in the
2087 echo area while this function is waiting for an event.
2089 The next available event will be
2091 -- any events in `unread-command-events' or `unread-command-event'; else
2092 -- the next event in the currently executing keyboard macro, if any; else
2093 -- an event queued by `enqueue-eval-event', if any; else
2094 -- the next available event from the window system or terminal driver.
2096 In the last case, this function will block until an event is available.
2098 The returned event will be one of the following types:
2100 -- a key-press event.
2101 -- a button-press or button-release event.
2102 -- a misc-user-event, meaning the user selected an item on a menu or used
2104 -- a process event, meaning that output from a subprocess is available.
2105 -- a timeout event, meaning that a timeout has elapsed.
2106 -- an eval event, which simply causes a function to be executed when the
2107 event is dispatched. Eval events are generated by `enqueue-eval-event'
2108 or by certain other conditions happening.
2109 -- a magic event, indicating that some window-system-specific event
2110 happened (such as a focus-change notification) that must be handled
2111 synchronously with other events. `dispatch-event' knows what to do with
2116 /* This function can call lisp */
2117 /* #### We start out using the selected console before an event
2118 is received, for echoing the partially completed command.
2119 This is most definitely wrong -- there needs to be a separate
2120 echo area for each console! */
2121 struct console *con = XCONSOLE (Vselected_console);
2122 struct command_builder *command_builder =
2123 XCOMMAND_BUILDER (con->command_builder);
2124 int store_this_key = 0;
2125 struct gcpro gcpro1;
2126 #ifdef LWLIB_MENUBARS_LUCID
2127 extern int in_menu_callback; /* defined in menubar-x.c */
2128 #endif /* LWLIB_MENUBARS_LUCID */
2131 /* DO NOT do QUIT anywhere within this function or the functions it calls.
2132 We want to read the ^G as an event. */
2134 #ifdef LWLIB_MENUBARS_LUCID
2136 * #### Fix the menu code so this isn't necessary.
2138 * We cannot allow the lwmenu code to be reentered, because the
2139 * code is not written to be reentrant and will crash. Therefore
2140 * paths from the menu callbacks back into the menu code have to
2141 * be blocked. Fnext_event is the normal path into the menu code,
2142 * so we signal an error here.
2144 if (in_menu_callback)
2145 error ("Attempt to call next-event inside menu callback");
2146 #endif /* LWLIB_MENUBARS_LUCID */
2149 event = Fmake_event (Qnil, Qnil);
2151 CHECK_LIVE_EVENT (event);
2156 CHECK_STRING (prompt);
2158 len = XSTRING_LENGTH (prompt);
2159 if (command_builder->echo_buf_length < len)
2160 len = command_builder->echo_buf_length - 1;
2161 memcpy (command_builder->echo_buf, XSTRING_DATA (prompt), len);
2162 command_builder->echo_buf[len] = 0;
2163 command_builder->echo_buf_index = len;
2164 echo_area_message (XFRAME (CONSOLE_SELECTED_FRAME (con)),
2165 command_builder->echo_buf,
2167 command_builder->echo_buf_index,
2171 start_over_and_avoid_hosage:
2173 /* If there is something in unread-command-events, simply return it.
2174 But do some error checking to make sure the user hasn't put something
2175 in the unread-command-events that they shouldn't have.
2176 This does not update this-command-keys and recent-keys.
2178 if (!NILP (Vunread_command_events))
2180 if (!CONSP (Vunread_command_events))
2182 Vunread_command_events = Qnil;
2183 signal_error (Qwrong_type_argument,
2184 list3 (Qconsp, Vunread_command_events,
2185 Qunread_command_events));
2189 Lisp_Object e = XCAR (Vunread_command_events);
2190 Vunread_command_events = XCDR (Vunread_command_events);
2191 if (!EVENTP (e) || !command_event_p (e))
2192 signal_error (Qwrong_type_argument,
2193 list3 (Qcommand_event_p, e, Qunread_command_events));
2196 Fcopy_event (e, event);
2197 DEBUG_PRINT_EMACS_EVENT ("unread-command-events", event);
2201 /* Do similar for unread-command-event (obsoleteness support). */
2202 else if (!NILP (Vunread_command_event))
2204 Lisp_Object e = Vunread_command_event;
2205 Vunread_command_event = Qnil;
2207 if (!EVENTP (e) || !command_event_p (e))
2209 signal_error (Qwrong_type_argument,
2210 list3 (Qeventp, e, Qunread_command_event));
2213 Fcopy_event (e, event);
2215 DEBUG_PRINT_EMACS_EVENT ("unread-command-event", event);
2218 /* If we're executing a keyboard macro, take the next event from that,
2219 and update this-command-keys and recent-keys.
2220 Note that the unread-command-events take precedence over kbd macros.
2224 if (!NILP (Vexecuting_macro))
2227 pop_kbd_macro_event (event); /* This throws past us at
2230 DEBUG_PRINT_EMACS_EVENT ("keyboard macro", event);
2232 /* Otherwise, read a real event, possibly from the
2233 command_event_queue, and update this-command-keys and
2237 run_pre_idle_hook ();
2239 next_event_internal (event, 1);
2240 Vquit_flag = Qnil; /* Read C-g as an event. */
2245 status_notify (); /* Notice process change */
2248 alloca (0); /* Cause a garbage collection now */
2249 /* Since we can free the most stuff here
2250 * (since this is typically called from
2251 * the command-loop top-level). */
2252 #endif /* C_ALLOCA */
2254 if (object_dead_p (XEVENT (event)->channel))
2255 /* event_console_or_selected may crash if the channel is dead.
2256 Best just to eat it and get the next event. */
2257 goto start_over_and_avoid_hosage;
2259 /* OK, now we can stop the selected-console kludge and use the
2260 actual console from the event. */
2261 con = event_console_or_selected (event);
2262 command_builder = XCOMMAND_BUILDER (con->command_builder);
2264 switch (XEVENT_TYPE (event))
2268 case button_release_event:
2269 case misc_user_event:
2270 /* don't echo menu accelerator keys */
2271 reset_key_echo (command_builder, 1);
2273 case button_press_event: /* key or mouse input can trigger prompting */
2274 goto STORE_AND_EXECUTE_KEY;
2275 case key_press_event: /* any key input can trigger autosave */
2279 maybe_do_auto_save ();
2281 STORE_AND_EXECUTE_KEY:
2284 echo_key_event (command_builder, event);
2288 /* Store the last-input-event. The semantics of this is that it is
2289 the thing most recently returned by next-command-event. It need
2290 not have come from the keyboard or a keyboard macro, it may have
2291 come from unread-command-events. It's always a command-event (a
2292 key, click, or menu selection), never a motion or process event.
2294 if (!EVENTP (Vlast_input_event))
2295 Vlast_input_event = Fmake_event (Qnil, Qnil);
2296 if (XEVENT_TYPE (Vlast_input_event) == dead_event)
2298 Vlast_input_event = Fmake_event (Qnil, Qnil);
2299 error ("Someone deallocated last-input-event!");
2301 if (! EQ (event, Vlast_input_event))
2302 Fcopy_event (event, Vlast_input_event);
2304 /* last-input-char and last-input-time are derived from
2306 Note that last-input-char will never have its high-bit set, in an
2307 effort to sidestep the ambiguity between M-x and oslash.
2309 Vlast_input_char = Fevent_to_character (Vlast_input_event,
2314 if (!CONSP (Vlast_input_time))
2315 Vlast_input_time = Fcons (Qnil, Qnil);
2316 XCAR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 16) & 0xffff);
2317 XCDR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 0) & 0xffff);
2318 if (!CONSP (Vlast_command_event_time))
2319 Vlast_command_event_time = list3 (Qnil, Qnil, Qnil);
2320 XCAR (Vlast_command_event_time) =
2321 make_int ((EMACS_SECS (t) >> 16) & 0xffff);
2322 XCAR (XCDR (Vlast_command_event_time)) =
2323 make_int ((EMACS_SECS (t) >> 0) & 0xffff);
2324 XCAR (XCDR (XCDR (Vlast_command_event_time)))
2325 = make_int (EMACS_USECS (t));
2327 /* If this key came from the keyboard or from a keyboard macro, then
2328 it goes into the recent-keys and this-command-keys vectors.
2329 If this key came from the keyboard, and we're defining a keyboard
2330 macro, then it goes into the macro.
2334 push_this_command_keys (event);
2335 if (!inhibit_input_event_recording)
2336 push_recent_keys (event);
2337 dribble_out_event (event);
2338 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
2340 if (!EVENTP (command_builder->current_events))
2341 finalize_kbd_macro_chars (con);
2342 store_kbd_macro_event (event);
2345 /* If this is the help char and there is a help form, then execute the
2346 help form and swallow this character. This is the only place where
2347 calling Fnext_event() can cause arbitrary lisp code to run. Note
2348 that execute_help_form() calls Fnext_command_event(), which calls
2349 this function, as well as Fdispatch_event.
2351 if (!NILP (Vhelp_form) &&
2352 event_matches_key_specifier_p (XEVENT (event), Vhelp_char))
2353 execute_help_form (command_builder, event);
2360 DEFUN ("next-command-event", Fnext_command_event, 0, 2, 0, /*
2361 Return the next available "user" event.
2362 Pass this object to `dispatch-event' to handle it.
2364 If EVENT is non-nil, it should be an event object and will be filled in
2365 and returned; otherwise a new event object will be created and returned.
2366 If PROMPT is non-nil, it should be a string and will be displayed in the
2367 echo area while this function is waiting for an event.
2369 The event returned will be a keyboard, mouse press, or mouse release event.
2370 If there are non-command events available (mouse motion, sub-process output,
2371 etc) then these will be executed (with `dispatch-event') and discarded. This
2372 function is provided as a convenience; it is roughly equivalent to the lisp code
2375 (next-event event prompt)
2376 (not (or (key-press-event-p event)
2377 (button-press-event-p event)
2378 (button-release-event-p event)
2379 (misc-user-event-p event))))
2380 (dispatch-event event))
2382 but it also makes a provision for displaying keystrokes in the echo area.
2386 /* This function can GC */
2387 struct gcpro gcpro1;
2389 maybe_echo_keys (XCOMMAND_BUILDER
2390 (XCONSOLE (Vselected_console)->
2391 command_builder), 0); /* #### This sucks bigtime */
2394 event = Fnext_event (event, prompt);
2395 if (command_event_p (event))
2398 execute_internal_event (event);
2405 reset_current_events (struct command_builder *command_builder)
2407 Lisp_Object event = command_builder->current_events;
2408 reset_command_builder_event_chain (command_builder);
2410 deallocate_event_chain (event);
2413 DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /*
2414 Discard any pending "user" events.
2415 Also cancel any kbd macro being defined.
2416 A user event is a key press, button press, button release, or
2417 "misc-user" event (menu selection or scrollbar action).
2421 /* This throws away user-input on the queue, but doesn't process any
2422 events. Calling dispatch_event() here leads to a race condition.
2424 Lisp_Object event = Fmake_event (Qnil, Qnil);
2425 Lisp_Object head = Qnil, tail = Qnil;
2426 Lisp_Object oiq = Vinhibit_quit;
2427 struct gcpro gcpro1, gcpro2;
2428 /* #### not correct here with Vselected_console? Should
2429 discard-input take a console argument, or maybe map over
2431 struct console *con = XCONSOLE (Vselected_console);
2433 /* next_event_internal() can cause arbitrary Lisp code to be evalled */
2434 GCPRO2 (event, oiq);
2436 /* If a macro was being defined then we have to mark the modeline
2437 has changed to ensure that it gets updated correctly. */
2438 if (!NILP (con->defining_kbd_macro))
2439 MARK_MODELINE_CHANGED;
2440 con->defining_kbd_macro = Qnil;
2441 reset_current_events (XCOMMAND_BUILDER (con->command_builder));
2443 while (!NILP (command_event_queue)
2444 || event_stream_event_pending_p (1))
2446 /* This will take stuff off the command_event_queue, or read it
2447 from the event_stream, but it will not block.
2449 next_event_internal (event, 1);
2450 Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it).
2451 It is vitally important that we reset
2452 Vquit_flag here. Otherwise, if we're
2453 reading from a TTY console,
2454 maybe_read_quit_event() will notice
2455 that C-g has been set and send us
2456 another C-g. That will cause us
2457 to get right back here, and read
2458 another C-g, ad infinitum ... */
2460 /* If the event is a user event, ignore it. */
2461 if (!command_event_p (event))
2463 /* Otherwise, chain the event onto our list of events not to ignore,
2464 and keep reading until the queue is empty. This does not mean
2465 that if a subprocess is generating an infinite amount of output,
2466 we will never terminate (*provided* that the behavior of
2467 next_event_cb() is correct -- see the comment in events.h),
2468 because this loop ends as soon as there are no more user events
2469 on the command_event_queue or event_stream.
2471 enqueue_event (Fcopy_event (event, Qnil), &head, &tail);
2475 if (!NILP (command_event_queue) || !NILP (command_event_queue_tail))
2478 /* Now tack our chain of events back on to the front of the queue.
2479 Actually, since the queue is now drained, we can just replace it.
2480 The effect of this will be that we have deleted all user events
2481 from the input stream without changing the relative ordering of
2482 any other events. (Some events may have been taken from the
2483 event_stream and added to the command_event_queue, however.)
2485 At this time, the command_event_queue will contain only eval_events.
2488 command_event_queue = head;
2489 command_event_queue_tail = tail;
2491 Fdeallocate_event (event);
2494 Vinhibit_quit = oiq;
2499 /**********************************************************************/
2500 /* pausing until an action occurs */
2501 /**********************************************************************/
2503 /* This is used in accept-process-output, sleep-for and sit-for.
2504 Before running any process_events in these routines, we set
2505 recursive_sit_for to Qt, and use this unwind protect to reset it to
2506 Qnil upon exit. When recursive_sit_for is Qt, calling sit-for will
2507 cause it to return immediately.
2509 All of these routines install timeouts, so we clear the installed
2512 Note: It's very easy to break the desired behaviors of these
2513 3 routines. If you make any changes to anything in this area, run
2514 the regression tests at the bottom of the file. -- dmoore */
2518 sit_for_unwind (Lisp_Object timeout_id)
2520 if (!NILP(timeout_id))
2521 Fdisable_timeout (timeout_id);
2523 recursive_sit_for = Qnil;
2527 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)?
2530 DEFUN ("accept-process-output", Faccept_process_output, 0, 3, 0, /*
2531 Allow any pending output from subprocesses to be read by Emacs.
2532 It is read into the process' buffers or given to their filter functions.
2533 Non-nil arg PROCESS means do not return until some output has been received
2534 from PROCESS. Nil arg PROCESS means do not return until some output has
2535 been received from any process.
2536 If the second arg is non-nil, it is the maximum number of seconds to wait:
2537 this function will return after that much time even if no input has arrived
2538 from PROCESS. This argument may be a float, meaning wait some fractional
2540 If the third arg is non-nil, it is a number of milliseconds that is added
2541 to the second arg. (This exists only for compatibility.)
2542 Return non-nil iff we received any output before the timeout expired.
2544 (process, timeout_secs, timeout_msecs))
2546 /* This function can GC */
2547 struct gcpro gcpro1, gcpro2;
2548 Lisp_Object event = Qnil;
2549 Lisp_Object result = Qnil;
2550 int timeout_id = -1;
2551 int timeout_enabled = 0;
2553 struct buffer *old_buffer = current_buffer;
2556 /* We preserve the current buffer but nothing else. If a focus
2557 change alters the selected window then the top level event loop
2558 will eventually alter current_buffer to match. In the mean time
2559 we don't want to mess up whatever called this function. */
2561 if (!NILP (process))
2562 CHECK_PROCESS (process);
2564 GCPRO2 (event, process);
2566 if (!NILP (timeout_secs) || !NILP (timeout_msecs))
2568 unsigned long msecs = 0;
2569 if (!NILP (timeout_secs))
2570 msecs = lisp_number_to_milliseconds (timeout_secs, 1);
2571 if (!NILP (timeout_msecs))
2573 CHECK_NATNUM (timeout_msecs);
2574 msecs += XINT (timeout_msecs);
2578 timeout_id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2579 timeout_enabled = 1;
2583 event = Fmake_event (Qnil, Qnil);
2585 count = specpdl_depth ();
2586 record_unwind_protect (sit_for_unwind,
2587 timeout_enabled ? make_int (timeout_id) : Qnil);
2588 recursive_sit_for = Qt;
2591 ((NILP (process) && timeout_enabled) ||
2592 (NILP (process) && event_stream_event_pending_p (0)) ||
2594 /* Calling detect_input_pending() is the wrong thing here, because
2595 that considers the Vunread_command_events and command_event_queue.
2596 We don't need to look at the command_event_queue because we are
2597 only interested in process events, which don't go on that. In
2598 fact, we can't read from it anyway, because we put stuff on it.
2600 Note that event_stream->event_pending_p must be called in such
2601 a way that it says whether any events *of any kind* are ready,
2602 not just user events, or (accept-process-output nil) will fail
2603 to dispatch any process events that may be on the queue. It is
2604 not clear to me that this is important, because the top-level
2605 loop will process it, and I don't think that there is ever a
2606 time when one calls accept-process-output with a nil argument
2607 and really need the processes to be handled. */
2609 /* If our timeout has arrived, we move along. */
2610 if (timeout_enabled && !event_stream_wakeup_pending_p (timeout_id, 0))
2612 timeout_enabled = 0;
2613 done = 1; /* We're done. */
2614 continue; /* Don't call next_event_internal */
2617 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2618 before reading output from the process - this makes it
2619 less likely that the filter will actually be aborted.
2622 next_event_internal (event, 0);
2623 /* If C-g was pressed while we were waiting, Vquit_flag got
2624 set and next_event_internal() also returns C-g. When
2625 we enqueue the C-g below, it will get discarded. The
2626 next time through, QUIT will be called and will signal a quit. */
2627 switch (XEVENT_TYPE (event))
2631 if (NILP (process) ||
2632 EQ (XEVENT (event)->event.process.process, process))
2635 /* RMS's version always returns nil when proc is nil,
2636 and only returns t if input ever arrived on proc. */
2640 execute_internal_event (event);
2644 /* We execute the event even if it's ours, and notice that it's
2646 case pointer_motion_event:
2649 execute_internal_event (event);
2654 enqueue_command_event_1 (event);
2660 unbind_to (count, timeout_enabled ? make_int (timeout_id) : Qnil);
2662 Fdeallocate_event (event);
2664 current_buffer = old_buffer;
2668 DEFUN ("sleep-for", Fsleep_for, 1, 1, 0, /*
2669 Pause, without updating display, for ARG seconds.
2670 ARG may be a float, meaning pause for some fractional part of a second.
2672 It is recommended that you never call sleep-for from inside of a process
2673 filter function or timer event (either synchronous or asynchronous).
2677 /* This function can GC */
2678 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
2680 Lisp_Object event = Qnil;
2682 struct gcpro gcpro1;
2686 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2687 event = Fmake_event (Qnil, Qnil);
2689 count = specpdl_depth ();
2690 record_unwind_protect (sit_for_unwind, make_int (id));
2691 recursive_sit_for = Qt;
2695 /* If our timeout has arrived, we move along. */
2696 if (!event_stream_wakeup_pending_p (id, 0))
2699 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2700 before reading output from the process - this makes it
2701 less likely that the filter will actually be aborted.
2703 /* We're a generator of the command_event_queue, so we can't be a
2704 consumer as well. We don't care about command and eval-events
2707 next_event_internal (event, 0); /* blocks */
2708 /* See the comment in accept-process-output about Vquit_flag */
2709 switch (XEVENT_TYPE (event))
2712 /* We execute the event even if it's ours, and notice that it's
2715 case pointer_motion_event:
2718 execute_internal_event (event);
2723 enqueue_command_event_1 (event);
2729 unbind_to (count, make_int (id));
2730 Fdeallocate_event (event);
2735 DEFUN ("sit-for", Fsit_for, 1, 2, 0, /*
2736 Perform redisplay, then wait ARG seconds or until user input is available.
2737 ARG may be a float, meaning a fractional part of a second.
2738 Optional second arg non-nil means don't redisplay, just wait for input.
2739 Redisplay is preempted as always if user input arrives, and does not
2740 happen if input is available before it starts.
2741 Value is t if waited the full time with no input arriving.
2743 If sit-for is called from within a process filter function or timer
2744 event (either synchronous or asynchronous) it will return immediately.
2746 (seconds, nodisplay))
2748 /* This function can GC */
2749 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
2750 Lisp_Object event, result;
2751 struct gcpro gcpro1;
2755 /* The unread-command-events count as pending input */
2756 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
2759 /* If the command-builder already has user-input on it (not eval events)
2760 then that means we're done too.
2762 if (!NILP (command_event_queue))
2764 EVENT_CHAIN_LOOP (event, command_event_queue)
2766 if (command_event_p (event))
2771 /* If we're in a macro, or noninteractive, or early in temacs, then
2773 if (noninteractive || !NILP (Vexecuting_macro))
2776 /* Recursive call from a filter function or timeout handler. */
2777 if (!NILP(recursive_sit_for))
2779 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
2781 run_pre_idle_hook ();
2788 /* Otherwise, start reading events from the event_stream.
2789 Do this loop at least once even if (sit-for 0) so that we
2790 redisplay when no input pending.
2793 event = Fmake_event (Qnil, Qnil);
2795 /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc.
2796 events get processed. The old (pre-19.12) code special-cased this
2797 and didn't generate a wakeup, but the resulting behavior was less than
2798 ideal; viz. the occurrence of (sit-for 0.001) scattered throughout
2799 the E-Lisp universe. */
2801 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2803 count = specpdl_depth ();
2804 record_unwind_protect (sit_for_unwind, make_int (id));
2805 recursive_sit_for = Qt;
2809 /* If there is no user input pending, then redisplay.
2811 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
2813 run_pre_idle_hook ();
2817 /* If our timeout has arrived, we move along. */
2818 if (!event_stream_wakeup_pending_p (id, 0))
2824 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2825 before reading output from the process - this makes it
2826 less likely that the filter will actually be aborted.
2828 /* We're a generator of the command_event_queue, so we can't be a
2829 consumer as well. In fact, we know there's nothing on the
2830 command_event_queue that we didn't just put there.
2832 next_event_internal (event, 0); /* blocks */
2833 /* See the comment in accept-process-output about Vquit_flag */
2835 if (command_event_p (event))
2837 QUIT; /* If the command was C-g check it here
2838 so that we abort out of the sit-for,
2839 not the next command. sleep-for and
2840 accept-process-output continue looping
2841 so they check QUIT again implicitly.*/
2845 switch (XEVENT_TYPE (event))
2849 /* eval-events get delayed until later. */
2850 enqueue_command_event (Fcopy_event (event, Qnil));
2855 /* We execute the event even if it's ours, and notice that it's
2859 execute_internal_event (event);
2866 unbind_to (count, make_int (id));
2868 /* Put back the event (if any) that made Fsit_for() exit before the
2869 timeout. Note that it is being added to the back of the queue, which
2870 would be inappropriate if there were any user events on the queue
2871 already: we would be misordering them. But we know that there are
2872 no user-events on the queue, or else we would not have reached this
2876 enqueue_command_event (event);
2878 Fdeallocate_event (event);
2884 /* This handy little function is used by xselect.c and energize.c to
2885 wait for replies from processes that aren't really processes (that is,
2886 the X server and the Energize server).
2889 wait_delaying_user_input (int (*predicate) (void *arg), void *predicate_arg)
2891 /* This function can GC */
2892 Lisp_Object event = Fmake_event (Qnil, Qnil);
2893 struct gcpro gcpro1;
2896 while (!(*predicate) (predicate_arg))
2898 QUIT; /* next_event_internal() does not QUIT. */
2900 /* We're a generator of the command_event_queue, so we can't be a
2901 consumer as well. Also, we have no reason to consult the
2902 command_event_queue; there are only user and eval-events there,
2903 and we'd just have to put them back anyway.
2905 next_event_internal (event, 0);
2906 /* See the comment in accept-process-output about Vquit_flag */
2907 if (command_event_p (event)
2908 || (XEVENT_TYPE (event) == eval_event)
2909 || (XEVENT_TYPE (event) == magic_eval_event))
2910 enqueue_command_event_1 (event);
2912 execute_internal_event (event);
2918 /**********************************************************************/
2919 /* dispatching events; command builder */
2920 /**********************************************************************/
2923 execute_internal_event (Lisp_Object event)
2925 /* events on dead channels get silently eaten */
2926 if (object_dead_p (XEVENT (event)->channel))
2929 /* This function can GC */
2930 switch (XEVENT_TYPE (event))
2937 call1 (XEVENT (event)->event.eval.function,
2938 XEVENT (event)->event.eval.object);
2942 case magic_eval_event:
2944 (XEVENT (event)->event.magic_eval.internal_function)
2945 (XEVENT (event)->event.magic_eval.object);
2949 case pointer_motion_event:
2951 if (!NILP (Vmouse_motion_handler))
2952 call1 (Vmouse_motion_handler, event);
2958 Lisp_Object p = XEVENT (event)->event.process.process;
2959 Charcount readstatus;
2961 assert (PROCESSP (p));
2962 while ((readstatus = read_process_output (p)) > 0)
2965 ; /* this clauses never gets executed but allows the #ifdefs
2968 else if (readstatus == -1 && errno == EWOULDBLOCK)
2970 #endif /* EWOULDBLOCK */
2972 else if (readstatus == -1 && errno == EAGAIN)
2975 else if ((readstatus == 0 &&
2976 /* Note that we cannot distinguish between no input
2977 available now and a closed pipe.
2978 With luck, a closed pipe will be accompanied by
2979 subprocess termination and SIGCHLD. */
2980 (!network_connection_p (p) ||
2982 When connected to ToolTalk (i.e.
2983 connected_via_filedesc_p()), it's not possible to
2984 reliably determine whether there is a message
2985 waiting for ToolTalk to receive. ToolTalk expects
2986 to have tt_message_receive() called exactly once
2987 every time the file descriptor becomes active, so
2988 the filter function forces this by returning 0.
2989 Emacs must not interpret this as a closed pipe. */
2990 connected_via_filedesc_p (XPROCESS (p))))
2992 /* On some OSs with ptys, when the process on one end of
2993 a pty exits, the other end gets an error reading with
2994 errno = EIO instead of getting an EOF (0 bytes read).
2995 Therefore, if we get an error reading and errno =
2996 EIO, just continue, because the child process has
2997 exited and should clean itself up soon (e.g. when we
2999 || (readstatus == -1 && errno == EIO)
3003 /* Currently, we rely on SIGCHLD to indicate that the
3004 process has terminated. Unfortunately, on some systems
3005 the SIGCHLD gets missed some of the time. So we put an
3006 additional check in status_notify() to see whether a
3007 process has terminated. We must tell status_notify()
3008 to enable that check, and we do so now. */
3009 kick_status_notify ();
3013 /* Deactivate network connection */
3014 Lisp_Object status = Fprocess_status (p);
3015 if (EQ (status, Qopen)
3016 /* In case somebody changes the theory of whether to
3017 return open as opposed to run for network connection
3019 || EQ (status, Qrun))
3020 update_process_status (p, Qexit, 256, 0);
3021 deactivate_process (p);
3024 /* We must call status_notify here to allow the
3025 event_stream->unselect_process_cb to be run if appropriate.
3026 Otherwise, dead fds may be selected for, and we will get a
3027 continuous stream of process events for them. Since we don't
3028 return until all process events have been flushed, we would
3029 get stuck here, processing events on a process whose status
3030 was 'exit. Call this after dispatch-event, or the fds will
3031 have been closed before we read the last data from them.
3032 It's safe for the filter to signal an error because
3033 status_notify() will be called on return to top-level.
3041 Lisp_Event *e = XEVENT (event);
3042 if (!NILP (e->event.timeout.function))
3043 call1 (e->event.timeout.function,
3044 e->event.timeout.object);
3049 event_stream_handle_magic_event (XEVENT (event));
3060 this_command_keys_replace_suffix (Lisp_Object suffix, Lisp_Object chain)
3062 Lisp_Object first_before_suffix =
3063 event_chain_find_previous (Vthis_command_keys, suffix);
3065 if (NILP (first_before_suffix))
3066 Vthis_command_keys = chain;
3068 XSET_EVENT_NEXT (first_before_suffix, chain);
3069 deallocate_event_chain (suffix);
3070 Vthis_command_keys_tail = event_chain_tail (chain);
3074 command_builder_replace_suffix (struct command_builder *builder,
3075 Lisp_Object suffix, Lisp_Object chain)
3077 Lisp_Object first_before_suffix =
3078 event_chain_find_previous (builder->current_events, suffix);
3080 if (NILP (first_before_suffix))
3081 builder->current_events = chain;
3083 XSET_EVENT_NEXT (first_before_suffix, chain);
3084 deallocate_event_chain (suffix);
3085 builder->most_current_event = event_chain_tail (chain);
3089 command_builder_find_leaf_1 (struct command_builder *builder)
3091 Lisp_Object event0 = builder->current_events;
3096 return event_binding (event0, 1);
3099 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3103 widget_value *current = lw_get_entries (False);
3104 widget_value *entries = lw_get_entries (True);
3105 widget_value *prev = NULL;
3107 while (entries != current)
3109 if (entries->name /*&& entries->enabled*/) prev = entries;
3110 entries = entries->next;
3115 /* move to last item */
3117 while (entries->next)
3119 if (entries->name /*&& entries->enabled*/) prev = entries;
3120 entries = entries->next;
3124 if (entries->name /*&& entries->enabled*/)
3129 /* no selectable items in this menu, pop up to previous level */
3138 menu_move_down (void)
3140 widget_value *current = lw_get_entries (False);
3141 widget_value *new = current;
3146 if (new->name /*&& new->enabled*/) break;
3149 if (new==current||!(new->name/*||new->enabled*/))
3151 new = lw_get_entries (True);
3152 while (new!=current)
3154 if (new->name /*&& new->enabled*/) break;
3157 if (new==current&&!(new->name /*|| new->enabled*/))
3168 menu_move_left (void)
3170 int level = lw_menu_level ();
3172 widget_value *current;
3174 while (level-- >= 3)
3178 current = lw_get_entries (False);
3179 if (l > 2 && current->contents)
3180 lw_push_menu (current->contents);
3184 menu_move_right (void)
3186 int level = lw_menu_level ();
3188 widget_value *current;
3190 while (level-- >= 3)
3194 current = lw_get_entries (False);
3195 if (l > 2 && current->contents)
3196 lw_push_menu (current->contents);
3200 menu_select_item (widget_value *val)
3203 val = lw_get_entries (False);
3205 /* is match a submenu? */
3209 /* enter the submenu */
3212 lw_push_menu (val->contents);
3216 /* Execute the menu entry by calling the menu's `select'
3219 lw_kill_menus (val);
3224 command_builder_operate_menu_accelerator (struct command_builder *builder)
3226 /* this function can GC */
3228 struct console *con = XCONSOLE (Vselected_console);
3229 Lisp_Object evee = builder->most_current_event;
3230 Lisp_Object binding;
3231 widget_value *entries;
3233 extern int lw_menu_accelerate; /* lwlib.c */
3241 t = builder->current_events;
3246 sprintf (buf,"OPERATE (%d): ",i);
3247 write_c_string (buf, Qexternal_debugging_output);
3248 print_internal (t, Qexternal_debugging_output, 1);
3249 write_c_string ("\n", Qexternal_debugging_output);
3250 t = XEVENT_NEXT (t);
3255 /* menu accelerator keys don't go into keyboard macros */
3256 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
3257 con->kbd_macro_ptr = con->kbd_macro_end;
3259 /* don't echo menu accelerator keys */
3260 /*reset_key_echo (builder, 1);*/
3262 if (!lw_menu_accelerate)
3264 /* `convert' mouse display to keyboard display
3265 by entering the open submenu
3267 entries = lw_get_entries (False);
3268 if (entries->contents)
3270 lw_push_menu (entries->contents);
3271 lw_display_menu (CurrentTime);
3275 /* compare event to the current menu accelerators */
3277 entries=lw_get_entries (True);
3282 VOID_TO_LISP (accel, entries->accel);
3283 if (entries->name && !NILP (accel))
3285 if (event_matches_key_specifier_p (XEVENT (evee), accel))
3289 menu_select_item (entries);
3291 if (lw_menu_active) lw_display_menu (CurrentTime);
3293 reset_this_command_keys (Vselected_console, 1);
3294 /*reset_command_builder_event_chain (builder);*/
3295 return Vmenu_accelerator_map;
3298 entries = entries->next;
3301 /* try to look up event in menu-accelerator-map */
3303 binding = event_binding_in (evee, Vmenu_accelerator_map, 1);
3307 /* beep at user for undefined key */
3312 if (EQ (binding, Qmenu_quit))
3314 /* turn off menus and set quit flag */
3315 lw_kill_menus (NULL);
3318 else if (EQ (binding, Qmenu_up))
3320 int level = lw_menu_level ();
3324 else if (EQ (binding, Qmenu_down))
3326 int level = lw_menu_level ();
3330 menu_select_item (NULL);
3332 else if (EQ (binding, Qmenu_left))
3334 int level = lw_menu_level ();
3338 lw_display_menu (CurrentTime);
3343 else if (EQ (binding, Qmenu_right))
3345 int level = lw_menu_level ();
3347 lw_get_entries (False)->contents)
3349 widget_value *current = lw_get_entries (False);
3350 if (current->contents)
3351 menu_select_item (NULL);
3356 else if (EQ (binding, Qmenu_select))
3357 menu_select_item (NULL);
3358 else if (EQ (binding, Qmenu_escape))
3360 int level = lw_menu_level ();
3365 lw_display_menu (CurrentTime);
3369 /* turn off menus quietly */
3370 lw_kill_menus (NULL);
3373 else if (KEYMAPP (binding))
3376 reset_this_command_keys (Vselected_console, 1);
3377 /*reset_command_builder_event_chain (builder);*/
3382 /* turn off menus and execute binding */
3383 lw_kill_menus (NULL);
3384 reset_this_command_keys (Vselected_console, 1);
3385 /*reset_command_builder_event_chain (builder);*/
3390 if (lw_menu_active) lw_display_menu (CurrentTime);
3392 reset_this_command_keys (Vselected_console, 1);
3393 /*reset_command_builder_event_chain (builder);*/
3395 return Vmenu_accelerator_map;
3399 menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored)
3401 Vmenu_accelerator_prefix = Qnil;
3402 Vmenu_accelerator_modifiers = Qnil;
3403 Vmenu_accelerator_enabled = Qnil;
3404 if (!NILP (errordata))
3406 Lisp_Object args[2];
3408 args[0] = build_string ("Error in menu accelerators (setting to nil)");
3409 /* #### This should call
3410 (with-output-to-string (display-error errordata))
3411 but that stuff is all in Lisp currently. */
3412 args[1] = errordata;
3413 warn_when_safe_lispobj
3415 emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s",
3416 Qnil, -1, 2, args));
3423 menu_accelerator_safe_compare (Lisp_Object event0)
3425 if (CONSP (Vmenu_accelerator_prefix))
3428 t=Vmenu_accelerator_prefix;
3431 && event_matches_key_specifier_p (XEVENT (event0), Fcar (t)))
3434 event0 = XEVENT_NEXT (event0);
3439 else if (NILP (event0))
3441 else if (event_matches_key_specifier_p (XEVENT (event0), Vmenu_accelerator_prefix))
3442 event0 = XEVENT_NEXT (event0);
3449 menu_accelerator_safe_mod_compare (Lisp_Object cons)
3451 return (event_matches_key_specifier_p (XEVENT (XCAR (cons)), XCDR (cons))
3457 command_builder_find_menu_accelerator (struct command_builder *builder)
3459 /* this function can GC */
3460 Lisp_Object event0 = builder->current_events;
3461 struct console *con = XCONSOLE (Vselected_console);
3462 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
3463 Widget menubar_widget;
3465 /* compare entries in event0 against the menu prefix */
3467 if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) ||
3468 XEVENT (event0)->event_type != key_press_event)
3471 if (!NILP (Vmenu_accelerator_prefix))
3473 event0 = condition_case_1 (Qerror,
3474 menu_accelerator_safe_compare,
3476 menu_accelerator_junk_on_error,
3483 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
3485 && CONSP (Vmenu_accelerator_modifiers))
3488 Lisp_Object last = Qnil;
3489 struct gcpro gcpro1;
3493 LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id;
3495 val = lw_get_all_values (id);
3498 val = val->contents;
3500 fake = Fcopy_sequence (Vmenu_accelerator_modifiers);
3503 while (!NILP (Fcdr (last)))
3506 Fsetcdr (last, Fcons (Qnil, Qnil));
3510 fake = Fcons (Qnil, fake);
3517 VOID_TO_LISP (accel, val->accel);
3518 if (val->name && !NILP (accel))
3520 Fsetcar (last, accel);
3521 Fsetcar (fake, event0);
3522 matchp = condition_case_1 (Qerror,
3523 menu_accelerator_safe_mod_compare,
3525 menu_accelerator_junk_on_error,
3531 lw_set_menu (menubar_widget, val);
3532 /* yah - yet another hack.
3533 pretend emacs timestamp is the same as an X timestamp,
3534 which for the moment it is. (read events.h)
3536 lw_map_menu (XEVENT (event0)->timestamp);
3539 lw_push_menu (val->contents);
3541 lw_display_menu (CurrentTime);
3543 /* menu accelerator keys don't go into keyboard macros */
3544 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
3545 con->kbd_macro_ptr = con->kbd_macro_end;
3547 /* don't echo menu accelerator keys */
3548 /*reset_key_echo (builder, 1);*/
3549 reset_this_command_keys (Vselected_console, 1);
3552 return Vmenu_accelerator_map;
3565 DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /*
3566 Make the menubar active. Menu items can be selected using menu accelerators
3567 or by actions defined in menu-accelerator-map.
3571 struct console *con = XCONSOLE (Vselected_console);
3572 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
3576 if (NILP (f->menubar_data))
3577 error ("Frame has no menubar.");
3579 id = XPOPUP_DATA (f->menubar_data)->id;
3580 val = lw_get_all_values (id);
3581 val = val->contents;
3582 lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val);
3583 lw_map_menu (CurrentTime);
3585 lw_display_menu (CurrentTime);
3587 /* menu accelerator keys don't go into keyboard macros */
3588 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
3589 con->kbd_macro_ptr = con->kbd_macro_end;
3593 #endif /* HAVE_X_WINDOWS && HAVE_MENUBARS */
3595 /* See if we can do function-key-map or key-translation-map translation
3596 on the current events in the command builder. If so, do this, and
3597 return the resulting binding, if any. */
3600 munge_keymap_translate (struct command_builder *builder,
3601 enum munge_me_out_the_door munge,
3602 int has_normal_binding_p)
3606 EVENT_CHAIN_LOOP (suffix, builder->munge_me[munge].first_mungeable_event)
3608 Lisp_Object result = munging_key_map_event_binding (suffix, munge);
3613 if (KEYMAPP (result))
3615 if (NILP (builder->last_non_munged_event)
3616 && !has_normal_binding_p)
3617 builder->last_non_munged_event = builder->most_current_event;
3620 builder->last_non_munged_event = Qnil;
3622 if (!KEYMAPP (result) &&
3623 !VECTORP (result) &&
3626 struct gcpro gcpro1;
3628 result = call1 (result, Qnil);
3634 if (KEYMAPP (result))
3637 if (VECTORP (result) || STRINGP (result))
3639 Lisp_Object new_chain = key_sequence_to_event_chain (result);
3643 /* If the first_mungeable_event of the other munger is
3644 within the events we're munging, then it will point to
3645 deallocated events afterwards, which is bad -- so make it
3646 point at the beginning of the munged events. */
3647 EVENT_CHAIN_LOOP (tempev, suffix)
3649 Lisp_Object *mungeable_event =
3650 &builder->munge_me[1 - munge].first_mungeable_event;
3651 if (EQ (tempev, *mungeable_event))
3653 *mungeable_event = new_chain;
3658 n = event_chain_count (suffix);
3659 command_builder_replace_suffix (builder, suffix, new_chain);
3660 builder->munge_me[munge].first_mungeable_event = Qnil;
3661 /* Now hork this-command-keys as well. */
3663 /* We just assume that the events we just replaced are
3664 sitting in copied form at the end of this-command-keys.
3665 If the user did weird things with `dispatch-event' this
3666 may not be the case, but at least we make sure we won't
3668 new_chain = copy_event_chain (new_chain);
3669 tckn = event_chain_count (Vthis_command_keys);
3672 this_command_keys_replace_suffix
3673 (event_chain_nth (Vthis_command_keys, tckn - n),
3677 result = command_builder_find_leaf_1 (builder);
3681 signal_simple_error ((munge == MUNGE_ME_FUNCTION_KEY ?
3682 "Invalid binding in function-key-map" :
3683 "Invalid binding in key-translation-map"),
3690 /* Compare the current state of the command builder against the local and
3691 global keymaps, and return the binding. If there is no match, try again,
3692 case-insensitively. The return value will be one of:
3693 -- nil (there is no binding)
3694 -- a keymap (part of a command has been specified)
3695 -- a command (anything that satisfies `commandp'; this includes
3696 some symbols, lists, subrs, strings, vectors, and
3697 compiled-function objects)
3700 command_builder_find_leaf (struct command_builder *builder,
3701 int allow_misc_user_events_p)
3703 /* This function can GC */
3705 Lisp_Object evee = builder->current_events;
3707 if (XEVENT_TYPE (evee) == misc_user_event)
3709 if (allow_misc_user_events_p && (NILP (XEVENT_NEXT (evee))))
3710 return list2 (XEVENT (evee)->event.eval.function,
3711 XEVENT (evee)->event.eval.object);
3716 /* if we're currently in a menu accelerator, check there for further events */
3717 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3720 return command_builder_operate_menu_accelerator (builder);
3725 if (EQ (Vmenu_accelerator_enabled, Qmenu_force))
3726 result = command_builder_find_menu_accelerator (builder);
3729 result = command_builder_find_leaf_1 (builder);
3730 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3732 && EQ (Vmenu_accelerator_enabled, Qmenu_fallback))
3733 result = command_builder_find_menu_accelerator (builder);
3737 /* Check to see if we have a potential function-key-map match. */
3740 result = munge_keymap_translate (builder, MUNGE_ME_FUNCTION_KEY, 0);
3741 regenerate_echo_keys_from_this_command_keys (builder);
3743 /* Check to see if we have a potential key-translation-map match. */
3745 Lisp_Object key_translate_result =
3746 munge_keymap_translate (builder, MUNGE_ME_KEY_TRANSLATION,
3748 if (!NILP (key_translate_result))
3750 result = key_translate_result;
3751 regenerate_echo_keys_from_this_command_keys (builder);
3758 /* If key-sequence wasn't bound, we'll try some fallbacks. */
3760 /* If we didn't find a binding, and the last event in the sequence is
3761 a shifted character, then try again with the lowercase version. */
3763 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3764 && !NILP (Vretry_undefined_key_binding_unshifted))
3766 Lisp_Object terminal = builder->most_current_event;
3767 struct key_data* key = & XEVENT (terminal)->event.key;
3769 if ((key->modifiers & MOD_SHIFT)
3770 || (CHAR_OR_CHAR_INTP (key->keysym)
3771 && ((c = XCHAR_OR_CHAR_INT (key->keysym)), c >= 'A' && c <= 'Z')))
3773 Lisp_Event terminal_copy = *XEVENT (terminal);
3775 if (key->modifiers & MOD_SHIFT)
3776 key->modifiers &= (~ MOD_SHIFT);
3778 key->keysym = make_char (c + 'a' - 'A');
3780 result = command_builder_find_leaf (builder, allow_misc_user_events_p);
3783 /* If there was no match with the lower-case version either,
3784 then put back the upper-case event for the error
3785 message. But make sure that function-key-map didn't
3786 change things out from under us. */
3787 if (EQ (terminal, builder->most_current_event))
3788 *XEVENT (terminal) = terminal_copy;
3792 /* help-char is `auto-bound' in every keymap */
3793 if (!NILP (Vprefix_help_command) &&
3794 event_matches_key_specifier_p (XEVENT (builder->most_current_event),
3796 return Vprefix_help_command;
3799 /* If keysym is a non-ASCII char, bind it to self-insert-char by default. */
3800 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3801 && !NILP (Vcomposed_character_default_binding))
3803 Lisp_Object keysym = XEVENT (builder->most_current_event)->event.key.keysym;
3804 if (CHARP (keysym) && !CHAR_ASCII_P (XCHAR (keysym)))
3805 return Vcomposed_character_default_binding;
3807 #endif /* HAVE_XIM */
3809 /* If we read extra events attempting to match a function key but end
3810 up failing, then we release those events back to the command loop
3811 and fail on the original lookup. The released events will then be
3812 reprocessed in the context of the first part having failed. */
3813 if (!NILP (builder->last_non_munged_event))
3815 Lisp_Object event0 = builder->last_non_munged_event;
3817 /* Put the commands back on the event queue. */
3818 enqueue_event_chain (XEVENT_NEXT (event0),
3819 &command_event_queue,
3820 &command_event_queue_tail);
3822 /* Then remove them from the command builder. */
3823 XSET_EVENT_NEXT (event0, Qnil);
3824 builder->most_current_event = event0;
3825 builder->last_non_munged_event = Qnil;
3832 /* Every time a command-event (a key, button, or menu selection) is read by
3833 Fnext_event(), it is stored in the recent_keys_ring, in Vlast_input_event,
3834 and in Vthis_command_keys. (Eval-events are not stored there.)
3836 Every time a command is invoked, Vlast_command_event is set to the last
3837 event in the sequence.
3839 This means that Vthis_command_keys is really about "input read since the
3840 last command was executed" rather than about "what keys invoked this
3841 command." This is a little counterintuitive, but that's the way it
3844 As an extra kink, the function read-key-sequence resets/updates the
3845 last-command-event and this-command-keys. It doesn't append to the
3846 command-keys as read-char does. Such are the pitfalls of having to
3847 maintain compatibility with a program for which the only specification
3850 (We could implement recent_keys_ring and Vthis_command_keys as the same
3854 DEFUN ("recent-keys", Frecent_keys, 0, 1, 0, /*
3855 Return a vector of recent keyboard or mouse button events read.
3856 If NUMBER is non-nil, not more than NUMBER events will be returned.
3857 Change number of events stored using `set-recent-keys-ring-size'.
3859 This copies the event objects into a new vector; it is safe to keep and
3864 struct gcpro gcpro1;
3865 Lisp_Object val = Qnil;
3867 int start, nkeys, i, j;
3871 nwanted = recent_keys_ring_size;
3874 CHECK_NATNUM (number);
3875 nwanted = XINT (number);
3878 /* Create the keys ring vector, if none present. */
3879 if (NILP (Vrecent_keys_ring))
3881 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
3882 /* And return nothing in particular. */
3883 return make_vector (0, Qnil);
3886 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3887 /* This means the vector has not yet wrapped */
3889 nkeys = recent_keys_ring_index;
3894 nkeys = recent_keys_ring_size;
3895 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3898 if (nwanted < nkeys)
3900 start += nkeys - nwanted;
3901 if (start >= recent_keys_ring_size)
3902 start -= recent_keys_ring_size;
3908 val = make_vector (nwanted, Qnil);
3910 for (i = 0, j = start; i < nkeys; i++)
3912 Lisp_Object e = XVECTOR_DATA (Vrecent_keys_ring)[j];
3916 XVECTOR_DATA (val)[i] = Fcopy_event (e, Qnil);
3917 if (++j >= recent_keys_ring_size)
3925 DEFUN ("recent-keys-ring-size", Frecent_keys_ring_size, 0, 0, 0, /*
3926 The maximum number of events `recent-keys' can return.
3930 return make_int (recent_keys_ring_size);
3933 DEFUN ("set-recent-keys-ring-size", Fset_recent_keys_ring_size, 1, 1, 0, /*
3934 Set the maximum number of events to be stored internally.
3938 Lisp_Object new_vector = Qnil;
3939 int i, j, nkeys, start, min;
3940 struct gcpro gcpro1;
3941 GCPRO1 (new_vector);
3944 if (XINT (size) <= 0)
3945 error ("Recent keys ring size must be positive");
3946 if (XINT (size) == recent_keys_ring_size)
3949 new_vector = make_vector (XINT (size), Qnil);
3951 if (NILP (Vrecent_keys_ring))
3953 Vrecent_keys_ring = new_vector;
3957 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3958 /* This means the vector has not yet wrapped */
3960 nkeys = recent_keys_ring_index;
3965 nkeys = recent_keys_ring_size;
3966 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3969 if (XINT (size) > nkeys)
3974 for (i = 0, j = start; i < min; i++)
3976 XVECTOR_DATA (new_vector)[i] = XVECTOR_DATA (Vrecent_keys_ring)[j];
3977 if (++j >= recent_keys_ring_size)
3980 recent_keys_ring_size = XINT (size);
3981 recent_keys_ring_index = (i < recent_keys_ring_size) ? i : 0;
3983 Vrecent_keys_ring = new_vector;
3989 /* Vthis_command_keys having value Qnil means that the next time
3990 push_this_command_keys is called, it should start over.
3991 The times at which the command-keys are reset
3992 (instead of merely being augmented) are pretty counterintuitive.
3995 -- We do not reset this-command-keys when we finish reading a
3996 command. This is because some commands (e.g. C-u) act
3997 like command prefixes; they signal this by setting prefix-arg
3999 -- Therefore, we reset this-command-keys when we finish
4000 executing a command, unless prefix-arg is set.
4001 -- However, if we ever do a non-local exit out of a command
4002 loop (e.g. an error in a command), we need to reset
4003 this-command-keys. We do this by calling reset_this_command_keys()
4004 from cmdloop.c, whenever an error causes an invocation of the
4005 default error handler, and whenever there's a throw to top-level.)
4009 reset_this_command_keys (Lisp_Object console, int clear_echo_area_p)
4011 struct command_builder *command_builder =
4012 XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
4014 reset_key_echo (command_builder, clear_echo_area_p);
4016 deallocate_event_chain (Vthis_command_keys);
4017 Vthis_command_keys = Qnil;
4018 Vthis_command_keys_tail = Qnil;
4020 reset_current_events (command_builder);
4024 push_this_command_keys (Lisp_Object event)
4026 Lisp_Object new = Fmake_event (Qnil, Qnil);
4028 Fcopy_event (event, new);
4029 enqueue_event (new, &Vthis_command_keys, &Vthis_command_keys_tail);
4032 /* The following two functions are used in call-interactively,
4033 for the @ and e specifications. We used to just use
4034 `current-mouse-event' (i.e. the last mouse event in this-command-keys),
4035 but FSF does it more generally so we follow their lead. */
4038 extract_this_command_keys_nth_mouse_event (int n)
4042 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
4045 && (XEVENT_TYPE (event) == button_press_event
4046 || XEVENT_TYPE (event) == button_release_event
4047 || XEVENT_TYPE (event) == misc_user_event))
4051 /* must copy to avoid an abort() in next_event_internal() */
4052 if (!NILP (XEVENT_NEXT (event)))
4053 return Fcopy_event (event, Qnil);
4065 extract_vector_nth_mouse_event (Lisp_Object vector, int n)
4068 int len = XVECTOR_LENGTH (vector);
4070 for (i = 0; i < len; i++)
4072 Lisp_Object event = XVECTOR_DATA (vector)[i];
4074 switch (XEVENT_TYPE (event))
4076 case button_press_event :
4077 case button_release_event :
4078 case misc_user_event :
4092 push_recent_keys (Lisp_Object event)
4096 if (NILP (Vrecent_keys_ring))
4097 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
4099 e = XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index];
4103 e = Fmake_event (Qnil, Qnil);
4104 XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index] = e;
4106 Fcopy_event (event, e);
4107 if (++recent_keys_ring_index == recent_keys_ring_size)
4108 recent_keys_ring_index = 0;
4113 current_events_into_vector (struct command_builder *command_builder)
4117 int n = event_chain_count (command_builder->current_events);
4119 /* Copy the vector and the events in it. */
4120 /* No need to copy the events, since they're already copies, and
4121 nobody other than the command-builder has pointers to them */
4122 vector = make_vector (n, Qnil);
4124 EVENT_CHAIN_LOOP (event, command_builder->current_events)
4125 XVECTOR_DATA (vector)[n++] = event;
4126 reset_command_builder_event_chain (command_builder);
4132 Given the current state of the command builder and a new command event
4133 that has just been dispatched:
4135 -- add the event to the event chain forming the current command
4136 (doing meta-translation as necessary)
4137 -- return the binding of this event chain; this will be one of:
4138 -- nil (there is no binding)
4139 -- a keymap (part of a command has been specified)
4140 -- a command (anything that satisfies `commandp'; this includes
4141 some symbols, lists, subrs, strings, vectors, and
4142 compiled-function objects)
4145 lookup_command_event (struct command_builder *command_builder,
4146 Lisp_Object event, int allow_misc_user_events_p)
4148 /* This function can GC */
4149 struct frame *f = selected_frame ();
4150 /* Clear output from previous command execution */
4151 if (!EQ (Qcommand, echo_area_status (f))
4152 /* but don't let mouse-up clear what mouse-down just printed */
4153 && (XEVENT (event)->event_type != button_release_event))
4154 clear_echo_area (f, Qnil, 0);
4156 /* Add the given event to the command builder.
4157 Extra hack: this also updates the recent_keys_ring and Vthis_command_keys
4158 vectors to translate "ESC x" to "M-x" (for any "x" of course).
4161 Lisp_Object recent = command_builder->most_current_event;
4164 && event_matches_key_specifier_p (XEVENT (recent), Vmeta_prefix_char))
4167 /* When we see a sequence like "ESC x", pretend we really saw "M-x".
4168 DoubleThink the recent-keys and this-command-keys as well. */
4170 /* Modify the previous most-recently-pushed event on the command
4171 builder to be a copy of this one with the meta-bit set instead of
4172 pushing a new event.
4174 Fcopy_event (event, recent);
4175 e = XEVENT (recent);
4176 if (e->event_type == key_press_event)
4177 e->event.key.modifiers |= MOD_META;
4178 else if (e->event_type == button_press_event
4179 || e->event_type == button_release_event)
4180 e->event.button.modifiers |= MOD_META;
4185 int tckn = event_chain_count (Vthis_command_keys);
4187 /* ??? very strange if it's < 2. */
4188 this_command_keys_replace_suffix
4189 (event_chain_nth (Vthis_command_keys, tckn - 2),
4190 Fcopy_event (recent, Qnil));
4193 regenerate_echo_keys_from_this_command_keys (command_builder);
4197 event = Fcopy_event (event, Fmake_event (Qnil, Qnil));
4199 command_builder_append_event (command_builder, event);
4204 Lisp_Object leaf = command_builder_find_leaf (command_builder,
4205 allow_misc_user_events_p);
4206 struct gcpro gcpro1;
4211 if (!lw_menu_active)
4213 Lisp_Object prompt = Fkeymap_prompt (leaf, Qt);
4214 if (STRINGP (prompt))
4216 /* Append keymap prompt to key echo buffer */
4217 int buf_index = command_builder->echo_buf_index;
4218 Bytecount len = XSTRING_LENGTH (prompt);
4220 if (len + buf_index + 1 <= command_builder->echo_buf_length)
4222 Bufbyte *echo = command_builder->echo_buf + buf_index;
4223 memcpy (echo, XSTRING_DATA (prompt), len);
4226 maybe_echo_keys (command_builder, 1);
4229 maybe_echo_keys (command_builder, 0);
4231 else if (!NILP (Vquit_flag)) {
4232 Lisp_Object quit_event = Fmake_event(Qnil, Qnil);
4233 Lisp_Event *e = XEVENT (quit_event);
4234 /* if quit happened during menu acceleration, pretend we read it */
4235 struct console *con = XCONSOLE (Fselected_console ());
4236 int ch = CONSOLE_QUIT_CHAR (con);
4238 character_to_event (ch, e, con, 1, 1);
4239 e->channel = make_console (con);
4241 enqueue_command_event (quit_event);
4245 else if (!NILP (leaf))
4247 if (EQ (Qcommand, echo_area_status (f))
4248 && command_builder->echo_buf_index > 0)
4250 /* If we had been echoing keys, echo the last one (without
4251 the trailing dash) and redisplay before executing the
4253 command_builder->echo_buf[command_builder->echo_buf_index] = 0;
4254 maybe_echo_keys (command_builder, 1);
4255 Fsit_for (Qzero, Qt);
4258 RETURN_UNGCPRO (leaf);
4263 execute_command_event (struct command_builder *command_builder,
4266 /* This function can GC */
4267 struct console *con = XCONSOLE (command_builder->console);
4268 struct gcpro gcpro1;
4270 GCPRO1 (event); /* event may be freshly created */
4271 reset_current_events (command_builder);
4273 switch (XEVENT (event)->event_type)
4275 case key_press_event:
4276 Vcurrent_mouse_event = Qnil;
4278 case button_press_event:
4279 case button_release_event:
4280 case misc_user_event:
4281 Vcurrent_mouse_event = Fcopy_event (event, Qnil);
4286 /* Store the last-command-event. The semantics of this is that it
4287 is the last event most recently involved in command-lookup. */
4288 if (!EVENTP (Vlast_command_event))
4289 Vlast_command_event = Fmake_event (Qnil, Qnil);
4290 if (XEVENT (Vlast_command_event)->event_type == dead_event)
4292 Vlast_command_event = Fmake_event (Qnil, Qnil);
4293 error ("Someone deallocated the last-command-event!");
4296 if (! EQ (event, Vlast_command_event))
4297 Fcopy_event (event, Vlast_command_event);
4299 /* Note that last-command-char will never have its high-bit set, in
4300 an effort to sidestep the ambiguity between M-x and oslash. */
4301 Vlast_command_char = Fevent_to_character (Vlast_command_event,
4304 /* Actually call the command, with all sorts of hair to preserve or clear
4305 the echo-area and region as appropriate and call the pre- and post-
4308 int old_kbd_macro = con->kbd_macro_end;
4309 struct window *w = XWINDOW (Fselected_window (Qnil));
4311 /* We're executing a new command, so the old value is irrelevant. */
4312 zmacs_region_stays = 0;
4314 /* If the previous command tried to force a specific window-start,
4315 reset the flag in case this command moves point far away from
4316 that position. Also, reset the window's buffer's change
4317 information so that we don't trigger an incremental update. */
4321 buffer_reset_changes (XBUFFER (w->buffer));
4324 pre_command_hook ();
4326 if (XEVENT (event)->event_type == misc_user_event)
4328 call1 (XEVENT (event)->event.eval.function,
4329 XEVENT (event)->event.eval.object);
4333 Fcommand_execute (Vthis_command, Qnil, Qnil);
4336 post_command_hook ();
4338 #if 0 /* #### here was an attempted fix that didn't work */
4339 if (XEVENT (event)->event_type == misc_user_event)
4343 if (!NILP (con->prefix_arg))
4345 /* Commands that set the prefix arg don't update last-command, don't
4346 reset the echoing state, and don't go into keyboard macros unless
4347 followed by another command. */
4348 maybe_echo_keys (command_builder, 0);
4350 /* If we're recording a keyboard macro, and the last command
4351 executed set a prefix argument, then decrement the pointer to
4352 the "last character really in the macro" to be just before this
4353 command. This is so that the ^U in "^U ^X )" doesn't go onto
4354 the end of macro. */
4355 if (!NILP (con->defining_kbd_macro))
4356 con->kbd_macro_end = old_kbd_macro;
4360 /* Start a new command next time */
4361 Vlast_command = Vthis_command;
4362 /* Emacs 18 doesn't unconditionally clear the echoed keystrokes,
4363 so we don't either */
4364 reset_this_command_keys (make_console (con), 0);
4371 /* Run the pre command hook. */
4374 pre_command_hook (void)
4376 last_point_position = BUF_PT (current_buffer);
4377 XSETBUFFER (last_point_position_buffer, current_buffer);
4378 /* This function can GC */
4379 safe_run_hook_trapping_errors
4380 ("Error in `pre-command-hook' (setting hook to nil)",
4381 Qpre_command_hook, 1);
4384 /* Run the post command hook. */
4387 post_command_hook (void)
4389 /* This function can GC */
4390 /* Turn off region highlighting unless this command requested that
4391 it be left on, or we're in the minibuffer. We don't turn it off
4392 when we're in the minibuffer so that things like M-x write-region
4395 This could be done via a function on the post-command-hook, but
4396 we don't want the user to accidentally remove it.
4399 Lisp_Object win = Fselected_window (Qnil);
4402 /* If the last command deleted the frame, `win' might be nil.
4403 It seems safest to do nothing in this case. */
4404 /* #### This doesn't really fix the problem,
4405 if delete-frame is called by some hook */
4410 if (! zmacs_region_stays
4411 && (!MINI_WINDOW_P (XWINDOW (win))
4412 || EQ (zmacs_region_buffer (), WINDOW_BUFFER (XWINDOW (win)))))
4413 zmacs_deactivate_region ();
4415 zmacs_update_region ();
4417 safe_run_hook_trapping_errors
4418 ("Error in `post-command-hook' (setting hook to nil)",
4419 Qpost_command_hook, 1);
4421 #ifdef DEFERRED_ACTION_CRAP
4422 if (!NILP (Vdeferred_action_list))
4423 call0 (Vdeferred_action_function);
4426 #ifdef ILL_CONCEIVED_HOOK
4427 if (NILP (Vunread_command_events)
4428 && NILP (Vexecuting_macro)
4429 && !NILP (Vpost_command_idle_hook)
4430 && !NILP (Fsit_for (make_float ((double) post_command_idle_delay
4432 safe_run_hook_trapping_errors
4433 ("Error in `post-command-idle-hook' (setting hook to nil)",
4434 Qpost_command_idle_hook, 1);
4438 if (!NILP (current_buffer->mark_active))
4440 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
4442 current_buffer->mark_active = Qnil;
4443 run_hook (intern ("deactivate-mark-hook"));
4445 else if (current_buffer != prev_buffer ||
4446 BUF_MODIFF (current_buffer) != prev_modiff)
4447 run_hook (intern ("activate-mark-hook"));
4449 #endif /* FSFmacs */
4451 /* #### Kludge!!! This is necessary to make sure that things
4452 are properly positioned even if post-command-hook moves point.
4453 #### There should be a cleaner way of handling this. */
4454 call0 (Qauto_show_make_point_visible);
4458 DEFUN ("dispatch-event", Fdispatch_event, 1, 1, 0, /*
4459 Given an event object as returned by `next-event', execute it.
4461 Key-press, button-press, and button-release events get accumulated
4462 until a complete key sequence (see `read-key-sequence') is reached,
4463 at which point the sequence is looked up in the current keymaps and
4466 Mouse motion events cause the low-level handling function stored in
4467 `mouse-motion-handler' to be called. (There are very few circumstances
4468 under which you should change this handler. Use `mode-motion-hook'
4471 Menu, timeout, and eval events cause the associated function or handler
4474 Process events cause the subprocess's output to be read and acted upon
4475 appropriately (see `start-process').
4477 Magic events are handled as necessary.
4481 /* This function can GC */
4482 struct command_builder *command_builder;
4484 Lisp_Object console;
4485 Lisp_Object channel;
4487 CHECK_LIVE_EVENT (event);
4488 ev = XEVENT (event);
4490 /* events on dead channels get silently eaten */
4491 channel = EVENT_CHANNEL (ev);
4492 if (object_dead_p (channel))
4495 /* Some events don't have channels (e.g. eval events). */
4496 console = CDFW_CONSOLE (channel);
4498 console = Vselected_console;
4499 else if (!EQ (console, Vselected_console))
4500 Fselect_console (console);
4502 command_builder = XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
4503 switch (XEVENT (event)->event_type)
4505 case button_press_event:
4506 case button_release_event:
4507 case key_press_event:
4509 Lisp_Object leaf = lookup_command_event (command_builder, event, 1);
4512 /* Incomplete key sequence */
4516 /* At this point, we know that the sequence is not bound to a
4517 command. Normally, we beep and print a message informing the
4518 user of this. But we do not beep or print a message when:
4520 o the last event in this sequence is a mouse-up event; or
4521 o the last event in this sequence is a mouse-down event and
4522 there is a binding for the mouse-up version.
4524 That is, if the sequence ``C-x button1'' is typed, and is not
4525 bound to a command, but the sequence ``C-x button1up'' is bound
4526 to a command, we do not complain about the ``C-x button1''
4527 sequence. If neither ``C-x button1'' nor ``C-x button1up'' is
4528 bound to a command, then we complain about the ``C-x button1''
4529 sequence, but later will *not* complain about the
4530 ``C-x button1up'' sequence, which would be redundant.
4532 This is pretty hairy, but I think it's the most intuitive
4535 Lisp_Object terminal = command_builder->most_current_event;
4537 if (XEVENT_TYPE (terminal) == button_press_event)
4540 /* Temporarily pretend the last event was an "up" instead of a
4541 "down", and look up its binding. */
4542 XEVENT_TYPE (terminal) = button_release_event;
4543 /* If the "up" version is bound, don't complain. */
4545 = !NILP (command_builder_find_leaf (command_builder, 0));
4546 /* Undo the temporary changes we just made. */
4547 XEVENT_TYPE (terminal) = button_press_event;
4550 /* Pretend this press was not seen (treat as a prefix) */
4551 if (EQ (command_builder->current_events, terminal))
4553 reset_current_events (command_builder);
4559 EVENT_CHAIN_LOOP (eve, command_builder->current_events)
4560 if (EQ (XEVENT_NEXT (eve), terminal))
4563 Fdeallocate_event (command_builder->
4564 most_current_event);
4565 XSET_EVENT_NEXT (eve, Qnil);
4566 command_builder->most_current_event = eve;
4568 maybe_echo_keys (command_builder, 1);
4573 /* Complain that the typed sequence is not defined, if this is the
4574 kind of sequence that warrants a complaint. */
4575 XCONSOLE (console)->defining_kbd_macro = Qnil;
4576 XCONSOLE (console)->prefix_arg = Qnil;
4577 /* Don't complain about undefined button-release events */
4578 if (XEVENT_TYPE (terminal) != button_release_event)
4580 Lisp_Object keys = current_events_into_vector (command_builder);
4581 struct gcpro gcpro1;
4583 /* Run the pre-command-hook before barfing about an undefined
4585 Vthis_command = Qnil;
4587 pre_command_hook ();
4589 /* The post-command-hook doesn't run. */
4590 Fsignal (Qundefined_keystroke_sequence, list1 (keys));
4592 /* Reset the command builder for reading the next sequence. */
4593 reset_this_command_keys (console, 1);
4595 else /* key sequence is bound to a command */
4598 int magic_undo_count = 20;
4600 Vthis_command = leaf;
4602 /* Don't push an undo boundary if the command set the prefix arg,
4603 or if we are executing a keyboard macro, or if in the
4604 minibuffer. If the command we are about to execute is
4605 self-insert, it's tricky: up to 20 consecutive self-inserts may
4606 be done without an undo boundary. This counter is reset as
4607 soon as a command other than self-insert-command is executed.
4609 Programmers can also use the `self-insert-undo-magic'
4610 property to install that behaviour on functions other
4611 than `self-insert-command', or to change the magic
4612 number 20 to something else. */
4616 Lisp_Object prop = Fget (leaf, Qself_insert_defer_undo, Qnil);
4618 magic_undo = 1, magic_undo_count = XINT (prop);
4619 else if (!NILP (prop))
4621 else if (EQ (leaf, Qself_insert_command))
4626 command_builder->self_insert_countdown = 0;
4627 if (NILP (XCONSOLE (console)->prefix_arg)
4628 && NILP (Vexecuting_macro)
4630 /* This was done in the days when there was no undo
4631 in the minibuffer. If we don't disable this code,
4632 then each instance of "undo" undoes everything in
4634 && !EQ (minibuf_window, Fselected_window (Qnil))
4636 && command_builder->self_insert_countdown == 0)
4641 if (--command_builder->self_insert_countdown < 0)
4642 command_builder->self_insert_countdown = magic_undo_count;
4644 execute_command_event
4646 internal_equal (event, command_builder-> most_current_event, 0)
4648 /* Use the translated event that was most recently seen.
4649 This way, last-command-event becomes f1 instead of
4650 the P from ESC O P. But we must copy it, else we'll
4651 lose when the command-builder events are deallocated. */
4652 : Fcopy_event (command_builder-> most_current_event, Qnil));
4656 case misc_user_event:
4660 We could just always use the menu item entry, whatever it is, but
4661 this might break some Lisp code that expects `this-command' to
4662 always contain a symbol. So only store it if this is a simple
4663 `call-interactively' sort of menu item.
4665 But this is bogus. `this-command' could be a string or vector
4666 anyway (for keyboard macros). There's even one instance
4667 (in pending-del.el) of `this-command' getting set to a cons
4668 (a lambda expression). So in the `eval' case I'll just
4669 convert it into a lambda expression.
4671 if (EQ (XEVENT (event)->event.eval.function, Qcall_interactively)
4672 && SYMBOLP (XEVENT (event)->event.eval.object))
4673 Vthis_command = XEVENT (event)->event.eval.object;
4674 else if (EQ (XEVENT (event)->event.eval.function, Qeval))
4676 Fcons (Qlambda, Fcons (Qnil, XEVENT (event)->event.eval.object));
4677 else if (SYMBOLP (XEVENT (event)->event.eval.function))
4678 /* A scrollbar command or the like. */
4679 Vthis_command = XEVENT (event)->event.eval.function;
4682 Vthis_command = Qnil;
4684 /* clear the echo area */
4685 reset_key_echo (command_builder, 1);
4687 command_builder->self_insert_countdown = 0;
4688 if (NILP (XCONSOLE (console)->prefix_arg)
4689 && NILP (Vexecuting_macro)
4690 && !EQ (minibuf_window, Fselected_window (Qnil)))
4692 execute_command_event (command_builder, event);
4697 execute_internal_event (event);
4704 DEFUN ("read-key-sequence", Fread_key_sequence, 1, 3, 0, /*
4705 Read a sequence of keystrokes or mouse clicks.
4706 Returns a vector of the event objects read. The vector and the event
4707 objects it contains are freshly created (and will not be side-effected
4708 by subsequent calls to this function).
4710 The sequence read is sufficient to specify a non-prefix command starting
4711 from the current local and global keymaps. A C-g typed while in this
4712 function is treated like any other character, and `quit-flag' is not set.
4714 First arg PROMPT is a prompt string. If nil, do not prompt specially.
4715 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echoes
4716 as a continuation of the previous key.
4718 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not
4719 convert the last event to lower case. (Normally any upper case event
4720 is converted to lower case if the original event is undefined and the lower
4721 case equivalent is defined.) This argument is provided mostly for
4722 FSF compatibility; the equivalent effect can be achieved more generally
4723 by binding `retry-undefined-key-binding-unshifted' to nil around the
4724 call to `read-key-sequence'.
4726 A C-g typed while in this function is treated like any other character,
4727 and `quit-flag' is not set.
4729 If the user selects a menu item while we are prompting for a key-sequence,
4730 the returned value will be a vector of a single menu-selection event.
4731 An error will be signalled if you pass this value to `lookup-key' or a
4734 `read-key-sequence' checks `function-key-map' for function key
4735 sequences, where they wouldn't conflict with ordinary bindings. See
4736 `function-key-map' for more details.
4738 (prompt, continue_echo, dont_downcase_last))
4740 /* This function can GC */
4741 struct console *con = XCONSOLE (Vselected_console); /* #### correct?
4745 struct command_builder *command_builder =
4746 XCOMMAND_BUILDER (con->command_builder);
4748 Lisp_Object event = Fmake_event (Qnil, Qnil);
4749 int speccount = specpdl_depth ();
4750 struct gcpro gcpro1;
4754 CHECK_STRING (prompt);
4755 /* else prompt = Fkeymap_prompt (current_buffer->keymap); may GC */
4758 if (NILP (continue_echo))
4759 reset_this_command_keys (make_console (con), 1);
4761 specbind (Qinhibit_quit, Qt);
4763 if (!NILP (dont_downcase_last))
4764 specbind (Qretry_undefined_key_binding_unshifted, Qnil);
4768 Fnext_event (event, prompt);
4769 /* restore the selected-console damage */
4770 con = event_console_or_selected (event);
4771 command_builder = XCOMMAND_BUILDER (con->command_builder);
4772 if (! command_event_p (event))
4773 execute_internal_event (event);
4776 if (XEVENT (event)->event_type == misc_user_event)
4777 reset_current_events (command_builder);
4778 result = lookup_command_event (command_builder, event, 1);
4779 if (!KEYMAPP (result))
4781 result = current_events_into_vector (command_builder);
4782 reset_key_echo (command_builder, 0);
4789 Vquit_flag = Qnil; /* In case we read a ^G; do not call check_quit() here */
4790 Fdeallocate_event (event);
4791 RETURN_UNGCPRO (unbind_to (speccount, result));
4794 DEFUN ("this-command-keys", Fthis_command_keys, 0, 0, 0, /*
4795 Return a vector of the keyboard or mouse button events that were used
4796 to invoke this command. This copies the vector and the events; it is safe
4797 to keep and modify them.
4805 if (NILP (Vthis_command_keys))
4806 return make_vector (0, Qnil);
4808 len = event_chain_count (Vthis_command_keys);
4810 result = make_vector (len, Qnil);
4812 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
4813 XVECTOR_DATA (result)[len++] = Fcopy_event (event, Qnil);
4817 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0, /*
4818 Used for complicated reasons in `universal-argument-other-key'.
4820 `universal-argument-other-key' rereads the event just typed.
4821 It then gets translated through `function-key-map'.
4822 The translated event gets included in the echo area and in
4823 the value of `this-command-keys' in addition to the raw original event.
4826 Calling this function directs the translated event to replace
4827 the original event, so that only one version of the event actually
4828 appears in the echo area and in the value of `this-command-keys'.
4832 /* #### I don't understand this at all, so currently it does nothing.
4833 If there is ever a problem, maybe someone should investigate. */
4839 dribble_out_event (Lisp_Object event)
4841 if (NILP (Vdribble_file))
4844 if (XEVENT (event)->event_type == key_press_event &&
4845 !XEVENT (event)->event.key.modifiers)
4847 Lisp_Object keysym = XEVENT (event)->event.key.keysym;
4848 if (CHARP (XEVENT (event)->event.key.keysym))
4850 Emchar ch = XCHAR (keysym);
4851 Bufbyte str[MAX_EMCHAR_LEN];
4852 Bytecount len = set_charptr_emchar (str, ch);
4853 Lstream_write (XLSTREAM (Vdribble_file), str, len);
4855 else if (string_char_length (XSYMBOL (keysym)->name) == 1)
4856 /* one-char key events are printed with just the key name */
4857 Fprinc (keysym, Vdribble_file);
4858 else if (EQ (keysym, Qreturn))
4859 Lstream_putc (XLSTREAM (Vdribble_file), '\n');
4860 else if (EQ (keysym, Qspace))
4861 Lstream_putc (XLSTREAM (Vdribble_file), ' ');
4863 Fprinc (event, Vdribble_file);
4866 Fprinc (event, Vdribble_file);
4867 Lstream_flush (XLSTREAM (Vdribble_file));
4870 DEFUN ("open-dribble-file", Fopen_dribble_file, 1, 1,
4871 "FOpen dribble file: ", /*
4872 Start writing all keyboard characters to a dribble file called FILE.
4873 If FILE is nil, close any open dribble file.
4877 /* This function can GC */
4878 /* XEmacs change: always close existing dribble file. */
4879 /* FSFmacs uses FILE *'s here. With lstreams, that's unnecessary. */
4880 if (!NILP (Vdribble_file))
4882 Lstream_close (XLSTREAM (Vdribble_file));
4883 Vdribble_file = Qnil;
4889 file = Fexpand_file_name (file, Qnil);
4890 fd = open ((char*) XSTRING_DATA (file),
4891 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4894 error ("Unable to create dribble file");
4895 Vdribble_file = make_filedesc_output_stream (fd, 0, 0, LSTR_CLOSING);
4898 make_encoding_output_stream (XLSTREAM (Vdribble_file),
4899 Fget_coding_system (Qescape_quoted));
4906 /************************************************************************/
4907 /* initialization */
4908 /************************************************************************/
4911 syms_of_event_stream (void)
4913 defsymbol (&Qdisabled, "disabled");
4914 defsymbol (&Qcommand_event_p, "command-event-p");
4916 deferror (&Qundefined_keystroke_sequence, "undefined-keystroke-sequence",
4917 "Undefined keystroke sequence", Qerror);
4919 DEFSUBR (Frecent_keys);
4920 DEFSUBR (Frecent_keys_ring_size);
4921 DEFSUBR (Fset_recent_keys_ring_size);
4922 DEFSUBR (Finput_pending_p);
4923 DEFSUBR (Fenqueue_eval_event);
4924 DEFSUBR (Fnext_event);
4925 DEFSUBR (Fnext_command_event);
4926 DEFSUBR (Fdiscard_input);
4928 DEFSUBR (Fsleep_for);
4929 DEFSUBR (Faccept_process_output);
4930 DEFSUBR (Fadd_timeout);
4931 DEFSUBR (Fdisable_timeout);
4932 DEFSUBR (Fadd_async_timeout);
4933 DEFSUBR (Fdisable_async_timeout);
4934 DEFSUBR (Fdispatch_event);
4935 DEFSUBR (Fread_key_sequence);
4936 DEFSUBR (Fthis_command_keys);
4937 DEFSUBR (Freset_this_command_lengths);
4938 DEFSUBR (Fopen_dribble_file);
4939 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
4940 DEFSUBR (Faccelerate_menu);
4943 defsymbol (&Qpre_command_hook, "pre-command-hook");
4944 defsymbol (&Qpost_command_hook, "post-command-hook");
4945 defsymbol (&Qunread_command_events, "unread-command-events");
4946 defsymbol (&Qunread_command_event, "unread-command-event");
4947 defsymbol (&Qpre_idle_hook, "pre-idle-hook");
4948 #ifdef ILL_CONCEIVED_HOOK
4949 defsymbol (&Qpost_command_idle_hook, "post-command-idle-hook");
4951 #ifdef DEFERRED_ACTION_CRAP
4952 defsymbol (&Qdeferred_action_function, "deferred-action-function");
4954 defsymbol (&Qretry_undefined_key_binding_unshifted,
4955 "retry-undefined-key-binding-unshifted");
4956 defsymbol (&Qauto_show_make_point_visible,
4957 "auto-show-make-point-visible");
4959 defsymbol (&Qmenu_force, "menu-force");
4960 defsymbol (&Qmenu_fallback, "menu-fallback");
4962 defsymbol (&Qmenu_quit, "menu-quit");
4963 defsymbol (&Qmenu_up, "menu-up");
4964 defsymbol (&Qmenu_down, "menu-down");
4965 defsymbol (&Qmenu_left, "menu-left");
4966 defsymbol (&Qmenu_right, "menu-right");
4967 defsymbol (&Qmenu_select, "menu-select");
4968 defsymbol (&Qmenu_escape, "menu-escape");
4970 defsymbol (&Qself_insert_defer_undo, "self-insert-defer-undo");
4971 defsymbol (&Qcancel_mode_internal, "cancel-mode-internal");
4975 reinit_vars_of_event_stream (void)
4977 recent_keys_ring_index = 0;
4978 recent_keys_ring_size = 100;
4979 num_input_chars = 0;
4980 Vtimeout_free_list = make_lcrecord_list (sizeof (Lisp_Timeout),
4982 staticpro_nodump (&Vtimeout_free_list);
4983 the_low_level_timeout_blocktype =
4984 Blocktype_new (struct low_level_timeout_blocktype);
4985 something_happened = 0;
4986 recursive_sit_for = Qnil;
4990 vars_of_event_stream (void)
4992 reinit_vars_of_event_stream ();
4993 Vrecent_keys_ring = Qnil;
4994 staticpro (&Vrecent_keys_ring);
4996 Vthis_command_keys = Qnil;
4997 staticpro (&Vthis_command_keys);
4998 Vthis_command_keys_tail = Qnil;
4999 pdump_wire (&Vthis_command_keys_tail);
5001 command_event_queue = Qnil;
5002 staticpro (&command_event_queue);
5003 command_event_queue_tail = Qnil;
5004 pdump_wire (&command_event_queue_tail);
5006 Vlast_selected_frame = Qnil;
5007 staticpro (&Vlast_selected_frame);
5009 pending_timeout_list = Qnil;
5010 staticpro (&pending_timeout_list);
5012 pending_async_timeout_list = Qnil;
5013 staticpro (&pending_async_timeout_list);
5015 last_point_position_buffer = Qnil;
5016 staticpro (&last_point_position_buffer);
5018 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes /*
5019 *Nonzero means echo unfinished commands after this many seconds of pause.
5021 Vecho_keystrokes = make_int (1);
5023 DEFVAR_INT ("auto-save-interval", &auto_save_interval /*
5024 *Number of keyboard input characters between auto-saves.
5025 Zero means disable autosaving due to number of characters typed.
5026 See also the variable `auto-save-timeout'.
5028 auto_save_interval = 300;
5030 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook /*
5031 Function or functions to run before every command.
5032 This may examine the `this-command' variable to find out what command
5033 is about to be run, or may change it to cause a different command to run.
5034 Function on this hook must be careful to avoid signalling errors!
5036 Vpre_command_hook = Qnil;
5038 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook /*
5039 Function or functions to run after every command.
5040 This may examine the `this-command' variable to find out what command
5043 Vpost_command_hook = Qnil;
5045 DEFVAR_LISP ("pre-idle-hook", &Vpre_idle_hook /*
5046 Normal hook run when XEmacs it about to be idle.
5047 This occurs whenever it is going to block, waiting for an event.
5048 This generally happens as a result of a call to `next-event',
5049 `next-command-event', `sit-for', `sleep-for', `accept-process-output',
5050 `x-get-selection', or various Energize-specific commands.
5051 Errors running the hook are caught and ignored.
5053 Vpre_idle_hook = Qnil;
5055 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse /*
5056 *Variable to control XEmacs behavior with respect to focus changing.
5057 If this variable is set to t, then XEmacs will not gratuitously change
5058 the keyboard focus. XEmacs cannot in general detect when this mode is
5059 used by the window manager, so it is up to the user to set it.
5061 focus_follows_mouse = 0;
5063 #ifdef ILL_CONCEIVED_HOOK
5064 /* Ill-conceived because it's not run in all sorts of cases
5065 where XEmacs is blocking. That's what `pre-idle-hook'
5066 is designed to solve. */
5067 xxDEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook /*
5068 Normal hook run after each command is executed, if idle.
5069 `post-command-idle-delay' specifies a time in microseconds that XEmacs
5070 must be idle for in order for the functions on this hook to be called.
5071 Errors running the hook are caught and ignored.
5073 Vpost_command_idle_hook = Qnil;
5075 xxDEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay /*
5076 Delay time before running `post-command-idle-hook'.
5077 This is measured in microseconds.
5079 post_command_idle_delay = 5000;
5080 #endif /* ILL_CONCEIVED_HOOK */
5082 #ifdef DEFERRED_ACTION_CRAP
5083 /* Random FSFmacs crap. There is absolutely nothing to gain,
5084 and a great deal to lose, in using this in place of just
5085 setting `post-command-hook'. */
5086 xxDEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list /*
5087 List of deferred actions to be performed at a later time.
5088 The precise format isn't relevant here; we just check whether it is nil.
5090 Vdeferred_action_list = Qnil;
5092 xxDEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function /*
5093 Function to call to handle deferred actions, after each command.
5094 This function is called with no arguments after each command
5095 whenever `deferred-action-list' is non-nil.
5097 Vdeferred_action_function = Qnil;
5098 #endif /* DEFERRED_ACTION_CRAP */
5100 DEFVAR_LISP ("last-command-event", &Vlast_command_event /*
5101 Last keyboard or mouse button event that was part of a command. This
5102 variable is off limits: you may not set its value or modify the event that
5103 is its value, as it is destructively modified by `read-key-sequence'. If
5104 you want to keep a pointer to this value, you must use `copy-event'.
5106 Vlast_command_event = Qnil;
5108 DEFVAR_LISP ("last-command-char", &Vlast_command_char /*
5109 If the value of `last-command-event' is a keyboard event, then
5110 this is the nearest ASCII equivalent to it. This is the value that
5111 `self-insert-command' will put in the buffer. Remember that there is
5112 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
5113 of keyboard events is much larger, so writing code that examines this
5114 variable to determine what key has been typed is bad practice, unless
5115 you are certain that it will be one of a small set of characters.
5117 Vlast_command_char = Qnil;
5119 DEFVAR_LISP ("last-input-event", &Vlast_input_event /*
5120 Last keyboard or mouse button event received. This variable is off
5121 limits: you may not set its value or modify the event that is its value, as
5122 it is destructively modified by `next-event'. If you want to keep a pointer
5123 to this value, you must use `copy-event'.
5125 Vlast_input_event = Qnil;
5127 DEFVAR_LISP ("current-mouse-event", &Vcurrent_mouse_event /*
5128 The mouse-button event which invoked this command, or nil.
5129 This is usually what `(interactive "e")' returns.
5131 Vcurrent_mouse_event = Qnil;
5133 DEFVAR_LISP ("last-input-char", &Vlast_input_char /*
5134 If the value of `last-input-event' is a keyboard event, then
5135 this is the nearest ASCII equivalent to it. Remember that there is
5136 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
5137 of keyboard events is much larger, so writing code that examines this
5138 variable to determine what key has been typed is bad practice, unless
5139 you are certain that it will be one of a small set of characters.
5141 Vlast_input_char = Qnil;
5143 DEFVAR_LISP ("last-input-time", &Vlast_input_time /*
5144 The time (in seconds since Jan 1, 1970) of the last-command-event,
5145 represented as a cons of two 16-bit integers. This is destructively
5146 modified, so copy it if you want to keep it.
5148 Vlast_input_time = Qnil;
5150 DEFVAR_LISP ("last-command-event-time", &Vlast_command_event_time /*
5151 The time (in seconds since Jan 1, 1970) of the last-command-event,
5152 represented as a list of three integers. The first integer contains
5153 the most significant 16 bits of the number of seconds, and the second
5154 integer contains the least significant 16 bits. The third integer
5155 contains the remainder number of microseconds, if the current system
5156 supports microsecond clock resolution. This list is destructively
5157 modified, so copy it if you want to keep it.
5159 Vlast_command_event_time = Qnil;
5161 DEFVAR_LISP ("unread-command-events", &Vunread_command_events /*
5162 List of event objects to be read as next command input events.
5163 This can be used to simulate the receipt of events from the user.
5164 Normally this is nil.
5165 Events are removed from the front of this list.
5167 Vunread_command_events = Qnil;
5169 DEFVAR_LISP ("unread-command-event", &Vunread_command_event /*
5170 Obsolete. Use `unread-command-events' instead.
5172 Vunread_command_event = Qnil;
5174 DEFVAR_LISP ("last-command", &Vlast_command /*
5175 The last command executed. Normally a symbol with a function definition,
5176 but can be whatever was found in the keymap, or whatever the variable
5177 `this-command' was set to by that command.
5179 Vlast_command = Qnil;
5181 DEFVAR_LISP ("this-command", &Vthis_command /*
5182 The command now being executed.
5183 The command can set this variable; whatever is put here
5184 will be in `last-command' during the following command.
5186 Vthis_command = Qnil;
5188 DEFVAR_LISP ("help-char", &Vhelp_char /*
5189 Character to recognize as meaning Help.
5190 When it is read, do `(eval help-form)', and display result if it's a string.
5191 If the value of `help-form' is nil, this char can be read normally.
5192 This can be any form recognized as a single key specifier.
5193 The help-char cannot be a negative number in XEmacs.
5195 Vhelp_char = make_char (8); /* C-h */
5197 DEFVAR_LISP ("help-form", &Vhelp_form /*
5198 Form to execute when character help-char is read.
5199 If the form returns a string, that string is displayed.
5200 If `help-form' is nil, the help char is not recognized.
5204 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command /*
5205 Command to run when `help-char' character follows a prefix key.
5206 This command is used only when there is no actual binding
5207 for that character after that prefix key.
5209 Vprefix_help_command = Qnil;
5211 DEFVAR_CONST_LISP ("keyboard-translate-table", &Vkeyboard_translate_table /*
5212 Hash table used as translate table for keyboard input.
5213 Use `keyboard-translate' to portably add entries to this table.
5214 Each key-press event is looked up in this table as follows:
5216 -- If an entry maps a symbol to a symbol, then a key-press event whose
5217 keysym is the former symbol (with any modifiers at all) gets its
5218 keysym changed and its modifiers left alone. This is useful for
5219 dealing with non-standard X keyboards, such as the grievous damage
5220 that Sun has inflicted upon the world.
5221 -- If an entry maps a character to a character, then a key-press event
5222 matching the former character gets converted to a key-press event
5223 matching the latter character. This is useful on ASCII terminals
5224 for (e.g.) making C-\\ look like C-s, to get around flow-control
5226 -- If an entry maps a character to a symbol, then a key-press event
5227 matching the character gets converted to a key-press event whose
5228 keysym is the given symbol and which has no modifiers.
5231 DEFVAR_LISP ("retry-undefined-key-binding-unshifted",
5232 &Vretry_undefined_key_binding_unshifted /*
5233 If a key-sequence which ends with a shifted keystroke is undefined
5234 and this variable is non-nil then the command lookup is retried again
5235 with the last key unshifted. (e.g. C-X C-F would be retried as C-X C-f.)
5236 If lookup still fails, a normal error is signalled. In general,
5237 you should *bind* this, not set it.
5239 Vretry_undefined_key_binding_unshifted = Qt;
5242 DEFVAR_LISP ("composed-character-default-binding",
5243 &Vcomposed_character_default_binding /*
5244 The default keybinding to use for key events from composed input.
5245 Window systems frequently have ways to allow the user to compose
5246 single characters in a language using multiple keystrokes.
5247 XEmacs sees these as single character keypress events.
5249 Vcomposed_character_default_binding = Qself_insert_command;
5250 #endif /* HAVE_XIM */
5252 Vcontrolling_terminal = Qnil;
5253 staticpro (&Vcontrolling_terminal);
5255 Vdribble_file = Qnil;
5256 staticpro (&Vdribble_file);
5259 DEFVAR_INT ("debug-emacs-events", &debug_emacs_events /*
5260 If non-zero, display debug information about Emacs events that XEmacs sees.
5261 Information is displayed on stderr.
5263 Before the event, the source of the event is displayed in parentheses,
5264 and is one of the following:
5266 \(real) A real event from the window system or
5267 terminal driver, as far as XEmacs can tell.
5269 \(keyboard macro) An event generated from a keyboard macro.
5271 \(unread-command-events) An event taken from `unread-command-events'.
5273 \(unread-command-event) An event taken from `unread-command-event'.
5275 \(command event queue) An event taken from an internal queue.
5276 Events end up on this queue when
5277 `enqueue-eval-event' is called or when
5278 user or eval events are received while
5279 XEmacs is blocking (e.g. in `sit-for',
5280 `sleep-for', or `accept-process-output',
5281 or while waiting for the reply to an
5284 \(->keyboard-translate-table) The result of an event translated through
5285 keyboard-translate-table. Note that in
5286 this case, two events are printed even
5287 though only one is really generated.
5289 \(SIGINT) A faked C-g resulting when XEmacs receives
5290 a SIGINT (e.g. C-c was pressed in XEmacs'
5291 controlling terminal or the signal was
5292 explicitly sent to the XEmacs process).
5294 debug_emacs_events = 0;
5297 DEFVAR_BOOL ("inhibit-input-event-recording", &inhibit_input_event_recording /*
5298 Non-nil inhibits recording of input-events to recent-keys ring.
5300 inhibit_input_event_recording = 0;
5302 DEFVAR_LISP("menu-accelerator-prefix", &Vmenu_accelerator_prefix /*
5303 Prefix key(s) that must be typed before menu accelerators will be activated.
5304 Set this to a value acceptable by define-key.
5306 Vmenu_accelerator_prefix = Qnil;
5308 DEFVAR_LISP ("menu-accelerator-modifiers", &Vmenu_accelerator_modifiers /*
5309 Modifier keys which must be pressed to get to the top level menu accelerators.
5310 This is a list of modifier key symbols. All modifier keys must be held down
5311 while a valid menu accelerator key is pressed in order for the top level
5312 menu to become active.
5314 See also menu-accelerator-enabled and menu-accelerator-prefix.
5316 Vmenu_accelerator_modifiers = list1 (Qmeta);
5318 DEFVAR_LISP ("menu-accelerator-enabled", &Vmenu_accelerator_enabled /*
5319 Whether menu accelerator keys can cause the menubar to become active.
5320 If 'menu-force or 'menu-fallback, then menu accelerator keys can
5321 be used to activate the top level menu. Once the menubar becomes active, the
5322 accelerator keys can be used regardless of the value of this variable.
5324 menu-force is used to indicate that the menu accelerator key takes
5325 precedence over bindings in the current keymap(s). menu-fallback means
5326 that bindings in the current keymap take precedence over menu accelerator keys.
5327 Thus a top level menu with an accelerator of "T" would be activated on a
5328 keypress of Meta-t if menu-accelerator-enabled is menu-force.
5329 However, if menu-accelerator-enabled is menu-fallback, then
5330 Meta-t will not activate the menubar and will instead run the function
5331 transpose-words, to which it is normally bound.
5333 See also menu-accelerator-modifiers and menu-accelerator-prefix.
5335 Vmenu_accelerator_enabled = Qnil;
5339 complex_vars_of_event_stream (void)
5341 Vkeyboard_translate_table =
5342 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
5344 DEFVAR_LISP ("menu-accelerator-map", &Vmenu_accelerator_map /*
5345 Keymap for use when the menubar is active.
5346 The actions menu-quit, menu-up, menu-down, menu-left, menu-right,
5347 menu-select and menu-escape can be mapped to keys in this map.
5349 menu-quit Immediately deactivate the menubar and any open submenus without
5351 menu-up Move the menu cursor up one row in the current menu. If the
5352 move extends past the top of the menu, wrap around to the bottom.
5353 menu-down Move the menu cursor down one row in the current menu. If the
5354 move extends past the bottom of the menu, wrap around to the top.
5355 If executed while the cursor is in the top level menu, move down
5356 into the selected menu.
5357 menu-left Move the cursor from a submenu into the parent menu. If executed
5358 while the cursor is in the top level menu, move the cursor to the
5359 left. If the move extends past the left edge of the menu, wrap
5360 around to the right edge.
5361 menu-right Move the cursor into a submenu. If the cursor is located in the
5362 top level menu or is not currently on a submenu heading, then move
5363 the cursor to the next top level menu entry. If the move extends
5364 past the right edge of the menu, wrap around to the left edge.
5365 menu-select Activate the item under the cursor. If the cursor is located on
5366 a submenu heading, then move the cursor into the submenu.
5367 menu-escape Pop up to the next level of menus. Moves from a submenu into its
5368 parent menu. From the top level menu, this deactivates the
5371 This keymap can also contain normal key-command bindings, in which case the
5372 menubar is deactivated and the corresponding command is executed.
5374 The action bindings used by the menu accelerator code are designed to mimic
5375 the actions of menu traversal keys in a commonly used PC operating system.
5377 Vmenu_accelerator_map = Fmake_keymap(Qnil);
5381 init_event_stream (void)
5385 #ifdef HAVE_UNIXOID_EVENT_LOOP
5386 init_event_unixoid ();
5388 #ifdef HAVE_X_WINDOWS
5389 if (!strcmp (display_use, "x"))
5390 init_event_Xt_late ();
5393 #ifdef HAVE_MS_WINDOWS
5394 if (!strcmp (display_use, "mswindows"))
5395 init_event_mswindows_late ();
5399 /* For TTY's, use the Xt event loop if we can; it allows
5400 us to later open an X connection. */
5401 #if defined (HAVE_MS_WINDOWS) && (!defined (HAVE_TTY) \
5402 || (defined (HAVE_MSG_SELECT) \
5403 && !defined (DEBUG_TTY_EVENT_STREAM)))
5404 init_event_mswindows_late ();
5405 #elif defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
5406 init_event_Xt_late ();
5407 #elif defined (HAVE_TTY)
5408 init_event_tty_late ();
5411 init_interrupts_late ();
5417 useful testcases for v18/v19 compatibility:
5421 (setq unread-command-event (character-to-event ?A (allocate-event)))
5422 (setq x (list (read-char)
5423 ; (read-key-sequence "") ; try it with and without this
5424 last-command-char last-input-char
5425 (recent-keys) (this-command-keys))))
5426 (global-set-key "\^Q" 'foo)
5428 without the read-key-sequence:
5429 ^Q ==> (65 17 65 [... ^Q] [^Q])
5430 ^U^U^Q ==> (65 17 65 [... ^U ^U ^Q] [^U ^U ^Q])
5431 ^U^U^U^G^Q ==> (65 17 65 [... ^U ^U ^U ^G ^Q] [^Q])
5433 with the read-key-sequence:
5434 ^Qb ==> (65 [b] 17 98 [... ^Q b] [b])
5435 ^U^U^Qb ==> (65 [b] 17 98 [... ^U ^U ^Q b] [b])
5436 ^U^U^U^G^Qb ==> (65 [b] 17 98 [... ^U ^U ^U ^G ^Q b] [b])
5438 ;the evi-mode command "4dlj.j.j.j.j.j." is also a good testcase (gag)
5440 ;(setq x (list (read-char) quit-flag))^J^G
5441 ;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G
5442 ;for BOTH, x should get set to (7 t), but no result should be printed.
5444 ;also do this: make two frames, one viewing "*scratch*", the other "foo".
5445 ;in *scratch*, type (sit-for 20)^J
5446 ;wait a couple of seconds, move cursor to foo, type "a"
5447 ;a should be inserted in foo. Cursor highlighting should not change in
5450 ;do it with sleep-for. move cursor into foo, then back into *scratch*
5452 ;repeat also with (accept-process-output nil 20)
5454 ;make sure ^G aborts sit-for, sleep-for and accept-process-output:
5457 (list (condition-case c
5462 (tst)^Ja^G ==> ((quit) 97) with no signal
5463 (tst)^J^Ga ==> ((quit) 97) with no signal
5464 (tst)^Jabc^G ==> ((quit) 97) with no signal, and "bc" inserted in buffer
5466 ; with sit-for only do the 2nd test.
5467 ; Do all 3 tests with (accept-process-output nil 20)
5470 (setq enable-recursive-minibuffers t
5471 minibuffer-max-depth nil)
5472 ESC ESC ESC ESC - there are now two minibuffers active
5473 C-g C-g C-g - there should be active 0, not 1
5475 C-x C-f ~ / ? - wait for "Making completion list..." to display
5476 C-g - wait for "Quit" to display
5477 C-g - minibuffer should not be active
5478 however C-g before "Quit" is displayed should leave minibuffer active.
5480 ;do it all in both v18 and v19 and make sure all results are the same.
5481 ;all of these cases matter a lot, but some in quite subtle ways.
5485 Additional test cases for accept-process-output, sleep-for, sit-for.
5486 Be sure you do all of the above checking for C-g and focus, too!
5488 ; Make sure that timer handlers are run during, not after sit-for:
5489 (defun timer-check ()
5490 (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil)
5492 (message "after sit-for"))
5494 ; The first message should appear after 2 seconds, and the final message
5495 ; 3 seconds after that.
5496 ; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
5500 ; Make sure that process filters are run during, not after sit-for.
5502 (message "sit-for = %s" (sit-for 30)))
5503 (add-hook 'post-command-hook 'fubar)
5505 ; Now type M-x shell RET
5506 ; wait for the shell prompt then send: ls RET
5507 ; the output of ls should fill immediately, and not wait 30 seconds.
5509 ; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
5513 ; Make sure that recursive invocations return immediately:
5514 (defmacro test-diff-time (start end)
5515 `(+ (* (- (car ,end) (car ,start)) 65536.0)
5516 (- (cadr ,end) (cadr ,start))
5517 (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
5519 (defun testee (ignore)
5523 (let ((start (current-time))
5525 (add-timeout 2 'testee nil)
5527 (add-timeout 2 'testee nil)
5529 (add-timeout 2 'testee nil)
5530 (accept-process-output nil 5)
5531 (setq end (current-time))
5532 (test-diff-time start end)))
5534 (test-them) should sit for 15 seconds.
5535 Repeat with testee set to sleep-for and accept-process-output.
5536 These should each delay 36 seconds.