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

3 4
Copyright (C) 1985-1989, 1993-1995, 1997-2013 Free Software Foundation,
Inc.
Jim Blandy's avatar
Jim Blandy committed
5 6 7

This file is part of GNU Emacs.

8
GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
9
it under the terms of the GNU General Public License as published by
10 11
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
12 13 14 15 16 17 18

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
19
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
20 21


Richard M. Stallman's avatar
Richard M. Stallman committed
22
#include <config.h>
Jim Blandy's avatar
Jim Blandy committed
23 24 25 26
#include <stdio.h>
#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"
41
#include "coding.h"
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
42
#include "blockinput.h"
Jim Blandy's avatar
Jim Blandy committed
43

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

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

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

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

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

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

68
/* Hash table read constants.  */
69 70 71 72 73 74 75 76
static Lisp_Object Qhash_table, Qdata;
static Lisp_Object Qtest, Qsize;
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
/* True means READCHAR should read bytes one by one (not character)
Kenichi Handa's avatar
Kenichi Handa committed
100
   when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
101 102
   This is set by read1 temporarily while handling #@NUMBER.  */
static bool load_each_byte;
Kenichi Handa's avatar
Kenichi Handa committed
103

104 105 106
/* List of descriptors now open for Fload.  */
static Lisp_Object load_descriptor_list;

107
/* File for get_file_char to read from.  Use by load.  */
Jim Blandy's avatar
Jim Blandy committed
108 109
static FILE *instream;

110
/* For use within read-from-string (this reader is non-reentrant!!)  */
111 112 113
static ptrdiff_t read_from_string_index;
static ptrdiff_t read_from_string_index_byte;
static ptrdiff_t read_from_string_limit;
114

115
/* Number of characters read in the current call to Fread or
116
   Fread_from_string.  */
117
static EMACS_INT readchar_count;
118

119
/* This contains the last string skipped with #@.  */
120 121
static char *saved_doc_string;
/* Length of buffer allocated in saved_doc_string.  */
122
static ptrdiff_t saved_doc_string_size;
123
/* Length of actual data in saved_doc_string.  */
124
static ptrdiff_t saved_doc_string_length;
125
/* This is the file position that string came from.  */
126
static file_offset saved_doc_string_position;
127

128 129 130 131 132
/* 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.  */
133
static ptrdiff_t prev_saved_doc_string_size;
134
/* Length of actual data in prev_saved_doc_string.  */
135
static ptrdiff_t prev_saved_doc_string_length;
136
/* This is the file position that string came from.  */
137
static file_offset prev_saved_doc_string_position;
138

139
/* True means inside a new-style backquote
140
   with no surrounding parentheses.
141
   Fread initializes this to false, so we need not specbind it
142
   or worry about what happens to it when there is an error.  */
143
static bool new_backquote_flag;
144
static Lisp_Object Qold_style_backquotes;
145 146 147 148

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

Lute Kamstra's avatar
Lute Kamstra committed
149
static Lisp_Object Vloads_in_progress;
150

151 152
static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
                                 Lisp_Object);
Kenichi Handa's avatar
Kenichi Handa committed
153

154
static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool,
155 156 157 158
                          Lisp_Object, Lisp_Object,
                          Lisp_Object, Lisp_Object);
static Lisp_Object load_unwind (Lisp_Object);
static Lisp_Object load_descriptor_unwind (Lisp_Object);
Jim Blandy's avatar
Jim Blandy committed
159

Kenichi Handa's avatar
Kenichi Handa committed
160 161 162 163 164 165
/* 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.  */

166 167 168
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
169

Jim Blandy's avatar
Jim Blandy committed
170 171
/* Handle unreading and rereading of characters.
   Write READCHAR to read a character,
Karl Heuer's avatar
Karl Heuer committed
172 173
   UNREAD(c) to unread c to be read again.

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

176
#define READCHAR readchar (readcharfun, NULL)
Jim Blandy's avatar
Jim Blandy committed
177 178
#define UNREAD(c) unreadchar (readcharfun, c)

179 180 181
/* 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
182
/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
Kenichi Handa's avatar
Kenichi Handa committed
183 184
   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
185
   means that there's no unread character.  */
Kenichi Handa's avatar
Kenichi Handa committed
186 187
static int unread_char;

Jim Blandy's avatar
Jim Blandy committed
188
static int
189
readchar (Lisp_Object readcharfun, bool *multibyte)
Jim Blandy's avatar
Jim Blandy committed
190 191
{
  Lisp_Object tem;
192
  register int c;
193
  int (*readbyte) (int, Lisp_Object);
Kenichi Handa's avatar
Kenichi Handa committed
194 195
  unsigned char buf[MAX_MULTIBYTE_LENGTH];
  int i, len;
196
  bool emacs_mule_encoding = 0;
Jim Blandy's avatar
Jim Blandy committed
197

198 199 200
  if (multibyte)
    *multibyte = 0;

201
  readchar_count++;
202

203
  if (BUFFERP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
204
    {
205
      register struct buffer *inbuffer = XBUFFER (readcharfun);
Jim Blandy's avatar
Jim Blandy committed
206

207
      ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
208

209 210
      if (pt_byte >= BUF_ZV_BYTE (inbuffer))
	return -1;
Jim Blandy's avatar
Jim Blandy committed
211

Tom Tromey's avatar
Tom Tromey committed
212
      if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
213
	{
214
	  /* Fetch the character code from the buffer.  */
215 216
	  unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
	  BUF_INC_POS (inbuffer, pt_byte);
217
	  c = STRING_CHAR (p);
218 219
	  if (multibyte)
	    *multibyte = 1;
220 221 222 223
	}
      else
	{
	  c = BUF_FETCH_BYTE (inbuffer, pt_byte);
Kenichi Handa's avatar
Kenichi Handa committed
224 225
	  if (! ASCII_BYTE_P (c))
	    c = BYTE8_TO_CHAR (c);
226
	  pt_byte++;
227
	}
228
      SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
229

230
      return c;
Jim Blandy's avatar
Jim Blandy committed
231
    }
232
  if (MARKERP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
233
    {
234
      register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
Jim Blandy's avatar
Jim Blandy committed
235

236
      ptrdiff_t bytepos = marker_byte_position (readcharfun);
237

238 239
      if (bytepos >= BUF_ZV_BYTE (inbuffer))
	return -1;
240

Tom Tromey's avatar
Tom Tromey committed
241
      if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
242
	{
243
	  /* Fetch the character code from the buffer.  */
244 245
	  unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
	  BUF_INC_POS (inbuffer, bytepos);
246
	  c = STRING_CHAR (p);
247 248
	  if (multibyte)
	    *multibyte = 1;
249 250 251 252
	}
      else
	{
	  c = BUF_FETCH_BYTE (inbuffer, bytepos);
Kenichi Handa's avatar
Kenichi Handa committed
253 254
	  if (! ASCII_BYTE_P (c))
	    c = BYTE8_TO_CHAR (c);
255
	  bytepos++;
256 257
	}

258 259 260 261
      XMARKER (readcharfun)->bytepos = bytepos;
      XMARKER (readcharfun)->charpos++;

      return c;
Jim Blandy's avatar
Jim Blandy committed
262
    }
263 264

  if (EQ (readcharfun, Qlambda))
Kenichi Handa's avatar
Kenichi Handa committed
265 266 267 268
    {
      readbyte = readbyte_for_lambda;
      goto read_multibyte;
    }
269

Jim Blandy's avatar
Jim Blandy committed
270
  if (EQ (readcharfun, Qget_file_char))
271
    {
Kenichi Handa's avatar
Kenichi Handa committed
272 273
      readbyte = readbyte_from_file;
      goto read_multibyte;
274
    }
Jim Blandy's avatar
Jim Blandy committed
275

276
  if (STRINGP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
277
    {
278
      if (read_from_string_index >= read_from_string_limit)
Jim Blandy's avatar
Jim Blandy committed
279
	c = -1;
280 281 282 283 284 285 286 287
      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);
	}
288
      else
289 290 291 292 293
	{
	  c = SREF (readcharfun, read_from_string_index_byte);
	  read_from_string_index++;
	  read_from_string_index_byte++;
	}
Jim Blandy's avatar
Jim Blandy committed
294 295 296
      return c;
    }

Kenichi Handa's avatar
Kenichi Handa committed
297 298 299 300 301 302 303 304 305 306 307 308
  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
309

Kenichi Handa's avatar
Kenichi Handa committed
310 311 312 313 314 315
  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
316 317 318

  tem = call0 (readcharfun);

Jim Blandy's avatar
Jim Blandy committed
319
  if (NILP (tem))
Jim Blandy's avatar
Jim Blandy committed
320 321
    return -1;
  return XINT (tem);
Kenichi Handa's avatar
Kenichi Handa committed
322 323 324 325 326 327 328 329 330

 read_multibyte:
  if (unread_char >= 0)
    {
      c = unread_char;
      unread_char = -1;
      return c;
    }
  c = (*readbyte) (-1, readcharfun);
331 332 333 334 335
  if (c < 0 || load_each_byte)
    return c;
  if (multibyte)
    *multibyte = 1;
  if (ASCII_BYTE_P (c))
Kenichi Handa's avatar
Kenichi Handa committed
336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352
    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;
    }
353
  return STRING_CHAR (buf);
Jim Blandy's avatar
Jim Blandy committed
354 355 356 357 358 359
}

/* 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
360
unreadchar (Lisp_Object readcharfun, int c)
Jim Blandy's avatar
Jim Blandy committed
361
{
362
  readchar_count--;
363 364 365 366
  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.  */
    ;
367
  else if (BUFFERP (readcharfun))
368
    {
369
      struct buffer *b = XBUFFER (readcharfun);
370 371
      ptrdiff_t charpos = BUF_PT (b);
      ptrdiff_t bytepos = BUF_PT_BYTE (b);
372

Tom Tromey's avatar
Tom Tromey committed
373
      if (! NILP (BVAR (b, enable_multibyte_characters)))
Kenichi Handa's avatar
Kenichi Handa committed
374
	BUF_DEC_POS (b, bytepos);
375
      else
Kenichi Handa's avatar
Kenichi Handa committed
376
	bytepos--;
377

378
      SET_BUF_PT_BOTH (b, charpos - 1, bytepos);
379
    }
380
  else if (MARKERP (readcharfun))
381
    {
382
      struct buffer *b = XMARKER (readcharfun)->buffer;
383
      ptrdiff_t bytepos = XMARKER (readcharfun)->bytepos;
384

Kenichi Handa's avatar
Kenichi Handa committed
385
      XMARKER (readcharfun)->charpos--;
Tom Tromey's avatar
Tom Tromey committed
386
      if (! NILP (BVAR (b, enable_multibyte_characters)))
Kenichi Handa's avatar
Kenichi Handa committed
387
	BUF_DEC_POS (b, bytepos);
388
      else
Kenichi Handa's avatar
Kenichi Handa committed
389
	bytepos--;
390

Kenichi Handa's avatar
Kenichi Handa committed
391
      XMARKER (readcharfun)->bytepos = bytepos;
392
    }
393
  else if (STRINGP (readcharfun))
394 395 396 397 398
    {
      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
399 400 401 402
  else if (CONSP (readcharfun))
    {
      unread_char = c;
    }
403
  else if (EQ (readcharfun, Qlambda))
Kenichi Handa's avatar
Kenichi Handa committed
404 405 406 407 408 409 410
    {
      unread_char = c;
    }
  else if (EQ (readcharfun, Qget_file_char)
	   || EQ (readcharfun, Qget_emacs_mule_file_char))
    {
      if (load_each_byte)
Miles Bader's avatar
Miles Bader committed
411
	{
412
	  block_input ();
Miles Bader's avatar
Miles Bader committed
413
	  ungetc (c, instream);
414
	  unblock_input ();
Miles Bader's avatar
Miles Bader committed
415
	}
Kenichi Handa's avatar
Kenichi Handa committed
416 417 418
      else
	unread_char = c;
    }
Jim Blandy's avatar
Jim Blandy committed
419 420 421 422
  else
    call1 (readcharfun, make_number (c));
}

Kenichi Handa's avatar
Kenichi Handa committed
423
static int
424
readbyte_for_lambda (int c, Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
425 426 427 428 429 430
{
  return read_bytecode_char (c >= 0);
}


static int
431
readbyte_from_file (int c, Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
432 433 434
{
  if (c >= 0)
    {
435
      block_input ();
Kenichi Handa's avatar
Kenichi Handa committed
436
      ungetc (c, instream);
437
      unblock_input ();
Kenichi Handa's avatar
Kenichi Handa committed
438 439 440
      return 0;
    }

441
  block_input ();
Kenichi Handa's avatar
Kenichi Handa committed
442
  c = getc (instream);
Miles Bader's avatar
Miles Bader committed
443

444
  /* Interrupted reads have been observed while reading over the network.  */
Miles Bader's avatar
Miles Bader committed
445 446
  while (c == EOF && ferror (instream) && errno == EINTR)
    {
447
      unblock_input ();
Miles Bader's avatar
Miles Bader committed
448
      QUIT;
449
      block_input ();
Miles Bader's avatar
Miles Bader committed
450
      clearerr (instream);
Miles Bader's avatar
Miles Bader committed
451
      c = getc (instream);
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
452
    }
Miles Bader's avatar
Miles Bader committed
453

454
  unblock_input ();
Miles Bader's avatar
Miles Bader committed
455

Kenichi Handa's avatar
Kenichi Handa committed
456 457 458 459
  return (c == EOF ? -1 : c);
}

static int
460
readbyte_from_string (int c, Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
461 462 463 464 465 466 467 468 469
{
  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
470

Kenichi Handa's avatar
Kenichi Handa committed
471 472 473 474 475 476 477 478 479 480 481 482 483 484 485
  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
486
read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514
{
  /* 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)
    {
515
      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
Kenichi Handa's avatar
Kenichi Handa committed
516 517 518 519 520 521 522
      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)
	{
523
	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
Kenichi Handa's avatar
Kenichi Handa committed
524 525 526 527
	  code = buf[2] & 0x7F;
	}
      else
	{
528
	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
Kenichi Handa's avatar
Kenichi Handa committed
529 530 531 532 533
	  code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
	}
    }
  else
    {
534
      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
Kenichi Handa's avatar
Kenichi Handa committed
535
      code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
Kenichi Handa's avatar
Kenichi Handa committed
536 537 538 539 540 541 542 543 544
    }
  c = DECODE_CHAR (charset, code);
  if (c < 0)
    Fsignal (Qinvalid_read_syntax,
	     Fcons (build_string ("invalid multibyte form"), Qnil));
  return c;
}


545 546 547
static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
                                        Lisp_Object);
static Lisp_Object read0 (Lisp_Object);
548
static Lisp_Object read1 (Lisp_Object, int *, bool);
549

550 551
static Lisp_Object read_list (bool, Lisp_Object);
static Lisp_Object read_vector (Lisp_Object, bool);
552

553 554 555 556 557
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);
558

Jim Blandy's avatar
Jim Blandy committed
559

560
/* Get a character from the tty.  */
Jim Blandy's avatar
Jim Blandy committed
561

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

564
   If NO_SWITCH_FRAME, switch-frame events are stashed
565 566 567
   until we get a character we like, and then stuffed into
   unread_switch_frame.

568
   If ASCII_REQUIRED, check function key events to see
569 570 571
   if the unmodified version of the symbol has a Qascii_character
   property, and use that character, if present.

572 573 574
   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
575 576
   character.

577
   If INPUT_METHOD, invoke the current input method
578 579
   if the character warrants that.

580
   If SECONDS is a number, wait that many seconds for input, and
581
   return Qnil if no input arrives within that time.  */
582

Andreas Schwab's avatar
Andreas Schwab committed
583
static Lisp_Object
584 585
read_filtered_event (bool no_switch_frame, bool ascii_required,
		     bool error_nonascii, bool input_method, Lisp_Object seconds)
586
{
587
  Lisp_Object val, delayed_switch_frame;
588
  EMACS_TIME end_time;
589

590
#ifdef HAVE_WINDOW_SYSTEM
591 592
  if (display_hourglass_p)
    cancel_hourglass ();
593
#endif
594

595
  delayed_switch_frame = Qnil;
596

597 598 599
  /* Compute timeout.  */
  if (NUMBERP (seconds))
    {
600
      double duration = extract_float (seconds);
601
      EMACS_TIME wait_time = EMACS_TIME_FROM_DOUBLE (duration);
602
      end_time = add_emacs_time (current_emacs_time (), wait_time);
603 604
    }

Karoly Lorentey's avatar
Karoly Lorentey committed
605
/* Read until we get an acceptable event.  */
606
 retry:
607
  do
Karoly Lorentey's avatar
Karoly Lorentey committed
608 609
    val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0,
		     NUMBERP (seconds) ? &end_time : NULL);
610
  while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */
611

612
  if (BUFFERP (val))
613 614
    goto retry;

615
  /* switch-frame events are put off until after the next ASCII
Karl Heuer's avatar
Karl Heuer committed
616
     character.  This is better than signaling an error just because
617 618 619 620 621
     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)
622
      && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
623 624 625 626 627
    {
      delayed_switch_frame = val;
      goto retry;
    }

628
  if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
629 630
    {
      /* Convert certain symbols to their ASCII equivalents.  */
631
      if (SYMBOLP (val))
632
	{
633
	  Lisp_Object tem, tem1;
634 635 636 637 638 639 640
	  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))
641
		XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
642 643
	    }
	}
644

645
      /* If we don't have a character now, deal with it appropriately.  */
646
      if (!INTEGERP (val))
647 648 649
	{
	  if (error_nonascii)
	    {
650
	      Vunread_command_events = Fcons (val, Qnil);
651 652 653 654 655 656 657 658 659 660
	      error ("Non-character input-event");
	    }
	  else
	    goto retry;
	}
    }

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

661 662
#if 0

663
#ifdef HAVE_WINDOW_SYSTEM
664 665
  if (display_hourglass_p)
    start_hourglass ();
666
#endif
667 668 669

#endif

670 671 672
  return val;
}

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

679 680
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
681 682
exception, switch-frame events are put off until non-character events
can be read.
683 684 685 686 687 688
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
689 690 691 692 693
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
694
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
695
{
696 697
  Lisp_Object val;

698 699
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
700
  val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
701 702 703

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

Paul Eggert's avatar
Paul Eggert committed
706
DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
707 708 709 710
       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
711 712 713 714 715
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
716
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
717
{
718 719
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
720
  return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
Jim Blandy's avatar
Jim Blandy committed
721 722
}

723
DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
724 725
       doc: /* Read a character from the command input (keyboard or macro).
It is returned as a number.  Non-character events are ignored.
726 727
If the character has modifiers, they are resolved and reflected to the
character code if possible (e.g. C-SPC -> 0).
728 729 730 731

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
732 733 734 735 736
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
737
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
738
{
739 740
  Lisp_Object val;

741 742
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
743

744
  val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
745 746 747

  return (NILP (val) ? Qnil
	  : make_number (char_resolve_modifier_mask (XINT (val))));
Jim Blandy's avatar
Jim Blandy committed
748 749 750
}

DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
751
       doc: /* Don't use this yourself.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
752
  (void)
Jim Blandy's avatar
Jim Blandy committed
753 754
{
  register Lisp_Object val;
755
  block_input ();
756
  XSETINT (val, getc (instream));
757
  unblock_input ();
Jim Blandy's avatar
Jim Blandy committed
758 759
  return val;
}
760 761


762 763 764 765


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

769
static bool
Stefan Monnier's avatar
Stefan Monnier committed
770
lisp_file_lexically_bound_p (Lisp_Object readcharfun)
771 772
{
  int ch = READCHAR;
773 774 775 776 777 778 779 780 781 782 783 784 785

  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
786 787
      /* It is OK to leave the position after a #! line, since
         that is what read1 does.  */
788 789
    }

790 791 792 793 794 795 796 797 798
  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.  */
    {
799
      bool rv = 0;
800 801 802
      enum {
	NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX,
      } beg_end_state = NOMINAL;
803
      bool in_file_vars = 0;
804

805 806 807 808 809 810 811 812 813 814
#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;					\
815 816 817 818 819 820 821 822 823 824 825 826
    }

      /* 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)
	{
827
	  char var[100], val[100];
828
	  unsigned i;
829 830 831 832 833 834 835

	  ch = READCHAR;

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

836
	  i = 0;
837
	  while (ch != ':' && ch != '\n' && ch != EOF && in_file_vars)
838
	    {
839 840
	      if (i < sizeof var - 1)
		var[i++] = ch;
841 842 843
	      UPDATE_BEG_END_STATE (ch);
	      ch = READCHAR;
	    }
844

845
	  /* Stop scanning if no colon was found before end marker.  */
846
	  if (!in_file_vars || ch == '\n' || ch == EOF)
847 848
	    break;

849 850 851
	  while (i > 0 && (var[i - 1] == ' ' || var[i - 1] == '\t'))
	    i--;
	  var[i] = '\0';
852 853 854 855 856 857 858 859 860

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

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

861
	      i = 0;
862 863
	      while (ch != ';' && ch != '\n' && ch != EOF && in_file_vars)
		{
864 865
		  if (i < sizeof val - 1)
		    val[i++] = ch;
866 867 868 869
		  UPDATE_BEG_END_STATE (ch);
		  ch = READCHAR;
		}
	      if (! in_file_vars)
870
		/* The value was terminated by an end-marker, which remove.  */
871 872 873 874
		i -= 3;
	      while (i > 0 && (val[i - 1] == ' ' || val[i - 1] == '\t'))
		i--;
	      val[i] = '\0';
875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890

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

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

      return rv;
    }
}
891

Kenichi Handa's avatar
Kenichi Handa committed
892
/* Value is a version number of byte compiled code if the file
Miles Bader's avatar
Miles Bader committed
893
   associated with file descriptor FD is a compiled Lisp file that's
Kenichi Handa's avatar
Kenichi Handa committed
894 895 896
   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.  */
897 898

static int
899
safe_to_load_version (int fd)
900 901 902
{
  char buf[512];
  int nbytes, i;
Kenichi Handa's avatar
Kenichi Handa committed
903
  int version = 1;
904 905 906

  /* Read the first few bytes from the file, and look for a line
     specifying the byte compiler version used.  */
907
  nbytes = emacs_read (fd, buf, sizeof buf);
908 909 910
  if (nbytes > 0)
    {
      /* Skip to the next newline, skipping over the initial `ELC'
Dave Love's avatar
Dave Love committed
911
	 with NUL bytes following it, but note the version.  */
912
      for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
Dave Love's avatar
Dave Love committed
913
	if (i == 4)
Kenichi Handa's avatar
Kenichi Handa committed
914
	  version = buf[i];
915

916
      if (i >= nbytes
917
	  || fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
918
					      buf + i, nbytes - i) < 0)
919
	version = 0;
920 921 922
    }

  lseek (fd, 0, SEEK_SET);
923
  return version;
924 925 926
}