keyboard.c 358 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 4
Copyright (C) 1985-1989, 1993-1997, 1999-2015 Free Software Foundation,
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 <http://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 43
#include "systime.h"
#include "atimer.h"
44
#include "process.h"
Jim Blandy's avatar
Jim Blandy committed
45 46
#include <errno.h>

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

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

Jim Blandy's avatar
Jim Blandy committed
61 62
#include "syssignal.h"

63 64
#include <sys/types.h>
#include <unistd.h>
65 66
#include <fcntl.h>

67 68 69
#ifdef HAVE_WINDOW_SYSTEM
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
70

71
/* Variables for blockinput.h:  */
72

73
/* Positive if interrupt input is blocked right now.  */
74
volatile int interrupt_input_blocked;
75

76
/* True means an input interrupt or alarm signal has arrived.
77
   The QUIT macro checks this.  */
78
volatile bool pending_signals;
Chong Yidong's avatar
Chong Yidong committed
79

80
#define KBD_BUFFER_SIZE 4096
Jim Blandy's avatar
Jim Blandy committed
81

82 83
KBOARD *initial_kboard;
KBOARD *current_kboard;
84
static KBOARD *all_kboards;
85

86 87
/* True in the single-kboard state, false in the any-kboard state.  */
static bool single_kboard;
88

89
#define NUM_RECENT_KEYS (300)
90 91 92 93 94 95 96 97 98

/* 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
99

100 101 102 103 104 105
/* 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;
106
ptrdiff_t this_command_key_count;
Jim Blandy's avatar
Jim Blandy committed
107

108 109
/* This vector is used as a buffer to record the events that were actually read
   by read_key_sequence.  */
110 111
static Lisp_Object raw_keybuf;
static int raw_keybuf_count;
112 113

#define GROW_RAW_KEYBUF							\
114
 if (raw_keybuf_count == ASIZE (raw_keybuf))				\
115
   raw_keybuf = larger_vector (raw_keybuf, 1, -1)
116

117 118
/* Number of elements of this_command_keys
   that precede this key sequence.  */
119
static ptrdiff_t this_single_command_key_start;
120

121 122 123 124 125 126 127 128 129 130 131 132 133
#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
134
/* For longjmp to where kbd input is being done.  */
135

136
static sys_jmp_buf getcjmp;
Jim Blandy's avatar
Jim Blandy committed
137 138

/* True while doing kbd input.  */
139
bool waiting_for_input;
Jim Blandy's avatar
Jim Blandy committed
140 141

/* True while displaying for echoing.   Delays C-g throwing.  */
142

143
static bool echoing;
Jim Blandy's avatar
Jim Blandy committed
144

145 146 147 148 149
/* 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;

150 151 152 153
/* 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.  */
154

155
struct kboard *echo_kboard;
156

157 158 159
/* The buffer used for echoing.  Set in echo_now, reset in
   cancel_echoing.  */

160
Lisp_Object echo_message_buffer;
161

162 163
/* True means C-g should cause immediate error-signal.  */
bool immediate_quit;
Jim Blandy's avatar
Jim Blandy committed
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183

/* 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.  */
184
EMACS_INT command_loop_level;
Jim Blandy's avatar
Jim Blandy committed
185

186 187
/* 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
188
   next command input, after any unread_command_events.
189 190 191 192 193

   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;
194

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

198 199
/* Total number of times read_char has returned, modulo UINTMAX_MAX + 1.  */
uintmax_t num_input_events;
Jim Blandy's avatar
Jim Blandy committed
200

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

203
static EMACS_INT last_auto_save;
Jim Blandy's avatar
Jim Blandy committed
204

205
/* The value of point when the last command was started.  */
206
static ptrdiff_t last_point_position;
207

208 209 210 211
/* 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
212 213 214 215 216
   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.  */
217 218
Lisp_Object internal_last_event_frame;

219
/* `read_key_sequence' stores here the command definition of the
Jim Blandy's avatar
Jim Blandy committed
220
   key sequence that it reads.  */
221
static Lisp_Object read_key_sequence_cmd;
222
static Lisp_Object read_key_sequence_remapped;
Jim Blandy's avatar
Jim Blandy committed
223 224

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

227
/* True if input is available.  */
228
bool input_pending;
Jim Blandy's avatar
Jim Blandy committed
229

230 231 232
/* 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
233
   indispensable to perform the user's commands, when input arrives
234 235 236 237 238 239 240 241 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
   "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;

278
/* Circular buffer for pre-read keyboard input.  */
279

280
static union buffered_input_event kbd_buffer[KBD_BUFFER_SIZE];
281 282 283

/* Pointer to next available character in kbd_buffer.
   If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
284
   This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the
285
   next available char is in kbd_buffer[0].  */
286
static union buffered_input_event *kbd_fetch_ptr;
287 288 289 290

/* Pointer to next place to store character in kbd_buffer.  This
   may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
   character should go in kbd_buffer[0].  */
291
static union buffered_input_event *volatile kbd_store_ptr;
292 293 294 295

/* 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
296
   there is input available if the two pointers are not equal.
297 298 299 300 301

   Why not just have a flag set and cleared by the enqueuing and
   dequeuing functions?  Such a flag could be screwed up by interrupts
   at inopportune times.  */

302
static void recursive_edit_unwind (Lisp_Object buffer);
303
static Lisp_Object command_loop (void);
304

305
static void echo_now (void);
306
static ptrdiff_t echo_length (void);
307

308
/* Incremented whenever a timer is run.  */
309
unsigned timers_run;
310

311
/* Address (if not 0) of struct timespec to zero out if a SIGIO interrupt
Jim Blandy's avatar
Jim Blandy committed
312
   happens.  */
313
struct timespec *input_available_clear_time;
Jim Blandy's avatar
Jim Blandy committed
314

315 316 317
/* 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
318 319

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

322 323
/* The time when Emacs started being idle.  */

324
static struct timespec timer_idleness_start_time;
325

326 327 328
/* After Emacs stops being idle, this saves the last value
   of timer_idleness_start_time from when it was idle.  */

329
static struct timespec timer_last_idleness_start_time;
330

Jim Blandy's avatar
Jim Blandy committed
331 332 333

/* Global variable declarations.  */

334 335 336 337 338
/* 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
339
/* Function for init_keyboard to call with no args (if nonzero).  */
340
static void (*keyboard_init_hook) (void);
Jim Blandy's avatar
Jim Blandy committed
341

342 343
static bool get_input_pending (int);
static bool readable_events (int);
344
static Lisp_Object read_char_x_menu_prompt (Lisp_Object,
345
                                            Lisp_Object, bool *);
346
static Lisp_Object read_char_minibuf_menu_prompt (int, Lisp_Object);
347 348 349 350
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,
351
					Time);
352
static Lisp_Object modify_event_symbol (ptrdiff_t, int, Lisp_Object,
353
                                        Lisp_Object, const char *const *,
354
                                        Lisp_Object *, ptrdiff_t);
355
static Lisp_Object make_lispy_switch_frame (Lisp_Object);
356
static Lisp_Object make_lispy_focus_in (Lisp_Object);
Joakim Verona's avatar
Joakim Verona committed
357
#ifdef HAVE_WINDOW_SYSTEM
358
static Lisp_Object make_lispy_focus_out (Lisp_Object);
Joakim Verona's avatar
Joakim Verona committed
359
#endif /* HAVE_WINDOW_SYSTEM */
360
static bool help_char_p (Lisp_Object);
361 362
static void save_getcjmp (sys_jmp_buf);
static void restore_getcjmp (sys_jmp_buf);
363
static Lisp_Object apply_modifiers (int, Lisp_Object);
364
static void restore_kboard_configuration (int);
365
static void handle_interrupt (bool);
366
static _Noreturn void quit_throw_to_read_char (bool);
367 368 369
static void timer_start_idle (void);
static void timer_stop_idle (void);
static void timer_resume_idle (void);
370
static void deliver_user_signal (int);
371
static char *find_user_signal_name (int);
372
static void store_user_signal_events (void);
Jim Blandy's avatar
Jim Blandy committed
373

Paul Eggert's avatar
Paul Eggert committed
374
/* These setters are used only in this file, so they can be private.  */
375
static void
Paul Eggert's avatar
Paul Eggert committed
376 377
kset_echo_string (struct kboard *kb, Lisp_Object val)
{
378
  kb->echo_string_ = val;
Paul Eggert's avatar
Paul Eggert committed
379
}
380
static void
381 382 383 384 385
kset_echo_prompt (struct kboard *kb, Lisp_Object val)
{
  kb->echo_prompt_ = val;
}
static void
Paul Eggert's avatar
Paul Eggert committed
386 387
kset_kbd_queue (struct kboard *kb, Lisp_Object val)
{
388
  kb->kbd_queue_ = val;
Paul Eggert's avatar
Paul Eggert committed
389
}
390
static void
Paul Eggert's avatar
Paul Eggert committed
391 392
kset_keyboard_translate_table (struct kboard *kb, Lisp_Object val)
{
393
  kb->Vkeyboard_translate_table_ = val;
Paul Eggert's avatar
Paul Eggert committed
394
}
395
static void
Paul Eggert's avatar
Paul Eggert committed
396 397
kset_last_prefix_arg (struct kboard *kb, Lisp_Object val)
{
398
  kb->Vlast_prefix_arg_ = val;
Paul Eggert's avatar
Paul Eggert committed
399
}
400
static void
Paul Eggert's avatar
Paul Eggert committed
401 402
kset_last_repeatable_command (struct kboard *kb, Lisp_Object val)
{
403
  kb->Vlast_repeatable_command_ = val;
Paul Eggert's avatar
Paul Eggert committed
404
}
405
static void
Paul Eggert's avatar
Paul Eggert committed
406 407
kset_local_function_key_map (struct kboard *kb, Lisp_Object val)
{
408
  kb->Vlocal_function_key_map_ = val;
Paul Eggert's avatar
Paul Eggert committed
409
}
410
static void
Paul Eggert's avatar
Paul Eggert committed
411 412
kset_overriding_terminal_local_map (struct kboard *kb, Lisp_Object val)
{
413
  kb->Voverriding_terminal_local_map_ = val;
Paul Eggert's avatar
Paul Eggert committed
414
}
415
static void
Paul Eggert's avatar
Paul Eggert committed
416 417
kset_real_last_command (struct kboard *kb, Lisp_Object val)
{
418
  kb->Vreal_last_command_ = val;
Paul Eggert's avatar
Paul Eggert committed
419
}
420
static void
Paul Eggert's avatar
Paul Eggert committed
421 422
kset_system_key_syms (struct kboard *kb, Lisp_Object val)
{
423
  kb->system_key_syms_ = val;
Paul Eggert's avatar
Paul Eggert committed
424 425
}

426

Chong Yidong's avatar
Chong Yidong committed
427 428 429
/* 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
430

431
static void
432
echo_add_key (Lisp_Object c)
Jim Blandy's avatar
Jim Blandy committed
433
{
434 435 436
  char initbuf[KEY_DESCRIPTION_SIZE + 100];
  ptrdiff_t size = sizeof initbuf;
  char *buffer = initbuf;
Chong Yidong's avatar
Chong Yidong committed
437
  char *ptr = buffer;
438
  Lisp_Object echo_string = KVAR (current_kboard, echo_string);
439
  USE_SAFE_ALLOCA;
Jim Blandy's avatar
Jim Blandy committed
440

441 442 443
  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
444

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

Chong Yidong's avatar
Chong Yidong committed
448 449 450 451 452
  if (INTEGERP (c))
    ptr = push_key_description (XINT (c), ptr);
  else if (SYMBOLP (c))
    {
      Lisp_Object name = SYMBOL_NAME (c);
453
      ptrdiff_t nbytes = SBYTES (name);
Chong Yidong's avatar
Chong Yidong committed
454 455

      if (size - (ptr - buffer) < nbytes)
Jim Blandy's avatar
Jim Blandy committed
456
	{
457
	  ptrdiff_t offset = ptr - buffer;
Chong Yidong's avatar
Chong Yidong committed
458
	  size = max (2 * size, size + nbytes);
459
	  buffer = SAFE_ALLOCA (size);
Chong Yidong's avatar
Chong Yidong committed
460
	  ptr = buffer + offset;
Jim Blandy's avatar
Jim Blandy committed
461
	}
Juanma Barranquero's avatar
Juanma Barranquero committed
462

Chong Yidong's avatar
Chong Yidong committed
463 464 465
      ptr += copy_text (SDATA (name), (unsigned char *) ptr, nbytes,
			STRING_MULTIBYTE (name), 1);
    }
466

Chong Yidong's avatar
Chong Yidong committed
467 468 469
  if ((NILP (echo_string) || SCHARS (echo_string) == 0)
      && help_char_p (c))
    {
470 471
      static const char text[] = " (Type ? for further options)";
      int len = sizeof text - 1;
Jim Blandy's avatar
Jim Blandy committed
472

Chong Yidong's avatar
Chong Yidong committed
473
      if (size - (ptr - buffer) < len)
Jim Blandy's avatar
Jim Blandy committed
474
	{
475
	  ptrdiff_t offset = ptr - buffer;
Chong Yidong's avatar
Chong Yidong committed
476
	  size += len;
477
	  buffer = SAFE_ALLOCA (size);
Chong Yidong's avatar
Chong Yidong committed
478
	  ptr = buffer + offset;
Jim Blandy's avatar
Jim Blandy committed
479 480
	}

Chong Yidong's avatar
Chong Yidong committed
481 482 483
      memcpy (ptr, text, len);
      ptr += len;
    }
484

Chong Yidong's avatar
Chong Yidong committed
485 486 487
  kset_echo_string
    (current_kboard,
     concat2 (echo_string, make_string (buffer, ptr - buffer)));
488
  SAFE_FREE ();
Chong Yidong's avatar
Chong Yidong committed
489 490
}

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

495
static void
496
echo_dash (void)
Jim Blandy's avatar
Jim Blandy committed
497
{
498
  /* Do nothing if not echoing at all.  */
499
  if (NILP (KVAR (current_kboard, echo_string)))
500 501
    return;

502
  if (!current_kboard->immediate_echo
503
      && SCHARS (KVAR (current_kboard, echo_string)) == 0)
Jim Blandy's avatar
Jim Blandy committed
504
    return;
Juanma Barranquero's avatar
Juanma Barranquero committed
505

506
  /* Do nothing if we just printed a prompt.  */
507 508 509
  if (STRINGP (KVAR (current_kboard, echo_prompt))
      && (SCHARS (KVAR (current_kboard, echo_prompt))
	  == SCHARS (KVAR (current_kboard, echo_string))))
510
    return;
Juanma Barranquero's avatar
Juanma Barranquero committed
511

512
  /* Do nothing if we have already put a dash at the end.  */
513
  if (SCHARS (KVAR (current_kboard, echo_string)) > 1)
514
    {
515
      Lisp_Object last_char, prev_char, idx;
516

517 518
      idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 2);
      prev_char = Faref (KVAR (current_kboard, echo_string), idx);
519

520 521
      idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 1);
      last_char = Faref (KVAR (current_kboard, echo_string), idx);
522

523 524
      if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
	return;
525 526
    }

Jim Blandy's avatar
Jim Blandy committed
527 528
  /* Put a dash at the end of the buffer temporarily,
     but make it go away when the next character is added.  */
529 530 531
  AUTO_STRING (dash, "-");
  kset_echo_string (current_kboard,
		    concat2 (KVAR (current_kboard, echo_string), dash));
532
  echo_now ();
Jim Blandy's avatar
Jim Blandy committed
533 534
}

535
static void
536
echo_update (void)
Jim Blandy's avatar
Jim Blandy committed
537
{
538
  if (current_kboard->immediate_echo)
Jim Blandy's avatar
Jim Blandy committed
539
    {
540
      ptrdiff_t i;
541 542
      Lisp_Object prompt = KVAR (current_kboard, echo_prompt);
      Lisp_Object prefix = call0 (Qinternal_echo_keystrokes_prefix);
543
      kset_echo_string (current_kboard,
544 545 546
			NILP (prompt) ? prefix
			: NILP (prefix) ? prompt
			: concat2 (prompt, prefix));
Jim Blandy's avatar
Jim Blandy committed
547 548

      for (i = 0; i < this_command_key_count; i++)
549 550
	{
	  Lisp_Object c;
551

552
	  c = AREF (this_command_keys, i);
553 554
	  if (! (EVENT_HAS_PARAMETERS (c)
		 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
555
	    echo_add_key (c);
556
	}
557

558 559 560 561 562 563
      echo_now ();
    }
}

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

565 566 567 568 569 570 571
static void
echo_now (void)
{
  if (!current_kboard->immediate_echo)
    {
      current_kboard->immediate_echo = true;
      echo_update ();
572
      /* Put a dash at the end to invite the user to type more.  */
Jim Blandy's avatar
Jim Blandy committed
573 574 575
      echo_dash ();
    }

576
  echoing = true;
577 578
  /* FIXME: Use call (Qmessage) so it can be advised (e.g. emacspeak).  */
  message3_nolog (KVAR (current_kboard, echo_string));
579
  echoing = false;
Jim Blandy's avatar
Jim Blandy committed
580

581 582 583 584
  /* 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
585
  if (waiting_for_input && !NILP (Vquit_flag))
586
    quit_throw_to_read_char (0);
Jim Blandy's avatar
Jim Blandy committed
587 588 589 590
}

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

Andreas Schwab's avatar
Andreas Schwab committed
591
void
592
cancel_echoing (void)
Jim Blandy's avatar
Jim Blandy committed
593
{
594
  current_kboard->immediate_echo = false;
595
  kset_echo_prompt (current_kboard, Qnil);
Paul Eggert's avatar
Paul Eggert committed
596
  kset_echo_string (current_kboard, Qnil);
597 598 599
  ok_to_echo_at_next_pause = NULL;
  echo_kboard = NULL;
  echo_message_buffer = Qnil;
Jim Blandy's avatar
Jim Blandy committed
600 601 602 603
}

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

604
static ptrdiff_t
605
echo_length (void)
Jim Blandy's avatar
Jim Blandy committed
606
{
607 608
  return (STRINGP (KVAR (current_kboard, echo_string))
	  ? SCHARS (KVAR (current_kboard, echo_string))
609
	  : 0);
Jim Blandy's avatar
Jim Blandy committed
610 611 612 613
}

/* 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
614
   switches frames while entering a key sequence.  */
Jim Blandy's avatar
Jim Blandy committed
615 616

static void
617
echo_truncate (ptrdiff_t nchars)
618
{
619
  if (STRINGP (KVAR (current_kboard, echo_string)))
Paul Eggert's avatar
Paul Eggert committed
620 621 622
    kset_echo_string (current_kboard,
		      Fsubstring (KVAR (current_kboard, echo_string),
				  make_number (0), make_number (nchars)));
623
  truncate_echo_area (nchars);
Jim Blandy's avatar
Jim Blandy committed
624 625 626 627 628
}


/* Functions for manipulating this_command_keys.  */
static void
629
add_command_key (Lisp_Object key)
Jim Blandy's avatar
Jim Blandy committed
630
{
631
  if (this_command_key_count >= ASIZE (this_command_keys))
632
    this_command_keys = larger_vector (this_command_keys, 1, -1);
633

634
  ASET (this_command_keys, this_command_key_count, key);
635
  ++this_command_key_count;
Jim Blandy's avatar
Jim Blandy committed
636
}
637

Jim Blandy's avatar
Jim Blandy committed
638 639

Lisp_Object
640
recursive_edit_1 (void)
Jim Blandy's avatar
Jim Blandy committed
641
{
642
  ptrdiff_t count = SPECPDL_INDEX ();
Jim Blandy's avatar
Jim Blandy committed
643 644 645 646 647 648 649 650
  Lisp_Object val;

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

651
#ifdef HAVE_WINDOW_SYSTEM
652
  /* The command loop has started an hourglass timer, so we have to
653
     cancel it here, otherwise it will fire because the recursive edit
654 655
     can take some time.  Do not check for display_hourglass_p here,
     because it could already be nil.  */
656
    cancel_hourglass ();
657 658
#endif

659 660 661 662 663 664 665 666 667 668 669 670
  /* 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;

Jim Blandy's avatar
Jim Blandy committed
671 672 673
  val = command_loop ();
  if (EQ (val, Qt))
    Fsignal (Qquit, Qnil);
674 675 676
  /* Handle throw from read_minibuf when using minibuffer
     while it's active but we're in another window.  */
  if (STRINGP (val))
677
    xsignal1 (Qerror, val);
Jim Blandy's avatar
Jim Blandy committed
678

679
  return unbind_to (count, Qnil);
Jim Blandy's avatar
Jim Blandy committed
680 681 682
}

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

684
void
685
record_auto_save (void)
Jim Blandy's avatar
Jim Blandy committed
686
{
687
  last_auto_save = num_nonmacro_input_events;
Jim Blandy's avatar
Jim Blandy committed
688
}
689 690 691

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

692
#ifdef SIGDANGER
Andreas Schwab's avatar
Andreas Schwab committed
693
void
694
force_auto_save_soon (void)
695 696
{
  last_auto_save = - auto_save_interval - 1;
697 698

  record_asynch_buffer_change ();
699
}
700
#endif
Jim Blandy's avatar
Jim Blandy committed
701 702

DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
703
       doc: /* Invoke the editor command loop recursively.
704 705 706
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
707
to the function that called it.  Throwing a t value causes
708
`recursive-edit' to quit, so that control returns to the command loop
709
one level up.
710

711
This function is called by the editor initialization to begin editing.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
712
  (void)
Jim Blandy's avatar
Jim Blandy committed
713
{
714
  ptrdiff_t count = SPECPDL_INDEX ();
715
  Lisp_Object buffer;
Jim Blandy's avatar
Jim Blandy committed
716

717 718
  /* If we enter while input is blocked, don't lock up here.
     This may happen through the debugger during redisplay.  */
719
  if (input_blocked_p ())
720 721
    return Qnil;

722
  if (command_loop_level >= 0
723
      && current_buffer != XBUFFER (XWINDOW (selected_window)->contents))
724 725 726 727
    buffer = Fcurrent_buffer ();
  else
    buffer = Qnil;

728 729 730 731 732 733 734
  /* 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);

735 736 737 738
  /* 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.  */
739 740
  if (command_loop_level > 0)
    temporarily_switch_to_single_kboard (SELECTED_FRAME ());
741

Jim Blandy's avatar
Jim Blandy committed
742 743 744 745
  recursive_edit_1 ();
  return unbind_to (count, Qnil);
}

746
void
747
recursive_edit_unwind (Lisp_Object buffer)
Jim Blandy's avatar
Jim Blandy committed
748
{
749 750
  if (BUFFERP (buffer))
    Fset_buffer (buffer);
Juanma Barranquero's avatar
Juanma Barranquero committed
751

Jim Blandy's avatar
Jim Blandy committed
752
  command_loop_level--;
753
  update_mode_lines = 18;
Jim Blandy's avatar
Jim Blandy committed
754
}
755

Jim Blandy's avatar
Jim Blandy committed
756

757
#if 0  /* These two functions are now replaced with
758
          temporarily_switch_to_single_kboard.  */
Karl Heuer's avatar
Karl Heuer committed
759
static void
760
any_kboard_state ()
Karl Heuer's avatar
Karl Heuer committed
761
{
762 763 764 765
#if 0 /* Theory: if there's anything in Vunread_command_events,
	 it will right away be read by read_key_sequence,
	 and then if we do switch KBOARDS, it will go into the side
	 queue then.  So we don't need to do anything special here -- rms.  */
Karl Heuer's avatar
Karl Heuer committed
766
  if (CONSP (Vunread_command_events))
767
    {
768 769
      current_kboard->kbd_queue
	= nconc2 (Vunread_command_events, current_kboard->kbd_queue);
770
      current_kboard->kbd_queue_has_data = true;
771
    }
Karl Heuer's avatar
Karl Heuer committed
772
  Vunread_command_events = Qnil;
773
#endif
774
  single_kboard = false;
Karl Heuer's avatar
Karl Heuer committed
775
}
776 777 778 779 780 781 782

/* Switch to the single-kboard state, making current_kboard
   the only KBOARD from which further input is accepted.  */

void
single_kboard_state ()
{
783
  single_kboard = true;
784
}
785
#endif
786

787 788 789 790
/* If we're in single_kboard state for kboard KBOARD,
   get out of it.  */

void
791
not_single_kboard_state (KBOARD *kboard)
792 793
{
  if (kboard == current_kboard)
794
    single_kboard = false;
795 796
}

797 798 799 800 801 802 803 804 805 806 807 808 809
/* 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
810
push_kboard (struct kboard *k)
811
{
812
  struct kboard_stack *p = xmalloc (sizeof *p);
813 814 815 816 817

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

818
  current_kboard = k;
819 820 821
}

void
822
pop_kboard (void)
823
{