X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/71a72686e3e81253f2bc0ad74568aafdbd86879c..9fb9136398821ed5f3a8b4405bbc222964f54028:/src/keyboard.c diff --git a/src/keyboard.c b/src/keyboard.c index d920ef45f4..5b66050aa9 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -231,7 +231,7 @@ static ptrdiff_t last_point_position; 'volatile' here. */ Lisp_Object internal_last_event_frame; -static Lisp_Object Qx_set_selection, Qhandle_switch_frame; +static Lisp_Object Qgui_set_selection, Qhandle_switch_frame; static Lisp_Object Qhandle_select_window; Lisp_Object QPRIMARY; @@ -270,9 +270,57 @@ static Lisp_Object Qhelp_form_show; /* File in which we write all commands we read. */ static FILE *dribble; -/* Nonzero if input is available. */ +/* True if input is available. */ bool input_pending; +/* True if more input was available last time we read an event. + + Since redisplay can take a significant amount of time and is not + indispensable to perform the user's commands, when input arrives + "too fast", Emacs skips redisplay. More specifically, if the next + command has already been input when we finish the previous command, + we skip the intermediate redisplay. + + This is useful to try and make sure Emacs keeps up with fast input + rates, such as auto-repeating keys. But in some cases, this proves + too conservative: we may end up disabling redisplay for the whole + duration of a key repetition, even though we could afford to + redisplay every once in a while. + + So we "sample" the input_pending flag before running a command and + use *that* value after running the command to decide whether to + skip redisplay or not. This way, we only skip redisplay if we + really can't keep up with the repeat rate. + + This only makes a difference if the next input arrives while running the + command, which is very unlikely if the command is executed quickly. + IOW this tends to avoid skipping redisplay after a long running command + (which is a case where skipping redisplay is not very useful since the + redisplay time is small compared to the time it took to run the command). + + A typical use case is when scrolling. Scrolling time can be split into: + - Time to do jit-lock on the newly displayed portion of buffer. + - Time to run the actual scroll command. + - Time to perform the redisplay. + Jit-lock can happen either during the command or during the redisplay. + In the most painful cases, the jit-lock time is the one that dominates. + Also jit-lock can be tweaked (via jit-lock-defer) to delay its job, at the + cost of temporary inaccuracy in display and scrolling. + So without input_was_pending, what typically happens is the following: + - when the command starts, there's no pending input (yet). + - the scroll command triggers jit-lock. + - during the long jit-lock time the next input arrives. + - at the end of the command, we check input_pending and hence decide to + skip redisplay. + - we read the next input and start over. + End result: all the hard work of jit-locking is "wasted" since redisplay + doesn't actually happens (at least not before the input rate slows down). + With input_was_pending redisplay is still skipped if Emacs can't keep up + with the input rate, but if it can keep up just enough that there's no + input_pending when we begin the command, then redisplay is not skipped + which results in better feedback to the user. */ +static bool input_was_pending; + /* Circular buffer for pre-read keyboard input. */ static struct input_event kbd_buffer[KBD_BUFFER_SIZE]; @@ -551,6 +599,7 @@ echo_add_key (Lisp_Object c) /* Replace a dash from echo_dash with a space, otherwise add a space at the end as a separator between keys. */ + AUTO_STRING (space, " "); if (STRINGP (echo_string) && SCHARS (echo_string) > 1) { Lisp_Object last_char, prev_char, idx; @@ -566,10 +615,10 @@ echo_add_key (Lisp_Object c) if (XINT (last_char) == '-' && XINT (prev_char) != ' ') Faset (echo_string, idx, make_number (' ')); else - echo_string = concat2 (echo_string, build_local_string (" ")); + echo_string = concat2 (echo_string, space); } else if (STRINGP (echo_string) && SCHARS (echo_string) > 0) - echo_string = concat2 (echo_string, build_local_string (" ")); + echo_string = concat2 (echo_string, space); kset_echo_string (current_kboard, @@ -630,9 +679,9 @@ echo_dash (void) /* Put a dash at the end of the buffer temporarily, but make it go away when the next character is added. */ - kset_echo_string - (current_kboard, - concat2 (KVAR (current_kboard, echo_string), build_local_string ("-"))); + AUTO_STRING (dash, "-"); + kset_echo_string (current_kboard, + concat2 (KVAR (current_kboard, echo_string), dash)); echo_now (); } @@ -1125,7 +1174,7 @@ Default value of `command-error-function'. */) { print_error_message (data, Qexternal_debugging_output, SSDATA (context), signal); - Fterpri (Qexternal_debugging_output); + Fterpri (Qexternal_debugging_output, Qnil); Fkill_emacs (make_number (-1)); } else @@ -1533,6 +1582,13 @@ command_loop_1 (void) /* Execute the command. */ + { + total_keys += total_keys < NUM_RECENT_KEYS; + ASET (recent_keys, recent_keys_index, + Fcons (Qnil, cmd)); + if (++recent_keys_index >= NUM_RECENT_KEYS) + recent_keys_index = 0; + } Vthis_command = cmd; Vreal_this_command = cmd; safe_run_hooks (Qpre_command_hook); @@ -1652,7 +1708,7 @@ command_loop_1 (void) = call1 (Fsymbol_value (Qregion_extract_function), Qnil); if (XINT (Flength (txt)) > 0) /* Don't set empty selections. */ - call2 (Qx_set_selection, QPRIMARY, txt); + call2 (Qgui_set_selection, QPRIMARY, txt); } if (current_buffer != prev_buffer || MODIFF != prev_modiff) @@ -1890,13 +1946,11 @@ safe_run_hooks_1 (ptrdiff_t nargs, Lisp_Object *args) static Lisp_Object safe_run_hooks_error (Lisp_Object error, ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object hook, fun; - eassert (nargs == 2); - hook = args[0]; - fun = args[1]; - Fmessage (4, ((Lisp_Object []) - { build_local_string ("Error in %s (%S): %S"), hook, fun, error })); + AUTO_STRING (format, "Error in %s (%S): %S"); + Lisp_Object hook = args[0]; + Lisp_Object fun = args[1]; + Fmessage (4, (Lisp_Object []) {format, hook, fun, error}); if (SYMBOLP (hook)) { @@ -2397,9 +2451,9 @@ echo_keystrokes_p (void) /* commandflag 0 means do not autosave, but do redisplay. -1 means do not redisplay, but do autosave. -2 means do neither. - 1 means do both. */ + 1 means do both. -/* The argument MAP is a keymap for menu prompting. + The argument MAP is a keymap for menu prompting. PREV_EVENT is the previous input event, or nil if we are reading the first event of a key sequence (or not reading a key sequence). @@ -2576,11 +2630,13 @@ read_char (int commandflag, Lisp_Object map, user-visible, such as X selection_request events. */ if (input_pending || detect_input_pending_run_timers (0)) - swallow_events (0); /* May clear input_pending. */ + swallow_events (false); /* May clear input_pending. */ /* Redisplay if no pending input. */ - while (!input_pending) + while (!(input_pending + && (input_was_pending || !redisplay_dont_pause))) { + input_was_pending = input_pending; if (help_echo_showing_p && !EQ (selected_window, minibuf_window)) redisplay_preserve_echo_area (5); else @@ -2592,7 +2648,7 @@ read_char (int commandflag, Lisp_Object map, /* Input arrived and pre-empted redisplay. Process any events which are not user-visible. */ - swallow_events (0); + swallow_events (false); /* If that cleared input_pending, try again to redisplay. */ } @@ -3249,6 +3305,7 @@ read_char (int commandflag, Lisp_Object map, exit: RESUME_POLLING; + input_was_pending = input_pending; RETURN_UNGCPRO (c); } @@ -3496,7 +3553,8 @@ readable_events (int flags) && event->part == scroll_bar_handle && event->modifiers == 0) #endif - ) + && !((flags & READABLE_EVENTS_FILTER_EVENTS) + && event->kind == BUFFER_SWITCH_EVENT)) return 1; event++; if (event == kbd_buffer + KBD_BUFFER_SIZE) @@ -3871,7 +3929,7 @@ kbd_buffer_get_event (KBOARD **kbp, Lisp_Object obj; #ifdef subprocesses - if (kbd_on_hold_p () && kbd_buffer_nr_stored () < KBD_BUFFER_SIZE/4) + if (kbd_on_hold_p () && kbd_buffer_nr_stored () < KBD_BUFFER_SIZE / 4) { /* Start reading input again because we have processed enough to be able to accept new events again. */ @@ -4363,7 +4421,7 @@ swallow_events (bool do_display) old_timers_run = timers_run; get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW); - if (timers_run != old_timers_run && do_display) + if (!input_pending && timers_run != old_timers_run && do_display) redisplay_preserve_echo_area (7); } @@ -4422,10 +4480,15 @@ decode_timer (Lisp_Object timer, struct timespec *result) vector = XVECTOR (timer)->contents; if (! NILP (vector[0])) return 0; + if (! INTEGERP (vector[2])) + return false; - return (decode_time_components (vector[1], vector[2], vector[3], vector[8], - result, 0) - && timespec_valid_p (*result)); + struct lisp_time t; + if (! decode_time_components (vector[1], vector[2], vector[3], vector[8], + &t, 0)) + return false; + *result = lisp_to_timespec (t); + return timespec_valid_p (*result); } @@ -5218,7 +5281,6 @@ static const char *const lispy_drag_n_drop_names[] = static Lisp_Object Qabove_handle, Qhandle, Qbelow_handle; static Lisp_Object Qbefore_handle, Qhorizontal_handle, Qafter_handle; Lisp_Object Qup, Qdown, Qtop, Qbottom; -Lisp_Object Qleft, Qright; static Lisp_Object Qleftmost, Qrightmost; static Lisp_Object Qend_scroll; static Lisp_Object Qratio; @@ -5334,12 +5396,14 @@ 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)); + xret = wx; yret = wy - WINDOW_HEADER_LINE_HEIGHT (w); } else if (part == ON_LEFT_FRINGE) { posn = Qleft_fringe; col = 0; + xret = wx; dx = wx - (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w) ? 0 : window_box_width (w, LEFT_MARGIN_AREA)); @@ -5349,6 +5413,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, { posn = Qright_fringe; col = 0; + xret = wx; dx = wx - window_box_width (w, LEFT_MARGIN_AREA) - window_box_width (w, TEXT_AREA) @@ -5362,9 +5427,23 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, posn = Qvertical_line; width = 1; dx = 0; + xret = wx; + dy = yret = wy; + } + else if (part == ON_VERTICAL_SCROLL_BAR) + { + posn = Qvertical_scroll_bar; + width = WINDOW_SCROLL_BAR_AREA_WIDTH (w); + dx = xret = wx; + dy = yret = wy; + } + else if (part == ON_HORIZONTAL_SCROLL_BAR) + { + posn = Qhorizontal_scroll_bar; + width = WINDOW_SCROLL_BAR_AREA_HEIGHT (w); + dx = xret = wx; dy = yret = wy; } - /* Nothing special for part == ON_SCROLL_BAR. */ else if (part == ON_RIGHT_DIVIDER) { posn = Qright_divider; @@ -5448,7 +5527,12 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, extra_info))); } else if (f != 0) - XSETFRAME (window, f); + { + /* Return mouse pixel coordinates here. */ + XSETFRAME (window, f); + xret = XINT (x); + yret = XINT (y); + } else window = Qnil; @@ -7885,12 +7969,12 @@ parse_menu_item (Lisp_Object item, int inmenubar) { /* This is a command. See if there is an equivalent key binding. */ Lisp_Object keyeq = AREF (item_properties, ITEM_PROPERTY_KEYEQ); + AUTO_STRING (space_space, " "); /* The previous code preferred :key-sequence to :keys, so we preserve this behavior. */ if (STRINGP (keyeq) && !CONSP (keyhint)) - keyeq = concat2 (build_local_string (" "), - Fsubstitute_command_keys (keyeq)); + keyeq = concat2 (space_space, Fsubstitute_command_keys (keyeq)); else { Lisp_Object prefix = keyeq; @@ -7933,7 +8017,7 @@ parse_menu_item (Lisp_Object item, int inmenubar) if (STRINGP (XCDR (prefix))) tem = concat2 (tem, XCDR (prefix)); } - keyeq = concat2 (build_local_string (" "), tem); + keyeq = concat2 (space_space, tem); } else keyeq = Qnil; @@ -8637,10 +8721,14 @@ read_char_minibuf_menu_prompt (int commandflag, /* Insert button prefix. */ Lisp_Object selected = AREF (item_properties, ITEM_PROPERTY_SELECTED); + AUTO_STRING (radio_yes, "(*) "); + AUTO_STRING (radio_no , "( ) "); + AUTO_STRING (check_yes, "[X] "); + AUTO_STRING (check_no , "[ ] "); if (EQ (tem, QCradio)) - tem = build_local_string (NILP (selected) ? "(*) " : "( ) "); + tem = NILP (selected) ? radio_yes : radio_no; else - tem = build_local_string (NILP (selected) ? "[X] " : "[ ] "); + tem = NILP (selected) ? check_yes : check_no; s = concat2 (tem, s); } @@ -10023,23 +10111,34 @@ If CHECK-TIMERS is non-nil, timers that are ready to run will do so. */) ? Qt : Qnil); } -DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0, - doc: /* Return vector of last 300 events, not counting those from keyboard macros. */) - (void) +DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 1, 0, + doc: /* Return vector of last few events, not counting those from keyboard macros. +If INCLUDE-CMDS is non-nil, include the commands that were run, +represented as events of the form (nil . COMMAND). */) + (Lisp_Object include_cmds) { - Lisp_Object *keys = XVECTOR (recent_keys)->contents; - Lisp_Object val; + bool cmds = !NILP (include_cmds); - if (total_keys < NUM_RECENT_KEYS) - return Fvector (total_keys, keys); + if (!total_keys + || (cmds && total_keys < NUM_RECENT_KEYS)) + return Fvector (total_keys, + XVECTOR (recent_keys)->contents); else { - val = Fvector (NUM_RECENT_KEYS, keys); - vcopy (val, 0, keys + recent_keys_index, - NUM_RECENT_KEYS - recent_keys_index); - vcopy (val, NUM_RECENT_KEYS - recent_keys_index, - keys, recent_keys_index); - return val; + Lisp_Object es = Qnil; + int i = (total_keys < NUM_RECENT_KEYS + ? 0 : recent_keys_index); + eassert (recent_keys_index < NUM_RECENT_KEYS); + do + { + Lisp_Object e = AREF (recent_keys, i); + if (cmds || !CONSP (e) || !NILP (XCAR (e))) + es = Fcons (e, es); + if (++i >= NUM_RECENT_KEYS) + i = 0; + } while (i != recent_keys_index); + es = Fnreverse (es); + return Fvconcat (1, &es); } } @@ -10347,7 +10446,7 @@ static void handle_interrupt_signal (int sig) { /* See if we have an active terminal on our controlling tty. */ - struct terminal *terminal = get_named_tty ("/dev/tty"); + struct terminal *terminal = get_named_terminal ("/dev/tty"); if (!terminal) { /* If there are no frames there, let's pretend that we are a @@ -10401,7 +10500,7 @@ handle_interrupt (bool in_signal_handler) cancel_echoing (); /* XXX This code needs to be revised for multi-tty support. */ - if (!NILP (Vquit_flag) && get_named_tty ("/dev/tty")) + if (!NILP (Vquit_flag) && get_named_terminal ("/dev/tty")) { if (! in_signal_handler) { @@ -10613,9 +10712,10 @@ Emacs reads input in CBREAK mode; see `set-input-interrupt-mode'. See also `current-input-mode'. */) (Lisp_Object flow, Lisp_Object terminal) { - struct terminal *t = get_terminal (terminal, 1); + struct terminal *t = decode_tty_terminal (terminal); struct tty_display_info *tty; - if (t == NULL || (t->type != output_termcap && t->type != output_msdos_raw)) + + if (!t) return Qnil; tty = t->display_info.tty; @@ -10655,11 +10755,11 @@ the currently selected frame. See also `current-input-mode'. */) (Lisp_Object meta, Lisp_Object terminal) { - struct terminal *t = get_terminal (terminal, 1); + struct terminal *t = decode_tty_terminal (terminal); struct tty_display_info *tty; int new_meta; - if (t == NULL || (t->type != output_termcap && t->type != output_msdos_raw)) + if (!t) return Qnil; tty = t->display_info.tty; @@ -10696,9 +10796,10 @@ process. See also `current-input-mode'. */) (Lisp_Object quit) { - struct terminal *t = get_named_tty ("/dev/tty"); + struct terminal *t = get_named_terminal ("/dev/tty"); struct tty_display_info *tty; - if (t == NULL || (t->type != output_termcap && t->type != output_msdos_raw)) + + if (!t) return Qnil; tty = t->display_info.tty; @@ -11140,7 +11241,7 @@ syms_of_keyboard (void) DEFSYM (Qpolling_period, "polling-period"); - DEFSYM (Qx_set_selection, "x-set-selection"); + DEFSYM (Qgui_set_selection, "gui-set-selection"); DEFSYM (QPRIMARY, "PRIMARY"); DEFSYM (Qhandle_switch_frame, "handle-switch-frame"); DEFSYM (Qhandle_select_window, "handle-select-window"); @@ -11818,7 +11919,7 @@ keys_of_keyboard (void) - we enter the second prompt. current-prefix-arg is non-nil, prefix-arg is nil. - before running the first real event, we run the special iconify-frame - event, but we pass the `special' arg to execute-command so + event, but we pass the `special' arg to command-execute so current-prefix-arg and prefix-arg are left untouched. - here we foolishly copy the non-nil current-prefix-arg to prefix-arg. - the next key event will have a spuriously non-nil current-prefix-arg. */