keyboard.c 359 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-2016 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 <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>

Paul Eggert's avatar
Paul Eggert committed
67 68
#include <ignore-value.h>

69 70 71
#ifdef HAVE_WINDOW_SYSTEM
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
72

73
/* Variables for blockinput.h:  */
74

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

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

82
#define KBD_BUFFER_SIZE 4096
Jim Blandy's avatar
Jim Blandy committed
83

84 85
KBOARD *initial_kboard;
KBOARD *current_kboard;
86
static KBOARD *all_kboards;
87

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

91
#define NUM_RECENT_KEYS (300)
92 93 94 95 96 97 98 99 100

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

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

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

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

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

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

138
static sys_jmp_buf getcjmp;
Jim Blandy's avatar
Jim Blandy committed
139 140

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

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

145
static bool echoing;
Jim Blandy's avatar
Jim Blandy committed
146

147 148 149 150 151
/* 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;

152 153 154 155
/* 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.  */
156

157
struct kboard *echo_kboard;
158

159 160 161
/* The buffer used for echoing.  Set in echo_now, reset in
   cancel_echoing.  */

162
Lisp_Object echo_message_buffer;
163

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

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

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

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

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

200
uintmax_t num_input_events;
Paul Eggert's avatar
Paul Eggert committed
201 202
ptrdiff_t point_before_last_command_or_undo;
struct buffer *buffer_before_last_command_or_undo;
Jim Blandy's avatar
Jim Blandy committed
203

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

206
static EMACS_INT last_auto_save;
Jim Blandy's avatar
Jim Blandy committed
207

208
/* The value of point when the last command was started. */
209
static ptrdiff_t last_point_position;
210

211 212 213 214
/* 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
215 216 217 218 219
   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.  */
220 221
Lisp_Object internal_last_event_frame;

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

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

230
/* True if input is available.  */
231
bool input_pending;
Jim Blandy's avatar
Jim Blandy committed
232

233 234 235
/* 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
236
   indispensable to perform the user's commands, when input arrives
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 278 279 280
   "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;

281
/* Circular buffer for pre-read keyboard input.  */
282

283
static union buffered_input_event kbd_buffer[KBD_BUFFER_SIZE];
284 285 286

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

/* 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].  */
294
static union buffered_input_event *volatile kbd_store_ptr;
295 296 297 298

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

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

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

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

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
static Lisp_Object make_lispy_focus_in (Lisp_Object);
Joakim Verona's avatar
Joakim Verona committed
360
#ifdef HAVE_WINDOW_SYSTEM
361
static Lisp_Object make_lispy_focus_out (Lisp_Object);
Joakim Verona's avatar
Joakim Verona committed
362
#endif /* HAVE_WINDOW_SYSTEM */
363
static bool help_char_p (Lisp_Object);
364 365
static void save_getcjmp (sys_jmp_buf);
static void restore_getcjmp (sys_jmp_buf);
366
static Lisp_Object apply_modifiers (int, Lisp_Object);
367
static void restore_kboard_configuration (int);
368
static void handle_interrupt (bool);
369
static _Noreturn void quit_throw_to_read_char (bool);
370 371 372
static void timer_start_idle (void);
static void timer_stop_idle (void);
static void timer_resume_idle (void);
373
static void deliver_user_signal (int);
374
static char *find_user_signal_name (int);
375
static void store_user_signal_events (void);
Jim Blandy's avatar
Jim Blandy committed
376

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

429

Chong Yidong's avatar
Chong Yidong committed
430 431 432
/* 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
433

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

444 445 446
  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
447

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

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

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

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

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

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

Chong Yidong's avatar
Chong Yidong committed
484 485 486
      memcpy (ptr, text, len);
      ptr += len;
    }
487

Chong Yidong's avatar
Chong Yidong committed
488 489 490
  kset_echo_string
    (current_kboard,
     concat2 (echo_string, make_string (buffer, ptr - buffer)));
491
  SAFE_FREE ();
Chong Yidong's avatar
Chong Yidong committed
492 493
}

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

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

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

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

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

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

523 524
      idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 1);
      last_char = Faref (KVAR (current_kboard, echo_string), idx);
525

526 527
      if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
	return;
528 529
    }

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

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

      for (i = 0; i < this_command_key_count; i++)
552 553
	{
	  Lisp_Object c;
554

555
	  c = AREF (this_command_keys, i);
556 557
	  if (! (EVENT_HAS_PARAMETERS (c)
		 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
558
	    echo_add_key (c);
559
	}
560

561 562 563 564 565 566
      echo_now ();
    }
}

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

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

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

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

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

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

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

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

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

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

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

637
  ASET (this_command_keys, this_command_key_count, key);
638
  ++this_command_key_count;
Jim Blandy's avatar
Jim Blandy committed
639
}
640

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

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

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

662 663 664 665 666 667 668 669 670 671 672 673
  /* 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
674 675 676
  val = command_loop ();
  if (EQ (val, Qt))
    Fsignal (Qquit, Qnil);
677 678 679
  /* Handle throw from read_minibuf when using minibuffer
     while it's active but we're in another window.  */
  if (STRINGP (val))
680
    xsignal1 (Qerror, val);
Jim Blandy's avatar
Jim Blandy committed
681

682
  return unbind_to (count, Qnil);
Jim Blandy's avatar
Jim Blandy committed
683 684 685
}

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

687
void
688
record_auto_save (void)
Jim Blandy's avatar
Jim Blandy committed
689
{
690
  last_auto_save = num_nonmacro_input_events;
Jim Blandy's avatar
Jim Blandy committed
691
}
692 693 694

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

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

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

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

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

725
  if (command_loop_level >= 0
726
      && current_buffer != XBUFFER (XWINDOW (selected_window)->contents))
727 728 729 730
    buffer = Fcurrent_buffer ();
  else
    buffer = Qnil;

731 732 733 734 735 736 737
  /* 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);

738 739 740 741
  /* 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.  */
742 743
  if (command_loop_level > 0)
    temporarily_switch_to_single_kboard (SELECTED_FRAME ());
744

Jim Blandy's avatar
Jim Blandy committed
745 746 747 748
  recursive_edit_1 ();
  return unbind_to (count, Qnil);
}

749
void
750
recursive_edit_unwind (Lisp_Object buffer)
Jim Blandy's avatar
Jim Blandy committed
751
{
752 753
  if (BUFFERP (buffer))
    Fset_buffer (buffer);
Juanma Barranquero's avatar
Juanma Barranquero committed
754

Jim Blandy's avatar
Jim Blandy committed
755
  command_loop_level--;
756
  update_mode_lines = 18;
Jim Blandy's avatar
Jim Blandy committed
757
}
758

Jim Blandy's avatar
Jim Blandy committed
759

760
#if 0  /* These two functions are now replaced with
761
          temporarily_switch_to_single_kboard.  */
Karl Heuer's avatar
Karl Heuer committed
762
static void
763
any_kboard_state ()
Karl Heuer's avatar
Karl Heuer committed
764
{
765 766 767 768
#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
769
  if (CONSP (Vunread_command_events))
770
    {
771 772
      current_kboard->kbd_queue
	= nconc2 (Vunread_command_events, current_kboard->kbd_queue);
773
      current_kboard->kbd_queue_has_data = true;
774
    }
Karl Heuer's avatar
Karl Heuer committed
775
  Vunread_command_events = Qnil;
776
#endif
777
  single_kboard = false;
Karl Heuer's avatar
Karl Heuer committed
778
}
779 780 781 782 783 784 785

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

void
single_kboard_state ()
{
786
  single_kboard = true;
787
}
788
#endif
789

790 791 792 793
/* If we're in single_kboard state for kboard KBOARD,
   get out of it.  */

void
794
not_single_kboard_state (KBOARD *kboard)
795 796
{
  if (kboard == current_kboard)
797
    single_kboard = false;
798 799
}

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

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

821
  current_kboard = k;