lread.c 150 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Lisp parsing and input streams.
2

Paul Eggert's avatar
Paul Eggert committed
3
Copyright (C) 1985-1989, 1993-1995, 1997-2019 Free Software Foundation,
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 22
/* Tell globals.h to define tables needed by init_obarray.  */
#define DEFINE_SYMBOLS
Jim Blandy's avatar
Jim Blandy committed
23

Richard M. Stallman's avatar
Richard M. Stallman committed
24
#include <config.h>
25
#include "sysstdio.h"
Paul Eggert's avatar
Paul Eggert committed
26
#include <stdlib.h>
Jim Blandy's avatar
Jim Blandy committed
27 28 29
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/file.h>
30
#include <errno.h>
31
#include <math.h>
32
#include <stat-time.h>
Jim Blandy's avatar
Jim Blandy committed
33
#include "lisp.h"
34
#include "dispextern.h"
35
#include "intervals.h"
Kenichi Handa's avatar
Kenichi Handa committed
36
#include "character.h"
37
#include "buffer.h"
Karl Heuer's avatar
Karl Heuer committed
38
#include "charset.h"
39
#include <epaths.h>
Jim Blandy's avatar
Jim Blandy committed
40
#include "commands.h"
Jim Blandy's avatar
Jim Blandy committed
41
#include "keyboard.h"
42
#include "systime.h"
43
#include "termhooks.h"
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
44
#include "blockinput.h"
Daniel Colascione's avatar
Daniel Colascione committed
45
#include "pdumper.h"
46
#include <c-ctype.h>
Jim Blandy's avatar
Jim Blandy committed
47

48 49 50 51
#ifdef MSDOS
#include "msdos.h"
#endif

52 53 54 55
#ifdef HAVE_NS
#include "nsterm.h"
#endif

Andreas Schwab's avatar
Andreas Schwab committed
56
#include <unistd.h>
Jim Blandy's avatar
Jim Blandy committed
57

Richard M. Stallman's avatar
Richard M. Stallman committed
58 59 60 61
#ifdef HAVE_SETLOCALE
#include <locale.h>
#endif /* HAVE_SETLOCALE */

Dave Love's avatar
Dave Love committed
62
#include <fcntl.h>
Richard M. Stallman's avatar
Richard M. Stallman committed
63

64
#ifdef HAVE_FSEEKO
65 66 67 68 69 70 71
#define file_offset off_t
#define file_tell ftello
#else
#define file_offset long
#define file_tell ftell
#endif

72
#if IEEE_FLOATING_POINT
73
# include <ieee754.h>
Paul Eggert's avatar
Paul Eggert committed
74 75 76
# ifndef INFINITY
#  define INFINITY ((union ieee754_double) {.ieee = {.exponent = -1}}.d)
# endif
77 78
#endif

79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
/* The objects or placeholders read with the #n=object form.

   A hash table maps a number to either a placeholder (while the
   object is still being parsed, in case it's referenced within its
   own definition) or to the completed object.  With small integers
   for keys, it's effectively little more than a vector, but it'll
   manage any needed resizing for us.

   The variable must be reset to an empty hash table before all
   top-level calls to read0.  In between calls, it may be an empty
   hash table left unused from the previous call (to reduce
   allocations), or nil.  */
static Lisp_Object read_objects_map;

/* The recursive objects read with the #n=object form.

   Objects that might have circular references are stored here, so
   that recursive substitution knows not to keep processing them
   multiple times.

   Only objects that are completely processed, including substituting
   references to themselves (but not necessarily replacing
   placeholders for other objects still being read), are stored.

   A hash table is used for efficient lookups of keys.  We don't care
   what the value slots hold.  The variable must be set to an empty
   hash table before all top-level calls to read0.  In between calls,
   it may be an empty hash table left unused from the previous call
   (to reduce allocations), or nil.  */
static Lisp_Object read_objects_completed;
109

110 111 112 113 114 115 116 117 118 119 120 121 122 123
/* File and lookahead for get-file-char and get-emacs-mule-file-char
   to read from.  Used by Fload.  */
static struct infile
{
  /* The input stream.  */
  FILE *stream;

  /* Lookahead byte count.  */
  signed char lookahead;

  /* Lookahead bytes, in reverse order.  Keep these here because it is
     not portable to ungetc more than one byte at a time.  */
  unsigned char buf[MAX_MULTIBYTE_LENGTH - 1];
} *infile;
Jim Blandy's avatar
Jim Blandy committed
124

125
/* For use within read-from-string (this reader is non-reentrant!!)  */
126 127 128
static ptrdiff_t read_from_string_index;
static ptrdiff_t read_from_string_index_byte;
static ptrdiff_t read_from_string_limit;
129

130
/* Number of characters read in the current call to Fread or
131
   Fread_from_string.  */
132
static EMACS_INT readchar_count;
133

134
/* This contains the last string skipped with #@.  */
135 136
static char *saved_doc_string;
/* Length of buffer allocated in saved_doc_string.  */
137
static ptrdiff_t saved_doc_string_size;
138
/* Length of actual data in saved_doc_string.  */
139
static ptrdiff_t saved_doc_string_length;
140
/* This is the file position that string came from.  */
141
static file_offset saved_doc_string_position;
142

143 144 145 146 147
/* This contains the previous string skipped with #@.
   We copy it from saved_doc_string when a new string
   is put in saved_doc_string.  */
static char *prev_saved_doc_string;
/* Length of buffer allocated in prev_saved_doc_string.  */
148
static ptrdiff_t prev_saved_doc_string_size;
149
/* Length of actual data in prev_saved_doc_string.  */
150
static ptrdiff_t prev_saved_doc_string_length;
151
/* This is the file position that string came from.  */
152
static file_offset prev_saved_doc_string_position;
153

154 155 156 157
/* True means inside a new-style backquote with no surrounding
   parentheses.  Fread initializes this to the value of
   `force_new_style_backquotes', so we need not specbind it or worry
   about what happens to it when there is an error.  */
158
static bool new_backquote_flag;
159 160 161 162

/* A list of file names for files being loaded in Fload.  Used to
   check for recursive loads.  */

Lute Kamstra's avatar
Lute Kamstra committed
163
static Lisp_Object Vloads_in_progress;
164

165 166
static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
                                 Lisp_Object);
Kenichi Handa's avatar
Kenichi Handa committed
167

168
static void readevalloop (Lisp_Object, struct infile *, Lisp_Object, bool,
169 170
                          Lisp_Object, Lisp_Object,
                          Lisp_Object, Lisp_Object);
171 172

static void build_load_history (Lisp_Object, bool);
Jim Blandy's avatar
Jim Blandy committed
173

Kenichi Handa's avatar
Kenichi Handa committed
174 175 176 177 178 179
/* Functions that read one byte from the current source READCHARFUN
   or unreads one byte.  If the integer argument C is -1, it returns
   one read byte, or -1 when there's no more byte in the source.  If C
   is 0 or positive, it unreads C, and the return value is not
   interesting.  */

180 181 182
static int readbyte_for_lambda (int, Lisp_Object);
static int readbyte_from_file (int, Lisp_Object);
static int readbyte_from_string (int, Lisp_Object);
Kenichi Handa's avatar
Kenichi Handa committed
183

Jim Blandy's avatar
Jim Blandy committed
184 185
/* Handle unreading and rereading of characters.
   Write READCHAR to read a character,
Karl Heuer's avatar
Karl Heuer committed
186 187
   UNREAD(c) to unread c to be read again.

Kenichi Handa's avatar
Kenichi Handa committed
188
   These macros correctly read/unread multibyte characters.  */
Jim Blandy's avatar
Jim Blandy committed
189

190
#define READCHAR readchar (readcharfun, NULL)
Jim Blandy's avatar
Jim Blandy committed
191 192
#define UNREAD(c) unreadchar (readcharfun, c)

193 194 195
/* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source.  */
#define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)

Kenichi Handa's avatar
Kenichi Handa committed
196
/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
Kenichi Handa's avatar
Kenichi Handa committed
197 198
   Qlambda, or a cons, we use this to keep an unread character because
   a file stream can't handle multibyte-char unreading.  The value -1
199
   means that there's no unread character.  */
Kenichi Handa's avatar
Kenichi Handa committed
200 201
static int unread_char;

Jim Blandy's avatar
Jim Blandy committed
202
static int
203
readchar (Lisp_Object readcharfun, bool *multibyte)
Jim Blandy's avatar
Jim Blandy committed
204 205
{
  Lisp_Object tem;
206
  register int c;
207
  int (*readbyte) (int, Lisp_Object);
Kenichi Handa's avatar
Kenichi Handa committed
208 209
  unsigned char buf[MAX_MULTIBYTE_LENGTH];
  int i, len;
210
  bool emacs_mule_encoding = 0;
Jim Blandy's avatar
Jim Blandy committed
211

212 213 214
  if (multibyte)
    *multibyte = 0;

215
  readchar_count++;
216

217
  if (BUFFERP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
218
    {
219
      register struct buffer *inbuffer = XBUFFER (readcharfun);
Jim Blandy's avatar
Jim Blandy committed
220

221
      ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
222

223 224 225
      if (! BUFFER_LIVE_P (inbuffer))
	return -1;

226 227
      if (pt_byte >= BUF_ZV_BYTE (inbuffer))
	return -1;
Jim Blandy's avatar
Jim Blandy committed
228

Tom Tromey's avatar
Tom Tromey committed
229
      if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
230
	{
231
	  /* Fetch the character code from the buffer.  */
232 233
	  unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
	  BUF_INC_POS (inbuffer, pt_byte);
234
	  c = STRING_CHAR (p);
235 236
	  if (multibyte)
	    *multibyte = 1;
237 238 239 240
	}
      else
	{
	  c = BUF_FETCH_BYTE (inbuffer, pt_byte);
241
	  if (! ASCII_CHAR_P (c))
Kenichi Handa's avatar
Kenichi Handa committed
242
	    c = BYTE8_TO_CHAR (c);
243
	  pt_byte++;
244
	}
245
      SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
246

247
      return c;
Jim Blandy's avatar
Jim Blandy committed
248
    }
249
  if (MARKERP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
250
    {
251
      register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
Jim Blandy's avatar
Jim Blandy committed
252

253
      ptrdiff_t bytepos = marker_byte_position (readcharfun);
254

255 256
      if (bytepos >= BUF_ZV_BYTE (inbuffer))
	return -1;
257

Tom Tromey's avatar
Tom Tromey committed
258
      if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
259
	{
260
	  /* Fetch the character code from the buffer.  */
261 262
	  unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
	  BUF_INC_POS (inbuffer, bytepos);
263
	  c = STRING_CHAR (p);
264 265
	  if (multibyte)
	    *multibyte = 1;
266 267 268 269
	}
      else
	{
	  c = BUF_FETCH_BYTE (inbuffer, bytepos);
270
	  if (! ASCII_CHAR_P (c))
Kenichi Handa's avatar
Kenichi Handa committed
271
	    c = BYTE8_TO_CHAR (c);
272
	  bytepos++;
273 274
	}

275 276 277 278
      XMARKER (readcharfun)->bytepos = bytepos;
      XMARKER (readcharfun)->charpos++;

      return c;
Jim Blandy's avatar
Jim Blandy committed
279
    }
280 281

  if (EQ (readcharfun, Qlambda))
Kenichi Handa's avatar
Kenichi Handa committed
282 283 284 285
    {
      readbyte = readbyte_for_lambda;
      goto read_multibyte;
    }
286

Jim Blandy's avatar
Jim Blandy committed
287
  if (EQ (readcharfun, Qget_file_char))
288
    {
Kenichi Handa's avatar
Kenichi Handa committed
289 290
      readbyte = readbyte_from_file;
      goto read_multibyte;
291
    }
Jim Blandy's avatar
Jim Blandy committed
292

293
  if (STRINGP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
294
    {
295
      if (read_from_string_index >= read_from_string_limit)
Jim Blandy's avatar
Jim Blandy committed
296
	c = -1;
297 298 299 300 301 302 303 304
      else if (STRING_MULTIBYTE (readcharfun))
	{
	  if (multibyte)
	    *multibyte = 1;
	  FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun,
					      read_from_string_index,
					      read_from_string_index_byte);
	}
305
      else
306 307 308 309 310
	{
	  c = SREF (readcharfun, read_from_string_index_byte);
	  read_from_string_index++;
	  read_from_string_index_byte++;
	}
Jim Blandy's avatar
Jim Blandy committed
311 312 313
      return c;
    }

314
  if (CONSP (readcharfun) && STRINGP (XCAR (readcharfun)))
Kenichi Handa's avatar
Kenichi Handa committed
315 316 317 318 319 320 321 322 323 324 325
    {
      /* This is the case that read_vector is reading from a unibyte
	 string that contains a byte sequence previously skipped
	 because of #@NUMBER.  The car part of readcharfun is that
	 string, and the cdr part is a value of readcharfun given to
	 read_vector.  */
      readbyte = readbyte_from_string;
      if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
	emacs_mule_encoding = 1;
      goto read_multibyte;
    }
Kenichi Handa's avatar
Kenichi Handa committed
326

Kenichi Handa's avatar
Kenichi Handa committed
327 328 329 330 331 332
  if (EQ (readcharfun, Qget_emacs_mule_file_char))
    {
      readbyte = readbyte_from_file;
      emacs_mule_encoding = 1;
      goto read_multibyte;
    }
Jim Blandy's avatar
Jim Blandy committed
333 334 335

  tem = call0 (readcharfun);

Jim Blandy's avatar
Jim Blandy committed
336
  if (NILP (tem))
Jim Blandy's avatar
Jim Blandy committed
337
    return -1;
Tom Tromey's avatar
Tom Tromey committed
338
  return XFIXNUM (tem);
Kenichi Handa's avatar
Kenichi Handa committed
339 340 341 342 343 344 345 346 347

 read_multibyte:
  if (unread_char >= 0)
    {
      c = unread_char;
      unread_char = -1;
      return c;
    }
  c = (*readbyte) (-1, readcharfun);
348
  if (c < 0)
349 350 351
    return c;
  if (multibyte)
    *multibyte = 1;
352
  if (ASCII_CHAR_P (c))
Kenichi Handa's avatar
Kenichi Handa committed
353 354 355 356 357 358 359 360
    return c;
  if (emacs_mule_encoding)
    return read_emacs_mule_char (c, readbyte, readcharfun);
  i = 0;
  buf[i++] = c;
  len = BYTES_BY_CHAR_HEAD (c);
  while (i < len)
    {
361
      buf[i++] = c = (*readbyte) (-1, readcharfun);
Kenichi Handa's avatar
Kenichi Handa committed
362 363
      if (c < 0 || ! TRAILING_CODE_P (c))
	{
364
	  for (i -= c < 0; 0 < --i; )
Kenichi Handa's avatar
Kenichi Handa committed
365 366 367 368
	    (*readbyte) (buf[i], readcharfun);
	  return BYTE8_TO_CHAR (buf[0]);
	}
    }
369
  return STRING_CHAR (buf);
Jim Blandy's avatar
Jim Blandy committed
370 371
}

Stefan Monnier's avatar
Stefan Monnier committed
372 373 374 375
#define FROM_FILE_P(readcharfun)			\
  (EQ (readcharfun, Qget_file_char)			\
   || EQ (readcharfun, Qget_emacs_mule_file_char))

376 377 378
static void
skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
{
Stefan Monnier's avatar
Stefan Monnier committed
379
  if (FROM_FILE_P (readcharfun))
380 381
    {
      block_input ();		/* FIXME: Not sure if it's needed.  */
382
      fseek (infile->stream, n - infile->lookahead, SEEK_CUR);
383
      unblock_input ();
384
      infile->lookahead = 0;
385 386 387 388 389 390 391 392 393 394 395 396 397 398 399
    }
  else
    { /* We're not reading directly from a file.  In that case, it's difficult
	 to reliably count bytes, since these are usually meant for the file's
	 encoding, whereas we're now typically in the internal encoding.
	 But luckily, skip_dyn_bytes is used to skip over a single
	 dynamic-docstring (or dynamic byte-code) which is always quoted such
	 that \037 is the final char.  */
      int c;
      do {
	c = READCHAR;
      } while (c >= 0 && c != '\037');
    }
}

400 401 402 403 404 405
static void
skip_dyn_eof (Lisp_Object readcharfun)
{
  if (FROM_FILE_P (readcharfun))
    {
      block_input ();		/* FIXME: Not sure if it's needed.  */
406
      fseek (infile->stream, 0, SEEK_END);
407
      unblock_input ();
408
      infile->lookahead = 0;
409 410 411 412 413
    }
  else
    while (READCHAR >= 0);
}

Jim Blandy's avatar
Jim Blandy committed
414 415 416 417
/* Unread the character C in the way appropriate for the stream READCHARFUN.
   If the stream is a user function, call it with the char as argument.  */

static void
418
unreadchar (Lisp_Object readcharfun, int c)
Jim Blandy's avatar
Jim Blandy committed
419
{
420
  readchar_count--;
421 422 423 424
  if (c == -1)
    /* Don't back up the pointer if we're unreading the end-of-input mark,
       since readchar didn't advance it when we read it.  */
    ;
425
  else if (BUFFERP (readcharfun))
426
    {
427
      struct buffer *b = XBUFFER (readcharfun);
428 429
      ptrdiff_t charpos = BUF_PT (b);
      ptrdiff_t bytepos = BUF_PT_BYTE (b);
430

Tom Tromey's avatar
Tom Tromey committed
431
      if (! NILP (BVAR (b, enable_multibyte_characters)))
Kenichi Handa's avatar
Kenichi Handa committed
432
	BUF_DEC_POS (b, bytepos);
433
      else
Kenichi Handa's avatar
Kenichi Handa committed
434
	bytepos--;
435

436
      SET_BUF_PT_BOTH (b, charpos - 1, bytepos);
437
    }
438
  else if (MARKERP (readcharfun))
439
    {
440
      struct buffer *b = XMARKER (readcharfun)->buffer;
441
      ptrdiff_t bytepos = XMARKER (readcharfun)->bytepos;
442

Kenichi Handa's avatar
Kenichi Handa committed
443
      XMARKER (readcharfun)->charpos--;
Tom Tromey's avatar
Tom Tromey committed
444
      if (! NILP (BVAR (b, enable_multibyte_characters)))
Kenichi Handa's avatar
Kenichi Handa committed
445
	BUF_DEC_POS (b, bytepos);
446
      else
Kenichi Handa's avatar
Kenichi Handa committed
447
	bytepos--;
448

Kenichi Handa's avatar
Kenichi Handa committed
449
      XMARKER (readcharfun)->bytepos = bytepos;
450
    }
451
  else if (STRINGP (readcharfun))
452 453 454 455 456
    {
      read_from_string_index--;
      read_from_string_index_byte
	= string_char_to_byte (readcharfun, read_from_string_index);
    }
457
  else if (CONSP (readcharfun) && STRINGP (XCAR (readcharfun)))
Kenichi Handa's avatar
Kenichi Handa committed
458 459 460
    {
      unread_char = c;
    }
461
  else if (EQ (readcharfun, Qlambda))
Kenichi Handa's avatar
Kenichi Handa committed
462 463 464
    {
      unread_char = c;
    }
Stefan Monnier's avatar
Stefan Monnier committed
465
  else if (FROM_FILE_P (readcharfun))
Kenichi Handa's avatar
Kenichi Handa committed
466
    {
467
      unread_char = c;
Kenichi Handa's avatar
Kenichi Handa committed
468
    }
Jim Blandy's avatar
Jim Blandy committed
469
  else
470
    call1 (readcharfun, make_fixnum (c));
Jim Blandy's avatar
Jim Blandy committed
471 472
}

Kenichi Handa's avatar
Kenichi Handa committed
473
static int
474
readbyte_for_lambda (int c, Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
475 476 477 478 479 480
{
  return read_bytecode_char (c >= 0);
}


static int
481
readbyte_from_stdio (void)
Kenichi Handa's avatar
Kenichi Handa committed
482
{
483 484 485 486 487
  if (infile->lookahead)
    return infile->buf[--infile->lookahead];

  int c;
  FILE *instream = infile->stream;
Kenichi Handa's avatar
Kenichi Handa committed
488

489
  block_input ();
Miles Bader's avatar
Miles Bader committed
490

491
  /* Interrupted reads have been observed while reading over the network.  */
492 493
  while ((c = getc_unlocked (instream)) == EOF && errno == EINTR
	 && ferror_unlocked (instream))
Miles Bader's avatar
Miles Bader committed
494
    {
495
      unblock_input ();
Paul Eggert's avatar
Paul Eggert committed
496
      maybe_quit ();
497
      block_input ();
498
      clearerr_unlocked (instream);
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
499
    }
Miles Bader's avatar
Miles Bader committed
500

501
  unblock_input ();
Miles Bader's avatar
Miles Bader committed
502

Kenichi Handa's avatar
Kenichi Handa committed
503 504 505
  return (c == EOF ? -1 : c);
}

506 507 508 509 510 511 512 513 514 515 516 517 518
static int
readbyte_from_file (int c, Lisp_Object readcharfun)
{
  if (c >= 0)
    {
      eassert (infile->lookahead < sizeof infile->buf);
      infile->buf[infile->lookahead++] = c;
      return 0;
    }

  return readbyte_from_stdio ();
}

Kenichi Handa's avatar
Kenichi Handa committed
519
static int
520
readbyte_from_string (int c, Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
521 522 523 524 525 526 527 528 529
{
  Lisp_Object string = XCAR (readcharfun);

  if (c >= 0)
    {
      read_from_string_index--;
      read_from_string_index_byte
	= string_char_to_byte (string, read_from_string_index);
    }
Kenichi Handa's avatar
Kenichi Handa committed
530

Kenichi Handa's avatar
Kenichi Handa committed
531 532 533 534 535 536 537 538 539 540
  if (read_from_string_index >= read_from_string_limit)
    c = -1;
  else
    FETCH_STRING_CHAR_ADVANCE (c, string,
			       read_from_string_index,
			       read_from_string_index_byte);
  return c;
}


541
/* Read one non-ASCII character from INFILE.  The character is
Kenichi Handa's avatar
Kenichi Handa committed
542 543 544 545
   encoded in `emacs-mule' and the first byte is already read in
   C.  */

static int
546
read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562
{
  /* Emacs-mule coding uses at most 4-byte for one character.  */
  unsigned char buf[4];
  int len = emacs_mule_bytes[c];
  struct charset *charset;
  int i;
  unsigned code;

  if (len == 1)
    /* C is not a valid leading-code of `emacs-mule'.  */
    return BYTE8_TO_CHAR (c);

  i = 0;
  buf[i++] = c;
  while (i < len)
    {
563
      buf[i++] = c = (*readbyte) (-1, readcharfun);
Kenichi Handa's avatar
Kenichi Handa committed
564 565
      if (c < 0xA0)
	{
566
	  for (i -= c < 0; 0 < --i; )
Kenichi Handa's avatar
Kenichi Handa committed
567 568 569 570 571 572 573
	    (*readbyte) (buf[i], readcharfun);
	  return BYTE8_TO_CHAR (buf[0]);
	}
    }

  if (len == 2)
    {
574
      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
Kenichi Handa's avatar
Kenichi Handa committed
575 576 577 578 579 580 581
      code = buf[1] & 0x7F;
    }
  else if (len == 3)
    {
      if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
	  || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
	{
582
	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
Kenichi Handa's avatar
Kenichi Handa committed
583 584 585 586
	  code = buf[2] & 0x7F;
	}
      else
	{
587
	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
Kenichi Handa's avatar
Kenichi Handa committed
588 589 590 591 592
	  code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
	}
    }
  else
    {
593
      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
Kenichi Handa's avatar
Kenichi Handa committed
594
      code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
Kenichi Handa's avatar
Kenichi Handa committed
595 596 597 598
    }
  c = DECODE_CHAR (charset, code);
  if (c < 0)
    Fsignal (Qinvalid_read_syntax,
599
	     list1 (build_string ("invalid multibyte form")));
Kenichi Handa's avatar
Kenichi Handa committed
600 601 602 603
  return c;
}


604 605 606 607 608 609 610 611 612 613 614 615 616 617
/* An in-progress substitution of OBJECT for PLACEHOLDER.  */
struct subst
{
  Lisp_Object object;
  Lisp_Object placeholder;

  /* Hash table of subobjects of OBJECT that might be circular.  If
     Qt, all such objects might be circular.  */
  Lisp_Object completed;

  /* List of subobjects of OBJECT that have already been visited.  */
  Lisp_Object seen;
};

618 619 620
static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
                                        Lisp_Object);
static Lisp_Object read0 (Lisp_Object);
621
static Lisp_Object read1 (Lisp_Object, int *, bool);
622

623 624
static Lisp_Object read_list (bool, Lisp_Object);
static Lisp_Object read_vector (Lisp_Object, bool);
625

626 627
static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object);
static void substitute_in_interval (INTERVAL, void *);
628

Jim Blandy's avatar
Jim Blandy committed
629

630
/* Get a character from the tty.  */
Jim Blandy's avatar
Jim Blandy committed
631

632 633
/* Read input events until we get one that's acceptable for our purposes.

634
   If NO_SWITCH_FRAME, switch-frame events are stashed
635 636 637
   until we get a character we like, and then stuffed into
   unread_switch_frame.

638
   If ASCII_REQUIRED, check function key events to see
639 640 641
   if the unmodified version of the symbol has a Qascii_character
   property, and use that character, if present.

642 643 644
   If ERROR_NONASCII, signal an error if the input we
   get isn't an ASCII character with modifiers.  If it's false but
   ASCII_REQUIRED is true, just re-read until we get an ASCII
645 646
   character.

647
   If INPUT_METHOD, invoke the current input method
648 649
   if the character warrants that.

650
   If SECONDS is a number, wait that many seconds for input, and
651
   return Qnil if no input arrives within that time.  */
652

Andreas Schwab's avatar
Andreas Schwab committed
653
static Lisp_Object
654 655
read_filtered_event (bool no_switch_frame, bool ascii_required,
		     bool error_nonascii, bool input_method, Lisp_Object seconds)
656
{
657
  Lisp_Object val, delayed_switch_frame;
658
  struct timespec end_time;
659

660
#ifdef HAVE_WINDOW_SYSTEM
661 662
  if (display_hourglass_p)
    cancel_hourglass ();
663
#endif
664

665
  delayed_switch_frame = Qnil;
666

667
  /* Compute timeout.  */
668
  if (NUMBERP (seconds))
669
    {
670
      double duration = XFLOATINT (seconds);
671 672
      struct timespec wait_time = dtotimespec (duration);
      end_time = timespec_add (current_timespec (), wait_time);
673 674
    }

675
  /* Read until we get an acceptable event.  */
676
 retry:
677
  do
678
    val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0,
679
		     NUMBERP (seconds) ? &end_time : NULL);
Tom Tromey's avatar
Tom Tromey committed
680
  while (FIXNUMP (val) && XFIXNUM (val) == -2); /* wrong_kboard_jmpbuf */
681

682
  if (BUFFERP (val))
683 684
    goto retry;

685
  /* `switch-frame' events are put off until after the next ASCII
Karl Heuer's avatar
Karl Heuer committed
686
     character.  This is better than signaling an error just because
687 688 689 690 691
     the last characters were typed to a separate minibuffer frame,
     for example.  Eventually, some code which can deal with
     switch-frame events will read it and process it.  */
  if (no_switch_frame
      && EVENT_HAS_PARAMETERS (val)
692
      && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
693 694 695 696 697
    {
      delayed_switch_frame = val;
      goto retry;
    }

698
  if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
699 700
    {
      /* Convert certain symbols to their ASCII equivalents.  */
701
      if (SYMBOLP (val))
702
	{
703
	  Lisp_Object tem, tem1;
704 705 706 707 708 709 710
	  tem = Fget (val, Qevent_symbol_element_mask);
	  if (!NILP (tem))
	    {
	      tem1 = Fget (Fcar (tem), Qascii_character);
	      /* Merge this symbol's modifier bits
		 with the ASCII equivalent of its basic code.  */
	      if (!NILP (tem1))
Tom Tromey's avatar
Tom Tromey committed
711
		XSETFASTINT (val, XFIXNUM (tem1) | XFIXNUM (Fcar (Fcdr (tem))));
712 713
	    }
	}
714

715
      /* If we don't have a character now, deal with it appropriately.  */
716
      if (!FIXNUMP (val))
717 718 719
	{
	  if (error_nonascii)
	    {
720
	      Vunread_command_events = list1 (val);
721 722 723 724 725 726 727 728 729 730
	      error ("Non-character input-event");
	    }
	  else
	    goto retry;
	}
    }

  if (! NILP (delayed_switch_frame))
    unread_switch_frame = delayed_switch_frame;

731 732
#if 0

733
#ifdef HAVE_WINDOW_SYSTEM
734 735
  if (display_hourglass_p)
    start_hourglass ();
736
#endif
737 738 739

#endif

740 741 742
  return val;
}

Paul Eggert's avatar
Paul Eggert committed
743
DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
744
       doc: /* Read a character event from the command input (keyboard or macro).
745
It is returned as a number.
746 747 748 749 750 751
If the event has modifiers, they are resolved and reflected in the
returned character code if possible (e.g. C-SPC yields 0 and C-a yields 97).
If some of the modifiers cannot be reflected in the character code, the
returned value will include those modifiers, and will not be a valid
character code: it will fail the `characterp' test.  Use `event-basic-type'
to recover the character code with the modifiers removed.
752

753 754
If the user generates an event which is not a character (i.e. a mouse
click or function key event), `read-char' signals an error.  As an
755 756
exception, switch-frame events are put off until non-character events
can be read.
757 758 759 760 761 762
If you want to read non-character events, or ignore them, call
`read-event' or `read-char-exclusive' instead.

If the optional argument PROMPT is non-nil, display that as a prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
763 764 765 766 767
is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input.  If no
input arrives in that time, return nil.  SECONDS may be a
floating-point value.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
768
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
769
{
770 771
  Lisp_Object val;

772 773
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
774
  val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
775 776

  return (NILP (val) ? Qnil
Tom Tromey's avatar
Tom Tromey committed
777
	  : make_fixnum (char_resolve_modifier_mask (XFIXNUM (val))));
Jim Blandy's avatar
Jim Blandy committed
778 779
}

Paul Eggert's avatar
Paul Eggert committed
780
DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
781 782 783 784
       doc: /* Read an event object from the input stream.
If the optional argument PROMPT is non-nil, display that as a prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
785 786 787 788 789
is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input.  If no
input arrives in that time, return nil.  SECONDS may be a
floating-point value.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
790
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
791
{
792 793
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
794
  return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
Jim Blandy's avatar
Jim Blandy committed
795 796
}

797
DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
798
       doc: /* Read a character event from the command input (keyboard or macro).
799
It is returned as a number.  Non-character events are ignored.
800 801 802 803 804 805
If the event has modifiers, they are resolved and reflected in the
returned character code if possible (e.g. C-SPC yields 0 and C-a yields 97).
If some of the modifiers cannot be reflected in the character code, the
returned value will include those modifiers, and will not be a valid
character code: it will fail the `characterp' test.  Use `event-basic-type'
to recover the character code with the modifiers removed.
806 807 808 809

If the optional argument PROMPT is non-nil, display that as a prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
810 811 812 813 814
is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input.  If no
input arrives in that time, return nil.  SECONDS may be a
floating-point value.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
815
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
816
{
817 818
  Lisp_Object val;

819 820
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
821

822
  val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
823 824

  return (NILP (val) ? Qnil
Tom Tromey's avatar
Tom Tromey committed
825
	  : make_fixnum (char_resolve_modifier_mask (XFIXNUM (val))));
Jim Blandy's avatar
Jim Blandy committed
826 827 828
}

DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
829
       doc: /* Don't use this yourself.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
830
  (void)
Jim Blandy's avatar
Jim Blandy committed
831
{
832 833
  if (!infile)
    error ("get-file-char misused");
834
  return make_fixnum (readbyte_from_stdio ());
Jim Blandy's avatar
Jim Blandy committed
835
}
836 837


838 839 840 841


/* Return true if the lisp code read using READCHARFUN defines a non-nil
   `lexical-binding' file variable.  After returning, the stream is
842 843
   positioned following the first line, if it is a comment or #! line,
   otherwise nothing is read.  */
844

845
static bool
Stefan Monnier's avatar
Stefan Monnier committed
846
lisp_file_lexically_bound_p (Lisp_Object readcharfun)
847 848
{
  int ch = READCHAR;