lread.c 152 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"
45
#include <c-ctype.h>
Jim Blandy's avatar
Jim Blandy committed
46

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

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

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

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

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

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

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

78 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
/* 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;
108

109 110 111 112 113 114 115 116 117 118 119 120 121 122
/* 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
123

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

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

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

142 143 144 145 146
/* 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.  */
147
static ptrdiff_t prev_saved_doc_string_size;
148
/* Length of actual data in prev_saved_doc_string.  */
149
static ptrdiff_t prev_saved_doc_string_length;
150
/* This is the file position that string came from.  */
151
static file_offset prev_saved_doc_string_position;
152

153 154 155 156
/* 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.  */
157
static bool new_backquote_flag;
158 159 160 161

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

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

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

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

static void build_load_history (Lisp_Object, bool);
Jim Blandy's avatar
Jim Blandy committed
172

Kenichi Handa's avatar
Kenichi Handa committed
173 174 175 176 177 178
/* 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.  */

179 180 181
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
182

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

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

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

192 193 194
/* 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
195
/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
Kenichi Handa's avatar
Kenichi Handa committed
196 197
   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
198
   means that there's no unread character.  */
Kenichi Handa's avatar
Kenichi Handa committed
199 200
static int unread_char;

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

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

214
  readchar_count++;
215

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

220
      ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
221

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

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

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

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

252
      ptrdiff_t bytepos = marker_byte_position (readcharfun);
253

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

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

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

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

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

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

292
  if (STRINGP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
293
    {
294
      if (read_from_string_index >= read_from_string_limit)
Jim Blandy's avatar
Jim Blandy committed
295
	c = -1;
296 297 298 299 300 301 302 303
      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);
	}
304
      else
305 306 307 308 309
	{
	  c = SREF (readcharfun, read_from_string_index_byte);
	  read_from_string_index++;
	  read_from_string_index_byte++;
	}
Jim Blandy's avatar
Jim Blandy committed
310 311 312
      return c;
    }

313
  if (CONSP (readcharfun) && STRINGP (XCAR (readcharfun)))
Kenichi Handa's avatar
Kenichi Handa committed
314 315 316 317 318 319 320 321 322 323 324
    {
      /* 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
325

Kenichi Handa's avatar
Kenichi Handa committed
326 327 328 329 330 331
  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
332 333 334

  tem = call0 (readcharfun);

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

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

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

375 376 377
static void
skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
{
Stefan Monnier's avatar
Stefan Monnier committed
378
  if (FROM_FILE_P (readcharfun))
379 380
    {
      block_input ();		/* FIXME: Not sure if it's needed.  */
381
      fseek (infile->stream, n - infile->lookahead, SEEK_CUR);
382
      unblock_input ();
383
      infile->lookahead = 0;
384 385 386 387 388 389 390 391 392 393 394 395 396 397 398
    }
  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');
    }
}

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

Jim Blandy's avatar
Jim Blandy committed
413 414 415 416
/* 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
417
unreadchar (Lisp_Object readcharfun, int c)
Jim Blandy's avatar
Jim Blandy committed
418
{
419
  readchar_count--;
420 421 422 423
  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.  */
    ;
424
  else if (BUFFERP (readcharfun))
425
    {
426
      struct buffer *b = XBUFFER (readcharfun);
427 428
      ptrdiff_t charpos = BUF_PT (b);
      ptrdiff_t bytepos = BUF_PT_BYTE (b);
429

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

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

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

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

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


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

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

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

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

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

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

505 506 507 508 509 510 511 512 513 514 515 516 517
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
518
static int
519
readbyte_from_string (int c, Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
520 521 522 523 524 525 526 527 528
{
  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
529

Kenichi Handa's avatar
Kenichi Handa committed
530 531 532 533 534 535 536 537 538 539
  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;
}


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

static int
545
read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561
{
  /* 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)
    {
562
      buf[i++] = c = (*readbyte) (-1, readcharfun);
Kenichi Handa's avatar
Kenichi Handa committed
563 564
      if (c < 0xA0)
	{
565
	  for (i -= c < 0; 0 < --i; )
Kenichi Handa's avatar
Kenichi Handa committed
566 567 568 569 570 571 572
	    (*readbyte) (buf[i], readcharfun);
	  return BYTE8_TO_CHAR (buf[0]);
	}
    }

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


603 604 605 606 607 608 609 610 611 612 613 614 615 616
/* 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;
};

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

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

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

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

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

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

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

641 642 643
   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
644 645
   character.

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

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

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

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

664
  delayed_switch_frame = Qnil;
665

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

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

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

684
  /* `switch-frame' events are put off until after the next ASCII
Karl Heuer's avatar
Karl Heuer committed
685
     character.  This is better than signaling an error just because
686 687 688 689 690
     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)
691
      && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
692 693 694 695 696
    {
      delayed_switch_frame = val;
      goto retry;
    }

697
  if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
698 699
    {
      /* Convert certain symbols to their ASCII equivalents.  */
700
      if (SYMBOLP (val))
701
	{
702
	  Lisp_Object tem, tem1;
703 704 705 706 707 708 709
	  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
710
		XSETFASTINT (val, XFIXNUM (tem1) | XFIXNUM (Fcar (Fcdr (tem))));
711 712
	    }
	}
713

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

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

730 731
#if 0

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

#endif

739 740 741
  return val;
}

Paul Eggert's avatar
Paul Eggert committed
742
DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
743
       doc: /* Read a character event from the command input (keyboard or macro).
744
It is returned as a number.
745 746 747 748 749 750
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.
751

752 753
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
754 755
exception, switch-frame events are put off until non-character events
can be read.
756 757 758 759 760 761
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
762 763 764 765 766
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
767
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
768
{
769 770
  Lisp_Object val;

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

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

Paul Eggert's avatar
Paul Eggert committed
779
DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
780 781 782 783
       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
784 785 786 787 788
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
789
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
790
{
791 792
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
793
  return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
Jim Blandy's avatar
Jim Blandy committed
794 795
}

796
DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
797
       doc: /* Read a character event from the command input (keyboard or macro).
798
It is returned as a number.  Non-character events are ignored.
799 800 801 802 803 804
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.
805 806 807 808

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
809 810 811 812 813
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
814
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
815
{
816 817
  Lisp_Object val;

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

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

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

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


837 838 839 840


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

844
static bool
Stefan Monnier's avatar
Stefan Monnier committed
845
lisp_file_lexically_bound_p (Lisp_Object readcharfun)
846 847
{
  int ch = READCHAR;
848 849 850 851 852 853 854 855 856 857 858 859 860

  if (ch == '#')
    {
      ch = READCHAR;
      if (ch != '!')
        {
          UNREAD (ch);
          UNREAD ('#');
          return 0;
        }
      while (ch != '\n' && ch != EOF)
        ch = READCHAR;
      if (ch == '\n') ch = READCHAR;
Glenn Morris's avatar
Comment  
Glenn Morris committed
861 862
      /* It is OK to leave the position after a #! line, since
         that is what read1 does.  */
863 864
    }

865 866 867 868 869 870 871 872 873
  if (ch != ';')
    /* The first line isn't a comment, just give up.  */
    {
      UNREAD (ch);
      return 0;
    }
  else
    /* Look for an appropriate file-variable in the first line.  */
    {
874
      bool rv = 0;
875
      enum {
Paul Eggert's avatar
Paul Eggert committed
876
	NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX
877
      } beg_end_state = NOMINAL;
878
      bool in_file_vars = 0;
879

880 881 882 883 884 885 886 887 888 889
#define UPDATE_BEG_END_STATE(ch)				\
  if (beg_end_state == NOMINAL)					\
    beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL);	\
  else if (beg_end_state == AFTER_FIRST_DASH)			\
    beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL);	\
  else if (beg_end_state == AFTER_ASTERIX)			\
    {								\
      if (ch == '-')						\
	in_file_vars = !in_file_vars;				\
      beg_end_state = NOMINAL;					\
890 891 892 893 894 895 896 897 898 899 900 901
    }

      /* Skip until we get to the file vars, if any.  */
      do
	{
	  ch = READCHAR;
	  UPDATE_BEG_END_STATE (ch);
	}
      while (!in_file_vars && ch != '\n' && ch != EOF);

      while (in_file_vars)
	{
902
	  char var[100], val[100];
903
	  unsigned i;
904 905 906 907 908 909 910

	  ch = READCHAR;

	  /* Read a variable name.  */
	  while (ch == ' ' || ch == '\t')
	    ch = READCHAR;

911
	  i = 0;
912
	  beg_end_state = NOMINAL;
913
	  while (ch != ':' && ch != '\n' && ch != EOF && in_file_vars)
914
	    {
915 916
	      if (i < sizeof var - 1)
		var[i++] = ch;
917 918 919
	      UPDATE_BEG_END_STATE (ch);
	      ch = READCHAR;
	    }
920

921
	  /* Stop scanning if no colon was found before end marker.  */
922
	  if (!in_file_vars || ch == '\n' || ch == EOF)