X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/632fd57c5b4aa2cface82b43e17879147c4c1308..refs/heads/wip:/src/keyboard.c
diff --git a/src/keyboard.c b/src/keyboard.c
index e92c86b7db..7e63357039 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -43,6 +43,7 @@ along with GNU Emacs. If not, see . */
#include "systime.h"
#include "atimer.h"
#include "process.h"
+#include "guile.h"
#include
#ifdef HAVE_PTHREAD
@@ -69,6 +70,8 @@ along with GNU Emacs. If not, see . */
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
+#include /* for GC_collect_a_little */
+
/* Variables for blockinput.h: */
/* Positive if interrupt input is blocked right now. */
@@ -135,7 +138,7 @@ static ptrdiff_t before_command_echo_length;
/* For longjmp to where kbd input is being done. */
-static sys_jmp_buf getcjmp;
+static Lisp_Object getctag;
/* True while doing kbd input. */
bool waiting_for_input;
@@ -356,7 +359,6 @@ static Lisp_Object Qecho_keystrokes;
static void recursive_edit_unwind (Lisp_Object buffer);
static Lisp_Object command_loop (void);
static Lisp_Object Qcommand_execute;
-struct timespec timer_check (void);
static void echo_now (void);
static ptrdiff_t echo_length (void);
@@ -377,12 +379,6 @@ bool interrupt_input;
/* Nonzero while interrupts are temporarily deferred during redisplay. */
bool interrupts_deferred;
-/* If we support a window system, turn on the code to poll periodically
- to detect C-g. It isn't actually used when doing interrupt input. */
-#ifdef HAVE_WINDOW_SYSTEM
-#define POLL_FOR_INPUT
-#endif
-
/* The time when Emacs started being idle. */
static struct timespec timer_idleness_start_time;
@@ -422,8 +418,6 @@ static Lisp_Object make_lispy_focus_in (Lisp_Object);
static Lisp_Object make_lispy_focus_out (Lisp_Object);
#endif /* HAVE_WINDOW_SYSTEM */
static bool help_char_p (Lisp_Object);
-static void save_getcjmp (sys_jmp_buf);
-static void restore_getcjmp (sys_jmp_buf);
static Lisp_Object apply_modifiers (int, Lisp_Object);
static void clear_event (struct input_event *);
static void restore_kboard_configuration (int);
@@ -745,7 +739,7 @@ add_command_key (Lisp_Object key)
Lisp_Object
recursive_edit_1 (void)
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
Lisp_Object val;
if (command_loop_level > 0)
@@ -782,7 +776,8 @@ recursive_edit_1 (void)
if (STRINGP (val))
xsignal1 (Qerror, val);
- return unbind_to (count, Qnil);
+ dynwind_end ();
+ return Qnil;
}
/* When an auto-save happens, record the "time", and don't do again soon. */
@@ -817,13 +812,15 @@ one level up.
This function is called by the editor initialization to begin editing. */)
(void)
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
Lisp_Object buffer;
/* If we enter while input is blocked, don't lock up here.
This may happen through the debugger during redisplay. */
- if (input_blocked_p ())
+ if (input_blocked_p ()) {
+ dynwind_end ();
return Qnil;
+ }
if (command_loop_level >= 0
&& current_buffer != XBUFFER (XWINDOW (selected_window)->contents))
@@ -846,7 +843,8 @@ This function is called by the editor initialization to begin editing. */)
temporarily_switch_to_single_kboard (SELECTED_FRAME ());
recursive_edit_1 ();
- return unbind_to (count, Qnil);
+ dynwind_end ();
+ return Qnil;
}
void
@@ -1168,24 +1166,55 @@ command_loop (void)
value to us. A value of nil means that command_loop_1 itself
returned due to end of file (or end of kbd macro). */
+static Lisp_Object
+command_loop_2_body (void *ignore)
+{
+ return command_loop_1 ();
+}
+
+static Lisp_Object
+command_loop_2_handler (void *ignore, SCM key, SCM args)
+{
+ return Fsignal (Qerror,
+ list3 (build_string ("Scheme error"), key, args));
+}
+
+static Lisp_Object
+command_loop_2_inner (void)
+{
+ return scm_c_with_throw_handler (SCM_BOOL_T,
+ command_loop_2_body, NULL,
+ command_loop_2_handler, NULL,
+ 0);
+}
+
static Lisp_Object
command_loop_2 (Lisp_Object ignore)
{
register Lisp_Object val;
do
- val = internal_condition_case (command_loop_1, Qerror, cmd_error);
+ val = internal_condition_case (command_loop_2_inner, Qerror, cmd_error);
while (!NILP (val));
return Qnil;
}
static Lisp_Object
-top_level_2 (void)
+top_level_2_body (void *ignore)
{
return Feval (Vtop_level, Qnil);
}
+static Lisp_Object
+top_level_2 (void)
+{
+ return scm_c_with_throw_handler (SCM_BOOL_T,
+ top_level_2_body, NULL,
+ command_loop_2_handler, NULL,
+ 0);
+}
+
static Lisp_Object
top_level_1 (Lisp_Object ignore)
{
@@ -1222,7 +1251,7 @@ user_error (const char *msg)
xsignal1 (Quser_error, build_string (msg));
}
-_Noreturn
+/* _Noreturn will be added to prototype by make-docfile. */
DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
doc: /* Exit from the innermost recursive edit or minibuffer. */)
(void)
@@ -1233,7 +1262,7 @@ DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0,
user_error ("No recursive edit is in progress");
}
-_Noreturn
+/* _Noreturn will be added to prototype by make-docfile. */
DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
doc: /* Abort the command that requested this recursive edit or minibuffer input. */)
(void)
@@ -1266,23 +1295,24 @@ tracking_off (Lisp_Object old_value)
}
}
-DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
+DEFUN ("call-with-track-mouse", Ftrack_mouse, Strack_mouse, 1, 1, 0,
doc: /* Evaluate BODY with mouse movement events enabled.
Within a `track-mouse' form, mouse motion generates input events that
you can read with `read-event'.
Normally, mouse motion is ignored.
usage: (track-mouse BODY...) */)
- (Lisp_Object args)
+ (Lisp_Object thunk)
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
Lisp_Object val;
record_unwind_protect (tracking_off, do_mouse_tracking);
do_mouse_tracking = Qt;
- val = Fprogn (args);
- return unbind_to (count, val);
+ val = call0 (thunk);
+ dynwind_end ();
+ return val;
}
/* If mouse has moved on some frame, return one of those frames.
@@ -1292,9 +1322,6 @@ usage: (track-mouse BODY...) */)
If ignore_mouse_drag_p is non-zero, ignore (implicit) mouse movement
after resizing the tool-bar window. */
-#if !defined HAVE_WINDOW_SYSTEM || defined USE_GTK || defined HAVE_NS
-static
-#endif
bool ignore_mouse_drag_p;
static struct frame *
@@ -1323,14 +1350,11 @@ some_mouse_moved (void)
static int read_key_sequence (Lisp_Object *, int, Lisp_Object,
bool, bool, bool, bool);
-void safe_run_hooks (Lisp_Object);
static void adjust_point_for_property (ptrdiff_t, bool);
/* The last boundary auto-added to buffer-undo-list. */
Lisp_Object last_undo_boundary;
-extern Lisp_Object Qregion_extract_function;
-
/* FIXME: This is wrong rather than test window-system, we should call
a new set-selection, which will then dispatch to x-set-selection, or
tty-set-selection, or w32-set-selection, ... */
@@ -1415,7 +1439,7 @@ command_loop_1 (void)
{
/* Bind inhibit-quit to t so that C-g gets read in
rather than quitting back to the minibuffer. */
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
specbind (Qinhibit_quit, Qt);
sit_for (Vminibuffer_message_timeout, 0, 2);
@@ -1424,7 +1448,7 @@ command_loop_1 (void)
message1 (0);
safe_run_hooks (Qecho_area_clear_hook);
- unbind_to (count, Qnil);
+ dynwind_end ();
/* If a C-g came in before, treat it as input now. */
if (!NILP (Vquit_flag))
@@ -1538,7 +1562,7 @@ command_loop_1 (void)
/* Here for a command that isn't executed directly. */
#ifdef HAVE_WINDOW_SYSTEM
- ptrdiff_t scount = SPECPDL_INDEX ();
+ dynwind_begin ();
if (display_hourglass_p
&& NILP (Vexecuting_kbd_macro))
@@ -1564,8 +1588,7 @@ command_loop_1 (void)
hourglass cursor anyway.
But don't cancel the hourglass within a macro
just because a command in the macro finishes. */
- if (NILP (Vexecuting_kbd_macro))
- unbind_to (scount, Qnil);
+ dynwind_end ();
#endif
}
kset_last_prefix_arg (current_kboard, Vcurrent_prefix_arg);
@@ -1690,7 +1713,7 @@ Lisp_Object
read_menu_command (void)
{
Lisp_Object keybuf[30];
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
int i;
/* We don't want to echo the keystrokes while navigating the
@@ -1700,7 +1723,7 @@ read_menu_command (void)
i = read_key_sequence (keybuf, ARRAYELTS (keybuf),
Qnil, 0, 1, 1, 1);
- unbind_to (count, Qnil);
+ dynwind_end ();
if (! FRAME_LIVE_P (XFRAME (selected_frame)))
Fkill_emacs (Qnil);
@@ -1941,20 +1964,15 @@ safe_run_hooks (Lisp_Object hook)
/* FIXME: our `internal_condition_case' does not provide any way to pass data
to its body or to its handlers other than via globals such as
dynamically-bound variables ;-) */
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
specbind (Qinhibit_quit, hook);
run_hook_with_args (1, &hook, safe_run_hook_funcall);
- unbind_to (count, Qnil);
+ dynwind_end ();
}
-/* Nonzero means polling for input is temporarily suppressed. */
-
-int poll_suppress_count;
-
-
#ifdef POLL_FOR_INPUT
/* Asynchronous timer for polling. */
@@ -1976,8 +1994,6 @@ poll_for_input_1 (void)
static void
poll_for_input (struct atimer *timer)
{
- if (poll_suppress_count == 0)
- pending_signals = 1;
}
#endif /* POLL_FOR_INPUT */
@@ -2012,10 +2028,6 @@ start_polling (void)
poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
poll_for_input, NULL);
}
-
- /* Let the timer's callback function poll for input
- if this becomes zero. */
- --poll_suppress_count;
}
#endif
}
@@ -2035,40 +2047,6 @@ input_polling_used (void)
#endif
}
-/* Turn off polling. */
-
-void
-stop_polling (void)
-{
-#ifdef POLL_FOR_INPUT
- /* XXX This condition was (read_socket_hook && !interrupt_input),
- but read_socket_hook is not global anymore. Let's pretend that
- it's always set. */
- if (!interrupt_input)
- ++poll_suppress_count;
-#endif
-}
-
-/* Set the value of poll_suppress_count to COUNT
- and start or stop polling accordingly. */
-
-void
-set_poll_suppress_count (int count)
-{
-#ifdef POLL_FOR_INPUT
- if (count == 0 && poll_suppress_count != 0)
- {
- poll_suppress_count = 1;
- start_polling ();
- }
- else if (count != 0 && poll_suppress_count == 0)
- {
- stop_polling ();
- }
- poll_suppress_count = count;
-#endif
-}
-
/* Bind polling_period to a value at least N.
But don't decrease it. */
@@ -2076,13 +2054,12 @@ void
bind_polling_period (int n)
{
#ifdef POLL_FOR_INPUT
- EMACS_INT new = polling_period;
+ EMACS_INT new = max (polling_period, new);
if (n > new)
new = n;
stop_other_atimers (poll_timer);
- stop_polling ();
specbind (Qpolling_period, make_number (new));
/* Start a new alarm with the new period. */
start_polling ();
@@ -2091,16 +2068,13 @@ bind_polling_period (int n)
/* Apply the control modifier to CHARACTER. */
-#ifndef HAVE_NTGUI
-static
-#endif
int
make_ctrl_char (int c)
{
/* Save the upper bits here. */
int upper = c & ~0177;
- if (! ASCII_BYTE_P (c))
+ if (! ASCII_CHAR_P (c))
return c |= ctrl_modifier;
c &= 0177;
@@ -2197,7 +2171,7 @@ show_help_echo (Lisp_Object help, Lisp_Object window, Lisp_Object object,
-/* Input of single characters from keyboard */
+/* Input of single characters from keyboard. */
static Lisp_Object kbd_buffer_get_event (KBOARD **kbp, bool *used_mouse_menu,
struct timespec *end_time);
@@ -2213,21 +2187,14 @@ read_char_help_form_unwind (void)
Fset_window_configuration (window_config);
}
-#define STOP_POLLING \
-do { if (! polling_stopped_here) stop_polling (); \
- polling_stopped_here = 1; } while (0)
-
-#define RESUME_POLLING \
-do { if (polling_stopped_here) start_polling (); \
- polling_stopped_here = 0; } while (0)
-
static Lisp_Object
read_event_from_main_queue (struct timespec *end_time,
- sys_jmp_buf local_getcjmp,
+ Lisp_Object local_tag,
bool *used_mouse_menu)
{
Lisp_Object c = Qnil;
- sys_jmp_buf save_jump;
+ Lisp_Object save_tag = Qnil;
+ sys_jmp_buf *save_jump = xmalloc (sizeof *save_jump);
KBOARD *kb IF_LINT (= NULL);
start:
@@ -2239,12 +2206,12 @@ read_event_from_main_queue (struct timespec *end_time,
return c;
/* Actually read a character, waiting if necessary. */
- save_getcjmp (save_jump);
- restore_getcjmp (local_getcjmp);
+ save_tag = getctag;
+ getctag = local_tag;
if (!end_time)
timer_start_idle ();
c = kbd_buffer_get_event (&kb, used_mouse_menu, end_time);
- restore_getcjmp (save_jump);
+ getctag = save_tag;
if (! NILP (c) && (kb != current_kboard))
{
@@ -2297,7 +2264,7 @@ read_event_from_main_queue (struct timespec *end_time,
to tty input. */
static Lisp_Object
read_decoded_event_from_main_queue (struct timespec *end_time,
- sys_jmp_buf local_getcjmp,
+ Lisp_Object local_getcjmp,
Lisp_Object prev_event,
bool *used_mouse_menu)
{
@@ -2410,37 +2377,139 @@ echo_keystrokes_p (void)
Value is t if we showed a menu and the user rejected it. */
+struct read_char_state
+{
+ int commandflag;
+ Lisp_Object map;
+ Lisp_Object prev_event;
+ bool *used_mouse_menu;
+ struct timespec *end_time;
+ Lisp_Object c;
+ Lisp_Object tag;
+ Lisp_Object local_tag;
+ Lisp_Object save_tag;
+ Lisp_Object previous_echo_area_message;
+ Lisp_Object also_record;
+ bool reread;
+ bool polling_stopped_here;
+ struct kboard *orig_kboard;
+};
+
+static Lisp_Object read_char_1 (bool, volatile struct read_char_state *);
+
+static Lisp_Object
+read_char_thunk (void *data)
+{
+ return read_char_1 (false, data);
+}
+
+static Lisp_Object
+read_char_handle_quit (void *data, Lisp_Object k)
+{
+ struct read_char_state *state = data;
+ /* Handle quits while reading the keyboard. */
+ /* We must have saved the outer value of getcjmp here,
+ so restore it now. */
+ getctag = state->save_tag;
+ XSETINT (state->c, quit_char);
+ internal_last_event_frame = selected_frame;
+ Vlast_event_frame = internal_last_event_frame;
+ /* If we report the quit char as an event,
+ don't do so more than once. */
+ if (!NILP (Vinhibit_quit))
+ Vquit_flag = Qnil;
+
+ {
+ KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame));
+ if (kb != current_kboard)
+ {
+ Lisp_Object last = KVAR (kb, kbd_queue);
+ /* We shouldn't get here if we were in single-kboard mode! */
+ if (single_kboard)
+ emacs_abort ();
+ if (CONSP (last))
+ {
+ while (CONSP (XCDR (last)))
+ last = XCDR (last);
+ if (!NILP (XCDR (last)))
+ emacs_abort ();
+ }
+ if (!CONSP (last))
+ kset_kbd_queue (kb, list1 (state->c));
+ else
+ XSETCDR (last, list1 (state->c));
+ kb->kbd_queue_has_data = 1;
+ current_kboard = kb;
+ /* This is going to exit from read_char
+ so we had better get rid of this frame's stuff. */
+ UNGCPRO;
+ return make_number (-2); /* wrong_kboard_jmpbuf */
+ }
+ }
+ return read_char_1 (true, state);
+}
+
+/* {{coccinelle:skip_start}} */
Lisp_Object
read_char (int commandflag, Lisp_Object map,
Lisp_Object prev_event,
bool *used_mouse_menu, struct timespec *end_time)
{
- Lisp_Object c;
- ptrdiff_t jmpcount;
- sys_jmp_buf local_getcjmp;
- sys_jmp_buf save_jump;
- Lisp_Object tem, save;
- volatile Lisp_Object previous_echo_area_message;
- volatile Lisp_Object also_record;
- volatile bool reread;
- struct gcpro gcpro1, gcpro2;
- bool volatile polling_stopped_here = 0;
- struct kboard *orig_kboard = current_kboard;
+ struct read_char_state *state = xmalloc (sizeof *state);
+
+ state->commandflag = commandflag;
+ state->map = map;
+ state->prev_event = prev_event;
+ state->used_mouse_menu = used_mouse_menu;
+ state->end_time = end_time;
+ state->c = Qnil;
+ state->local_tag = Qnil;
+ state->save_tag = Qnil;
+ state->previous_echo_area_message = Qnil;
+ state->also_record = Qnil;
+ state->reread = false;
+ state->polling_stopped_here = false;
+ state->orig_kboard = current_kboard;
+
+ /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
+ We will do that below, temporarily for short sections of code,
+ when appropriate. local_getcjmp must be in effect
+ around any call to sit_for or kbd_buffer_get_event;
+ it *must not* be in effect when we call redisplay. */
- also_record = Qnil;
+ state->tag = state->local_tag = make_prompt_tag ();
-#if 0 /* This was commented out as part of fixing echo for C-u left. */
- before_command_key_count = this_command_key_count;
- before_command_echo_length = echo_length ();
-#endif
- c = Qnil;
- previous_echo_area_message = Qnil;
+ return call_with_prompt (state->tag,
+ make_c_closure (read_char_thunk, state, 0, 0),
+ make_c_closure (read_char_handle_quit, state, 1, 0));
+}
+
+static Lisp_Object
+read_char_1 (bool jump, volatile struct read_char_state *state)
+{
+#define commandflag state->commandflag
+#define map state->map
+#define prev_event state->prev_event
+#define used_mouse_menu state->used_mouse_menu
+#define end_time state->end_time
+#define c state->c
+#define jmpcount state->jmpcount
+#define local_getcjmp state->local_tag
+#define save_jump state->save_tag
+#define previous_echo_area_message state->previous_echo_area_message
+#define also_record state->also_record
+#define reread state->reread
+#define polling_stopped_here state->polling_stopped_here
+#define orig_kboard state->orig_kboard
+#define save_getcjmp(x) (x = getctag)
+#define restore_getcjmp(x) (getctag = x)
+ Lisp_Object tem, save;
- GCPRO2 (c, previous_echo_area_message);
+ if (jump)
+ goto non_reread;
retry:
- reread = 0;
if (CONSP (Vunread_post_input_method_events))
{
c = XCAR (Vunread_post_input_method_events);
@@ -2454,9 +2523,12 @@ read_char (int commandflag, Lisp_Object map,
&& NILP (XCDR (c)))
c = XCAR (c);
- reread = 1;
+ reread = true;
goto reread_first;
}
+ else
+ reread = false;
+
if (CONSP (Vunread_command_events))
{
@@ -2465,17 +2537,13 @@ read_char (int commandflag, Lisp_Object map,
c = XCAR (Vunread_command_events);
Vunread_command_events = XCDR (Vunread_command_events);
- reread = 1;
-
/* Undo what sit-for did when it unread additional keys
inside universal-argument. */
- if (CONSP (c)
- && EQ (XCAR (c), Qt))
- {
- reread = 0;
- c = XCDR (c);
- }
+ if (CONSP (c) && EQ (XCAR (c), Qt))
+ c = XCDR (c);
+ else
+ reread = true;
/* Undo what read_char_x_menu_prompt did when it unread
additional keys returned by Fx_popup_menu. */
@@ -2509,7 +2577,7 @@ read_char (int commandflag, Lisp_Object map,
&& (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
&& NILP (XCDR (c)))
c = XCAR (c);
- reread = 1;
+ reread = true;
goto reread_for_input_method;
}
@@ -2651,58 +2719,6 @@ read_char (int commandflag, Lisp_Object map,
goto exit;
}
- /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
- We will do that below, temporarily for short sections of code,
- when appropriate. local_getcjmp must be in effect
- around any call to sit_for or kbd_buffer_get_event;
- it *must not* be in effect when we call redisplay. */
-
- jmpcount = SPECPDL_INDEX ();
- if (sys_setjmp (local_getcjmp))
- {
- /* Handle quits while reading the keyboard. */
- /* We must have saved the outer value of getcjmp here,
- so restore it now. */
- restore_getcjmp (save_jump);
- unbind_to (jmpcount, Qnil);
- XSETINT (c, quit_char);
- internal_last_event_frame = selected_frame;
- Vlast_event_frame = internal_last_event_frame;
- /* If we report the quit char as an event,
- don't do so more than once. */
- if (!NILP (Vinhibit_quit))
- Vquit_flag = Qnil;
-
- {
- KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame));
- if (kb != current_kboard)
- {
- Lisp_Object last = KVAR (kb, kbd_queue);
- /* We shouldn't get here if we were in single-kboard mode! */
- if (single_kboard)
- emacs_abort ();
- if (CONSP (last))
- {
- while (CONSP (XCDR (last)))
- last = XCDR (last);
- if (!NILP (XCDR (last)))
- emacs_abort ();
- }
- if (!CONSP (last))
- kset_kbd_queue (kb, list1 (c));
- else
- XSETCDR (last, list1 (c));
- kb->kbd_queue_has_data = 1;
- current_kboard = kb;
- /* This is going to exit from read_char
- so we had better get rid of this frame's stuff. */
- UNGCPRO;
- return make_number (-2); /* wrong_kboard_jmpbuf */
- }
- }
- goto non_reread;
- }
-
/* Start idle timers if no time limit is supplied. We don't do it
if a time limit is supplied to avoid an infinite recursion in the
situation where an idle timer calls `sit-for'. */
@@ -2827,7 +2843,7 @@ read_char (int commandflag, Lisp_Object map,
/* If there is still no input available, ask for GC. */
if (!detect_input_pending_run_timers (0))
- maybe_gc ();
+ GC_collect_a_little ();
}
/* Notify the caller if an autosave hook, or a timer, sentinel or
@@ -2849,6 +2865,11 @@ read_char (int commandflag, Lisp_Object map,
{
c = XCAR (Vunread_command_events);
Vunread_command_events = XCDR (Vunread_command_events);
+
+ if (CONSP (c) && EQ (XCAR (c), Qt))
+ c = XCDR (c);
+ else
+ reread = true;
}
/* Read something from current KBOARD's side queue, if possible. */
@@ -2896,14 +2917,12 @@ read_char (int commandflag, Lisp_Object map,
wrong_kboard:
- STOP_POLLING;
-
if (NILP (c))
{
c = read_decoded_event_from_main_queue (end_time, local_getcjmp,
prev_event, used_mouse_menu);
- if (NILP(c) && end_time &&
- timespec_cmp (*end_time, current_timespec ()) <= 0)
+ if (NILP (c) && end_time
+ && timespec_cmp (*end_time, current_timespec ()) <= 0)
{
goto exit;
}
@@ -2921,7 +2940,6 @@ read_char (int commandflag, Lisp_Object map,
if (!end_time)
timer_stop_idle ();
- RESUME_POLLING;
if (NILP (c))
{
@@ -3067,7 +3085,6 @@ read_char (int commandflag, Lisp_Object map,
ptrdiff_t key_count;
bool key_count_reset;
struct gcpro gcpro1;
- ptrdiff_t count = SPECPDL_INDEX ();
/* Save the echo status. */
bool saved_immediate_echo = current_kboard->immediate_echo;
@@ -3075,6 +3092,8 @@ read_char (int commandflag, Lisp_Object map,
Lisp_Object saved_echo_string = KVAR (current_kboard, echo_string);
ptrdiff_t saved_echo_after_prompt = current_kboard->echo_after_prompt;
+ dynwind_begin ();
+
#if 0
if (before_command_restore_flag)
{
@@ -3116,7 +3135,7 @@ read_char (int commandflag, Lisp_Object map,
/* Call the input method. */
tem = call1 (Vinput_method_function, c);
- tem = unbind_to (count, tem);
+ dynwind_end ();
/* Restore the saved echoing state
and this_command_keys state. */
@@ -3203,7 +3222,7 @@ read_char (int commandflag, Lisp_Object map,
/* Process the help character specially if enabled. */
if (!NILP (Vhelp_form) && help_char_p (c))
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
help_form_saved_window_configs
= Fcons (Fcurrent_window_configuration (Qnil),
@@ -3221,7 +3240,7 @@ read_char (int commandflag, Lisp_Object map,
}
while (BUFFERP (c));
/* Remove the help from the frame. */
- unbind_to (count, Qnil);
+ dynwind_end ();
redisplay ();
if (EQ (c, make_number (040)))
@@ -3234,9 +3253,25 @@ read_char (int commandflag, Lisp_Object map,
}
exit:
- RESUME_POLLING;
RETURN_UNGCPRO (c);
-}
+#undef commandflag
+#undef map
+#undef prev_event
+#undef used_mouse_menu
+#undef end_time
+#undef c
+#undef jmpcount
+#undef local_getcjmp
+#undef save_jump
+#undef previous_echo_area_message
+#undef also_record
+#undef reread
+#undef polling_stopped_here
+#undef orig_kboard
+#undef save_getcjmp
+#undef restore_getcjmp
+}
+/* {{coccinelle:skip_end}} */
/* Record a key that came from a mouse menu.
Record it for echoing, for this-command-keys, and so on. */
@@ -3422,23 +3457,6 @@ record_char (Lisp_Object c)
unblock_input ();
}
}
-
-/* Copy out or in the info on where C-g should throw to.
- This is used when running Lisp code from within get_char,
- in case get_char is called recursively.
- See read_process_output. */
-
-static void
-save_getcjmp (sys_jmp_buf temp)
-{
- memcpy (temp, getcjmp, sizeof getcjmp);
-}
-
-static void
-restore_getcjmp (sys_jmp_buf temp)
-{
- memcpy (getcjmp, temp, sizeof getcjmp);
-}
/* Low level keyboard/mouse input.
kbd_buffer_store_event places events in kbd_buffer, and
@@ -3662,14 +3680,14 @@ kbd_buffer_store_event_hold (register struct input_event *event,
*kbd_store_ptr = *event;
++kbd_store_ptr;
#ifdef subprocesses
- if (kbd_buffer_nr_stored () > KBD_BUFFER_SIZE/2 && ! kbd_on_hold_p ())
+ if (kbd_buffer_nr_stored () > KBD_BUFFER_SIZE / 2
+ && ! kbd_on_hold_p ())
{
/* Don't read keyboard input until we have processed kbd_buffer.
This happens when pasting text longer than KBD_BUFFER_SIZE/2. */
hold_keyboard_input ();
if (!noninteractive)
ignore_sigio ();
- stop_polling ();
}
#endif /* subprocesses */
}
@@ -3833,7 +3851,6 @@ kbd_buffer_get_event (KBOARD **kbp,
/* Start reading input again because we have processed enough to
be able to accept new events again. */
unhold_keyboard_input ();
- start_polling ();
}
#endif /* subprocesses */
@@ -4507,7 +4524,7 @@ timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers)
{
if (NILP (AREF (chosen_timer, 0)))
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
Lisp_Object old_deactivate_mark = Vdeactivate_mark;
/* Mark the timer as triggered to prevent problems if the lisp
@@ -4519,7 +4536,7 @@ timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers)
call1 (Qtimer_event_handler, chosen_timer);
Vdeactivate_mark = old_deactivate_mark;
timers_run++;
- unbind_to (count, Qnil);
+ dynwind_end ();
/* Since we have handled the event,
we don't need to tell the caller to wake up and do it. */
@@ -5230,7 +5247,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
/* It's a click in window WINDOW at frame coordinates (X,Y) */
struct window *w = XWINDOW (window);
Lisp_Object string_info = Qnil;
- ptrdiff_t textpos = -1;
+ ptrdiff_t textpos = 0;
int col = -1, row = -1;
int dx = -1, dy = -1;
int width = -1, height = -1;
@@ -5265,9 +5282,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
&object, &dx, &dy, &width, &height);
if (STRINGP (string))
string_info = Fcons (string, make_number (charpos));
- textpos = (w == XWINDOW (selected_window)
- && current_buffer == XBUFFER (w->contents))
- ? PT : marker_position (w->pointm);
+ textpos = -1;
xret = wx;
yret = wy;
@@ -5335,7 +5350,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
/* For clicks in the text area, fringes, or margins, call
buffer_posn_from_coords to extract TEXTPOS, the buffer
position nearest to the click. */
- if (textpos < 0)
+ if (!textpos)
{
Lisp_Object string2, object2 = Qnil;
struct display_pos p;
@@ -5386,15 +5401,15 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
}
#endif
- /* Object info */
+ /* Object info. */
extra_info
= list3 (object,
Fcons (make_number (dx), make_number (dy)),
Fcons (make_number (width), make_number (height)));
- /* String info */
+ /* String info. */
extra_info = Fcons (string_info,
- Fcons (make_number (textpos),
+ Fcons (textpos < 0 ? Qnil : make_number (textpos),
Fcons (Fcons (make_number (col),
make_number (row)),
extra_info)));
@@ -6796,16 +6811,7 @@ record_asynch_buffer_change (void)
event.arg = Qnil;
/* Make sure no interrupt happens while storing the event. */
-#ifdef USABLE_SIGIO
- if (interrupt_input)
- kbd_buffer_store_event (&event);
- else
-#endif
- {
- stop_polling ();
- kbd_buffer_store_event (&event);
- start_polling ();
- }
+ kbd_buffer_store_event (&event);
}
}
@@ -7491,8 +7497,8 @@ menu_bar_items (Lisp_Object old)
{
int i = menu_bar_items_index;
if (i + 4 > ASIZE (menu_bar_items_vector))
- menu_bar_items_vector =
- larger_vector (menu_bar_items_vector, 4, -1);
+ menu_bar_items_vector
+ = larger_vector (menu_bar_items_vector, 4, -1);
/* Add this item. */
ASET (menu_bar_items_vector, i, Qnil); i++;
ASET (menu_bar_items_vector, i, Qnil); i++;
@@ -7608,12 +7614,13 @@ eval_dyn (Lisp_Object form)
Lisp_Object
menu_item_eval_property (Lisp_Object sexpr)
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
Lisp_Object val;
specbind (Qinhibit_redisplay, Qt);
val = internal_condition_case_1 (eval_dyn, sexpr, Qerror,
menu_item_eval_property_1);
- return unbind_to (count, val);
+ dynwind_end ();
+ return val;
}
/* This function parses a menu item and leaves the result in the
@@ -7847,7 +7854,7 @@ parse_menu_item (Lisp_Object item, int inmenubar)
(such as lmenu.el set it up), check if the
original command matches the cached command. */
&& !(SYMBOLP (def)
- && EQ (tem, XSYMBOL (def)->function))))
+ && EQ (tem, SYMBOL_FUNCTION (def)))))
keys = Qnil;
}
@@ -8262,7 +8269,7 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
const char *capt = STRINGP (tcapt) ? SSDATA (tcapt) : "";
ptrdiff_t max_lbl =
2 * max (0, min (tool_bar_max_label_size, STRING_BYTES_BOUND / 2));
- char *buf = xmalloc (max_lbl + 1);
+ char *buf = xmalloc_atomic (max_lbl + 1);
Lisp_Object new_lbl;
ptrdiff_t caption_len = strlen (capt);
@@ -8714,9 +8721,10 @@ access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt,
/* Handle a symbol whose function definition is a keymap
or an array. */
if (SYMBOLP (next) && !NILP (Ffboundp (next))
- && (ARRAYP (XSYMBOL (next)->function)
- || KEYMAPP (XSYMBOL (next)->function)))
- next = Fautoload_do_load (XSYMBOL (next)->function, next, Qnil);
+ && (ARRAYP (SYMBOL_FUNCTION (next))
+ || KEYMAPP (SYMBOL_FUNCTION (next))))
+ next = Fautoload_do_load (SYMBOL_FUNCTION (next),
+ next, Qnil);
/* If the keymap gives a function, not an
array, then call the function with one arg and use
@@ -8860,8 +8868,6 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
bool dont_downcase_last, bool can_return_switch_frame,
bool fix_current_buffer, bool prevent_redisplay)
{
- ptrdiff_t count = SPECPDL_INDEX ();
-
/* How many keys there are in the current key sequence. */
int t;
@@ -8928,6 +8934,8 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
struct gcpro gcpro1;
+ dynwind_begin ();
+
GCPRO1 (fake_prefixed_keys);
raw_keybuf_count = 0;
@@ -9159,7 +9167,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
Just return -1. */
if (EQ (key, Qt))
{
- unbind_to (count, Qnil);
+ dynwind_end ();
UNGCPRO;
return -1;
}
@@ -9395,16 +9403,6 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
first_unbound = min (t, first_unbound);
head = EVENT_HEAD (key);
- if (help_char_p (head) && t > 0)
- {
- read_key_sequence_cmd = Vprefix_help_command;
- keybuf[t++] = key;
- last_nonmenu_event = key;
- /* The Microsoft C compiler can't handle the goto that
- would go here. */
- dummyflag = 1;
- break;
- }
if (SYMBOLP (head))
{
@@ -9662,6 +9660,17 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
goto replay_sequence;
}
+
+ if (NILP (current_binding)
+ && help_char_p (EVENT_HEAD (key)) && t > 1)
+ {
+ read_key_sequence_cmd = Vprefix_help_command;
+ /* The Microsoft C compiler can't handle the goto that
+ would go here. */
+ dummyflag = 1;
+ break;
+ }
+
/* If KEY is not defined in any of the keymaps,
and cannot be part of a function key or translation,
and is a shifted function key,
@@ -9717,7 +9726,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
: Qnil;
unread_switch_frame = delayed_switch_frame;
- unbind_to (count, Qnil);
+ dynwind_end ();
/* Don't downcase the last character if the caller says don't.
Don't downcase it if the result is undefined, either. */
@@ -9761,7 +9770,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
Lisp_Object keybuf[30];
register int i;
struct gcpro gcpro1;
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
if (!NILP (prompt))
CHECK_STRING (prompt);
@@ -9807,9 +9816,9 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
QUIT;
}
UNGCPRO;
- return unbind_to (count,
- ((allow_string ? make_event_array : Fvector)
- (i, keybuf)));
+ Lisp_Object tem0 = ((allow_string ? make_event_array : Fvector) (i, keybuf));
+ dynwind_end ();
+ return tem0;
}
DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0,
@@ -10156,7 +10165,7 @@ Some operating systems cannot stop the Emacs process and resume it later.
On such systems, Emacs starts a subshell instead of suspending. */)
(Lisp_Object stuffstring)
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
int old_height, old_width;
int width, height;
struct gcpro gcpro1;
@@ -10183,7 +10192,7 @@ On such systems, Emacs starts a subshell instead of suspending. */)
sys_subshell ();
else
sys_suspend ();
- unbind_to (count, Qnil);
+ dynwind_end ();
/* Check if terminal/window size has changed.
Note that this is not useful when we are running directly
@@ -10323,9 +10332,6 @@ static void
handle_interrupt (bool in_signal_handler)
{
char c;
- sigset_t blocked;
- sigemptyset (&blocked);
- sigaddset (&blocked, SIGINT);
cancel_echoing ();
@@ -10337,6 +10343,9 @@ handle_interrupt (bool in_signal_handler)
/* If SIGINT isn't blocked, don't let us be interrupted by
a SIGINT. It might be harmful due to non-reentrancy
in I/O functions. */
+ sigset_t blocked;
+ sigemptyset (&blocked);
+ sigaddset (&blocked, SIGINT);
pthread_sigmask (SIG_BLOCK, &blocked, 0);
}
@@ -10364,34 +10373,18 @@ handle_interrupt (bool in_signal_handler)
is used. Note that [Enter] is not echoed by dos. */
cursor_to (SELECTED_FRAME (), 0, 0);
#endif
- /* It doesn't work to autosave while GC is in progress;
- the code used for auto-saving doesn't cope with the mark bit. */
- if (!gc_in_progress)
- {
- printf ("Auto-save? (y or n) ");
- fflush (stdout);
- if (((c = getchar ()) & ~040) == 'Y')
- {
- Fdo_auto_save (Qt, Qnil);
+ printf ("Auto-save? (y or n) ");
+ fflush (stdout);
+ if (((c = getchar ()) & ~040) == 'Y')
+ {
+ Fdo_auto_save (Qt, Qnil);
#ifdef MSDOS
- printf ("\r\nAuto-save done");
+ printf ("\r\nAuto-save done");
#else /* not MSDOS */
- printf ("Auto-save done\n");
-#endif /* not MSDOS */
- }
- while (c != '\n') c = getchar ();
- }
- else
- {
- /* During GC, it must be safe to reenable quitting again. */
- Vinhibit_quit = Qnil;
-#ifdef MSDOS
- printf ("\r\n");
+ printf ("Auto-save done\n");
#endif /* not MSDOS */
- printf ("Garbage collection in progress; cannot auto-save now\r\n");
- printf ("but will instead do a real quit after garbage collection ends\r\n");
- fflush (stdout);
- }
+ }
+ while (c != '\n') c = getchar ();
#ifdef MSDOS
printf ("\r\nAbort? (y or n) ");
@@ -10421,7 +10414,7 @@ handle_interrupt (bool in_signal_handler)
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
immediate_quit = 0;
- pthread_sigmask (SIG_UNBLOCK, &blocked, 0);
+ pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
saved = gl_state;
GCPRO4 (saved.object, saved.global_code,
saved.current_syntax_table, saved.old_prop);
@@ -10442,7 +10435,7 @@ handle_interrupt (bool in_signal_handler)
}
}
- pthread_sigmask (SIG_UNBLOCK, &blocked, 0);
+ pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
/* TODO: The longjmp in this call throws the NS event loop integration off,
and it seems to do fine without this. Probably some attention
@@ -10478,7 +10471,7 @@ quit_throw_to_read_char (bool from_signal)
do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
0, 0, Qnil);
- sys_longjmp (getcjmp, 1);
+ abort_to_prompt (getctag, SCM_EOL);
}
DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,
@@ -10508,9 +10501,6 @@ See also `current-input-mode'. */)
if (new_interrupt_input != interrupt_input)
{
-#ifdef POLL_FOR_INPUT
- stop_polling ();
-#endif
#ifndef DOS_NT
/* this causes startup screen to be restored and messes with the mouse */
reset_all_sys_modes ();
@@ -10521,7 +10511,6 @@ See also `current-input-mode'. */)
#endif
#ifdef POLL_FOR_INPUT
- poll_suppress_count = 1;
start_polling ();
#endif
}
@@ -10931,7 +10920,6 @@ init_keyboard (void)
#ifdef POLL_FOR_INPUT
poll_timer = NULL;
- poll_suppress_count = 1;
start_polling ();
#endif
}
@@ -10961,6 +10949,8 @@ static const struct event_head head_table[] = {
void
syms_of_keyboard (void)
{
+#include "keyboard.x"
+
pending_funcalls = Qnil;
staticpro (&pending_funcalls);
@@ -11140,38 +11130,6 @@ syms_of_keyboard (void)
help_form_saved_window_configs = Qnil;
staticpro (&help_form_saved_window_configs);
- defsubr (&Scurrent_idle_time);
- defsubr (&Sevent_symbol_parse_modifiers);
- defsubr (&Sevent_convert_list);
- defsubr (&Sread_key_sequence);
- defsubr (&Sread_key_sequence_vector);
- defsubr (&Srecursive_edit);
- defsubr (&Strack_mouse);
- defsubr (&Sinput_pending_p);
- defsubr (&Srecent_keys);
- defsubr (&Sthis_command_keys);
- defsubr (&Sthis_command_keys_vector);
- defsubr (&Sthis_single_command_keys);
- defsubr (&Sthis_single_command_raw_keys);
- defsubr (&Sreset_this_command_lengths);
- defsubr (&Sclear_this_command_keys);
- defsubr (&Ssuspend_emacs);
- defsubr (&Sabort_recursive_edit);
- defsubr (&Sexit_recursive_edit);
- defsubr (&Srecursion_depth);
- defsubr (&Scommand_error_default_function);
- defsubr (&Stop_level);
- defsubr (&Sdiscard_input);
- defsubr (&Sopen_dribble_file);
- defsubr (&Sset_input_interrupt_mode);
- defsubr (&Sset_output_flow_control);
- defsubr (&Sset_input_meta_mode);
- defsubr (&Sset_quit_char);
- defsubr (&Sset_input_mode);
- defsubr (&Scurrent_input_mode);
- defsubr (&Sposn_at_point);
- defsubr (&Sposn_at_x_y);
-
DEFVAR_LISP ("last-command-event", last_command_event,
doc: /* Last input event that was part of a command. */);
@@ -11771,52 +11729,3 @@ keys_of_keyboard (void)
initial_define_lispy_key (Vspecial_event_map, "focus-out",
"handle-focus-out");
}
-
-/* Mark the pointers in the kboard objects.
- Called by Fgarbage_collect. */
-void
-mark_kboards (void)
-{
- KBOARD *kb;
- Lisp_Object *p;
- for (kb = all_kboards; kb; kb = kb->next_kboard)
- {
- if (kb->kbd_macro_buffer)
- for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++)
- mark_object (*p);
- mark_object (KVAR (kb, Voverriding_terminal_local_map));
- mark_object (KVAR (kb, Vlast_command));
- mark_object (KVAR (kb, Vreal_last_command));
- mark_object (KVAR (kb, Vkeyboard_translate_table));
- mark_object (KVAR (kb, Vlast_repeatable_command));
- mark_object (KVAR (kb, Vprefix_arg));
- mark_object (KVAR (kb, Vlast_prefix_arg));
- mark_object (KVAR (kb, kbd_queue));
- mark_object (KVAR (kb, defining_kbd_macro));
- mark_object (KVAR (kb, Vlast_kbd_macro));
- mark_object (KVAR (kb, Vsystem_key_alist));
- mark_object (KVAR (kb, system_key_syms));
- mark_object (KVAR (kb, Vwindow_system));
- mark_object (KVAR (kb, Vinput_decode_map));
- mark_object (KVAR (kb, Vlocal_function_key_map));
- mark_object (KVAR (kb, Vdefault_minibuffer_frame));
- mark_object (KVAR (kb, echo_string));
- }
- {
- struct input_event *event;
- for (event = kbd_fetch_ptr; event != kbd_store_ptr; event++)
- {
- if (event == kbd_buffer + KBD_BUFFER_SIZE)
- event = kbd_buffer;
- /* These two special event types has no Lisp_Objects to mark. */
- if (event->kind != SELECTION_REQUEST_EVENT
- && event->kind != SELECTION_CLEAR_EVENT)
- {
- mark_object (event->x);
- mark_object (event->y);
- mark_object (event->frame_or_window);
- mark_object (event->arg);
- }
- }
- }
-}