keyboard.c 369 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Keyboard and mouse input; editor command loop.
2

Paul Eggert's avatar
Paul Eggert committed
3
Copyright (C) 1985-1989, 1993-1997, 1999-2019 Free Software Foundation,
Paul Eggert's avatar
Paul Eggert committed
4
Inc.
Jim Blandy's avatar
Jim Blandy committed
5 6 7

This file is part of GNU Emacs.

8
GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
9
it under the terms of the GNU General Public License as published by
10 11
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
12 13 14 15 16 17 18

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
19
along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
20

21
#include <config.h>
Paul Eggert's avatar
Paul Eggert committed
22

23
#include <sys/stat.h>
24

25
#include "lisp.h"
26
#include "coding.h"
Jim Blandy's avatar
Jim Blandy committed
27 28
#include "termchar.h"
#include "termopts.h"
29
#include "frame.h"
Jim Blandy's avatar
Jim Blandy committed
30 31
#include "termhooks.h"
#include "macros.h"
32
#include "keyboard.h"
Jim Blandy's avatar
Jim Blandy committed
33 34
#include "window.h"
#include "commands.h"
35
#include "character.h"
36
#include "buffer.h"
37
#include "dispextern.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
38
#include "syntax.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
39
#include "intervals.h"
Stefan Monnier's avatar
Stefan Monnier committed
40
#include "keymap.h"
41
#include "blockinput.h"
42
#include "sysstdio.h"
43 44
#include "systime.h"
#include "atimer.h"
45
#include "process.h"
46
#include "menu.h"
Jim Blandy's avatar
Jim Blandy committed
47 48
#include <errno.h>

49
#ifdef HAVE_PTHREAD
50 51
#include <pthread.h>
#endif
52 53 54 55
#ifdef MSDOS
#include "msdos.h"
#include <time.h>
#else /* not MSDOS */
Jim Blandy's avatar
Jim Blandy committed
56
#include <sys/ioctl.h>
57
#endif /* not MSDOS */
Jim Blandy's avatar
Jim Blandy committed
58

Paul Eggert's avatar
Paul Eggert committed
59 60 61 62
#if defined USABLE_FIONREAD && defined USG5_4
# include <sys/filio.h>
#endif

Jim Blandy's avatar
Jim Blandy committed
63 64
#include "syssignal.h"

65 66
#include <sys/types.h>
#include <unistd.h>
67 68
#include <fcntl.h>

Paul Eggert's avatar
Paul Eggert committed
69 70
#include <ignore-value.h>

Daniel Colascione's avatar
Daniel Colascione committed
71 72
#include "pdumper.h"

73 74 75
#ifdef HAVE_WINDOW_SYSTEM
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
76

77 78 79 80 81
/* Work around GCC bug 54561.  */
#if GNUC_PREREQ (4, 3, 0)
# pragma GCC diagnostic ignored "-Wclobbered"
#endif

Paul Eggert's avatar
Paul Eggert committed
82 83 84 85 86 87
#ifdef WINDOWSNT
char const DEV_TTY[] = "CONOUT$";
#else
char const DEV_TTY[] = "/dev/tty";
#endif

88
/* Variables for blockinput.h:  */
89

90
/* Positive if interrupt input is blocked right now.  */
91
volatile int interrupt_input_blocked;
92

93
/* True means an input interrupt or alarm signal has arrived.
Paul Eggert's avatar
Paul Eggert committed
94
   The maybe_quit function checks this.  */
95
volatile bool pending_signals;
Chong Yidong's avatar
Chong Yidong committed
96

Paul Eggert's avatar
Paul Eggert committed
97
enum { KBD_BUFFER_SIZE = 4096 };
Jim Blandy's avatar
Jim Blandy committed
98

99 100
KBOARD *initial_kboard;
KBOARD *current_kboard;
101
static KBOARD *all_kboards;
102

103 104
/* True in the single-kboard state, false in the any-kboard state.  */
static bool single_kboard;
105

106
#define NUM_RECENT_KEYS (300)
107 108 109 110 111 112 113 114 115

/* Index for storing next element into recent_keys.  */
static int recent_keys_index;

/* Total number of elements stored into recent_keys.  */
static int total_keys;

/* This vector holds the last NUM_RECENT_KEYS keystrokes.  */
static Lisp_Object recent_keys;
Jim Blandy's avatar
Jim Blandy committed
116

117 118 119 120 121 122
/* Vector holding the key sequence that invoked the current command.
   It is reused for each command, and it may be longer than the current
   sequence; this_command_key_count indicates how many elements
   actually mean something.
   It's easier to staticpro a single Lisp_Object than an array.  */
Lisp_Object this_command_keys;
123
ptrdiff_t this_command_key_count;
Jim Blandy's avatar
Jim Blandy committed
124

125 126
/* This vector is used as a buffer to record the events that were actually read
   by read_key_sequence.  */
127 128 129 130 131 132
static Lisp_Object raw_keybuf;
static int raw_keybuf_count;

#define GROW_RAW_KEYBUF							\
 if (raw_keybuf_count == ASIZE (raw_keybuf))				\
   raw_keybuf = larger_vector (raw_keybuf, 1, -1)
133

134 135
/* Number of elements of this_command_keys
   that precede this key sequence.  */
136
static ptrdiff_t this_single_command_key_start;
137

138 139 140 141 142 143 144 145 146 147 148 149 150
#ifdef HAVE_STACK_OVERFLOW_HANDLING

/* For longjmp to recover from C stack overflow.  */
sigjmp_buf return_to_command_loop;

/* Message displayed by Vtop_level when recovering from C stack overflow.  */
static Lisp_Object recover_top_level_message;

#endif /* HAVE_STACK_OVERFLOW_HANDLING */

/* Message normally displayed by Vtop_level.  */
static Lisp_Object regular_top_level_message;

Jim Blandy's avatar
Jim Blandy committed
151
/* True while displaying for echoing.   Delays C-g throwing.  */
152

153
static bool echoing;
Jim Blandy's avatar
Jim Blandy committed
154

155 156 157 158 159
/* Non-null means we can start echoing at the next input pause even
   though there is something in the echo area.  */

static struct kboard *ok_to_echo_at_next_pause;

160 161 162 163
/* The kboard last echoing, or null for none.  Reset to 0 in
   cancel_echoing.  If non-null, and a current echo area message
   exists, and echo_message_buffer is eq to the current message
   buffer, we know that the message comes from echo_kboard.  */
164

165
struct kboard *echo_kboard;
166

167 168 169
/* The buffer used for echoing.  Set in echo_now, reset in
   cancel_echoing.  */

170
Lisp_Object echo_message_buffer;
171

Jim Blandy's avatar
Jim Blandy committed
172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190
/* Character that causes a quit.  Normally C-g.

   If we are running on an ordinary terminal, this must be an ordinary
   ASCII char, since we want to make it our interrupt character.

   If we are not running on an ordinary terminal, it still needs to be
   an ordinary ASCII char.  This character needs to be recognized in
   the input interrupt handler.  At this point, the keystroke is
   represented as a struct input_event, while the desired quit
   character is specified as a lispy event.  The mapping from struct
   input_events to lispy events cannot run in an interrupt handler,
   and the reverse mapping is difficult for anything but ASCII
   keystrokes.

   FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
   ASCII character.  */
int quit_char;

/* Current depth in recursive edits.  */
191
EMACS_INT command_loop_level;
Jim Blandy's avatar
Jim Blandy committed
192

193 194
/* If not Qnil, this is a switch-frame event which we decided to put
   off until the end of a key sequence.  This should be read as the
Jim Blandy's avatar
Jim Blandy committed
195
   next command input, after any unread_command_events.
196 197 198 199 200

   read_key_sequence uses this to delay switch-frame events until the
   end of the key sequence; Fread_char uses it to put off switch-frame
   events until a non-ASCII event is acceptable as input.  */
Lisp_Object unread_switch_frame;
201

Jim Blandy's avatar
Jim Blandy committed
202
/* Last size recorded for a current buffer which is not a minibuffer.  */
203
static ptrdiff_t last_non_minibuf_size;
Jim Blandy's avatar
Jim Blandy committed
204

205
uintmax_t num_input_events;
Paul Eggert's avatar
Paul Eggert committed
206 207
ptrdiff_t point_before_last_command_or_undo;
struct buffer *buffer_before_last_command_or_undo;
Jim Blandy's avatar
Jim Blandy committed
208

209
/* Value of num_nonmacro_input_events as of last auto save.  */
Jim Blandy's avatar
Jim Blandy committed
210

211
static intmax_t last_auto_save;
Jim Blandy's avatar
Jim Blandy committed
212

213
/* The value of point when the last command was started. */
214
static ptrdiff_t last_point_position;
215

216 217 218 219
/* The frame in which the last input event occurred, or Qmacro if the
   last event came from a macro.  We use this to determine when to
   generate switch-frame events.  This may be cleared by functions
   like Fselect_frame, to make sure that a switch-frame event is
220 221 222 223 224
   generated by the next character.

   FIXME: This is modified by a signal handler so it should be volatile.
   It's exported to Lisp, though, so it can't simply be marked
   'volatile' here.  */
225 226
Lisp_Object internal_last_event_frame;

227
/* `read_key_sequence' stores here the command definition of the
Jim Blandy's avatar
Jim Blandy committed
228
   key sequence that it reads.  */
229
static Lisp_Object read_key_sequence_cmd;
230
static Lisp_Object read_key_sequence_remapped;
Jim Blandy's avatar
Jim Blandy committed
231 232

/* File in which we write all commands we read.  */
233
static FILE *dribble;
Jim Blandy's avatar
Jim Blandy committed
234

235
/* True if input is available.  */
236
bool input_pending;
Jim Blandy's avatar
Jim Blandy committed
237

238 239 240
/* True if more input was available last time we read an event.

   Since redisplay can take a significant amount of time and is not
Paul Eggert's avatar
Paul Eggert committed
241
   indispensable to perform the user's commands, when input arrives
242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285
   "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;

286
/* Circular buffer for pre-read keyboard input.  */
287

288
static union buffered_input_event kbd_buffer[KBD_BUFFER_SIZE];
289 290

/* Pointer to next available character in kbd_buffer.
Paul Eggert's avatar
Paul Eggert committed
291
   If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.  */
292
static union buffered_input_event *kbd_fetch_ptr;
293

Paul Eggert's avatar
Paul Eggert committed
294 295
/* Pointer to next place to store character in kbd_buffer.  */
static union buffered_input_event *kbd_store_ptr;
296 297 298 299

/* The above pair of variables forms a "queue empty" flag.  When we
   enqueue a non-hook event, we increment kbd_store_ptr.  When we
   dequeue a non-hook event, we increment kbd_fetch_ptr.  We say that
Glenn Morris's avatar
Glenn Morris committed
300
   there is input available if the two pointers are not equal.
301 302

   Why not just have a flag set and cleared by the enqueuing and
Paul Eggert's avatar
Paul Eggert committed
303
   dequeuing functions?  The code is a bit simpler this way.  */
304

305
static void recursive_edit_unwind (Lisp_Object buffer);
306
static Lisp_Object command_loop (void);
307

308
static void echo_now (void);
309
static ptrdiff_t echo_length (void);
310

311
/* Incremented whenever a timer is run.  */
312
unsigned timers_run;
313

Eli Zaretskii's avatar
Eli Zaretskii committed
314 315 316 317
/* Address (if not 0) of struct timespec to zero out if a SIGIO interrupt
   happens.  */
struct timespec *input_available_clear_time;

318 319 320
/* True means use SIGIO interrupts; false means use CBREAK mode.
   Default is true if INTERRUPT_INPUT is defined.  */
bool interrupt_input;
Jim Blandy's avatar
Jim Blandy committed
321 322

/* Nonzero while interrupts are temporarily deferred during redisplay.  */
323
bool interrupts_deferred;
Jim Blandy's avatar
Jim Blandy committed
324

325 326
/* The time when Emacs started being idle.  */

327
static struct timespec timer_idleness_start_time;
328

329 330 331
/* After Emacs stops being idle, this saves the last value
   of timer_idleness_start_time from when it was idle.  */

332
static struct timespec timer_last_idleness_start_time;
333

Jim Blandy's avatar
Jim Blandy committed
334 335 336

/* Global variable declarations.  */

337 338 339 340 341
/* Flags for readable_events.  */
#define READABLE_EVENTS_DO_TIMERS_NOW		(1 << 0)
#define READABLE_EVENTS_FILTER_EVENTS		(1 << 1)
#define READABLE_EVENTS_IGNORE_SQUEEZABLES	(1 << 2)

Jim Blandy's avatar
Jim Blandy committed
342
/* Function for init_keyboard to call with no args (if nonzero).  */
343
static void (*keyboard_init_hook) (void);
Jim Blandy's avatar
Jim Blandy committed
344

345 346
static bool get_input_pending (int);
static bool readable_events (int);
347
static Lisp_Object read_char_x_menu_prompt (Lisp_Object,
348
                                            Lisp_Object, bool *);
349
static Lisp_Object read_char_minibuf_menu_prompt (int, Lisp_Object);
350 351 352 353
static Lisp_Object make_lispy_event (struct input_event *);
static Lisp_Object make_lispy_movement (struct frame *, Lisp_Object,
                                        enum scroll_bar_part,
                                        Lisp_Object, Lisp_Object,
354
					Time);
355
static Lisp_Object modify_event_symbol (ptrdiff_t, int, Lisp_Object,
356
                                        Lisp_Object, const char *const *,
357
                                        Lisp_Object *, ptrdiff_t);
358
static Lisp_Object make_lispy_switch_frame (Lisp_Object);
359 360
static Lisp_Object make_lispy_focus_in (Lisp_Object);
static Lisp_Object make_lispy_focus_out (Lisp_Object);
361
static bool help_char_p (Lisp_Object);
362
static void save_getcjmp (sys_jmp_buf);
363
static void restore_getcjmp (void *);
364
static Lisp_Object apply_modifiers (int, Lisp_Object);
365
static void restore_kboard_configuration (int);
366
static void handle_interrupt (bool);
367
static AVOID quit_throw_to_read_char (bool);
368 369 370
static void timer_start_idle (void);
static void timer_stop_idle (void);
static void timer_resume_idle (void);
371
static void deliver_user_signal (int);
372
static char *find_user_signal_name (int);
373
static void store_user_signal_events (void);
Jim Blandy's avatar
Jim Blandy committed
374

Paul Eggert's avatar
Paul Eggert committed
375 376 377 378 379 380 381 382 383 384 385 386 387 388
/* Advance or retreat a buffered input event pointer.  */

static union buffered_input_event *
next_kbd_event (union buffered_input_event *ptr)
{
  return ptr == kbd_buffer + KBD_BUFFER_SIZE - 1 ? kbd_buffer : ptr + 1;
}

static union buffered_input_event *
prev_kbd_event (union buffered_input_event *ptr)
{
  return ptr == kbd_buffer ? kbd_buffer + KBD_BUFFER_SIZE - 1 : ptr - 1;
}

389 390 391 392 393 394 395 396 397
/* Like EVENT_START, but assume EVENT is an event.
   This pacifies gcc -Wnull-dereference, which might otherwise
   complain about earlier checks that EVENT is indeed an event.  */
static Lisp_Object
xevent_start (Lisp_Object event)
{
  return XCAR (XCDR (event));
}

Paul Eggert's avatar
Paul Eggert committed
398
/* These setters are used only in this file, so they can be private.  */
399
static void
Paul Eggert's avatar
Paul Eggert committed
400 401
kset_echo_string (struct kboard *kb, Lisp_Object val)
{
402
  kb->echo_string_ = val;
Paul Eggert's avatar
Paul Eggert committed
403
}
404
static void
405 406 407 408 409
kset_echo_prompt (struct kboard *kb, Lisp_Object val)
{
  kb->echo_prompt_ = val;
}
static void
Paul Eggert's avatar
Paul Eggert committed
410 411
kset_kbd_queue (struct kboard *kb, Lisp_Object val)
{
412
  kb->kbd_queue_ = val;
Paul Eggert's avatar
Paul Eggert committed
413
}
414
static void
Paul Eggert's avatar
Paul Eggert committed
415 416
kset_keyboard_translate_table (struct kboard *kb, Lisp_Object val)
{
417
  kb->Vkeyboard_translate_table_ = val;
Paul Eggert's avatar
Paul Eggert committed
418
}
419
static void
Paul Eggert's avatar
Paul Eggert committed
420 421
kset_last_prefix_arg (struct kboard *kb, Lisp_Object val)
{
422
  kb->Vlast_prefix_arg_ = val;
Paul Eggert's avatar
Paul Eggert committed
423
}
424
static void
Paul Eggert's avatar
Paul Eggert committed
425 426
kset_last_repeatable_command (struct kboard *kb, Lisp_Object val)
{
427
  kb->Vlast_repeatable_command_ = val;
Paul Eggert's avatar
Paul Eggert committed
428
}
429
static void
Paul Eggert's avatar
Paul Eggert committed
430 431
kset_local_function_key_map (struct kboard *kb, Lisp_Object val)
{
432
  kb->Vlocal_function_key_map_ = val;
Paul Eggert's avatar
Paul Eggert committed
433
}
434
static void
Paul Eggert's avatar
Paul Eggert committed
435 436
kset_overriding_terminal_local_map (struct kboard *kb, Lisp_Object val)
{
437
  kb->Voverriding_terminal_local_map_ = val;
Paul Eggert's avatar
Paul Eggert committed
438
}
439
static void
Paul Eggert's avatar
Paul Eggert committed
440 441
kset_real_last_command (struct kboard *kb, Lisp_Object val)
{
442
  kb->Vreal_last_command_ = val;
Paul Eggert's avatar
Paul Eggert committed
443
}
444
static void
Paul Eggert's avatar
Paul Eggert committed
445 446
kset_system_key_syms (struct kboard *kb, Lisp_Object val)
{
447
  kb->system_key_syms_ = val;
Paul Eggert's avatar
Paul Eggert committed
448 449
}

450

451 452 453
static bool
echo_keystrokes_p (void)
{
454
  return (FLOATP (Vecho_keystrokes) ? XFLOAT_DATA (Vecho_keystrokes) > 0.0
Tom Tromey's avatar
Tom Tromey committed
455
	  : FIXNUMP (Vecho_keystrokes) ? XFIXNUM (Vecho_keystrokes) > 0
456
          : false);
457 458
}

Chong Yidong's avatar
Chong Yidong committed
459 460 461
/* Add C to the echo string, without echoing it immediately.  C can be
   a character, which is pretty-printed, or a symbol, whose name is
   printed.  */
Jim Blandy's avatar
Jim Blandy committed
462

463
static void
464
echo_add_key (Lisp_Object c)
Jim Blandy's avatar
Jim Blandy committed
465
{
466 467 468
  char initbuf[KEY_DESCRIPTION_SIZE + 100];
  ptrdiff_t size = sizeof initbuf;
  char *buffer = initbuf;
Chong Yidong's avatar
Chong Yidong committed
469
  char *ptr = buffer;
470
  Lisp_Object echo_string = KVAR (current_kboard, echo_string);
471
  USE_SAFE_ALLOCA;
Jim Blandy's avatar
Jim Blandy committed
472

473 474 475
  if (STRINGP (echo_string) && SCHARS (echo_string) > 0)
    /* Add a space at the end as a separator between keys.  */
    ptr++[0] = ' ';
Juanma Barranquero's avatar
Juanma Barranquero committed
476

Chong Yidong's avatar
Chong Yidong committed
477 478
  /* If someone has passed us a composite event, use its head symbol.  */
  c = EVENT_HEAD (c);
Jim Blandy's avatar
Jim Blandy committed
479

480
  if (FIXNUMP (c))
Tom Tromey's avatar
Tom Tromey committed
481
    ptr = push_key_description (XFIXNUM (c), ptr);
Chong Yidong's avatar
Chong Yidong committed
482 483 484
  else if (SYMBOLP (c))
    {
      Lisp_Object name = SYMBOL_NAME (c);
485
      ptrdiff_t nbytes = SBYTES (name);
Chong Yidong's avatar
Chong Yidong committed
486 487

      if (size - (ptr - buffer) < nbytes)
Jim Blandy's avatar
Jim Blandy committed
488
	{
489
	  ptrdiff_t offset = ptr - buffer;
Chong Yidong's avatar
Chong Yidong committed
490
	  size = max (2 * size, size + nbytes);
491
	  buffer = SAFE_ALLOCA (size);
Chong Yidong's avatar
Chong Yidong committed
492
	  ptr = buffer + offset;
Jim Blandy's avatar
Jim Blandy committed
493
	}
Juanma Barranquero's avatar
Juanma Barranquero committed
494

Chong Yidong's avatar
Chong Yidong committed
495 496 497
      ptr += copy_text (SDATA (name), (unsigned char *) ptr, nbytes,
			STRING_MULTIBYTE (name), 1);
    }
498

Chong Yidong's avatar
Chong Yidong committed
499 500 501
  if ((NILP (echo_string) || SCHARS (echo_string) == 0)
      && help_char_p (c))
    {
502 503
      static const char text[] = " (Type ? for further options)";
      int len = sizeof text - 1;
Jim Blandy's avatar
Jim Blandy committed
504

Chong Yidong's avatar
Chong Yidong committed
505
      if (size - (ptr - buffer) < len)
Jim Blandy's avatar
Jim Blandy committed
506
	{
507
	  ptrdiff_t offset = ptr - buffer;
Chong Yidong's avatar
Chong Yidong committed
508
	  size += len;
509
	  buffer = SAFE_ALLOCA (size);
Chong Yidong's avatar
Chong Yidong committed
510
	  ptr = buffer + offset;
Jim Blandy's avatar
Jim Blandy committed
511 512
	}

Chong Yidong's avatar
Chong Yidong committed
513 514 515
      memcpy (ptr, text, len);
      ptr += len;
    }
516

Chong Yidong's avatar
Chong Yidong committed
517 518 519
  kset_echo_string
    (current_kboard,
     concat2 (echo_string, make_string (buffer, ptr - buffer)));
520
  SAFE_FREE ();
Chong Yidong's avatar
Chong Yidong committed
521 522
}

Jim Blandy's avatar
Jim Blandy committed
523
/* Temporarily add a dash to the end of the echo string if it's not
Chong Yidong's avatar
Chong Yidong committed
524 525
   empty, so that it serves as a mini-prompt for the very next
   character.  */
Jim Blandy's avatar
Jim Blandy committed
526

527
static void
528
echo_dash (void)
Jim Blandy's avatar
Jim Blandy committed
529
{
530
  /* Do nothing if not echoing at all.  */
531
  if (NILP (KVAR (current_kboard, echo_string)))
532 533
    return;

534
  if (!current_kboard->immediate_echo
535
      && SCHARS (KVAR (current_kboard, echo_string)) == 0)
Jim Blandy's avatar
Jim Blandy committed
536
    return;
Juanma Barranquero's avatar
Juanma Barranquero committed
537

538
  /* Do nothing if we just printed a prompt.  */
539 540 541
  if (STRINGP (KVAR (current_kboard, echo_prompt))
      && (SCHARS (KVAR (current_kboard, echo_prompt))
	  == SCHARS (KVAR (current_kboard, echo_string))))
542
    return;
Juanma Barranquero's avatar
Juanma Barranquero committed
543

544
  /* Do nothing if we have already put a dash at the end.  */
545
  if (SCHARS (KVAR (current_kboard, echo_string)) > 1)
546
    {
547
      Lisp_Object last_char, prev_char, idx;
548

549
      idx = make_fixnum (SCHARS (KVAR (current_kboard, echo_string)) - 2);
550
      prev_char = Faref (KVAR (current_kboard, echo_string), idx);
551

552
      idx = make_fixnum (SCHARS (KVAR (current_kboard, echo_string)) - 1);
553
      last_char = Faref (KVAR (current_kboard, echo_string), idx);
554

Tom Tromey's avatar
Tom Tromey committed
555
      if (XFIXNUM (last_char) == '-' && XFIXNUM (prev_char) != ' ')
556
	return;
557 558
    }

Jim Blandy's avatar
Jim Blandy committed
559 560
  /* Put a dash at the end of the buffer temporarily,
     but make it go away when the next character is added.  */
561 562 563
  AUTO_STRING (dash, "-");
  kset_echo_string (current_kboard,
		    concat2 (KVAR (current_kboard, echo_string), dash));
564
  echo_now ();
Jim Blandy's avatar
Jim Blandy committed
565 566
}

567
static void
568
echo_update (void)
Jim Blandy's avatar
Jim Blandy committed
569
{
570
  if (current_kboard->immediate_echo)
Jim Blandy's avatar
Jim Blandy committed
571
    {
572
      ptrdiff_t i;
573 574
      Lisp_Object prompt = KVAR (current_kboard, echo_prompt);
      Lisp_Object prefix = call0 (Qinternal_echo_keystrokes_prefix);
575
      kset_echo_string (current_kboard,
576 577 578
			NILP (prompt) ? prefix
			: NILP (prefix) ? prompt
			: concat2 (prompt, prefix));
Jim Blandy's avatar
Jim Blandy committed
579 580

      for (i = 0; i < this_command_key_count; i++)
581 582
	{
	  Lisp_Object c;
583

584
	  c = AREF (this_command_keys, i);
585 586
	  if (! (EVENT_HAS_PARAMETERS (c)
		 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
587
	    echo_add_key (c);
588
	}
589

590 591 592 593 594 595
      echo_now ();
    }
}

/* Display the current echo string, and begin echoing if not already
   doing so.  */
596

597 598 599
static void
echo_now (void)
{
600 601 602
  if (!current_kboard->immediate_echo
      /* This test breaks calls that use `echo_now' to display the echo_prompt.
         && echo_keystrokes_p () */)
603 604 605
    {
      current_kboard->immediate_echo = true;
      echo_update ();
606
      /* Put a dash at the end to invite the user to type more.  */
Jim Blandy's avatar
Jim Blandy committed
607 608 609
      echo_dash ();
    }

610
  echoing = true;
611 612
  /* FIXME: Use call (Qmessage) so it can be advised (e.g. emacspeak).  */
  message3_nolog (KVAR (current_kboard, echo_string));
613
  echoing = false;
Jim Blandy's avatar
Jim Blandy committed
614

615 616 617 618
  /* Record in what buffer we echoed, and from which kboard.  */
  echo_message_buffer = echo_area_buffer[0];
  echo_kboard = current_kboard;

Jim Blandy's avatar
Jim Blandy committed
619
  if (waiting_for_input && !NILP (Vquit_flag))
620
    quit_throw_to_read_char (0);
Jim Blandy's avatar
Jim Blandy committed
621 622 623 624
}

/* Turn off echoing, for the start of a new command.  */

Andreas Schwab's avatar
Andreas Schwab committed
625
void
626
cancel_echoing (void)
Jim Blandy's avatar
Jim Blandy committed
627
{
628
  current_kboard->immediate_echo = false;
629
  kset_echo_prompt (current_kboard, Qnil);
Paul Eggert's avatar
Paul Eggert committed
630
  kset_echo_string (current_kboard, Qnil);
631 632 633
  ok_to_echo_at_next_pause = NULL;
  echo_kboard = NULL;
  echo_message_buffer = Qnil;
Jim Blandy's avatar
Jim Blandy committed
634 635 636 637
}

/* Return the length of the current echo string.  */

638
static ptrdiff_t
639
echo_length (void)
Jim Blandy's avatar
Jim Blandy committed
640
{
641 642
  return (STRINGP (KVAR (current_kboard, echo_string))
	  ? SCHARS (KVAR (current_kboard, echo_string))
643
	  : 0);
Jim Blandy's avatar
Jim Blandy committed
644 645 646 647
}

/* Truncate the current echo message to its first LEN chars.
   This and echo_char get used by read_key_sequence when the user
Jim Blandy's avatar
Jim Blandy committed
648
   switches frames while entering a key sequence.  */
Jim Blandy's avatar
Jim Blandy committed
649 650

static void
651
echo_truncate (ptrdiff_t nchars)
652
{
653 654
  Lisp_Object es = KVAR (current_kboard, echo_string);
  if (STRINGP (es) && SCHARS (es) > nchars)
Paul Eggert's avatar
Paul Eggert committed
655 656
    kset_echo_string (current_kboard,
		      Fsubstring (KVAR (current_kboard, echo_string),
657
				  make_fixnum (0), make_fixnum (nchars)));
658
  truncate_echo_area (nchars);
Jim Blandy's avatar
Jim Blandy committed
659 660 661 662 663
}


/* Functions for manipulating this_command_keys.  */
static void
664
add_command_key (Lisp_Object key)
Jim Blandy's avatar
Jim Blandy committed
665
{
666
  if (this_command_key_count >= ASIZE (this_command_keys))
667
    this_command_keys = larger_vector (this_command_keys, 1, -1);
668

669
  ASET (this_command_keys, this_command_key_count, key);
670
  ++this_command_key_count;
Jim Blandy's avatar
Jim Blandy committed
671
}
672

Jim Blandy's avatar
Jim Blandy committed
673 674

Lisp_Object
675
recursive_edit_1 (void)
Jim Blandy's avatar
Jim Blandy committed
676
{
677
  ptrdiff_t count = SPECPDL_INDEX ();
Jim Blandy's avatar
Jim Blandy committed
678 679 680 681 682 683 684 685
  Lisp_Object val;

  if (command_loop_level > 0)
    {
      specbind (Qstandard_output, Qt);
      specbind (Qstandard_input, Qt);
    }

686
#ifdef HAVE_WINDOW_SYSTEM
687
  /* The command loop has started an hourglass timer, so we have to
688
     cancel it here, otherwise it will fire because the recursive edit
689 690
     can take some time.  Do not check for display_hourglass_p here,
     because it could already be nil.  */
691
    cancel_hourglass ();
692 693
#endif

694 695 696 697 698 699 700 701 702 703 704 705
  /* This function may have been called from a debugger called from
     within redisplay, for instance by Edebugging a function called
     from fontification-functions.  We want to allow redisplay in
     the debugging session.

     The recursive edit is left with a `(throw exit ...)'.  The `exit'
     tag is not caught anywhere in redisplay, i.e. when we leave the
     recursive edit, the original redisplay leading to the recursive
     edit will be unwound.  The outcome should therefore be safe.  */
  specbind (Qinhibit_redisplay, Qnil);
  redisplaying_p = 0;

706 707 708 709 710 711 712 713
  /* This variable stores buffers that have changed so that an undo
     boundary can be added. specbind this so that changes in the
     recursive edit will not result in undo boundaries in buffers
     changed before we entered there recursive edit.
     See Bug #23632.
  */
  specbind (Qundo_auto__undoably_changed_buffers, Qnil);

Jim Blandy's avatar
Jim Blandy committed
714 715
  val = command_loop ();
  if (EQ (val, Qt))
Paul Eggert's avatar
Paul Eggert committed
716
    quit ();
717 718 719
  /* Handle throw from read_minibuf when using minibuffer
     while it's active but we're in another window.  */
  if (STRINGP (val))
720
    xsignal1 (Qerror, val);
Jim Blandy's avatar
Jim Blandy committed
721

722
  return unbind_to (count, Qnil);
Jim Blandy's avatar
Jim Blandy committed
723 724 725
}

/* When an auto-save happens, record the "time", and don't do again soon.  */
726

727
void
728
record_auto_save (void)
Jim Blandy's avatar
Jim Blandy committed
729
{
730
  last_auto_save = num_nonmacro_input_events;
Jim Blandy's avatar
Jim Blandy committed
731
}
732 733 734

/* Make an auto save happen as soon as possible at command level.  */

735
#ifdef SIGDANGER
Andreas Schwab's avatar
Andreas Schwab committed
736
void
737
force_auto_save_soon (void)
738 739
{
  last_auto_save = - auto_save_interval - 1;
740 741
  /* FIXME: What's the relationship between forcing auto-save and adding
     a buffer-switch event?  */
742
  record_asynch_buffer_change ();
743
}
744
#endif
Jim Blandy's avatar
Jim Blandy committed
745 746

DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
747
       doc: /* Invoke the editor command loop recursively.
748 749 750
To get out of the recursive edit, a command can throw to `exit' -- for
instance (throw \\='exit nil).
If you throw a value other than t, `recursive-edit' returns normally
751
to the function that called it.  Throwing a t value causes
752
`recursive-edit' to quit, so that control returns to the command loop
753
one level up.
754

755
This function is called by the editor initialization to begin editing.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
756
  (void)
Jim Blandy's avatar
Jim Blandy committed
757
{
758
  ptrdiff_t count = SPECPDL_INDEX ();
759
  Lisp_Object buffer;
Jim Blandy's avatar
Jim Blandy committed
760

761 762
  /* If we enter while input is blocked, don't lock up here.
     This may happen through the debugger during redisplay.  */
763
  if (input_blocked_p ())
764 765
    return Qnil;

766
  if (command_loop_level >= 0
767
      && current_buffer != XBUFFER (XWINDOW (selected_window)->contents))
768 769 770 771
    buffer = Fcurrent_buffer ();
  else
    buffer = Qnil;

772 773 774 775 776 777 778
  /* Don't do anything interesting between the increment and the
     record_unwind_protect!  Otherwise, we could get distracted and
     never decrement the counter again.  */
  command_loop_level++;
  update_mode_lines = 17;
  record_unwind_protect (recursive_edit_unwind, buffer);

779 780 781 782
  /* If we leave recursive_edit_1 below with a `throw' for instance,
     like it is done in the splash screen display, we have to
     make sure that we restore single_kboard as command_loop_1
     would have done if it were left normally.  */
783 784
  if (command_loop_level > 0)
    temporarily_switch_to_single_kboard (SELECTED_FRAME ());
785

Jim Blandy's avatar
Jim Blandy committed
786 787 788 789
  recursive_edit_1 ();
  return unbind_to (count, Qnil);
}

790
void
791
recursive_edit_unwind (Lisp_Object buffer)
Jim Blandy's avatar
Jim Blandy committed
792
{
793 794
  if (BUFFERP (buffer))
    Fset_buffer (buffer);
Juanma Barranquero's avatar
Juanma Barranquero committed
795

Jim Blandy's avatar
Jim Blandy committed
796
  command_loop_level--;
797
  update_mode_lines = 18;
Jim Blandy's avatar
Jim Blandy committed
798
}
799

Jim Blandy's avatar
Jim Blandy committed
800

801

802 803 804 805
/* If we're in single_kboard state for kboard KBOARD,
   get out of it.  */

void
806
not_single_kboard_state (KBOARD *kboard)
807 808
{
  if (kboard == current_kboard)
809
    single_kboard = false;
810 811
}

812 813 814 815 816 817 818 819 820 821 822 823 824
/* Maintain a stack of kboards, so other parts of Emacs
   can switch temporarily to the kboard of a given frame
   and then revert to the previous status.  */

struct kboard_stack
{
  KBOARD *kboard;
  struct kboard_stack *next;
};

static struct kboard_stack *kboard_stack;

void
825
push_kboard (struct kboard *k)
826
{
827
  struct kboard_stack *p = xmalloc (sizeof *p);
828 829 830 831 832

  p->next = kboard_stack;
  p->kboard = current_kboard;
  kboard_stack = p;

833
  current_kboard = k;
834 835 836
}

void
837
pop_kboard (void)
838
{
839
  struct terminal *t;