lread.c 137 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 22
/* Tell globals.h to define tables needed by init_obarray.  */
#define DEFINE_SYMBOLS
Jim Blandy's avatar
Jim Blandy committed
23

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

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

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

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

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

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

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

69 70 71 72
/* 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.  */
73
static Lisp_Object read_objects;
74

75
/* File for get_file_char to read from.  Use by load.  */
Jim Blandy's avatar
Jim Blandy committed
76 77
static FILE *instream;

78
/* For use within read-from-string (this reader is non-reentrant!!)  */
79 80 81
static ptrdiff_t read_from_string_index;
static ptrdiff_t read_from_string_index_byte;
static ptrdiff_t read_from_string_limit;
82

83
/* Number of characters read in the current call to Fread or
84
   Fread_from_string.  */
85
static EMACS_INT readchar_count;
86

87
/* This contains the last string skipped with #@.  */
88 89
static char *saved_doc_string;
/* Length of buffer allocated in saved_doc_string.  */
90
static ptrdiff_t saved_doc_string_size;
91
/* Length of actual data in saved_doc_string.  */
92
static ptrdiff_t saved_doc_string_length;
93
/* This is the file position that string came from.  */
94
static file_offset saved_doc_string_position;
95

96 97 98 99 100
/* 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.  */
101
static ptrdiff_t prev_saved_doc_string_size;
102
/* Length of actual data in prev_saved_doc_string.  */
103
static ptrdiff_t prev_saved_doc_string_length;
104
/* This is the file position that string came from.  */
105
static file_offset prev_saved_doc_string_position;
106

107
/* True means inside a new-style backquote
108
   with no surrounding parentheses.
109
   Fread initializes this to false, so we need not specbind it
110
   or worry about what happens to it when there is an error.  */
111
static bool new_backquote_flag;
112 113 114 115

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

Lute Kamstra's avatar
Lute Kamstra committed
116
static Lisp_Object Vloads_in_progress;
117

118 119
static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
                                 Lisp_Object);
Kenichi Handa's avatar
Kenichi Handa committed
120

121
static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool,
122 123
                          Lisp_Object, Lisp_Object,
                          Lisp_Object, Lisp_Object);
Jim Blandy's avatar
Jim Blandy committed
124

Kenichi Handa's avatar
Kenichi Handa committed
125 126 127 128 129 130
/* 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.  */

131 132 133
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
134

Jim Blandy's avatar
Jim Blandy committed
135 136
/* Handle unreading and rereading of characters.
   Write READCHAR to read a character,
Karl Heuer's avatar
Karl Heuer committed
137 138
   UNREAD(c) to unread c to be read again.

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

141
#define READCHAR readchar (readcharfun, NULL)
Jim Blandy's avatar
Jim Blandy committed
142 143
#define UNREAD(c) unreadchar (readcharfun, c)

144 145 146
/* 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
147
/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
Kenichi Handa's avatar
Kenichi Handa committed
148 149
   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
150
   means that there's no unread character.  */
Kenichi Handa's avatar
Kenichi Handa committed
151 152
static int unread_char;

Jim Blandy's avatar
Jim Blandy committed
153
static int
154
readchar (Lisp_Object readcharfun, bool *multibyte)
Jim Blandy's avatar
Jim Blandy committed
155 156
{
  Lisp_Object tem;
157
  register int c;
158
  int (*readbyte) (int, Lisp_Object);
Kenichi Handa's avatar
Kenichi Handa committed
159 160
  unsigned char buf[MAX_MULTIBYTE_LENGTH];
  int i, len;
161
  bool emacs_mule_encoding = 0;
Jim Blandy's avatar
Jim Blandy committed
162

163 164 165
  if (multibyte)
    *multibyte = 0;

166
  readchar_count++;
167

168
  if (BUFFERP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
169
    {
170
      register struct buffer *inbuffer = XBUFFER (readcharfun);
Jim Blandy's avatar
Jim Blandy committed
171

172
      ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
173

174 175 176
      if (! BUFFER_LIVE_P (inbuffer))
	return -1;

177 178
      if (pt_byte >= BUF_ZV_BYTE (inbuffer))
	return -1;
Jim Blandy's avatar
Jim Blandy committed
179

Tom Tromey's avatar
Tom Tromey committed
180
      if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
181
	{
182
	  /* Fetch the character code from the buffer.  */
183 184
	  unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
	  BUF_INC_POS (inbuffer, pt_byte);
185
	  c = STRING_CHAR (p);
186 187
	  if (multibyte)
	    *multibyte = 1;
188 189 190 191
	}
      else
	{
	  c = BUF_FETCH_BYTE (inbuffer, pt_byte);
192
	  if (! ASCII_CHAR_P (c))
Kenichi Handa's avatar
Kenichi Handa committed
193
	    c = BYTE8_TO_CHAR (c);
194
	  pt_byte++;
195
	}
196
      SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
197

198
      return c;
Jim Blandy's avatar
Jim Blandy committed
199
    }
200
  if (MARKERP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
201
    {
202
      register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
Jim Blandy's avatar
Jim Blandy committed
203

204
      ptrdiff_t bytepos = marker_byte_position (readcharfun);
205

206 207
      if (bytepos >= BUF_ZV_BYTE (inbuffer))
	return -1;
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, bytepos);
	  BUF_INC_POS (inbuffer, bytepos);
214
	  c = STRING_CHAR (p);
215 216
	  if (multibyte)
	    *multibyte = 1;
217 218 219 220
	}
      else
	{
	  c = BUF_FETCH_BYTE (inbuffer, bytepos);
221
	  if (! ASCII_CHAR_P (c))
Kenichi Handa's avatar
Kenichi Handa committed
222
	    c = BYTE8_TO_CHAR (c);
223
	  bytepos++;
224 225
	}

226 227 228 229
      XMARKER (readcharfun)->bytepos = bytepos;
      XMARKER (readcharfun)->charpos++;

      return c;
Jim Blandy's avatar
Jim Blandy committed
230
    }
231 232

  if (EQ (readcharfun, Qlambda))
Kenichi Handa's avatar
Kenichi Handa committed
233 234 235 236
    {
      readbyte = readbyte_for_lambda;
      goto read_multibyte;
    }
237

Jim Blandy's avatar
Jim Blandy committed
238
  if (EQ (readcharfun, Qget_file_char))
239
    {
Kenichi Handa's avatar
Kenichi Handa committed
240 241
      readbyte = readbyte_from_file;
      goto read_multibyte;
242
    }
Jim Blandy's avatar
Jim Blandy committed
243

244
  if (STRINGP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
245
    {
246
      if (read_from_string_index >= read_from_string_limit)
Jim Blandy's avatar
Jim Blandy committed
247
	c = -1;
248 249 250 251 252 253 254 255
      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);
	}
256
      else
257 258 259 260 261
	{
	  c = SREF (readcharfun, read_from_string_index_byte);
	  read_from_string_index++;
	  read_from_string_index_byte++;
	}
Jim Blandy's avatar
Jim Blandy committed
262 263 264
      return c;
    }

Kenichi Handa's avatar
Kenichi Handa committed
265 266 267 268 269 270 271 272 273 274 275 276
  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
277

Kenichi Handa's avatar
Kenichi Handa committed
278 279 280 281 282 283
  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
284 285 286

  tem = call0 (readcharfun);

Jim Blandy's avatar
Jim Blandy committed
287
  if (NILP (tem))
Jim Blandy's avatar
Jim Blandy committed
288 289
    return -1;
  return XINT (tem);
Kenichi Handa's avatar
Kenichi Handa committed
290 291 292 293 294 295 296 297 298

 read_multibyte:
  if (unread_char >= 0)
    {
      c = unread_char;
      unread_char = -1;
      return c;
    }
  c = (*readbyte) (-1, readcharfun);
299
  if (c < 0)
300 301 302
    return c;
  if (multibyte)
    *multibyte = 1;
303
  if (ASCII_CHAR_P (c))
Kenichi Handa's avatar
Kenichi Handa committed
304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320
    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;
    }
321
  return STRING_CHAR (buf);
Jim Blandy's avatar
Jim Blandy committed
322 323
}

Stefan Monnier's avatar
Stefan Monnier committed
324 325 326 327
#define FROM_FILE_P(readcharfun)			\
  (EQ (readcharfun, Qget_file_char)			\
   || EQ (readcharfun, Qget_emacs_mule_file_char))

328 329 330
static void
skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
{
Stefan Monnier's avatar
Stefan Monnier committed
331
  if (FROM_FILE_P (readcharfun))
332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350
    {
      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');
    }
}

351 352 353 354 355 356 357 358 359 360 361 362 363
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
364 365 366 367
/* 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
368
unreadchar (Lisp_Object readcharfun, int c)
Jim Blandy's avatar
Jim Blandy committed
369
{
370
  readchar_count--;
371 372 373 374
  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.  */
    ;
375
  else if (BUFFERP (readcharfun))
376
    {
377
      struct buffer *b = XBUFFER (readcharfun);
378 379
      ptrdiff_t charpos = BUF_PT (b);
      ptrdiff_t bytepos = BUF_PT_BYTE (b);
380

Tom Tromey's avatar
Tom Tromey committed
381
      if (! NILP (BVAR (b, enable_multibyte_characters)))
Kenichi Handa's avatar
Kenichi Handa committed
382
	BUF_DEC_POS (b, bytepos);
383
      else
Kenichi Handa's avatar
Kenichi Handa committed
384
	bytepos--;
385

386
      SET_BUF_PT_BOTH (b, charpos - 1, bytepos);
387
    }
388
  else if (MARKERP (readcharfun))
389
    {
390
      struct buffer *b = XMARKER (readcharfun)->buffer;
391
      ptrdiff_t bytepos = XMARKER (readcharfun)->bytepos;
392

Kenichi Handa's avatar
Kenichi Handa committed
393
      XMARKER (readcharfun)->charpos--;
Tom Tromey's avatar
Tom Tromey committed
394
      if (! NILP (BVAR (b, enable_multibyte_characters)))
Kenichi Handa's avatar
Kenichi Handa committed
395
	BUF_DEC_POS (b, bytepos);
396
      else
Kenichi Handa's avatar
Kenichi Handa committed
397
	bytepos--;
398

Kenichi Handa's avatar
Kenichi Handa committed
399
      XMARKER (readcharfun)->bytepos = bytepos;
400
    }
401
  else if (STRINGP (readcharfun))
402 403 404 405 406
    {
      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
407 408 409 410
  else if (CONSP (readcharfun))
    {
      unread_char = c;
    }
411
  else if (EQ (readcharfun, Qlambda))
Kenichi Handa's avatar
Kenichi Handa committed
412 413 414
    {
      unread_char = c;
    }
Stefan Monnier's avatar
Stefan Monnier committed
415
  else if (FROM_FILE_P (readcharfun))
Kenichi Handa's avatar
Kenichi Handa committed
416
    {
417
      unread_char = c;
Kenichi Handa's avatar
Kenichi Handa committed
418
    }
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
    }
  c = DECODE_CHAR (charset, code);
  if (c < 0)
    Fsignal (Qinvalid_read_syntax,
540
	     list1 (build_string ("invalid multibyte form")));
Kenichi Handa's avatar
Kenichi Handa committed
541 542 543 544
  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
  struct timespec 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 602
      struct timespec wait_time = dtotimespec (duration);
      end_time = timespec_add (current_timespec (), wait_time);
603 604
    }

605
  /* Read until we get an acceptable event.  */
606
 retry:
607
  do
608
    val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0,
Karoly Lorentey's avatar
Karoly Lorentey committed
609
		     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 = list1 (val);
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
      enum {
Paul Eggert's avatar
Paul Eggert committed
801
	NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX
802
      } 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
}


927 928 929
/* Callback for record_unwind_protect.  Restore the old load list OLD,
   after loading a file successfully.  */

930