lread.c 138 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-2015 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 <http://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
20 21


Richard M. Stallman's avatar
Richard M. Stallman committed
22
#include <config.h>
23
#include "sysstdio.h"
Jim Blandy's avatar
Jim Blandy committed
24 25 26
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/file.h>
27
#include <errno.h>
28
#include <limits.h>	/* For CHAR_BIT.  */
29
#include <stat-time.h>
Jim Blandy's avatar
Jim Blandy committed
30
#include "lisp.h"
31
#include "intervals.h"
Kenichi Handa's avatar
Kenichi Handa committed
32
#include "character.h"
33
#include "buffer.h"
Karl Heuer's avatar
Karl Heuer committed
34
#include "charset.h"
Kenichi Handa's avatar
Kenichi Handa committed
35
#include "coding.h"
36
#include <epaths.h>
Jim Blandy's avatar
Jim Blandy committed
37
#include "commands.h"
Jim Blandy's avatar
Jim Blandy committed
38
#include "keyboard.h"
39
#include "frame.h"
40
#include "termhooks.h"
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
41
#include "blockinput.h"
Jim Blandy's avatar
Jim Blandy committed
42

43 44 45 46
#ifdef MSDOS
#include "msdos.h"
#endif

47 48 49 50
#ifdef HAVE_NS
#include "nsterm.h"
#endif

Andreas Schwab's avatar
Andreas Schwab committed
51
#include <unistd.h>
Jim Blandy's avatar
Jim Blandy committed
52

Richard M. Stallman's avatar
Richard M. Stallman committed
53 54 55 56
#ifdef HAVE_SETLOCALE
#include <locale.h>
#endif /* HAVE_SETLOCALE */

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

59
#ifdef HAVE_FSEEKO
60 61 62 63 64 65 66
#define file_offset off_t
#define file_tell ftello
#else
#define file_offset long
#define file_tell ftell
#endif

67
/* Hash table read constants.  */
68
static Lisp_Object Qhash_table, Qdata;
Paul Eggert's avatar
Paul Eggert committed
69 70
static Lisp_Object Qtest;
Lisp_Object Qsize;
71 72 73 74 75 76
static Lisp_Object Qweakness;
static Lisp_Object Qrehash_size;
static Lisp_Object Qrehash_threshold;

static Lisp_Object Qread_char, Qget_file_char, Qcurrent_load_list;
Lisp_Object Qstandard_input;
77
Lisp_Object Qvariable_documentation;
78
static Lisp_Object Qascii_character, Qload, Qload_file_name;
79
Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
80 81
static Lisp_Object Qinhibit_file_name_operation;
static Lisp_Object Qeval_buffer_list;
82
Lisp_Object Qlexical_binding;
83
static Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
84

Kenichi Handa's avatar
Kenichi Handa committed
85 86 87 88 89 90
/* Used instead of Qget_file_char while loading *.elc files compiled
   by Emacs 21 or older.  */
static Lisp_Object Qget_emacs_mule_file_char;

static Lisp_Object Qload_force_doc_strings;

91
static Lisp_Object Qload_in_progress;
Ken Raeburn's avatar
Ken Raeburn committed
92

93 94 95 96
/* The association list of objects read with the #n=object form.
   Each member of the list has the form (n . object), and is used to
   look up the object for the corresponding #n# construct.
   It must be set to nil before all top-level calls to read0.  */
97
static Lisp_Object read_objects;
98

99
/* File for get_file_char to read from.  Use by load.  */
Jim Blandy's avatar
Jim Blandy committed
100 101
static FILE *instream;

102
/* For use within read-from-string (this reader is non-reentrant!!)  */
103 104 105
static ptrdiff_t read_from_string_index;
static ptrdiff_t read_from_string_index_byte;
static ptrdiff_t read_from_string_limit;
106

107
/* Number of characters read in the current call to Fread or
108
   Fread_from_string.  */
109
static EMACS_INT readchar_count;
110

111
/* This contains the last string skipped with #@.  */
112 113
static char *saved_doc_string;
/* Length of buffer allocated in saved_doc_string.  */
114
static ptrdiff_t saved_doc_string_size;
115
/* Length of actual data in saved_doc_string.  */
116
static ptrdiff_t saved_doc_string_length;
117
/* This is the file position that string came from.  */
118
static file_offset saved_doc_string_position;
119

120 121 122 123 124
/* 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.  */
125
static ptrdiff_t prev_saved_doc_string_size;
126
/* Length of actual data in prev_saved_doc_string.  */
127
static ptrdiff_t prev_saved_doc_string_length;
128
/* This is the file position that string came from.  */
129
static file_offset prev_saved_doc_string_position;
130

131
/* True means inside a new-style backquote
132
   with no surrounding parentheses.
133
   Fread initializes this to false, so we need not specbind it
134
   or worry about what happens to it when there is an error.  */
135
static bool new_backquote_flag;
136
static Lisp_Object Qold_style_backquotes;
137 138 139 140

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

Lute Kamstra's avatar
Lute Kamstra committed
141
static Lisp_Object Vloads_in_progress;
142

143 144
static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
                                 Lisp_Object);
Kenichi Handa's avatar
Kenichi Handa committed
145

146
static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool,
147 148
                          Lisp_Object, Lisp_Object,
                          Lisp_Object, Lisp_Object);
Jim Blandy's avatar
Jim Blandy committed
149

Kenichi Handa's avatar
Kenichi Handa committed
150 151 152 153 154 155
/* 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.  */

156 157 158
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
159

Jim Blandy's avatar
Jim Blandy committed
160 161
/* Handle unreading and rereading of characters.
   Write READCHAR to read a character,
Karl Heuer's avatar
Karl Heuer committed
162 163
   UNREAD(c) to unread c to be read again.

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

166
#define READCHAR readchar (readcharfun, NULL)
Jim Blandy's avatar
Jim Blandy committed
167 168
#define UNREAD(c) unreadchar (readcharfun, c)

169 170 171
/* 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
172
/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
Kenichi Handa's avatar
Kenichi Handa committed
173 174
   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
175
   means that there's no unread character.  */
Kenichi Handa's avatar
Kenichi Handa committed
176 177
static int unread_char;

Jim Blandy's avatar
Jim Blandy committed
178
static int
179
readchar (Lisp_Object readcharfun, bool *multibyte)
Jim Blandy's avatar
Jim Blandy committed
180 181
{
  Lisp_Object tem;
182
  register int c;
183
  int (*readbyte) (int, Lisp_Object);
Kenichi Handa's avatar
Kenichi Handa committed
184 185
  unsigned char buf[MAX_MULTIBYTE_LENGTH];
  int i, len;
186
  bool emacs_mule_encoding = 0;
Jim Blandy's avatar
Jim Blandy committed
187

188 189 190
  if (multibyte)
    *multibyte = 0;

191
  readchar_count++;
192

193
  if (BUFFERP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
194
    {
195
      register struct buffer *inbuffer = XBUFFER (readcharfun);
Jim Blandy's avatar
Jim Blandy committed
196

197
      ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
198

199 200 201
      if (! BUFFER_LIVE_P (inbuffer))
	return -1;

202 203
      if (pt_byte >= BUF_ZV_BYTE (inbuffer))
	return -1;
Jim Blandy's avatar
Jim Blandy committed
204

Tom Tromey's avatar
Tom Tromey committed
205
      if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
206
	{
207
	  /* Fetch the character code from the buffer.  */
208 209
	  unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
	  BUF_INC_POS (inbuffer, pt_byte);
210
	  c = STRING_CHAR (p);
211 212
	  if (multibyte)
	    *multibyte = 1;
213 214 215 216
	}
      else
	{
	  c = BUF_FETCH_BYTE (inbuffer, pt_byte);
217
	  if (! ASCII_CHAR_P (c))
Kenichi Handa's avatar
Kenichi Handa committed
218
	    c = BYTE8_TO_CHAR (c);
219
	  pt_byte++;
220
	}
221
      SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
222

223
      return c;
Jim Blandy's avatar
Jim Blandy committed
224
    }
225
  if (MARKERP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
226
    {
227
      register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
Jim Blandy's avatar
Jim Blandy committed
228

229
      ptrdiff_t bytepos = marker_byte_position (readcharfun);
230

231 232
      if (bytepos >= BUF_ZV_BYTE (inbuffer))
	return -1;
233

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

251 252 253 254
      XMARKER (readcharfun)->bytepos = bytepos;
      XMARKER (readcharfun)->charpos++;

      return c;
Jim Blandy's avatar
Jim Blandy committed
255
    }
256 257

  if (EQ (readcharfun, Qlambda))
Kenichi Handa's avatar
Kenichi Handa committed
258 259 260 261
    {
      readbyte = readbyte_for_lambda;
      goto read_multibyte;
    }
262

Jim Blandy's avatar
Jim Blandy committed
263
  if (EQ (readcharfun, Qget_file_char))
264
    {
Kenichi Handa's avatar
Kenichi Handa committed
265 266
      readbyte = readbyte_from_file;
      goto read_multibyte;
267
    }
Jim Blandy's avatar
Jim Blandy committed
268

269
  if (STRINGP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
270
    {
271
      if (read_from_string_index >= read_from_string_limit)
Jim Blandy's avatar
Jim Blandy committed
272
	c = -1;
273 274 275 276 277 278 279 280
      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);
	}
281
      else
282 283 284 285 286
	{
	  c = SREF (readcharfun, read_from_string_index_byte);
	  read_from_string_index++;
	  read_from_string_index_byte++;
	}
Jim Blandy's avatar
Jim Blandy committed
287 288 289
      return c;
    }

Kenichi Handa's avatar
Kenichi Handa committed
290 291 292 293 294 295 296 297 298 299 300 301
  if (CONSP (readcharfun))
    {
      /* 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
302

Kenichi Handa's avatar
Kenichi Handa committed
303 304 305 306 307 308
  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
309 310 311

  tem = call0 (readcharfun);

Jim Blandy's avatar
Jim Blandy committed
312
  if (NILP (tem))
Jim Blandy's avatar
Jim Blandy committed
313 314
    return -1;
  return XINT (tem);
Kenichi Handa's avatar
Kenichi Handa committed
315 316 317 318 319 320 321 322 323

 read_multibyte:
  if (unread_char >= 0)
    {
      c = unread_char;
      unread_char = -1;
      return c;
    }
  c = (*readbyte) (-1, readcharfun);
324
  if (c < 0)
325 326 327
    return c;
  if (multibyte)
    *multibyte = 1;
328
  if (ASCII_CHAR_P (c))
Kenichi Handa's avatar
Kenichi Handa committed
329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345
    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)
    {
      c = (*readbyte) (-1, readcharfun);
      if (c < 0 || ! TRAILING_CODE_P (c))
	{
	  while (--i > 1)
	    (*readbyte) (buf[i], readcharfun);
	  return BYTE8_TO_CHAR (buf[0]);
	}
      buf[i++] = c;
    }
346
  return STRING_CHAR (buf);
Jim Blandy's avatar
Jim Blandy committed
347 348
}

Stefan Monnier's avatar
Stefan Monnier committed
349 350 351 352
#define FROM_FILE_P(readcharfun)			\
  (EQ (readcharfun, Qget_file_char)			\
   || EQ (readcharfun, Qget_emacs_mule_file_char))

353 354 355
static void
skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
{
Stefan Monnier's avatar
Stefan Monnier committed
356
  if (FROM_FILE_P (readcharfun))
357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375
    {
      block_input ();		/* FIXME: Not sure if it's needed.  */
      fseek (instream, n, SEEK_CUR);
      unblock_input ();
    }
  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');
    }
}

376 377 378 379 380 381 382 383 384 385 386 387 388
static void
skip_dyn_eof (Lisp_Object readcharfun)
{
  if (FROM_FILE_P (readcharfun))
    {
      block_input ();		/* FIXME: Not sure if it's needed.  */
      fseek (instream, 0, SEEK_END);
      unblock_input ();
    }
  else
    while (READCHAR >= 0);
}

Jim Blandy's avatar
Jim Blandy committed
389 390 391 392
/* 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
393
unreadchar (Lisp_Object readcharfun, int c)
Jim Blandy's avatar
Jim Blandy committed
394
{
395
  readchar_count--;
396 397 398 399
  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.  */
    ;
400
  else if (BUFFERP (readcharfun))
401
    {
402
      struct buffer *b = XBUFFER (readcharfun);
403 404
      ptrdiff_t charpos = BUF_PT (b);
      ptrdiff_t bytepos = BUF_PT_BYTE (b);
405

Tom Tromey's avatar
Tom Tromey committed
406
      if (! NILP (BVAR (b, enable_multibyte_characters)))
Kenichi Handa's avatar
Kenichi Handa committed
407
	BUF_DEC_POS (b, bytepos);
408
      else
Kenichi Handa's avatar
Kenichi Handa committed
409
	bytepos--;
410

411
      SET_BUF_PT_BOTH (b, charpos - 1, bytepos);
412
    }
413
  else if (MARKERP (readcharfun))
414
    {
415
      struct buffer *b = XMARKER (readcharfun)->buffer;
416
      ptrdiff_t bytepos = XMARKER (readcharfun)->bytepos;
417

Kenichi Handa's avatar
Kenichi Handa committed
418
      XMARKER (readcharfun)->charpos--;
Tom Tromey's avatar
Tom Tromey committed
419
      if (! NILP (BVAR (b, enable_multibyte_characters)))
Kenichi Handa's avatar
Kenichi Handa committed
420
	BUF_DEC_POS (b, bytepos);
421
      else
Kenichi Handa's avatar
Kenichi Handa committed
422
	bytepos--;
423

Kenichi Handa's avatar
Kenichi Handa committed
424
      XMARKER (readcharfun)->bytepos = bytepos;
425
    }
426
  else if (STRINGP (readcharfun))
427 428 429 430 431
    {
      read_from_string_index--;
      read_from_string_index_byte
	= string_char_to_byte (readcharfun, read_from_string_index);
    }
Kenichi Handa's avatar
Kenichi Handa committed
432 433 434 435
  else if (CONSP (readcharfun))
    {
      unread_char = c;
    }
436
  else if (EQ (readcharfun, Qlambda))
Kenichi Handa's avatar
Kenichi Handa committed
437 438 439
    {
      unread_char = c;
    }
Stefan Monnier's avatar
Stefan Monnier committed
440
  else if (FROM_FILE_P (readcharfun))
Kenichi Handa's avatar
Kenichi Handa committed
441
    {
442
      unread_char = c;
Kenichi Handa's avatar
Kenichi Handa committed
443
    }
Jim Blandy's avatar
Jim Blandy committed
444 445 446 447
  else
    call1 (readcharfun, make_number (c));
}

Kenichi Handa's avatar
Kenichi Handa committed
448
static int
449
readbyte_for_lambda (int c, Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
450 451 452 453 454 455
{
  return read_bytecode_char (c >= 0);
}


static int
456
readbyte_from_file (int c, Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
457 458 459
{
  if (c >= 0)
    {
460
      block_input ();
Kenichi Handa's avatar
Kenichi Handa committed
461
      ungetc (c, instream);
462
      unblock_input ();
Kenichi Handa's avatar
Kenichi Handa committed
463 464 465
      return 0;
    }

466
  block_input ();
Kenichi Handa's avatar
Kenichi Handa committed
467
  c = getc (instream);
Miles Bader's avatar
Miles Bader committed
468

469
  /* Interrupted reads have been observed while reading over the network.  */
Miles Bader's avatar
Miles Bader committed
470 471
  while (c == EOF && ferror (instream) && errno == EINTR)
    {
472
      unblock_input ();
Miles Bader's avatar
Miles Bader committed
473
      QUIT;
474
      block_input ();
Miles Bader's avatar
Miles Bader committed
475
      clearerr (instream);
Miles Bader's avatar
Miles Bader committed
476
      c = getc (instream);
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
477
    }
Miles Bader's avatar
Miles Bader committed
478

479
  unblock_input ();
Miles Bader's avatar
Miles Bader committed
480

Kenichi Handa's avatar
Kenichi Handa committed
481 482 483 484
  return (c == EOF ? -1 : c);
}

static int
485
readbyte_from_string (int c, Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
486 487 488 489 490 491 492 493 494
{
  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
495

Kenichi Handa's avatar
Kenichi Handa committed
496 497 498 499 500 501 502 503 504 505 506 507 508 509 510
  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;
}


/* Read one non-ASCII character from INSTREAM.  The character is
   encoded in `emacs-mule' and the first byte is already read in
   C.  */

static int
511
read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539
{
  /* 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)
    {
      c = (*readbyte) (-1, readcharfun);
      if (c < 0xA0)
	{
	  while (--i > 1)
	    (*readbyte) (buf[i], readcharfun);
	  return BYTE8_TO_CHAR (buf[0]);
	}
      buf[i++] = c;
    }

  if (len == 2)
    {
540
      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
Kenichi Handa's avatar
Kenichi Handa committed
541 542 543 544 545 546 547
      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)
	{
548
	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
Kenichi Handa's avatar
Kenichi Handa committed
549 550 551 552
	  code = buf[2] & 0x7F;
	}
      else
	{
553
	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
Kenichi Handa's avatar
Kenichi Handa committed
554 555 556 557 558
	  code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
	}
    }
  else
    {
559
      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
Kenichi Handa's avatar
Kenichi Handa committed
560
      code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
Kenichi Handa's avatar
Kenichi Handa committed
561 562 563 564
    }
  c = DECODE_CHAR (charset, code);
  if (c < 0)
    Fsignal (Qinvalid_read_syntax,
565
	     list1 (build_string ("invalid multibyte form")));
Kenichi Handa's avatar
Kenichi Handa committed
566 567 568 569
  return c;
}


570 571 572
static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
                                        Lisp_Object);
static Lisp_Object read0 (Lisp_Object);
573
static Lisp_Object read1 (Lisp_Object, int *, bool);
574

575 576
static Lisp_Object read_list (bool, Lisp_Object);
static Lisp_Object read_vector (Lisp_Object, bool);
577

578 579 580 581 582
static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object,
                                              Lisp_Object);
static void substitute_object_in_subtree (Lisp_Object,
                                          Lisp_Object);
static void substitute_in_interval (INTERVAL, Lisp_Object);
583

Jim Blandy's avatar
Jim Blandy committed
584

585
/* Get a character from the tty.  */
Jim Blandy's avatar
Jim Blandy committed
586

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

589
   If NO_SWITCH_FRAME, switch-frame events are stashed
590 591 592
   until we get a character we like, and then stuffed into
   unread_switch_frame.

593
   If ASCII_REQUIRED, check function key events to see
594 595 596
   if the unmodified version of the symbol has a Qascii_character
   property, and use that character, if present.

597 598 599
   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
600 601
   character.

602
   If INPUT_METHOD, invoke the current input method
603 604
   if the character warrants that.

605
   If SECONDS is a number, wait that many seconds for input, and
606
   return Qnil if no input arrives within that time.  */
607

Andreas Schwab's avatar
Andreas Schwab committed
608
static Lisp_Object
609 610
read_filtered_event (bool no_switch_frame, bool ascii_required,
		     bool error_nonascii, bool input_method, Lisp_Object seconds)
611
{
612
  Lisp_Object val, delayed_switch_frame;
613
  struct timespec end_time;
614

615
#ifdef HAVE_WINDOW_SYSTEM
616 617
  if (display_hourglass_p)
    cancel_hourglass ();
618
#endif
619

620
  delayed_switch_frame = Qnil;
621

622 623 624
  /* Compute timeout.  */
  if (NUMBERP (seconds))
    {
625
      double duration = extract_float (seconds);
626 627
      struct timespec wait_time = dtotimespec (duration);
      end_time = timespec_add (current_timespec (), wait_time);
628 629
    }

630
  /* Read until we get an acceptable event.  */
631
 retry:
632
  do
633
    val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0,
Karoly Lorentey's avatar
Karoly Lorentey committed
634
		     NUMBERP (seconds) ? &end_time : NULL);
635
  while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */
636

637
  if (BUFFERP (val))
638 639
    goto retry;

640
  /* `switch-frame' events are put off until after the next ASCII
Karl Heuer's avatar
Karl Heuer committed
641
     character.  This is better than signaling an error just because
642 643 644 645 646
     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)
647
      && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
648 649 650 651 652
    {
      delayed_switch_frame = val;
      goto retry;
    }

653
  if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
654 655
    {
      /* Convert certain symbols to their ASCII equivalents.  */
656
      if (SYMBOLP (val))
657
	{
658
	  Lisp_Object tem, tem1;
659 660 661 662 663 664 665
	  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))
666
		XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
667 668
	    }
	}
669

670
      /* If we don't have a character now, deal with it appropriately.  */
671
      if (!INTEGERP (val))
672 673 674
	{
	  if (error_nonascii)
	    {
675
	      Vunread_command_events = list1 (val);
676 677 678 679 680 681 682 683 684 685
	      error ("Non-character input-event");
	    }
	  else
	    goto retry;
	}
    }

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

686 687
#if 0

688
#ifdef HAVE_WINDOW_SYSTEM
689 690
  if (display_hourglass_p)
    start_hourglass ();
691
#endif
692 693 694

#endif

695 696 697
  return val;
}

Paul Eggert's avatar
Paul Eggert committed
698
DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
699 700
       doc: /* Read a character from the command input (keyboard or macro).
It is returned as a number.
701 702 703
If the character has modifiers, they are resolved and reflected to the
character code if possible (e.g. C-SPC -> 0).

704 705
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
706 707
exception, switch-frame events are put off until non-character events
can be read.
708 709 710 711 712 713
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
714 715 716 717 718
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
719
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
720
{
721 722
  Lisp_Object val;

723 724
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
725
  val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
726 727 728

  return (NILP (val) ? Qnil
	  : make_number (char_resolve_modifier_mask (XINT (val))));
Jim Blandy's avatar
Jim Blandy committed
729 730
}

Paul Eggert's avatar
Paul Eggert committed
731
DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
732 733 734 735
       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
736 737 738 739 740
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
741
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
742
{
743 744
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
745
  return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
Jim Blandy's avatar
Jim Blandy committed
746 747
}

748
DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
749 750
       doc: /* Read a character from the command input (keyboard or macro).
It is returned as a number.  Non-character events are ignored.
751 752
If the character has modifiers, they are resolved and reflected to the
character code if possible (e.g. C-SPC -> 0).
753 754 755 756

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
757 758 759 760 761
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
762
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
763
{
764 765
  Lisp_Object val;

766 767
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
768

769
  val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
770 771 772

  return (NILP (val) ? Qnil
	  : make_number (char_resolve_modifier_mask (XINT (val))));
Jim Blandy's avatar
Jim Blandy committed
773 774 775
}

DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
776
       doc: /* Don't use this yourself.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
777
  (void)
Jim Blandy's avatar
Jim Blandy committed
778 779
{
  register Lisp_Object val;
780
  block_input ();
781
  XSETINT (val, getc (instream));
782
  unblock_input ();
Jim Blandy's avatar
Jim Blandy committed
783 784
  return val;
}
785 786


787 788 789 790


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

794
static bool
Stefan Monnier's avatar
Stefan Monnier committed
795
lisp_file_lexically_bound_p (Lisp_Object readcharfun)
796 797
{
  int ch = READCHAR;
798 799 800 801 802 803 804 805 806 807 808 809 810

  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
811 812
      /* It is OK to leave the position after a #! line, since
         that is what read1 does.  */
813 814
    }

815 816 817 818 819 820 821 822 823
  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.  */
    {
824
      bool rv = 0;
825
      enum {
Paul Eggert's avatar
Paul Eggert committed
826
	NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX
827
      } beg_end_state = NOMINAL;
828
      bool in_file_vars = 0;
829

830 831 832 833 834 835 836 837 838 839
#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;					\
840 841 842 843 844 845 846 847 848 849 850 851
    }

      /* 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)
	{
852
	  char var[100], val[100];
853
	  unsigned i;
854 855 856 857 858 859 860

	  ch = READCHAR;

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

861
	  i = 0;
862
	  while (ch != ':' && ch != '\n' && ch != EOF && in_file_vars)
863
	    {
864 865
	      if (i < sizeof var - 1)
		var[i++] = ch;
866 867 868
	      UPDATE_BEG_END_STATE (ch);
	      ch = READCHAR;
	    }
869

870
	  /* Stop scanning if no colon was found before end marker.  */
871
	  if (!in_file_vars || ch == '\n' || ch == EOF)
872 873
	    break;

874 875 876
	  while (i > 0 && (var[i - 1] == ' ' || var[i - 1] == '\t'))
	    i--;
	  var[i] = '\0';
877 878 879 880 881 882 883 884 885

	  if (ch == ':')
	    {
	      /* Read a variable value.  */
	      ch = READCHAR;

	      while (ch == ' ' || ch == '\t')
		ch = READCHAR;

886
	      i = 0;
887 888
	      while (ch != ';' && ch != '\n' && ch != EOF && in_file_vars)
		{
889 890
		  if (i < sizeof val - 1)
		    val[i++] = ch;
891 892 893 894
		  UPDATE_BEG_END_STATE (ch);
		  ch = READCHAR;
		}
	      if (! in_file_vars)
895
		/* The value was terminated by an end-marker, which remove.  */
896 897 898 899
		i -= 3;
	      while (i > 0 && (val[i - 1] == ' ' || val[i - 1] == '\t'))
		i--;
	      val[i] = '\0';
900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915

	      if (strcmp (var, "lexical-binding") == 0)
		/* This is it...  */
		{
		  rv = (strcmp (val, "nil") != 0);
		  break;
		}
	    }
	}

      while (ch != '\n' && ch != EOF)
	ch = READCHAR;

      return rv;
    }
}
916

Kenichi Handa's avatar
Kenichi Handa committed
917
/* Value is a version number of byte compiled code if the file
Miles Bader's avatar
Miles Bader committed
918
   associated with file descriptor FD is a compiled Lisp file that's
Kenichi Handa's avatar
Kenichi Handa committed
919 920 921
   safe to load.  Only files compiled with Emacs are safe to load.
   Files compiled with XEmacs can lead to a crash in Fbyte_code
   because of an incompatible change in the byte compiler.  */
922 923

static int
924
safe_to_load_version (int fd)
925 926 927
{
  char buf[512];
  int nbytes, i;
Kenichi Handa's avatar
Kenichi Handa committed
928
  int version = 1;
929 930 931

  /* Read the first few bytes from the file, and look for a line
     specifying the byte compiler version used.  */
932
  nbytes = emacs_read (fd, buf, sizeof buf);