lread.c 135 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"
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 69 70 71 72 73 74 75
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;
76
Lisp_Object Qvariable_documentation;
77
static Lisp_Object Qascii_character, Qload, Qload_file_name;
78
Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
79 80
static Lisp_Object Qinhibit_file_name_operation;
static Lisp_Object Qeval_buffer_list;
81
Lisp_Object Qlexical_binding;
82
static Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
83

Kenichi Handa's avatar
Kenichi Handa committed
84 85 86 87 88 89
/* 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;

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

92 93 94 95
/* 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.  */
96
static Lisp_Object read_objects;
97

98 99 100
/* List of descriptors now open for Fload.  */
static Lisp_Object load_descriptor_list;

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

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

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

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

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

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

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

Lute Kamstra's avatar
Lute Kamstra committed
143
static Lisp_Object Vloads_in_progress;
144

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

148
static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool,
149 150 151 152
                          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
153

Kenichi Handa's avatar
Kenichi Handa committed
154 155 156 157 158 159
/* 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.  */

160 161 162
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
163

Jim Blandy's avatar
Jim Blandy committed
164 165
/* Handle unreading and rereading of characters.
   Write READCHAR to read a character,
Karl Heuer's avatar
Karl Heuer committed
166 167
   UNREAD(c) to unread c to be read again.

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

170
#define READCHAR readchar (readcharfun, NULL)
Jim Blandy's avatar
Jim Blandy committed
171 172
#define UNREAD(c) unreadchar (readcharfun, c)

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

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

192 193 194
  if (multibyte)
    *multibyte = 0;

195
  readchar_count++;
196

197
  if (BUFFERP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
198
    {
199
      register struct buffer *inbuffer = XBUFFER (readcharfun);
Jim Blandy's avatar
Jim Blandy committed
200

201
      ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
202

203 204 205
      if (! BUFFER_LIVE_P (inbuffer))
	return -1;

206 207
      if (pt_byte >= BUF_ZV_BYTE (inbuffer))
	return -1;
Jim Blandy's avatar
Jim Blandy committed
208

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

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

233
      ptrdiff_t bytepos = marker_byte_position (readcharfun);
234

235 236
      if (bytepos >= BUF_ZV_BYTE (inbuffer))
	return -1;
237

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

255 256 257 258
      XMARKER (readcharfun)->bytepos = bytepos;
      XMARKER (readcharfun)->charpos++;

      return c;
Jim Blandy's avatar
Jim Blandy committed
259
    }
260 261

  if (EQ (readcharfun, Qlambda))
Kenichi Handa's avatar
Kenichi Handa committed
262 263 264 265
    {
      readbyte = readbyte_for_lambda;
      goto read_multibyte;
    }
266

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

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

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

Kenichi Handa's avatar
Kenichi Handa committed
307 308 309 310 311 312
  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
313 314 315

  tem = call0 (readcharfun);

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

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

Stefan Monnier's avatar
Stefan Monnier committed
353 354 355 356
#define FROM_FILE_P(readcharfun)			\
  (EQ (readcharfun, Qget_file_char)			\
   || EQ (readcharfun, Qget_emacs_mule_file_char))

357 358 359
static void
skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
{
Stefan Monnier's avatar
Stefan Monnier committed
360
  if (FROM_FILE_P (readcharfun))
361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379
    {
      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');
    }
}

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

Tom Tromey's avatar
Tom Tromey committed
410
      if (! NILP (BVAR (b, enable_multibyte_characters)))
Kenichi Handa's avatar
Kenichi Handa committed
411
	BUF_DEC_POS (b, bytepos);
412
      else
Kenichi Handa's avatar
Kenichi Handa committed
413
	bytepos--;
414

415
      SET_BUF_PT_BOTH (b, charpos - 1, bytepos);
416
    }
417
  else if (MARKERP (readcharfun))
418
    {
419
      struct buffer *b = XMARKER (readcharfun)->buffer;
420
      ptrdiff_t bytepos = XMARKER (readcharfun)->bytepos;
421

Kenichi Handa's avatar
Kenichi Handa committed
422
      XMARKER (readcharfun)->charpos--;
Tom Tromey's avatar
Tom Tromey committed
423
      if (! NILP (BVAR (b, enable_multibyte_characters)))
Kenichi Handa's avatar
Kenichi Handa committed
424
	BUF_DEC_POS (b, bytepos);
425
      else
Kenichi Handa's avatar
Kenichi Handa committed
426
	bytepos--;
427

Kenichi Handa's avatar
Kenichi Handa committed
428
      XMARKER (readcharfun)->bytepos = bytepos;
429
    }
430
  else if (STRINGP (readcharfun))
431 432 433 434 435
    {
      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
436 437 438 439
  else if (CONSP (readcharfun))
    {
      unread_char = c;
    }
440
  else if (EQ (readcharfun, Qlambda))
Kenichi Handa's avatar
Kenichi Handa committed
441 442 443
    {
      unread_char = c;
    }
Stefan Monnier's avatar
Stefan Monnier committed
444
  else if (FROM_FILE_P (readcharfun))
Kenichi Handa's avatar
Kenichi Handa committed
445
    {
446
      unread_char = c;
Kenichi Handa's avatar
Kenichi Handa committed
447
    }
Jim Blandy's avatar
Jim Blandy committed
448 449 450 451
  else
    call1 (readcharfun, make_number (c));
}

Kenichi Handa's avatar
Kenichi Handa committed
452
static int
453
readbyte_for_lambda (int c, Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
454 455 456 457 458 459
{
  return read_bytecode_char (c >= 0);
}


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

470
  block_input ();
Kenichi Handa's avatar
Kenichi Handa committed
471
  c = getc (instream);
Miles Bader's avatar
Miles Bader committed
472

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

483
  unblock_input ();
Miles Bader's avatar
Miles Bader committed
484

Kenichi Handa's avatar
Kenichi Handa committed
485 486 487 488
  return (c == EOF ? -1 : c);
}

static int
489
readbyte_from_string (int c, Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
490 491 492 493 494 495 496 497 498
{
  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
499

Kenichi Handa's avatar
Kenichi Handa committed
500 501 502 503 504 505 506 507 508 509 510 511 512 513 514
  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
515
read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543
{
  /* 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)
    {
544
      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
Kenichi Handa's avatar
Kenichi Handa committed
545 546 547 548 549 550 551
      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)
	{
552
	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
Kenichi Handa's avatar
Kenichi Handa committed
553 554 555 556
	  code = buf[2] & 0x7F;
	}
      else
	{
557
	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
Kenichi Handa's avatar
Kenichi Handa committed
558 559 560 561 562
	  code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
	}
    }
  else
    {
563
      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
Kenichi Handa's avatar
Kenichi Handa committed
564
      code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
Kenichi Handa's avatar
Kenichi Handa committed
565 566 567 568 569 570 571 572 573
    }
  c = DECODE_CHAR (charset, code);
  if (c < 0)
    Fsignal (Qinvalid_read_syntax,
	     Fcons (build_string ("invalid multibyte form"), Qnil));
  return c;
}


574 575 576
static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
                                        Lisp_Object);
static Lisp_Object read0 (Lisp_Object);
577
static Lisp_Object read1 (Lisp_Object, int *, bool);
578

579 580
static Lisp_Object read_list (bool, Lisp_Object);
static Lisp_Object read_vector (Lisp_Object, bool);
581

582 583 584 585 586
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);
587

Jim Blandy's avatar
Jim Blandy committed
588

589
/* Get a character from the tty.  */
Jim Blandy's avatar
Jim Blandy committed
590

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

593
   If NO_SWITCH_FRAME, switch-frame events are stashed
594 595 596
   until we get a character we like, and then stuffed into
   unread_switch_frame.

597
   If ASCII_REQUIRED, check function key events to see
598 599 600
   if the unmodified version of the symbol has a Qascii_character
   property, and use that character, if present.

601 602 603
   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
604 605
   character.

606
   If INPUT_METHOD, invoke the current input method
607 608
   if the character warrants that.

609
   If SECONDS is a number, wait that many seconds for input, and
610
   return Qnil if no input arrives within that time.  */
611

Andreas Schwab's avatar
Andreas Schwab committed
612
static Lisp_Object
613 614
read_filtered_event (bool no_switch_frame, bool ascii_required,
		     bool error_nonascii, bool input_method, Lisp_Object seconds)
615
{
616
  Lisp_Object val, delayed_switch_frame;
617
  EMACS_TIME end_time;
618

619
#ifdef HAVE_WINDOW_SYSTEM
620 621
  if (display_hourglass_p)
    cancel_hourglass ();
622
#endif
623

624
  delayed_switch_frame = Qnil;
625

626 627 628
  /* Compute timeout.  */
  if (NUMBERP (seconds))
    {
629
      double duration = extract_float (seconds);
630
      EMACS_TIME wait_time = EMACS_TIME_FROM_DOUBLE (duration);
631
      end_time = add_emacs_time (current_emacs_time (), wait_time);
632 633
    }

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

641
  if (BUFFERP (val))
642 643
    goto retry;

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

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

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

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

690 691
#if 0

692
#ifdef HAVE_WINDOW_SYSTEM
693 694
  if (display_hourglass_p)
    start_hourglass ();
695
#endif
696 697 698

#endif

699 700 701
  return val;
}

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

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

727 728
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
729
  val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
730 731 732

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

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

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

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
761 762 763 764 765
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
766
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
767
{
768 769
  Lisp_Object val;

770 771
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
772

773
  val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
774 775 776

  return (NILP (val) ? Qnil
	  : make_number (char_resolve_modifier_mask (XINT (val))));
Jim Blandy's avatar
Jim Blandy committed
777 778 779
}

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


791 792 793 794


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

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

  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
815 816
      /* It is OK to leave the position after a #! line, since
         that is what read1 does.  */
817 818
    }

819 820 821 822 823 824 825 826 827
  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.  */
    {
828
      bool rv = 0;
829 830 831
      enum {
	NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX,
      } beg_end_state = NOMINAL;
832
      bool in_file_vars = 0;
833

834 835 836 837 838 839 840 841 842 843
#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;					\
844 845 846 847 848 849 850 851 852 853 854 855
    }

      /* 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)
	{
856
	  char var[100], val[100];
857
	  unsigned i;
858 859 860 861 862 863 864

	  ch = READCHAR;

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

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

874
	  /* Stop scanning if no colon was found before end marker.  */
875
	  if (!in_file_vars || ch == '\n' || ch == EOF)
876 877
	    break;

878 879 880
	  while (i > 0 && (var[i - 1] == ' ' || var[i - 1] == '\t'))
	    i--;
	  var[i] = '\0';
881 882 883 884 885 886 887 888 889

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

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

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

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

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

      return rv;
    }
}
920

Kenichi Handa's avatar
Kenichi Handa committed
921
/* Value is a version number of byte compiled code if the file
Miles Bader's avatar
Miles Bader committed
922
   associated with file descriptor FD is a compiled Lisp file that's
Kenichi Handa's avatar
Kenichi Handa committed
923 924 925
   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.  */
926 927

static int
928
safe_to_load_version (int fd)
929 930 931
{
  char buf[512];
  int nbytes, i;
Kenichi Handa's avatar
Kenichi Handa committed
932
  int version = 1;
933 934 935

  /* Read the first few bytes from the file, and look for a line
     specifying the byte compiler version used.  */
936
  nbytes = emacs_read (fd, buf, sizeof buf);
937 938 939
  if (nbytes > 0)
    {
      /* Skip to the next newline, skipping over the initial `ELC'
Dave Love's avatar
Dave Love committed
940
	 with NUL bytes following it, but note the version.  */
941
      for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
Dave Love's avatar
Dave Love committed
942
	if (i == 4)
Kenichi Handa's avatar
Kenichi Handa committed
943
	  version = buf[i];
944

Paul Eggert's avatar