X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/2bfa3d3e1fb347ba76bddf77f3e288049635821d..refs/heads/wip:/src/keyboard.c
diff --git a/src/keyboard.c b/src/keyboard.c
index 20498d074f..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
@@ -137,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;
@@ -417,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);
@@ -1167,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)
{
@@ -1265,13 +1295,13 @@ 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)
{
dynwind_begin ();
Lisp_Object val;
@@ -1280,7 +1310,7 @@ usage: (track-mouse BODY...) */)
do_mouse_tracking = Qt;
- val = Fprogn (args);
+ val = call0 (thunk);
dynwind_end ();
return val;
}
@@ -1683,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
@@ -1693,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);
@@ -1943,11 +1973,6 @@ safe_run_hooks (Lisp_Object hook)
}
-/* Nonzero means polling for input is temporarily suppressed. */
-
-int poll_suppress_count;
-
-
#ifdef POLL_FOR_INPUT
/* Asynchronous timer for polling. */
@@ -1969,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 */
@@ -2005,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
}
@@ -2028,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. */
@@ -2069,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 ();
@@ -2203,20 +2187,13 @@ 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;
+ Lisp_Object save_tag = Qnil;
sys_jmp_buf *save_jump = xmalloc (sizeof *save_jump);
KBOARD *kb IF_LINT (= NULL);
@@ -2229,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))
{
@@ -2287,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)
{
@@ -2408,9 +2385,9 @@ struct read_char_state
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 tag;
+ Lisp_Object local_tag;
+ Lisp_Object save_tag;
Lisp_Object previous_echo_area_message;
Lisp_Object also_record;
bool reread;
@@ -2420,13 +2397,65 @@ struct read_char_state
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)
{
- volatile struct read_char_state *state = xmalloc (sizeof *state);
+ struct read_char_state *state = xmalloc (sizeof *state);
state->commandflag = commandflag;
state->map = map;
@@ -2434,8 +2463,8 @@ read_char (int commandflag, Lisp_Object map,
state->used_mouse_menu = used_mouse_menu;
state->end_time = end_time;
state->c = Qnil;
- state->local_getcjmp = xmalloc (sizeof (*state->local_getcjmp));
- state->save_jump = xmalloc (sizeof (*state->save_jump));
+ state->local_tag = Qnil;
+ state->save_tag = Qnil;
state->previous_echo_area_message = Qnil;
state->also_record = Qnil;
state->reread = false;
@@ -2448,54 +2477,11 @@ read_char (int commandflag, Lisp_Object map,
around any call to sit_for or kbd_buffer_get_event;
it *must not* be in effect when we call redisplay. */
- state->jmpcount = SPECPDL_INDEX ();
- if (sys_setjmp (*state->local_getcjmp))
- {
- /* Handle quits while reading the keyboard. */
- /* We must have saved the outer value of getcjmp here,
- so restore it now. */
- restore_getcjmp (state->save_jump);
- pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
- unbind_to (state->jmpcount, Qnil);
- 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);
- }
+ state->tag = state->local_tag = make_prompt_tag ();
- return read_char_1 (false, state);
+ 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
@@ -2508,13 +2494,15 @@ read_char_1 (bool jump, volatile struct read_char_state *state)
#define end_time state->end_time
#define c state->c
#define jmpcount state->jmpcount
-#define local_getcjmp state->local_getcjmp
-#define save_jump state->save_jump
+#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;
if (jump)
@@ -2929,8 +2917,6 @@ read_char_1 (bool jump, volatile struct read_char_state *state)
wrong_kboard:
- STOP_POLLING;
-
if (NILP (c))
{
c = read_decoded_event_from_main_queue (end_time, local_getcjmp,
@@ -2954,7 +2940,6 @@ read_char_1 (bool jump, volatile struct read_char_state *state)
if (!end_time)
timer_stop_idle ();
- RESUME_POLLING;
if (NILP (c))
{
@@ -3268,7 +3253,6 @@ read_char_1 (bool jump, volatile struct read_char_state *state)
}
exit:
- RESUME_POLLING;
RETURN_UNGCPRO (c);
#undef commandflag
#undef map
@@ -3284,6 +3268,8 @@ read_char_1 (bool jump, volatile struct read_char_state *state)
#undef reread
#undef polling_stopped_here
#undef orig_kboard
+#undef save_getcjmp
+#undef restore_getcjmp
}
/* {{coccinelle:skip_end}} */
@@ -3471,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
@@ -3719,7 +3688,6 @@ kbd_buffer_store_event_hold (register struct input_event *event,
hold_keyboard_input ();
if (!noninteractive)
ignore_sigio ();
- stop_polling ();
}
#endif /* subprocesses */
}
@@ -3883,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 */
@@ -6844,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);
}
}
@@ -7896,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;
}
@@ -8763,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
@@ -10512,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,
@@ -10542,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 ();
@@ -10555,7 +10511,6 @@ See also `current-input-mode'. */)
#endif
#ifdef POLL_FOR_INPUT
- poll_suppress_count = 1;
start_polling ();
#endif
}
@@ -10965,7 +10920,6 @@ init_keyboard (void)
#ifdef POLL_FOR_INPUT
poll_timer = NULL;
- poll_suppress_count = 1;
start_polling ();
#endif
}