HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(scan_lists): Follow coding convention.
[bpt/emacs.git] / src / lread.c
CommitLineData
078e7b4a 1/* Lisp parsing and input streams.
0b5538bd
TTN		 2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
8cabe764 4 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
078e7b4a
JB		 5
6This file is part of GNU Emacs.
7
8GNU Emacs is free software; you can redistribute it and/or modify
9it under the terms of the GNU General Public License as published by
684d6f5b 10the Free Software Foundation; either version 3, or (at your option)
078e7b4a
JB		 11any later version.
12
13GNU Emacs is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17
18You should have received a copy of the GNU General Public License
19along with GNU Emacs; see the file COPYING. If not, write to
4fc5845f
LK		 20the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21Boston, MA 02110-1301, USA. */
078e7b4a
JB		 22
23
98280b76 24#include <config.h>
078e7b4a
JB		 25#include <stdio.h>
26#include <sys/types.h>
27#include <sys/stat.h>
28#include <sys/file.h>
2c1b5dbe 29#include <errno.h>
b3e6f69c 30#include <setjmp.h>
078e7b4a 31#include "lisp.h"
95384e1e 32#include "intervals.h"
078e7b4a 33#include "buffer.h"
1571601b 34#include "character.h"
fe0e03f3 35#include "charset.h"
8792be66 36#include "coding.h"
57bda87a 37#include <epaths.h>
078e7b4a 38#include "commands.h"
e37c0805 39#include "keyboard.h"
428a555e 40#include "frame.h"
7bd279cd 41#include "termhooks.h"
eb191db2 42#include "coding.h"
66cd0949 43#include "blockinput.h"
078e7b4a 44
79051982
RS		 45#ifdef MSDOS
46#if __DJGPP__ < 2
47#include <unistd.h> /* to get X_OK */
48#endif
49#include "msdos.h"
50#endif
51
c1a2f60a
AS		 52#ifdef HAVE_UNISTD_H
53#include <unistd.h>
54#endif
55
078e7b4a
JB		 56#ifndef X_OK
57#define X_OK 01
58#endif
59
078e7b4a 60#include <math.h>
078e7b4a 61
c011e9a5
RS		 62#ifdef HAVE_SETLOCALE
63#include <locale.h>
64#endif /* HAVE_SETLOCALE */
65
bcdec28b
DL		 66#ifdef HAVE_FCNTL_H
67#include <fcntl.h>
68#endif
f7d279f0
RS		 69#ifndef O_RDONLY
70#define O_RDONLY 0
71#endif
72
79cf851c 73#ifdef HAVE_FSEEKO
68c45bf0
PE		 74#define file_offset off_t
75#define file_tell ftello
76#else
77#define file_offset long
78#define file_tell ftell
79#endif
80
03695ace 81#ifndef USE_CRT_DLL
2c1b5dbe 82extern int errno;
03695ace 83#endif
2c1b5dbe 84
8a1f1537 85Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
078e7b4a 86Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
20ea2964 87Lisp_Object Qascii_character, Qload, Qload_file_name;
2b6cae0c 88Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
74549846 89Lisp_Object Qinhibit_file_name_operation;
3f39f996 90Lisp_Object Qeval_buffer_list, Veval_buffer_list;
6bb6da3e 91Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
7bd279cd 92
8792be66
KH		 93/* Used instead of Qget_file_char while loading *.elc files compiled
94 by Emacs 21 or older. */
95static Lisp_Object Qget_emacs_mule_file_char;
96
97static Lisp_Object Qload_force_doc_strings;
98
7bd279cd 99extern Lisp_Object Qevent_symbol_element_mask;
74549846 100extern Lisp_Object Qfile_exists_p;
078e7b4a 101
e0f24100 102/* non-zero if inside `load' */
078e7b4a
JB		 103int load_in_progress;
104
1521a8fa
RS		 105/* Directory in which the sources were found. */
106Lisp_Object Vsource_directory;
107
e61b9b87 108/* Search path and suffixes for files to be loaded. */
971a4293 109Lisp_Object Vload_path, Vload_suffixes, Vload_file_rep_suffixes;
078e7b4a 110
4116ab9f
KH		 111/* File name of user's init file. */
112Lisp_Object Vuser_init_file;
113
ae321d28
RS		 114/* This is the user-visible association list that maps features to
115 lists of defs in their load files. */
116Lisp_Object Vload_history;
117
20ea2964 118/* This is used to build the load history. */
ae321d28
RS		 119Lisp_Object Vcurrent_load_list;
120
4b104c41
RS		 121/* List of files that were preloaded. */
122Lisp_Object Vpreloaded_file_list;
123
20ea2964
RS		 124/* Name of file actually being read by `load'. */
125Lisp_Object Vload_file_name;
126
84a15045
RS		 127/* Function to use for reading, in `load' and friends. */
128Lisp_Object Vload_read_function;
129
4ad679f9
EN		 130/* The association list of objects read with the #n=object form.
131 Each member of the list has the form (n . object), and is used to
132 look up the object for the corresponding #n# construct.
133 It must be set to nil before all top-level calls to read0. */
134Lisp_Object read_objects;
135
b2a30870
RS		 136/* Nonzero means load should forcibly load all dynamic doc strings. */
137static int load_force_doc_strings;
138
94e554db
RS		 139/* Nonzero means read should convert strings to unibyte. */
140static int load_convert_to_unibyte;
141
8792be66
KH		 142/* Nonzero means READCHAR should read bytes one by one (not character)
143 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
144 This is set to 1 by read1 temporarily while handling #@NUMBER. */
145static int load_each_byte;
146
9b33a603 147/* Function to use for loading an Emacs Lisp source file (not
fe0e03f3
KH		 148 compiled) instead of readevalloop. */
149Lisp_Object Vload_source_file_function;
150
1ffcc3b1
DL		 151/* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
152Lisp_Object Vbyte_boolean_vars;
153
abb13b09
CW		 154/* Whether or not to add a `read-positions' property to symbols
155 read. */
156Lisp_Object Vread_with_symbol_positions;
157
158/* List of (SYMBOL . POSITION) accumulated so far. */
159Lisp_Object Vread_symbol_positions_list;
160
d2c6be7f
RS		 161/* List of descriptors now open for Fload. */
162static Lisp_Object load_descriptor_list;
163
b2a30870 164/* File for get_file_char to read from. Use by load. */
078e7b4a
JB		 165static FILE *instream;
166
167/* When nonzero, read conses in pure space */
168static int read_pure;
169
b2a30870 170/* For use within read-from-string (this reader is non-reentrant!!) */
078e7b4a 171static int read_from_string_index;
bed23cb2 172static int read_from_string_index_byte;
078e7b4a 173static int read_from_string_limit;
17634846 174
abb13b09
CW		 175/* Number of characters read in the current call to Fread or
176 Fread_from_string. */
177static int readchar_count;
6f7f43d5 178
c15cfd1f 179/* This contains the last string skipped with #@. */
b2a30870
RS		 180static char *saved_doc_string;
181/* Length of buffer allocated in saved_doc_string. */
182static int saved_doc_string_size;
183/* Length of actual data in saved_doc_string. */
184static int saved_doc_string_length;
185/* This is the file position that string came from. */
68c45bf0 186static file_offset saved_doc_string_position;
b2a30870 187
c15cfd1f
RS		 188/* This contains the previous string skipped with #@.
189 We copy it from saved_doc_string when a new string
190 is put in saved_doc_string. */
191static char *prev_saved_doc_string;
192/* Length of buffer allocated in prev_saved_doc_string. */
193static int prev_saved_doc_string_size;
194/* Length of actual data in prev_saved_doc_string. */
195static int prev_saved_doc_string_length;
196/* This is the file position that string came from. */
68c45bf0 197static file_offset prev_saved_doc_string_position;
c15cfd1f 198
17634846
RS		 199/* Nonzero means inside a new-style backquote
200 with no surrounding parentheses.
201 Fread initializes this to zero, so we need not specbind it
202 or worry about what happens to it when there is an error. */
203static int new_backquote_flag;
1d064697 204static Lisp_Object Vold_style_backquotes, Qold_style_backquotes;
7ee3bd7b
GM		 205
206/* A list of file names for files being loaded in Fload. Used to
207 check for recursive loads. */
208
9942fa0c 209static Lisp_Object Vloads_in_progress;
7ee3bd7b 210
550a625e
GM		 211/* Non-zero means load dangerous compiled Lisp files. */
212
213int load_dangerous_libraries;
214
215/* A regular expression used to detect files compiled with Emacs. */
216
217static Lisp_Object Vbytecomp_version_regexp;
218
8792be66
KH		 219static int read_emacs_mule_char P_ ((int, int (*) (int, Lisp_Object),
220 Lisp_Object));
221
11d89e5d 222static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,
550a625e 223 Lisp_Object (*) (), int,
4c03c46d 224 Lisp_Object, Lisp_Object,
550a625e
GM		 225 Lisp_Object, Lisp_Object));
226static Lisp_Object load_unwind P_ ((Lisp_Object));
227static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));
228
336d4a9c 229static void invalid_syntax P_ ((const char *, int)) NO_RETURN;
2381d38d 230static void end_of_file_error P_ (()) NO_RETURN;
336d4a9c 231
078e7b4a 232\f
8792be66
KH		 233/* Functions that read one byte from the current source READCHARFUN
234 or unreads one byte. If the integer argument C is -1, it returns
235 one read byte, or -1 when there's no more byte in the source. If C
236 is 0 or positive, it unreads C, and the return value is not
237 interesting. */
238
239static int readbyte_for_lambda P_ ((int, Lisp_Object));
240static int readbyte_from_file P_ ((int, Lisp_Object));
241static int readbyte_from_string P_ ((int, Lisp_Object));
242
078e7b4a
JB		 243/* Handle unreading and rereading of characters.
244 Write READCHAR to read a character,
fe0e03f3
KH		 245 UNREAD(c) to unread c to be read again.
246
8792be66 247 These macros correctly read/unread multibyte characters. */
078e7b4a 248
1202434b 249#define READCHAR readchar (readcharfun, NULL)
078e7b4a
JB		 250#define UNREAD(c) unreadchar (readcharfun, c)
251
1202434b
KH		 252/* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
253#define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
254
8792be66 255/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
8f924df7
KH		 256 Qlambda, or a cons, we use this to keep an unread character because
257 a file stream can't handle multibyte-char unreading. The value -1
8792be66
KH		 258 means that there's no unread character. */
259static int unread_char;
260
078e7b4a 261static int
1202434b 262readchar (readcharfun, multibyte)
078e7b4a 263 Lisp_Object readcharfun;
1202434b 264 int *multibyte;
078e7b4a
JB		 265{
266 Lisp_Object tem;
95384e1e 267 register int c;
8792be66
KH		 268 int (*readbyte) P_ ((int, Lisp_Object));
269 unsigned char buf[MAX_MULTIBYTE_LENGTH];
270 int i, len;
271 int emacs_mule_encoding = 0;
078e7b4a 272
1202434b
KH		 273 if (multibyte)
274 *multibyte = 0;
275
abb13b09 276 readchar_count++;
177c0ea7 277
cfff016d 278 if (BUFFERP (readcharfun))
078e7b4a 279 {
bed23cb2 280 register struct buffer *inbuffer = XBUFFER (readcharfun);
078e7b4a 281
bed23cb2 282 int pt_byte = BUF_PT_BYTE (inbuffer);
00a9a935 283
bed23cb2
RS		 284 if (pt_byte >= BUF_ZV_BYTE (inbuffer))
285 return -1;
078e7b4a 286
bed23cb2
RS		 287 if (! NILP (inbuffer->enable_multibyte_characters))
288 {
00a9a935 289 /* Fetch the character code from the buffer. */
bed23cb2
RS		 290 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
291 BUF_INC_POS (inbuffer, pt_byte);
292 c = STRING_CHAR (p, pt_byte - orig_pt_byte);
1202434b
KH		 293 if (multibyte)
294 *multibyte = 1;
bed23cb2
RS		 295 }
296 else
297 {
298 c = BUF_FETCH_BYTE (inbuffer, pt_byte);
8792be66
KH		 299 if (! ASCII_BYTE_P (c))
300 c = BYTE8_TO_CHAR (c);
bed23cb2 301 pt_byte++;
6f7f43d5 302 }
bed23cb2 303 SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
6f7f43d5 304
bed23cb2 305 return c;
078e7b4a 306 }
cfff016d 307 if (MARKERP (readcharfun))
078e7b4a 308 {
bed23cb2 309 register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
078e7b4a 310
bed23cb2 311 int bytepos = marker_byte_position (readcharfun);
00a9a935 312
bed23cb2
RS		 313 if (bytepos >= BUF_ZV_BYTE (inbuffer))
314 return -1;
6f7f43d5 315
bed23cb2
RS		 316 if (! NILP (inbuffer->enable_multibyte_characters))
317 {
00a9a935 318 /* Fetch the character code from the buffer. */
bed23cb2
RS		 319 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
320 BUF_INC_POS (inbuffer, bytepos);
321 c = STRING_CHAR (p, bytepos - orig_bytepos);
1202434b
KH		 322 if (multibyte)
323 *multibyte = 1;
bed23cb2
RS		 324 }
325 else
326 {
327 c = BUF_FETCH_BYTE (inbuffer, bytepos);
8792be66
KH		 328 if (! ASCII_BYTE_P (c))
329 c = BYTE8_TO_CHAR (c);
bed23cb2 330 bytepos++;
6f7f43d5
RS		 331 }
332
bed23cb2
RS		 333 XMARKER (readcharfun)->bytepos = bytepos;
334 XMARKER (readcharfun)->charpos++;
335
336 return c;
078e7b4a 337 }
ad0153e4
RS		 338
339 if (EQ (readcharfun, Qlambda))
8792be66
KH		 340 {
341 readbyte = readbyte_for_lambda;
342 goto read_multibyte;
343 }
ad0153e4 344
078e7b4a 345 if (EQ (readcharfun, Qget_file_char))
2c1b5dbe 346 {
8792be66
KH		 347 readbyte = readbyte_from_file;
348 goto read_multibyte;
2c1b5dbe 349 }
078e7b4a 350
cfff016d 351 if (STRINGP (readcharfun))
078e7b4a 352 {
bed23cb2 353 if (read_from_string_index >= read_from_string_limit)
078e7b4a 354 c = -1;
1202434b
KH		 355 else if (STRING_MULTIBYTE (readcharfun))
356 {
357 if (multibyte)
358 *multibyte = 1;
359 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun,
360 read_from_string_index,
361 read_from_string_index_byte);
362 }
f0354c03 363 else
1202434b
KH		 364 {
365 c = SREF (readcharfun, read_from_string_index_byte);
366 read_from_string_index++;
367 read_from_string_index_byte++;
368 }
078e7b4a
JB		 369 return c;
370 }
371
8792be66
KH		 372 if (CONSP (readcharfun))
373 {
374 /* This is the case that read_vector is reading from a unibyte
375 string that contains a byte sequence previously skipped
376 because of #@NUMBER. The car part of readcharfun is that
377 string, and the cdr part is a value of readcharfun given to
378 read_vector. */
379 readbyte = readbyte_from_string;
380 if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
381 emacs_mule_encoding = 1;
382 goto read_multibyte;
383 }
8f924df7 384
8792be66
KH		 385 if (EQ (readcharfun, Qget_emacs_mule_file_char))
386 {
387 readbyte = readbyte_from_file;
388 emacs_mule_encoding = 1;
389 goto read_multibyte;
390 }
078e7b4a
JB		 391
392 tem = call0 (readcharfun);
393
265a9e55 394 if (NILP (tem))
078e7b4a
JB		 395 return -1;
396 return XINT (tem);
8792be66
KH		 397
398 read_multibyte:
399 if (unread_char >= 0)
400 {
401 c = unread_char;
402 unread_char = -1;
403 return c;
404 }
405 c = (*readbyte) (-1, readcharfun);
1202434b
KH		 406 if (c < 0 || load_each_byte)
407 return c;
408 if (multibyte)
409 *multibyte = 1;
410 if (ASCII_BYTE_P (c))
8792be66
KH		 411 return c;
412 if (emacs_mule_encoding)
413 return read_emacs_mule_char (c, readbyte, readcharfun);
414 i = 0;
415 buf[i++] = c;
416 len = BYTES_BY_CHAR_HEAD (c);
417 while (i < len)
418 {
419 c = (*readbyte) (-1, readcharfun);
420 if (c < 0 || ! TRAILING_CODE_P (c))
421 {
422 while (--i > 1)
423 (*readbyte) (buf[i], readcharfun);
424 return BYTE8_TO_CHAR (buf[0]);
425 }
426 buf[i++] = c;
427 }
428 return STRING_CHAR (buf, i);
078e7b4a
JB		 429}
430
431/* Unread the character C in the way appropriate for the stream READCHARFUN.
432 If the stream is a user function, call it with the char as argument. */
433
434static void
435unreadchar (readcharfun, c)
436 Lisp_Object readcharfun;
437 int c;
438{
abb13b09 439 readchar_count--;
92fddec9
KH		 440 if (c == -1)
441 /* Don't back up the pointer if we're unreading the end-of-input mark,
442 since readchar didn't advance it when we read it. */
443 ;
cfff016d 444 else if (BUFFERP (readcharfun))
d7760ca9 445 {
bed23cb2
RS		 446 struct buffer *b = XBUFFER (readcharfun);
447 int bytepos = BUF_PT_BYTE (b);
d7760ca9 448
8792be66
KH		 449 BUF_PT (b)--;
450 if (! NILP (b->enable_multibyte_characters))
451 BUF_DEC_POS (b, bytepos);
bed23cb2 452 else
8792be66 453 bytepos--;
d7760ca9 454
8792be66 455 BUF_PT_BYTE (b) = bytepos;
d7760ca9 456 }
cfff016d 457 else if (MARKERP (readcharfun))
d7760ca9 458 {
bed23cb2
RS		 459 struct buffer *b = XMARKER (readcharfun)->buffer;
460 int bytepos = XMARKER (readcharfun)->bytepos;
d7760ca9 461
8792be66
KH		 462 XMARKER (readcharfun)->charpos--;
463 if (! NILP (b->enable_multibyte_characters))
464 BUF_DEC_POS (b, bytepos);
bed23cb2 465 else
8792be66 466 bytepos--;
d7760ca9 467
8792be66 468 XMARKER (readcharfun)->bytepos = bytepos;
d7760ca9 469 }
cfff016d 470 else if (STRINGP (readcharfun))
bed23cb2
RS		 471 {
472 read_from_string_index--;
473 read_from_string_index_byte
474 = string_char_to_byte (readcharfun, read_from_string_index);
475 }
8792be66
KH		 476 else if (CONSP (readcharfun))
477 {
478 unread_char = c;
479 }
ad0153e4 480 else if (EQ (readcharfun, Qlambda))
8792be66
KH		 481 {
482 unread_char = c;
483 }
484 else if (EQ (readcharfun, Qget_file_char)
485 || EQ (readcharfun, Qget_emacs_mule_file_char))
486 {
487 if (load_each_byte)
d85d3839
MB		 488 {
489 BLOCK_INPUT;
490 ungetc (c, instream);
491 UNBLOCK_INPUT;
492 }
8792be66
KH		 493 else
494 unread_char = c;
495 }
078e7b4a
JB		 496 else
497 call1 (readcharfun, make_number (c));
498}
499
8792be66
KH		 500static int
501readbyte_for_lambda (c, readcharfun)
502 int c;
503 Lisp_Object readcharfun;
504{
505 return read_bytecode_char (c >= 0);
506}
507
508
509static int
510readbyte_from_file (c, readcharfun)
511 int c;
512 Lisp_Object readcharfun;
513{
514 if (c >= 0)
515 {
66cd0949 516 BLOCK_INPUT;
8792be66 517 ungetc (c, instream);
66cd0949 518 UNBLOCK_INPUT;
8792be66
KH		 519 return 0;
520 }
521
d85d3839 522 BLOCK_INPUT;
8792be66 523 c = getc (instream);
d85d3839 524
8792be66 525#ifdef EINTR
d85d3839
MB		 526 /* Interrupted reads have been observed while reading over the network */
527 while (c == EOF && ferror (instream) && errno == EINTR)
528 {
57cb2e6f 529 UNBLOCK_INPUT;
d85d3839 530 QUIT;
d85d3839 531 BLOCK_INPUT;
57cb2e6f 532 clearerr (instream);
d85d3839 533 c = getc (instream);
66cd0949 534 }
8792be66 535#endif
d85d3839 536
57cb2e6f
MB		 537 UNBLOCK_INPUT;
538
8792be66
KH		 539 return (c == EOF ? -1 : c);
540}
541
542static int
543readbyte_from_string (c, readcharfun)
544 int c;
545 Lisp_Object readcharfun;
546{
547 Lisp_Object string = XCAR (readcharfun);
548
549 if (c >= 0)
550 {
551 read_from_string_index--;
552 read_from_string_index_byte
553 = string_char_to_byte (string, read_from_string_index);
554 }
8f924df7 555
8792be66
KH		 556 if (read_from_string_index >= read_from_string_limit)
557 c = -1;
558 else
559 FETCH_STRING_CHAR_ADVANCE (c, string,
560 read_from_string_index,
561 read_from_string_index_byte);
562 return c;
563}
564
565
566/* Read one non-ASCII character from INSTREAM. The character is
567 encoded in `emacs-mule' and the first byte is already read in
568 C. */
569
570extern char emacs_mule_bytes[256];
571
572static int
573read_emacs_mule_char (c, readbyte, readcharfun)
574 int c;
575 int (*readbyte) P_ ((int, Lisp_Object));
576 Lisp_Object readcharfun;
577{
578 /* Emacs-mule coding uses at most 4-byte for one character. */
579 unsigned char buf[4];
580 int len = emacs_mule_bytes[c];
581 struct charset *charset;
582 int i;
583 unsigned code;
584
585 if (len == 1)
586 /* C is not a valid leading-code of `emacs-mule'. */
587 return BYTE8_TO_CHAR (c);
588
589 i = 0;
590 buf[i++] = c;
591 while (i < len)
592 {
593 c = (*readbyte) (-1, readcharfun);
594 if (c < 0xA0)
595 {
596 while (--i > 1)
597 (*readbyte) (buf[i], readcharfun);
598 return BYTE8_TO_CHAR (buf[0]);
599 }
600 buf[i++] = c;
601 }
602
603 if (len == 2)
604 {
da6b532c 605 charset = emacs_mule_charset[buf[0]];
8792be66
KH		 606 code = buf[1] & 0x7F;
607 }
608 else if (len == 3)
609 {
610 if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
611 || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
612 {
613 charset = emacs_mule_charset[buf[1]];
614 code = buf[2] & 0x7F;
615 }
616 else
617 {
618 charset = emacs_mule_charset[buf[0]];
619 code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
620 }
621 }
622 else
623 {
624 charset = emacs_mule_charset[buf[1]];
8f924df7 625 code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
8792be66
KH		 626 }
627 c = DECODE_CHAR (charset, code);
628 if (c < 0)
629 Fsignal (Qinvalid_read_syntax,
630 Fcons (build_string ("invalid multibyte form"), Qnil));
631 return c;
632}
633
634
abb13b09
CW		 635static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,
636 Lisp_Object));
637static Lisp_Object read0 P_ ((Lisp_Object));
177c0ea7 638static Lisp_Object read1 P_ ((Lisp_Object, int *, int));
abb13b09
CW		 639
640static Lisp_Object read_list P_ ((int, Lisp_Object));
641static Lisp_Object read_vector P_ ((Lisp_Object, int));
abb13b09
CW		 642
643static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object,
644 Lisp_Object));
645static void substitute_object_in_subtree P_ ((Lisp_Object,
646 Lisp_Object));
647static void substitute_in_interval P_ ((INTERVAL, Lisp_Object));
9e062b6c 648
078e7b4a 649\f
bed23cb2 650/* Get a character from the tty. */
078e7b4a 651
f42be754
JB		 652/* Read input events until we get one that's acceptable for our purposes.
653
654 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
655 until we get a character we like, and then stuffed into
656 unread_switch_frame.
657
658 If ASCII_REQUIRED is non-zero, we check function key events to see
659 if the unmodified version of the symbol has a Qascii_character
660 property, and use that character, if present.
661
662 If ERROR_NONASCII is non-zero, we signal an error if the input we
663 get isn't an ASCII character with modifiers. If it's zero but
664 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
bb49a192
RS		 665 character.
666
667 If INPUT_METHOD is nonzero, we invoke the current input method
50e48299
CY		 668 if the character warrants that.
669
670 If SECONDS is a number, we wait that many seconds for input, and
671 return Qnil if no input arrives within that time. */
cc39bc38 672
f42be754 673Lisp_Object
bb49a192 674read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
50e48299 675 input_method, seconds)
bb49a192 676 int no_switch_frame, ascii_required, error_nonascii, input_method;
50e48299 677 Lisp_Object seconds;
f42be754 678{
4332cf50 679 Lisp_Object val, delayed_switch_frame;
50e48299 680 EMACS_TIME end_time;
153a17b7 681
5dbf89bc 682#ifdef HAVE_WINDOW_SYSTEM
df6c90d8
GM		 683 if (display_hourglass_p)
684 cancel_hourglass ();
5dbf89bc 685#endif
177c0ea7 686
153a17b7 687 delayed_switch_frame = Qnil;
f42be754 688
50e48299
CY		 689 /* Compute timeout. */
690 if (NUMBERP (seconds))
691 {
692 EMACS_TIME wait_time;
693 int sec, usec;
51d8b30e 694 double duration = extract_float (seconds);
50e48299
CY		 695
696 sec = (int) duration;
697 usec = (duration - sec) * 1000000;
698 EMACS_GET_TIME (end_time);
699 EMACS_SET_SECS_USECS (wait_time, sec, usec);
700 EMACS_ADD_TIME (end_time, end_time, wait_time);
701 }
702
251bc578 703/* Read until we get an acceptable event. */
f42be754 704 retry:
88852d45 705 do
251bc578
KL		 706 val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0,
707 NUMBERP (seconds) ? &end_time : NULL);
9688ff53 708 while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */
f42be754 709
cfff016d 710 if (BUFFERP (val))
6c82d689
KH		 711 goto retry;
712
f42be754 713 /* switch-frame events are put off until after the next ASCII
8e6208c5 714 character. This is better than signaling an error just because
f42be754
JB		 715 the last characters were typed to a separate minibuffer frame,
716 for example. Eventually, some code which can deal with
717 switch-frame events will read it and process it. */
718 if (no_switch_frame
719 && EVENT_HAS_PARAMETERS (val)
ca77ee45 720 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
f42be754
JB		 721 {
722 delayed_switch_frame = val;
723 goto retry;
724 }
725
50e48299 726 if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
f42be754
JB		 727 {
728 /* Convert certain symbols to their ASCII equivalents. */
cfff016d 729 if (SYMBOLP (val))
f42be754 730 {
95384e1e 731 Lisp_Object tem, tem1;
f42be754
JB		 732 tem = Fget (val, Qevent_symbol_element_mask);
733 if (!NILP (tem))
734 {
735 tem1 = Fget (Fcar (tem), Qascii_character);
736 /* Merge this symbol's modifier bits
737 with the ASCII equivalent of its basic code. */
738 if (!NILP (tem1))
baf69866 739 XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
f42be754
JB		 740 }
741 }
177c0ea7 742
f42be754 743 /* If we don't have a character now, deal with it appropriately. */
cfff016d 744 if (!INTEGERP (val))
f42be754
JB		 745 {
746 if (error_nonascii)
747 {
1ec84625 748 Vunread_command_events = Fcons (val, Qnil);
f42be754
JB		 749 error ("Non-character input-event");
750 }
751 else
752 goto retry;
753 }
754 }
755
756 if (! NILP (delayed_switch_frame))
757 unread_switch_frame = delayed_switch_frame;
758
67868d27
PJ		 759#if 0
760
5dbf89bc 761#ifdef HAVE_WINDOW_SYSTEM
df6c90d8
GM		 762 if (display_hourglass_p)
763 start_hourglass ();
5dbf89bc 764#endif
67868d27
PJ		 765
766#endif
767
f42be754 768 return val;
f42be754
JB		 769}
770
50e48299 771DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
5de38842
PJ		 772 doc: /* Read a character from the command input (keyboard or macro).
773It is returned as a number.
774If the user generates an event which is not a character (i.e. a mouse
775click or function key event), `read-char' signals an error. As an
776exception, switch-frame events are put off until non-ASCII events can
777be read.
778If you want to read non-character events, or ignore them, call
779`read-event' or `read-char-exclusive' instead.
780
781If the optional argument PROMPT is non-nil, display that as a prompt.
782If the optional argument INHERIT-INPUT-METHOD is non-nil and some
783input method is turned on in the current buffer, that input method
50e48299
CY		 784is used for reading a character.
785If the optional argument SECONDS is non-nil, it should be a number
786specifying the maximum number of seconds to wait for input. If no
787input arrives in that time, return nil. SECONDS may be a
788floating-point value. */)
789 (prompt, inherit_input_method, seconds)
790 Lisp_Object prompt, inherit_input_method, seconds;
078e7b4a 791{
bb49a192
RS		 792 if (! NILP (prompt))
793 message_with_string ("%s", prompt, 0);
50e48299 794 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
078e7b4a
JB		 795}
796
50e48299 797DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
5de38842
PJ		 798 doc: /* Read an event object from the input stream.
799If the optional argument PROMPT is non-nil, display that as a prompt.
800If the optional argument INHERIT-INPUT-METHOD is non-nil and some
801input method is turned on in the current buffer, that input method
50e48299
CY		 802is used for reading a character.
803If the optional argument SECONDS is non-nil, it should be a number
804specifying the maximum number of seconds to wait for input. If no
805input arrives in that time, return nil. SECONDS may be a
806floating-point value. */)
807 (prompt, inherit_input_method, seconds)
808 Lisp_Object prompt, inherit_input_method, seconds;
078e7b4a 809{
bb49a192
RS		 810 if (! NILP (prompt))
811 message_with_string ("%s", prompt, 0);
50e48299 812 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
078e7b4a
JB		 813}
814
50e48299 815DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
5de38842
PJ		 816 doc: /* Read a character from the command input (keyboard or macro).
817It is returned as a number. Non-character events are ignored.
818
819If the optional argument PROMPT is non-nil, display that as a prompt.
820If the optional argument INHERIT-INPUT-METHOD is non-nil and some
821input method is turned on in the current buffer, that input method
50e48299
CY		 822is used for reading a character.
823If the optional argument SECONDS is non-nil, it should be a number
824specifying the maximum number of seconds to wait for input. If no
825input arrives in that time, return nil. SECONDS may be a
826floating-point value. */)
827 (prompt, inherit_input_method, seconds)
828 Lisp_Object prompt, inherit_input_method, seconds;
078e7b4a 829{
bb49a192
RS		 830 if (! NILP (prompt))
831 message_with_string ("%s", prompt, 0);
50e48299 832 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
078e7b4a 833}
078e7b4a
JB		 834
835DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
5de38842
PJ		 836 doc: /* Don't use this yourself. */)
837 ()
078e7b4a
JB		 838{
839 register Lisp_Object val;
66cd0949 840 BLOCK_INPUT;
1805de4f 841 XSETINT (val, getc (instream));
66cd0949 842 UNBLOCK_INPUT;
078e7b4a
JB		 843 return val;
844}
da84f340
GM		 845
846
550a625e 847\f
8792be66 848/* Value is a version number of byte compiled code if the file
c73bd236 849 associated with file descriptor FD is a compiled Lisp file that's
8792be66
KH		 850 safe to load. Only files compiled with Emacs are safe to load.
851 Files compiled with XEmacs can lead to a crash in Fbyte_code
852 because of an incompatible change in the byte compiler. */
da84f340
GM		 853
854static int
855safe_to_load_p (fd)
856 int fd;
857{
858 char buf[512];
859 int nbytes, i;
860 int safe_p = 1;
8f924df7 861 int version = 1;
da84f340
GM		 862
863 /* Read the first few bytes from the file, and look for a line
864 specifying the byte compiler version used. */
865 nbytes = emacs_read (fd, buf, sizeof buf - 1);
866 if (nbytes > 0)
867 {
868 buf[nbytes] = '\0';
869
870 /* Skip to the next newline, skipping over the initial `ELC'
1da3b9e4 871 with NUL bytes following it, but note the version. */
da84f340 872 for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
1da3b9e4 873 if (i == 4)
8792be66 874 version = buf[i];
da84f340 875
927f12da
KH		 876 if (i == nbytes
877 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
da84f340
GM		 878 buf + i) < 0)
879 safe_p = 0;
880 }
1da3b9e4
DL		 881 if (safe_p)
882 safe_p = version;
da84f340
GM		 883
884 lseek (fd, 0, SEEK_SET);
885 return safe_p;
886}
887
888
7ee3bd7b
GM		 889/* Callback for record_unwind_protect. Restore the old load list OLD,
890 after loading a file successfully. */
891
892static Lisp_Object
893record_load_unwind (old)
894 Lisp_Object old;
895{
896 return Vloads_in_progress = old;
897}
898
164c8bfe
RS		 899/* This handler function is used via internal_condition_case_1. */
900
901static Lisp_Object
902load_error_handler (data)
903 Lisp_Object data;
904{
905 return Qnil;
906}
7ee3bd7b 907
1d064697
SM		 908static Lisp_Object
909load_warn_old_style_backquotes (file)
910 Lisp_Object file;
911{
912 if (!NILP (Vold_style_backquotes))
913 {
b636b4c1 914 Lisp_Object args[2];
18a4a65e 915 args[0] = build_string ("Loading `%s': old-style backquotes detected!");
1d064697
SM		 916 args[1] = file;
917 Fmessage (2, args);
918 }
919 return Qnil;
920}
921
971a4293
LT		 922DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
923 doc: /* Return the suffixes that `load' should try if a suffix is \
924required.
925This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
926 ()
927{
928 Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext;
929 while (CONSP (suffixes))
930 {
931 Lisp_Object exts = Vload_file_rep_suffixes;
932 suffix = XCAR (suffixes);
933 suffixes = XCDR (suffixes);
934 while (CONSP (exts))
935 {
936 ext = XCAR (exts);
937 exts = XCDR (exts);
938 lst = Fcons (concat2 (suffix, ext), lst);
939 }
940 }
941 return Fnreverse (lst);
942}
943
f0a50954 944DEFUN ("load", Fload, Sload, 1, 5, 0,
5de38842
PJ		 945 doc: /* Execute a file of Lisp code named FILE.
946First try FILE with `.elc' appended, then try with `.el',
971a4293 947then try FILE unmodified (the exact suffixes in the exact order are
88852d45 948determined by `load-suffixes'). Environment variable references in
971a4293 949FILE are replaced with their values by calling `substitute-in-file-name'.
5de38842 950This function searches the directories in `load-path'.
971a4293 951
5de38842 952If optional second arg NOERROR is non-nil,
971a4293 953report no error if FILE doesn't exist.
5de38842 954Print messages at start and end of loading unless
971a4293 955optional third arg NOMESSAGE is non-nil.
5de38842 956If optional fourth arg NOSUFFIX is non-nil, don't try adding
971a4293 957suffixes `.elc' or `.el' to the specified name FILE.
5de38842 958If optional fifth arg MUST-SUFFIX is non-nil, insist on
971a4293
LT		 959the suffix `.elc' or `.el'; don't accept just FILE unless
960it ends in one of those suffixes or includes a directory name.
961
962If this function fails to find a file, it may look for different
963representations of that file before trying another file.
964It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
965to the file name. Emacs uses this feature mainly to find compressed
966versions of files when Auto Compression mode is enabled.
967
968The exact suffixes that this function tries out, in the exact order,
969are given by the value of the variable `load-file-rep-suffixes' if
970NOSUFFIX is non-nil and by the return value of the function
971`get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
972MUST-SUFFIX are nil, this function first tries out the latter suffixes
973and then the former.
0fc213e9
RS		 974
975Loading a file records its definitions, and its `provide' and
976`require' calls, in an element of `load-history' whose
977car is the file name loaded. See `load-history'.
978
971a4293 979Return t if the file exists and loads successfully. */)
5de38842 980 (file, noerror, nomessage, nosuffix, must_suffix)
f0a50954 981 Lisp_Object file, noerror, nomessage, nosuffix, must_suffix;
078e7b4a
JB		 982{
983 register FILE *stream;
984 register int fd = -1;
aed13378 985 int count = SPECPDL_INDEX ();
6bb6da3e
AM		 986 struct gcpro gcpro1, gcpro2, gcpro3;
987 Lisp_Object found, efound, hist_file_name;
04fc68e7
RS		 988 /* 1 means we printed the ".el is newer" message. */
989 int newer = 0;
990 /* 1 means we are loading a compiled file. */
991 int compiled = 0;
c2225d00 992 Lisp_Object handler;
456c67a4 993 int safe_p = 1;
229ba775 994 char *fmode = "r";
6bb6da3e 995 Lisp_Object tmp[2];
8792be66
KH		 996 int version;
997
317073d5 998#ifdef DOS_NT
229ba775 999 fmode = "rt";
317073d5 1000#endif /* DOS_NT */
078e7b4a 1001
b7826503 1002 CHECK_STRING (file);
078e7b4a 1003
c2225d00 1004 /* If file name is magic, call the handler. */
e61b9b87
SM		 1005 /* This shouldn't be necessary any more now that `openp' handles it right.
1006 handler = Ffind_file_name_handler (file, Qload);
1007 if (!NILP (handler))
1008 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
c2225d00 1009
07a0bda3
RS		 1010 /* Do this after the handler to avoid
1011 the need to gcpro noerror, nomessage and nosuffix.
e61b9b87
SM		 1012 (Below here, we care only whether they are nil or not.)
1013 The presence of this call is the result of a historical accident:
6bb6da3e 1014 it used to be in every file-operation and when it got removed
e61b9b87
SM		 1015 everywhere, it accidentally stayed here. Since then, enough people
1016 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1017 that it seemed risky to remove. */
164c8bfe
RS		 1018 if (! NILP (noerror))
1019 {
1020 file = internal_condition_case_1 (Fsubstitute_in_file_name, file,
1021 Qt, load_error_handler);
1022 if (NILP (file))
1023 return Qnil;
1024 }
1025 else
1026 file = Fsubstitute_in_file_name (file);
177c0ea7 1027
07a0bda3 1028
078e7b4a
JB		 1029 /* Avoid weird lossage with null string as arg,
1030 since it would try to load a directory as a Lisp file */
d5db4077 1031 if (SCHARS (file) > 0)
078e7b4a 1032 {
d5db4077 1033 int size = SBYTES (file);
211f7dcd 1034
0fc213e9
RS		 1035 found = Qnil;
1036 GCPRO2 (file, found);
211f7dcd
RS		 1037
1038 if (! NILP (must_suffix))
1039 {
1040 /* Don't insist on adding a suffix if FILE already ends with one. */
1041 if (size > 3
d5db4077 1042 && !strcmp (SDATA (file) + size - 3, ".el"))
211f7dcd
RS		 1043 must_suffix = Qnil;
1044 else if (size > 4
d5db4077 1045 && !strcmp (SDATA (file) + size - 4, ".elc"))
211f7dcd
RS		 1046 must_suffix = Qnil;
1047 /* Don't insist on adding a suffix
1048 if the argument includes a directory name. */
1049 else if (! NILP (Ffile_name_directory (file)))
1050 must_suffix = Qnil;
1051 }
1052
f0a50954 1053 fd = openp (Vload_path, file,
e61b9b87 1054 (!NILP (nosuffix) ? Qnil
971a4293
LT		 1055 : !NILP (must_suffix) ? Fget_load_suffixes ()
1056 : Fappend (2, (tmp[0] = Fget_load_suffixes (),
1057 tmp[1] = Vload_file_rep_suffixes,
e61b9b87 1058 tmp))),
86d00812 1059 &found, Qnil);
5a6e5452 1060 UNGCPRO;
078e7b4a
JB		 1061 }
1062
96dc0f4e 1063 if (fd == -1)
078e7b4a 1064 {
265a9e55 1065 if (NILP (noerror))
336d4a9c
KS		 1066 xsignal2 (Qfile_error, build_string ("Cannot open load file"), file);
1067 return Qnil;
078e7b4a
JB		 1068 }
1069
ba0d1195 1070 /* Tell startup.el whether or not we found the user's init file. */
4116ab9f
KH		 1071 if (EQ (Qt, Vuser_init_file))
1072 Vuser_init_file = found;
1073
96dc0f4e
MB		 1074 /* If FD is -2, that means openp found a magic file. */
1075 if (fd == -2)
74549846 1076 {
5e24a1f7
KH		 1077 if (NILP (Fequal (found, file)))
1078 /* If FOUND is a different file name from FILE,
1079 find its handler even if we have already inhibited
1080 the `load' operation on FILE. */
1081 handler = Ffind_file_name_handler (found, Qt);
1082 else
1083 handler = Ffind_file_name_handler (found, Qload);
1084 if (! NILP (handler))
1085 return call5 (handler, Qload, found, noerror, nomessage, Qt);
74549846
RS		 1086 }
1087
550a625e
GM		 1088 /* Check if we're stuck in a recursive load cycle.
1089
1090 2000-09-21: It's not possible to just check for the file loaded
1091 being a member of Vloads_in_progress. This fails because of the
1092 way the byte compiler currently works; `provide's are not
1093 evaluted, see font-lock.el/jit-lock.el as an example. This
1094 leads to a certain amount of ``normal'' recursion.
1095
1096 Also, just loading a file recursively is not always an error in
1097 the general case; the second load may do something different. */
3ba6fd9a
RS		 1098 {
1099 int count = 0;
1100 Lisp_Object tem;
1101 for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
1102 if (!NILP (Fequal (found, XCAR (tem))))
1103 count++;
1104 if (count > 3)
3fdf12ca
EZ		 1105 {
1106 if (fd >= 0)
1107 emacs_close (fd);
336d4a9c 1108 signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
3fdf12ca 1109 }
3ba6fd9a
RS		 1110 record_unwind_protect (record_load_unwind, Vloads_in_progress);
1111 Vloads_in_progress = Fcons (found, Vloads_in_progress);
1112 }
7ee3bd7b 1113
6bb6da3e
AM		 1114 /* Get the name for load-history. */
1115 hist_file_name = (! NILP (Vpurify_flag)
1116 ? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
1117 tmp[1] = Ffile_name_nondirectory (found),
1118 tmp))
1119 : found) ;
1120
8792be66 1121 version = -1;
1bb9a689 1122
88852d45 1123 /* Check for the presence of old-style quotes and warn about them. */
1d064697
SM		 1124 specbind (Qold_style_backquotes, Qnil);
1125 record_unwind_protect (load_warn_old_style_backquotes, file);
1126
a1c89c0a 1127 if (!bcmp (SDATA (found) + SBYTES (found) - 4,
8792be66
KH		 1128 ".elc", 4)
1129 || (version = safe_to_load_p (fd)) > 0)
96dc0f4e
MB		 1130 /* Load .elc files directly, but not when they are
1131 remote and have no handler! */
078e7b4a 1132 {
96dc0f4e 1133 if (fd != -2)
da84f340 1134 {
96dc0f4e
MB		 1135 struct stat s1, s2;
1136 int result;
da84f340 1137
6bb6da3e 1138 GCPRO3 (file, found, hist_file_name);
0fc213e9 1139
8792be66
KH		 1140 if (version < 0
1141 && ! (version = safe_to_load_p (fd)))
96dc0f4e
MB		 1142 {
1143 safe_p = 0;
1144 if (!load_dangerous_libraries)
e63304b7
DL		 1145 {
1146 if (fd >= 0)
1147 emacs_close (fd);
1148 error ("File `%s' was not compiled in Emacs",
1149 SDATA (found));
1150 }
96dc0f4e
MB		 1151 else if (!NILP (nomessage))
1152 message_with_string ("File `%s' not compiled in Emacs", found, 1);
1153 }
04fc68e7 1154
96dc0f4e
MB		 1155 compiled = 1;
1156
eb191db2
EZ		 1157 efound = ENCODE_FILE (found);
1158
26fbf20b 1159#ifdef DOS_NT
96dc0f4e 1160 fmode = "rb";
26fbf20b 1161#endif /* DOS_NT */
d5db4077 1162 stat ((char *)SDATA (efound), &s1);
a1c89c0a 1163 SSET (efound, SBYTES (efound) - 1, 0);
d5db4077 1164 result = stat ((char *)SDATA (efound), &s2);
a1c89c0a 1165 SSET (efound, SBYTES (efound) - 1, 'c');
eb191db2 1166
96dc0f4e
MB		 1167 if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
1168 {
1169 /* Make the progress messages mention that source is newer. */
1170 newer = 1;
04fc68e7 1171
96dc0f4e 1172 /* If we won't print another message, mention this anyway. */
714d8c39
GM		 1173 if (!NILP (nomessage))
1174 {
0fc213e9
RS		 1175 Lisp_Object msg_file;
1176 msg_file = Fsubstring (found, make_number (0), make_number (-1));
714d8c39 1177 message_with_string ("Source file `%s' newer than byte-compiled file",
0fc213e9 1178 msg_file, 1);
714d8c39 1179 }
96dc0f4e 1180 }
0fc213e9 1181 UNGCPRO;
51ac6f83 1182 }
078e7b4a 1183 }
fe0e03f3
KH		 1184 else
1185 {
1186 /* We are loading a source file (*.el). */
1187 if (!NILP (Vload_source_file_function))
1188 {
7ee3bd7b 1189 Lisp_Object val;
96dc0f4e
MB		 1190
1191 if (fd >= 0)
68c45bf0 1192 emacs_close (fd);
6bb6da3e 1193 val = call4 (Vload_source_file_function, found, hist_file_name,
7ee3bd7b
GM		 1194 NILP (noerror) ? Qnil : Qt,
1195 NILP (nomessage) ? Qnil : Qt);
1196 return unbind_to (count, val);
fe0e03f3
KH		 1197 }
1198 }
078e7b4a 1199
6bb6da3e 1200 GCPRO3 (file, found, hist_file_name);
0fc213e9 1201
229ba775 1202#ifdef WINDOWSNT
68c45bf0 1203 emacs_close (fd);
eb191db2 1204 efound = ENCODE_FILE (found);
d5db4077 1205 stream = fopen ((char *) SDATA (efound), fmode);
229ba775
EZ		 1206#else /* not WINDOWSNT */
1207 stream = fdopen (fd, fmode);
1208#endif /* not WINDOWSNT */
078e7b4a
JB		 1209 if (stream == 0)
1210 {
68c45bf0 1211 emacs_close (fd);
d5db4077 1212 error ("Failure to create stdio stream for %s", SDATA (file));
078e7b4a
JB		 1213 }
1214
4b104c41
RS		 1215 if (! NILP (Vpurify_flag))
1216 Vpreloaded_file_list = Fcons (file, Vpreloaded_file_list);
1217
04fc68e7
RS		 1218 if (NILP (nomessage))
1219 {
da84f340
GM		 1220 if (!safe_p)
1221 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1222 file, 1);
1223 else if (!compiled)
e28552a4 1224 message_with_string ("Loading %s (source)...", file, 1);
db5cae4b 1225 else if (newer)
e28552a4
RS		 1226 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1227 file, 1);
db5cae4b 1228 else /* The typical case; compiled file newer than source file. */
e28552a4 1229 message_with_string ("Loading %s...", file, 1);
04fc68e7 1230 }
078e7b4a 1231
c04d9e70 1232 record_unwind_protect (load_unwind, make_save_value (stream, 0));
d2c6be7f 1233 record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
20ea2964 1234 specbind (Qload_file_name, found);
74549846 1235 specbind (Qinhibit_file_name_operation, Qnil);
d2c6be7f
RS		 1236 load_descriptor_list
1237 = Fcons (make_number (fileno (stream)), load_descriptor_list);
078e7b4a 1238 load_in_progress++;
ab2a47e1 1239 if (! version || version >= 22)
b883cdb2 1240 readevalloop (Qget_file_char, stream, hist_file_name,
6a2bd1a5 1241 Feval, 0, Qnil, Qnil, Qnil, Qnil);
8792be66
KH		 1242 else
1243 {
1244 /* We can't handle a file which was compiled with
1245 byte-compile-dynamic by older version of Emacs. */
1246 specbind (Qload_force_doc_strings, Qt);
b883cdb2 1247 readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, Feval,
768d4533 1248 0, Qnil, Qnil, Qnil, Qnil);
8792be66 1249 }
078e7b4a
JB		 1250 unbind_to (count, Qnil);
1251
6bb6da3e
AM		 1252 /* Run any eval-after-load forms for this file */
1253 if (NILP (Vpurify_flag)
1254 && (!NILP (Ffboundp (Qdo_after_load_evaluation))))
1255 call1 (Qdo_after_load_evaluation, hist_file_name) ;
1256
078e7b4a
JB		 1257 UNGCPRO;
1258
b2a30870
RS		 1259 if (saved_doc_string)
1260 free (saved_doc_string);
1261 saved_doc_string = 0;
1262 saved_doc_string_size = 0;
1263
c15cfd1f 1264 if (prev_saved_doc_string)
3cb65b0e 1265 xfree (prev_saved_doc_string);
c15cfd1f
RS		 1266 prev_saved_doc_string = 0;
1267 prev_saved_doc_string_size = 0;
1268
265a9e55 1269 if (!noninteractive && NILP (nomessage))
04fc68e7 1270 {
da84f340
GM		 1271 if (!safe_p)
1272 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1273 file, 1);
1274 else if (!compiled)
e28552a4 1275 message_with_string ("Loading %s (source)...done", file, 1);
db5cae4b 1276 else if (newer)
e28552a4
RS		 1277 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1278 file, 1);
db5cae4b 1279 else /* The typical case; compiled file newer than source file. */
e28552a4 1280 message_with_string ("Loading %s...done", file, 1);
04fc68e7 1281 }
7ee3bd7b 1282
11810d78
SM		 1283 if (!NILP (Fequal (build_string ("obsolete"),
1284 Ffile_name_nondirectory
1285 (Fdirectory_file_name (Ffile_name_directory (found))))))
1286 message_with_string ("Package %s is obsolete", file, 1);
1287
078e7b4a
JB		 1288 return Qt;
1289}
1290
1291static Lisp_Object
ebfe97a2
KS		 1292load_unwind (arg) /* used as unwind-protect function in load */
1293 Lisp_Object arg;
078e7b4a 1294{
ebfe97a2
KS		 1295 FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
1296 if (stream != NULL)
66cd0949
YM		 1297 {
1298 BLOCK_INPUT;
1299 fclose (stream);
1300 UNBLOCK_INPUT;
1301 }
078e7b4a
JB		 1302 if (--load_in_progress < 0) load_in_progress = 0;
1303 return Qnil;
1304}
1305
d2c6be7f
RS		 1306static Lisp_Object
1307load_descriptor_unwind (oldlist)
1308 Lisp_Object oldlist;
1309{
1310 load_descriptor_list = oldlist;
838abf56 1311 return Qnil;
d2c6be7f
RS		 1312}
1313
1314/* Close all descriptors in use for Floads.
1315 This is used when starting a subprocess. */
1316
1317void
1318close_load_descs ()
1319{
f3849f25 1320#ifndef WINDOWSNT
d2c6be7f 1321 Lisp_Object tail;
9beb8baa 1322 for (tail = load_descriptor_list; CONSP (tail); tail = XCDR (tail))
68c45bf0 1323 emacs_close (XFASTINT (XCAR (tail)));
f3849f25 1324#endif
d2c6be7f 1325}
078e7b4a
JB		 1326\f
1327static int
1328complete_filename_p (pathname)
1329 Lisp_Object pathname;
1330{
4b2dd274 1331 register const unsigned char *s = SDATA (pathname);
317073d5 1332 return (IS_DIRECTORY_SEP (s[0])
d5db4077 1333 || (SCHARS (pathname) > 2
317073d5 1334 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))
078e7b4a
JB		 1335#ifdef VMS
1336 || index (s, ':')
1337#endif /* VMS */
1338 );
1339}
1340
86d00812
SM		 1341DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
1342 doc: /* Search for FILENAME through PATH.
57a131fb 1343Returns the file's name in absolute form, or nil if not found.
86d00812
SM		 1344If SUFFIXES is non-nil, it should be a list of suffixes to append to
1345file name when searching.
1346If non-nil, PREDICATE is used instead of `file-readable-p'.
1347PREDICATE can also be an integer to pass to the access(2) function,
1348in which case file-name-handlers are ignored. */)
1349 (filename, path, suffixes, predicate)
1350 Lisp_Object filename, path, suffixes, predicate;
1351{
1352 Lisp_Object file;
1353 int fd = openp (path, filename, suffixes, &file, predicate);
1354 if (NILP (predicate) && fd > 0)
1355 close (fd);
1356 return file;
1357}
1358
1359
078e7b4a
JB		 1360/* Search for a file whose name is STR, looking in directories
1361 in the Lisp list PATH, and trying suffixes from SUFFIX.
078e7b4a
JB		 1362 On success, returns a file descriptor. On failure, returns -1.
1363
e61b9b87 1364 SUFFIXES is a list of strings containing possible suffixes.
e0f24100 1365 The empty suffix is automatically added if the list is empty.
e61b9b87 1366
86d00812
SM		 1367 PREDICATE non-nil means don't open the files,
1368 just look for one that satisfies the predicate. In this case,
1369 returns 1 on success. The predicate can be a lisp function or
1370 an integer to pass to `access' (in which case file-name-handlers
1371 are ignored).
078e7b4a
JB		 1372
1373 If STOREPTR is nonzero, it points to a slot where the name of
1374 the file actually found should be stored as a Lisp string.
74549846
RS		 1375 nil is stored there on failure.
1376
96dc0f4e 1377 If the file we find is remote, return -2
86d00812 1378 but store the found remote file name in *STOREPTR. */
078e7b4a
JB		 1379
1380int
86d00812 1381openp (path, str, suffixes, storeptr, predicate)
078e7b4a 1382 Lisp_Object path, str;
e61b9b87 1383 Lisp_Object suffixes;
078e7b4a 1384 Lisp_Object *storeptr;
86d00812 1385 Lisp_Object predicate;
078e7b4a
JB		 1386{
1387 register int fd;
1388 int fn_size = 100;
1389 char buf[100];
1390 register char *fn = buf;
1391 int absolute = 0;
1392 int want_size;
74549846 1393 Lisp_Object filename;
078e7b4a 1394 struct stat st;
eb191db2
EZ		 1395 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1396 Lisp_Object string, tail, encoded_fn;
e61b9b87
SM		 1397 int max_suffix_len = 0;
1398
6f8eafd1
SM		 1399 CHECK_STRING (str);
1400
e61b9b87
SM		 1401 for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
1402 {
f5df591a 1403 CHECK_STRING_CAR (tail);
e61b9b87 1404 max_suffix_len = max (max_suffix_len,
d5db4077 1405 SBYTES (XCAR (tail)));
e61b9b87 1406 }
078e7b4a 1407
8b9d426a 1408 string = filename = encoded_fn = Qnil;
eb191db2
EZ		 1409 GCPRO6 (str, string, filename, path, suffixes, encoded_fn);
1410
078e7b4a
JB		 1411 if (storeptr)
1412 *storeptr = Qnil;
1413
1414 if (complete_filename_p (str))
1415 absolute = 1;
1416
e61b9b87 1417 for (; CONSP (path); path = XCDR (path))
078e7b4a 1418 {
e61b9b87 1419 filename = Fexpand_file_name (str, XCAR (path));
078e7b4a
JB		 1420 if (!complete_filename_p (filename))
1421 /* If there are non-absolute elts in PATH (eg ".") */
1422 /* Of course, this could conceivably lose if luser sets
1423 default-directory to be something non-absolute... */
1424 {
1425 filename = Fexpand_file_name (filename, current_buffer->directory);
1426 if (!complete_filename_p (filename))
1427 /* Give up on this path element! */
1428 continue;
1429 }
1430
1431 /* Calculate maximum size of any filename made from
1432 this path element/specified file name and any possible suffix. */
d5db4077 1433 want_size = max_suffix_len + SBYTES (filename) + 1;
078e7b4a
JB		 1434 if (fn_size < want_size)
1435 fn = (char *) alloca (fn_size = 100 + want_size);
1436
078e7b4a 1437 /* Loop over suffixes. */
a74d1c97 1438 for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes;
e61b9b87 1439 CONSP (tail); tail = XCDR (tail))
078e7b4a 1440 {
d5db4077 1441 int lsuffix = SBYTES (XCAR (tail));
74549846 1442 Lisp_Object handler;
eb191db2 1443 int exists;
078e7b4a 1444
c49afcd7
RS		 1445 /* Concatenate path element/specified name with the suffix.
1446 If the directory starts with /:, remove that. */
d5db4077
KR		 1447 if (SCHARS (filename) > 2
1448 && SREF (filename, 0) == '/'
1449 && SREF (filename, 1) == ':')
c49afcd7 1450 {
d5db4077
KR		 1451 strncpy (fn, SDATA (filename) + 2,
1452 SBYTES (filename) - 2);
1453 fn[SBYTES (filename) - 2] = 0;
c49afcd7
RS		 1454 }
1455 else
1456 {
d5db4077
KR		 1457 strncpy (fn, SDATA (filename),
1458 SBYTES (filename));
1459 fn[SBYTES (filename)] = 0;
c49afcd7
RS		 1460 }
1461
078e7b4a 1462 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
d5db4077 1463 strncat (fn, SDATA (XCAR (tail)), lsuffix);
eb191db2 1464
74549846 1465 /* Check that the file exists and is not a directory. */
e61b9b87
SM		 1466 /* We used to only check for handlers on non-absolute file names:
1467 if (absolute)
1468 handler = Qnil;
1469 else
1470 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1471 It's not clear why that was the case and it breaks things like
1472 (load "/bar.el") where the file is actually "/bar.el.gz". */
eb191db2 1473 string = build_string (fn);
4773b8ca 1474 handler = Ffind_file_name_handler (string, Qfile_exists_p);
86d00812
SM		 1475 if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
1476 {
1477 if (NILP (predicate))
1478 exists = !NILP (Ffile_readable_p (string));
1479 else
1480 exists = !NILP (call1 (predicate, string));
eb191db2 1481 if (exists && !NILP (Ffile_directory_p (string)))
74549846
RS		 1482 exists = 0;
1483
1484 if (exists)
078e7b4a
JB		 1485 {
1486 /* We succeeded; return this descriptor and filename. */
1487 if (storeptr)
eb191db2 1488 *storeptr = string;
5ef2a3c0 1489 UNGCPRO;
96dc0f4e 1490 return -2;
74549846
RS		 1491 }
1492 }
1493 else
1494 {
4b2dd274 1495 const char *pfn;
eb191db2
EZ		 1496
1497 encoded_fn = ENCODE_FILE (string);
d5db4077 1498 pfn = SDATA (encoded_fn);
eb191db2
EZ		 1499 exists = (stat (pfn, &st) >= 0
1500 && (st.st_mode & S_IFMT) != S_IFDIR);
74549846
RS		 1501 if (exists)
1502 {
1503 /* Check that we can access or open it. */
86d00812
SM		 1504 if (NATNUMP (predicate))
1505 fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
74549846 1506 else
eb191db2 1507 fd = emacs_open (pfn, O_RDONLY, 0);
74549846
RS		 1508
1509 if (fd >= 0)
1510 {
1511 /* We succeeded; return this descriptor and filename. */
1512 if (storeptr)
eb191db2 1513 *storeptr = string;
74549846
RS		 1514 UNGCPRO;
1515 return fd;
1516 }
078e7b4a
JB		 1517 }
1518 }
078e7b4a 1519 }
5a6e5452 1520 if (absolute)
5ef2a3c0 1521 break;
078e7b4a
JB		 1522 }
1523
5ef2a3c0
KH		 1524 UNGCPRO;
1525 return -1;
078e7b4a
JB		 1526}
1527
1528\f
ae321d28
RS		 1529/* Merge the list we've accumulated of globals from the current input source
1530 into the load_history variable. The details depend on whether
b502a9a1
RS		 1531 the source has an associated file name or not.
1532
1533 FILENAME is the file name that we are loading from.
1534 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
ae321d28
RS		 1535
1536static void
b502a9a1
RS		 1537build_load_history (filename, entire)
1538 Lisp_Object filename;
1539 int entire;
ae321d28
RS		 1540{
1541 register Lisp_Object tail, prev, newelt;
1542 register Lisp_Object tem, tem2;
b502a9a1 1543 register int foundit = 0;
ae321d28
RS		 1544
1545 tail = Vload_history;
1546 prev = Qnil;
b502a9a1 1547
86d00812 1548 while (CONSP (tail))
ae321d28 1549 {
86d00812 1550 tem = XCAR (tail);
ae321d28
RS		 1551
1552 /* Find the feature's previous assoc list... */
b502a9a1 1553 if (!NILP (Fequal (filename, Fcar (tem))))
ae321d28
RS		 1554 {
1555 foundit = 1;
1556
b502a9a1
RS		 1557 /* If we're loading the entire file, remove old data. */
1558 if (entire)
86d00812 1559 {
ae321d28 1560 if (NILP (prev))
86d00812 1561 Vload_history = XCDR (tail);
ae321d28 1562 else
86d00812 1563 Fsetcdr (prev, XCDR (tail));
ae321d28
RS		 1564 }
1565
1566 /* Otherwise, cons on new symbols that are not already members. */
1567 else
1568 {
1569 tem2 = Vcurrent_load_list;
1570
1571 while (CONSP (tem2))
1572 {
86d00812 1573 newelt = XCAR (tem2);
ae321d28 1574
d642e4f9 1575 if (NILP (Fmember (newelt, tem)))
86d00812
SM		 1576 Fsetcar (tail, Fcons (XCAR (tem),
1577 Fcons (newelt, XCDR (tem))));
ae321d28 1578
86d00812 1579 tem2 = XCDR (tem2);
ae321d28
RS		 1580 QUIT;
1581 }
1582 }
1583 }
1584 else
1585 prev = tail;
86d00812 1586 tail = XCDR (tail);
ae321d28
RS		 1587 QUIT;
1588 }
1589
b502a9a1
RS		 1590 /* If we're loading an entire file, cons the new assoc onto the
1591 front of load-history, the most-recently-loaded position. Also
1592 do this if we didn't find an existing member for the file. */
1593 if (entire || !foundit)
8a1f1537
RS		 1594 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
1595 Vload_history);
ae321d28
RS		 1596}
1597
078e7b4a 1598Lisp_Object
232ccf27
DL		 1599unreadpure (junk) /* Used as unwind-protect function in readevalloop */
1600 Lisp_Object junk;
078e7b4a
JB		 1601{
1602 read_pure = 0;
1603 return Qnil;
1604}
1605
94e554db
RS		 1606static Lisp_Object
1607readevalloop_1 (old)
1608 Lisp_Object old;
1609{
1610 load_convert_to_unibyte = ! NILP (old);
1611 return Qnil;
1612}
1613
9c97398c
GM		 1614/* Signal an `end-of-file' error, if possible with file name
1615 information. */
1616
1617static void
1618end_of_file_error ()
1619{
9c97398c 1620 if (STRINGP (Vload_file_name))
336d4a9c 1621 xsignal1 (Qend_of_file, Vload_file_name);
9c97398c 1622
336d4a9c 1623 xsignal0 (Qend_of_file);
9c97398c
GM		 1624}
1625
94e554db 1626/* UNIBYTE specifies how to set load_convert_to_unibyte
976350af 1627 for this invocation.
4c03c46d 1628 READFUN, if non-nil, is used instead of `read'.
1ed7b9ae
RS		 1629
1630 START, END specify region to read in current buffer (from eval-region).
1631 If the input is not from a buffer, they must be nil. */
94e554db 1632
078e7b4a 1633static void
4c03c46d
KS		 1634readevalloop (readcharfun, stream, sourcename, evalfun,
1635 printflag, unibyte, readfun, start, end)
078e7b4a 1636 Lisp_Object readcharfun;
ae321d28
RS		 1637 FILE *stream;
1638 Lisp_Object sourcename;
078e7b4a
JB		 1639 Lisp_Object (*evalfun) ();
1640 int printflag;
976350af 1641 Lisp_Object unibyte, readfun;
4c03c46d 1642 Lisp_Object start, end;
078e7b4a
JB		 1643{
1644 register int c;
1645 register Lisp_Object val;
aed13378 1646 int count = SPECPDL_INDEX ();
0a37f512 1647 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
49cf7ff4 1648 struct buffer *b = 0;
f38952fe 1649 int continue_reading_p;
d11db2c8
RS		 1650 /* Nonzero if reading an entire buffer. */
1651 int whole_buffer = 0;
1652 /* 1 on the first time around. */
1653 int first_sexp = 1;
1654
1655 if (MARKERP (readcharfun))
1656 {
1657 if (NILP (start))
8878319c 1658 start = readcharfun;
d11db2c8 1659 }
49cf7ff4
RS		 1660
1661 if (BUFFERP (readcharfun))
1662 b = XBUFFER (readcharfun);
1663 else if (MARKERP (readcharfun))
1664 b = XMARKER (readcharfun)->buffer;
078e7b4a 1665
1ed7b9ae
RS		 1666 /* We assume START is nil when input is not from a buffer. */
1667 if (! NILP (start) && !b)
1668 abort ();
1669
0a37f512 1670 specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */
8a1f1537 1671 specbind (Qcurrent_load_list, Qnil);
94e554db
RS		 1672 record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
1673 load_convert_to_unibyte = !NILP (unibyte);
078e7b4a 1674
0a37f512 1675 GCPRO4 (sourcename, readfun, start, end);
ae321d28 1676
6bb6da3e
AM		 1677 /* Try to ensure sourcename is a truename, except whilst preloading. */
1678 if (NILP (Vpurify_flag)
91fe9496
SM		 1679 && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))
1680 && !NILP (Ffboundp (Qfile_truename)))
6bb6da3e
AM		 1681 sourcename = call1 (Qfile_truename, sourcename) ;
1682
ae321d28
RS		 1683 LOADHIST_ATTACH (sourcename);
1684
f38952fe
GM		 1685 continue_reading_p = 1;
1686 while (continue_reading_p)
078e7b4a 1687 {
4c03c46d
KS		 1688 int count1 = SPECPDL_INDEX ();
1689
49cf7ff4
RS		 1690 if (b != 0 && NILP (b->name))
1691 error ("Reading from killed buffer");
1692
4c03c46d
KS		 1693 if (!NILP (start))
1694 {
721b7d9e 1695 /* Switch to the buffer we are reading from. */
4c03c46d 1696 record_unwind_protect (save_excursion_restore, save_excursion_save ());
721b7d9e
RS		 1697 set_buffer_internal (b);
1698
1699 /* Save point in it. */
4c03c46d 1700 record_unwind_protect (save_excursion_restore, save_excursion_save ());
721b7d9e 1701 /* Save ZV in it. */
4c03c46d 1702 record_unwind_protect (save_restriction_restore, save_restriction_save ());
721b7d9e
RS		 1703 /* Those get unbound after we read one expression. */
1704
1705 /* Set point and ZV around stuff to be read. */
4c03c46d 1706 Fgoto_char (start);
d11db2c8
RS		 1707 if (!NILP (end))
1708 Fnarrow_to_region (make_number (BEGV), end);
1709
1710 /* Just for cleanliness, convert END to a marker
1711 if it is an integer. */
1712 if (INTEGERP (end))
1713 end = Fpoint_max_marker ();
4c03c46d
KS		 1714 }
1715
d11db2c8
RS		 1716 /* On the first cycle, we can easily test here
1717 whether we are reading the whole buffer. */
1718 if (b && first_sexp)
1719 whole_buffer = (PT == BEG && ZV == Z);
1720
078e7b4a 1721 instream = stream;
4c03c46d 1722 read_next:
078e7b4a
JB		 1723 c = READCHAR;
1724 if (c == ';')
1725 {
1726 while ((c = READCHAR) != '\n' && c != -1);
4c03c46d
KS		 1727 goto read_next;
1728 }
1729 if (c < 0)
1730 {
1731 unbind_to (count1, Qnil);
1732 break;
078e7b4a 1733 }
6069d957
RS		 1734
1735 /* Ignore whitespace here, so we can detect eof. */
adef3de7
RS		 1736 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r'
1737 || c == 0x8a0) /* NBSP */
4c03c46d 1738 goto read_next;
078e7b4a 1739
265a9e55 1740 if (!NILP (Vpurify_flag) && c == '(')
078e7b4a
JB		 1741 {
1742 record_unwind_protect (unreadpure, Qnil);
1743 val = read_list (-1, readcharfun);
078e7b4a
JB		 1744 }
1745 else
1746 {
1747 UNREAD (c);
4ad679f9 1748 read_objects = Qnil;
f38952fe
GM		 1749 if (!NILP (readfun))
1750 {
1751 val = call1 (readfun, readcharfun);
1752
1753 /* If READCHARFUN has set point to ZV, we should
1754 stop reading, even if the form read sets point
1755 to a different value when evaluated. */
1756 if (BUFFERP (readcharfun))
1757 {
1758 struct buffer *b = XBUFFER (readcharfun);
1759 if (BUF_PT (b) == BUF_ZV (b))
1760 continue_reading_p = 0;
1761 }
1762 }
976350af 1763 else if (! NILP (Vload_read_function))
84a15045 1764 val = call1 (Vload_read_function, readcharfun);
976350af 1765 else
abb13b09 1766 val = read_internal_start (readcharfun, Qnil, Qnil);
078e7b4a
JB		 1767 }
1768
4c03c46d
KS		 1769 if (!NILP (start) && continue_reading_p)
1770 start = Fpoint_marker ();
d11db2c8
RS		 1771
1772 /* Restore saved point and BEGV. */
4c03c46d
KS		 1773 unbind_to (count1, Qnil);
1774
d11db2c8 1775 /* Now eval what we just read. */
078e7b4a 1776 val = (*evalfun) (val);
f38952fe 1777
078e7b4a
JB		 1778 if (printflag)
1779 {
1780 Vvalues = Fcons (val, Vvalues);
1781 if (EQ (Vstandard_output, Qt))
1782 Fprin1 (val, Qnil);
1783 else
1784 Fprint (val, Qnil);
1785 }
d11db2c8
RS		 1786
1787 first_sexp = 0;
078e7b4a
JB		 1788 }
1789
8878319c 1790 build_load_history (sourcename,
d11db2c8 1791 stream || whole_buffer);
b502a9a1 1792
ae321d28
RS		 1793 UNGCPRO;
1794
078e7b4a
JB		 1795 unbind_to (count, Qnil);
1796}
1797
1076254d 1798DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
5de38842
PJ		 1799 doc: /* Execute the current buffer as Lisp code.
1800Programs can pass two arguments, BUFFER and PRINTFLAG.
1801BUFFER is the buffer to evaluate (nil means use current buffer).
1802PRINTFLAG controls printing of output:
51d8b30e 1803A value of nil means discard it; anything else is stream for print.
5de38842
PJ		 1804
1805If the optional third argument FILENAME is non-nil,
1806it specifies the file name to use for `load-history'.
1807The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1808for this invocation.
1809
3f9ab804 1810The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
5de38842
PJ		 1811`print' and related functions should work normally even if PRINTFLAG is nil.
1812
1813This function preserves the position of point. */)
1814 (buffer, printflag, filename, unibyte, do_allow_print)
1076254d 1815 Lisp_Object buffer, printflag, filename, unibyte, do_allow_print;
228d4b1c 1816{
aed13378 1817 int count = SPECPDL_INDEX ();
228d4b1c
JA		 1818 Lisp_Object tem, buf;
1819
9391b698 1820 if (NILP (buffer))
228d4b1c
JA		 1821 buf = Fcurrent_buffer ();
1822 else
9391b698 1823 buf = Fget_buffer (buffer);
dfdb645c 1824 if (NILP (buf))
13febd85 1825 error ("No such buffer");
228d4b1c 1826
1076254d 1827 if (NILP (printflag) && NILP (do_allow_print))
228d4b1c
JA		 1828 tem = Qsymbolp;
1829 else
1830 tem = printflag;
13febd85
RS		 1831
1832 if (NILP (filename))
1833 filename = XBUFFER (buf)->filename;
1834
3f39f996 1835 specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
228d4b1c
JA		 1836 specbind (Qstandard_output, tem);
1837 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1838 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
4c03c46d
KS		 1839 readevalloop (buf, 0, filename, Feval,
1840 !NILP (printflag), unibyte, Qnil, Qnil, Qnil);
cb09ab7a 1841 unbind_to (count, Qnil);
228d4b1c
JA		 1842
1843 return Qnil;
1844}
1845
976350af 1846DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r",
5de38842
PJ		 1847 doc: /* Execute the region as Lisp code.
1848When called from programs, expects two arguments,
1849giving starting and ending indices in the current buffer
1850of the text to be executed.
1851Programs can pass third argument PRINTFLAG which controls output:
51d8b30e 1852A value of nil means discard it; anything else is stream for printing it.
5de38842
PJ		 1853Also the fourth argument READ-FUNCTION, if non-nil, is used
1854instead of `read' to read each expression. It gets one argument
1855which is the input stream for reading characters.
1856
1857This function does not move point. */)
1858 (start, end, printflag, read_function)
976350af 1859 Lisp_Object start, end, printflag, read_function;
078e7b4a 1860{
aed13378 1861 int count = SPECPDL_INDEX ();
ae321d28
RS		 1862 Lisp_Object tem, cbuf;
1863
1864 cbuf = Fcurrent_buffer ();
078e7b4a 1865
265a9e55 1866 if (NILP (printflag))
078e7b4a
JB		 1867 tem = Qsymbolp;
1868 else
1869 tem = printflag;
1870 specbind (Qstandard_output, tem);
3f39f996 1871 specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
078e7b4a 1872
4c03c46d 1873 /* readevalloop calls functions which check the type of start and end. */
94e554db 1874 readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval,
4c03c46d
KS		 1875 !NILP (printflag), Qnil, read_function,
1876 start, end);
078e7b4a
JB		 1877
1878 return unbind_to (count, Qnil);
1879}
1880
078e7b4a
JB		 1881\f
1882DEFUN ("read", Fread, Sread, 0, 1, 0,
5de38842
PJ		 1883 doc: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1884If STREAM is nil, use the value of `standard-input' (which see).
1885STREAM or the value of `standard-input' may be:
1886 a buffer (read from point and advance it)
1887 a marker (read from where it points and advance it)
1888 a function (call it with no arguments for each character,
1889 call it with a char as argument to push a char back)
1890 a string (takes text from string, starting at the beginning)
1891 t (read text line using minibuffer and use it, or read from
1892 standard input in batch mode). */)
1893 (stream)
5be02dff 1894 Lisp_Object stream;
078e7b4a 1895{
5be02dff
KH		 1896 if (NILP (stream))
1897 stream = Vstandard_input;
1898 if (EQ (stream, Qt))
1899 stream = Qread_char;
5be02dff 1900 if (EQ (stream, Qread_char))
078e7b4a 1901 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
078e7b4a 1902
abb13b09 1903 return read_internal_start (stream, Qnil, Qnil);
078e7b4a
JB		 1904}
1905
1906DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
5de38842
PJ		 1907 doc: /* Read one Lisp expression which is represented as text by STRING.
1908Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1909START and END optionally delimit a substring of STRING from which to read;
1910 they default to 0 and (length STRING) respectively. */)
1911 (string, start, end)
078e7b4a
JB		 1912 Lisp_Object string, start, end;
1913{
2530ceaf 1914 Lisp_Object ret;
b7826503 1915 CHECK_STRING (string);
2530ceaf
CW		 1916 /* read_internal_start sets read_from_string_index. */
1917 ret = read_internal_start (string, start, end);
5135ab39 1918 return Fcons (ret, make_number (read_from_string_index));
abb13b09 1919}
078e7b4a 1920
abb13b09
CW		 1921/* Function to set up the global context we need in toplevel read
1922 calls. */
1923static Lisp_Object
1924read_internal_start (stream, start, end)
1925 Lisp_Object stream;
1926 Lisp_Object start; /* Only used when stream is a string. */
1927 Lisp_Object end; /* Only used when stream is a string. */
1928{
1929 Lisp_Object retval;
078e7b4a 1930
abb13b09 1931 readchar_count = 0;
17634846 1932 new_backquote_flag = 0;
4ad679f9 1933 read_objects = Qnil;
abb13b09
CW		 1934 if (EQ (Vread_with_symbol_positions, Qt)
1935 || EQ (Vread_with_symbol_positions, stream))
1936 Vread_symbol_positions_list = Qnil;
1937
8f924df7
KH		 1938 if (STRINGP (stream)
1939 || ((CONSP (stream) && STRINGP (XCAR (stream)))))
abb13b09
CW		 1940 {
1941 int startval, endval;
8f924df7 1942 Lisp_Object string;
078e7b4a 1943
8f924df7
KH		 1944 if (STRINGP (stream))
1945 string = stream;
1946 else
1947 string = XCAR (stream);
078e7b4a 1948
abb13b09 1949 if (NILP (end))
8f924df7 1950 endval = SCHARS (string);
abb13b09
CW		 1951 else
1952 {
1953 CHECK_NUMBER (end);
1954 endval = XINT (end);
8f924df7
KH		 1955 if (endval < 0 || endval > SCHARS (string))
1956 args_out_of_range (string, end);
abb13b09 1957 }
17634846 1958
abb13b09
CW		 1959 if (NILP (start))
1960 startval = 0;
1961 else
1962 {
1963 CHECK_NUMBER (start);
1964 startval = XINT (start);
1965 if (startval < 0 || startval > endval)
8f924df7 1966 args_out_of_range (string, start);
abb13b09
CW		 1967 }
1968 read_from_string_index = startval;
8f924df7 1969 read_from_string_index_byte = string_char_to_byte (string, startval);
abb13b09
CW		 1970 read_from_string_limit = endval;
1971 }
177c0ea7 1972
abb13b09
CW		 1973 retval = read0 (stream);
1974 if (EQ (Vread_with_symbol_positions, Qt)
1975 || EQ (Vread_with_symbol_positions, stream))
1976 Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
1977 return retval;
078e7b4a
JB		 1978}
1979\f
336d4a9c
KS		 1980
1981/* Signal Qinvalid_read_syntax error.
1982 S is error string of length N (if > 0) */
1983
1984static void
1985invalid_syntax (s, n)
1986 const char *s;
1987 int n;
1988{
1989 if (!n)
1990 n = strlen (s);
1991 xsignal1 (Qinvalid_read_syntax, make_string (s, n));
1992}
1993
1994
6428369f
KH		 1995/* Use this for recursive reads, in contexts where internal tokens
1996 are not allowed. */
e28552a4 1997
078e7b4a
JB		 1998static Lisp_Object
1999read0 (readcharfun)
2000 Lisp_Object readcharfun;
2001{
2002 register Lisp_Object val;
e28552a4 2003 int c;
078e7b4a 2004
17634846 2005 val = read1 (readcharfun, &c, 0);
336d4a9c
KS		 2006 if (!c)
2007 return val;
078e7b4a 2008
336d4a9c
KS		 2009 xsignal1 (Qinvalid_read_syntax,
2010 Fmake_string (make_number (1), make_number (c)));
078e7b4a
JB		 2011}
2012\f
2013static int read_buffer_size;
2014static char *read_buffer;
2015
f6f79b37 2016/* Read a \-escape sequence, assuming we already read the `\'.
8f924df7 2017 If the escape sequence forces unibyte, return eight-bit char. */
6f7f43d5 2018
078e7b4a 2019static int
8792be66 2020read_escape (readcharfun, stringp)
078e7b4a 2021 Lisp_Object readcharfun;
e7fc914b 2022 int stringp;
078e7b4a
JB		 2023{
2024 register int c = READCHAR;
71b169b8
EZ		 2025 /* \u allows up to four hex digits, \U up to eight. Default to the
2026 behaviour for \u, and change this value in the case that \U is seen. */
2027 int unicode_hex_count = 4;
f6f79b37 2028
078e7b4a
JB		 2029 switch (c)
2030 {
f3849f25 2031 case -1:
da3b886d 2032 end_of_file_error ();
f3849f25 2033
078e7b4a 2034 case 'a':
265a9e55 2035 return '\007';
078e7b4a
JB		 2036 case 'b':
2037 return '\b';
f405a585
RS		 2038 case 'd':
2039 return 0177;
078e7b4a
JB		 2040 case 'e':
2041 return 033;
2042 case 'f':
2043 return '\f';
2044 case 'n':
2045 return '\n';
2046 case 'r':
2047 return '\r';
2048 case 't':
2049 return '\t';
2050 case 'v':
2051 return '\v';
2052 case '\n':
2053 return -1;
e28552a4 2054 case ' ':
e7fc914b
KH		 2055 if (stringp)
2056 return -1;
2057 return ' ';
078e7b4a
JB		 2058
2059 case 'M':
2060 c = READCHAR;
2061 if (c != '-')
2062 error ("Invalid escape character syntax");
2063 c = READCHAR;
2064 if (c == '\\')
8792be66 2065 c = read_escape (readcharfun, 0);
7bd279cd 2066 return c | meta_modifier;
f405a585
RS		 2067
2068 case 'S':
2069 c = READCHAR;
2070 if (c != '-')
2071 error ("Invalid escape character syntax");
2072 c = READCHAR;
2073 if (c == '\\')
8792be66 2074 c = read_escape (readcharfun, 0);
7bd279cd
RS		 2075 return c | shift_modifier;
2076
2077 case 'H':
2078 c = READCHAR;
2079 if (c != '-')
2080 error ("Invalid escape character syntax");
2081 c = READCHAR;
2082 if (c == '\\')
8792be66 2083 c = read_escape (readcharfun, 0);
7bd279cd
RS		 2084 return c | hyper_modifier;
2085
2086 case 'A':
2087 c = READCHAR;
2088 if (c != '-')
2089 error ("Invalid escape character syntax");
2090 c = READCHAR;
2091 if (c == '\\')
8792be66 2092 c = read_escape (readcharfun, 0);
7bd279cd
RS		 2093 return c | alt_modifier;
2094
2095 case 's':
2096 c = READCHAR;
4d7528d0 2097 if (stringp || c != '-')
010b7eac
RS		 2098 {
2099 UNREAD (c);
2100 return ' ';
2101 }
7bd279cd
RS		 2102 c = READCHAR;
2103 if (c == '\\')
8792be66 2104 c = read_escape (readcharfun, 0);
7bd279cd 2105 return c | super_modifier;
078e7b4a
JB		 2106
2107 case 'C':
2108 c = READCHAR;
2109 if (c != '-')
2110 error ("Invalid escape character syntax");
2111 case '^':
2112 c = READCHAR;
2113 if (c == '\\')
8792be66 2114 c = read_escape (readcharfun, 0);
164d590d
KH		 2115 if ((c & ~CHAR_MODIFIER_MASK) == '?')
2116 return 0177 | (c & CHAR_MODIFIER_MASK);
2117 else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
2118 return c | ctrl_modifier;
f405a585
RS		 2119 /* ASCII control chars are made from letters (both cases),
2120 as well as the non-letters within 0100...0137. */
2121 else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
2122 return (c & (037 | ~0177));
2123 else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
2124 return (c & (037 | ~0177));
078e7b4a 2125 else
7bd279cd 2126 return c | ctrl_modifier;
078e7b4a
JB		 2127
2128 case '0':
2129 case '1':
2130 case '2':
2131 case '3':
2132 case '4':
2133 case '5':
2134 case '6':
2135 case '7':
2136 /* An octal escape, as in ANSI C. */
2137 {
2138 register int i = c - '0';
2139 register int count = 0;
2140 while (++count < 3)
2141 {
2142 if ((c = READCHAR) >= '0' && c <= '7')
2143 {
2144 i *= 8;
2145 i += c - '0';
2146 }
2147 else
2148 {
2149 UNREAD (c);
2150 break;
2151 }
2152 }
177c0ea7 2153
8f924df7 2154 if (i >= 0x80 && i < 0x100)
8792be66 2155 i = BYTE8_TO_CHAR (i);
078e7b4a
JB		 2156 return i;
2157 }
2158
2159 case 'x':
2160 /* A hex escape, as in ANSI C. */
2161 {
2162 int i = 0;
1571601b 2163 int count = 0;
078e7b4a
JB		 2164 while (1)
2165 {
2166 c = READCHAR;
2167 if (c >= '0' && c <= '9')
2168 {
2169 i *= 16;
2170 i += c - '0';
2171 }
2172 else if ((c >= 'a' && c <= 'f')
2173 || (c >= 'A' && c <= 'F'))
2174 {
2175 i *= 16;
2176 if (c >= 'a' && c <= 'f')
2177 i += c - 'a' + 10;
2178 else
2179 i += c - 'A' + 10;
2180 }
2181 else
2182 {
2183 UNREAD (c);
2184 break;
2185 }
1571601b 2186 count++;
078e7b4a 2187 }
f6f79b37 2188
1571601b 2189 if (count < 3 && i >= 0x80)
8792be66 2190 return BYTE8_TO_CHAR (i);
078e7b4a
JB		 2191 return i;
2192 }
2193
71b169b8
EZ		 2194 case 'U':
2195 /* Post-Unicode-2.0: Up to eight hex chars. */
2196 unicode_hex_count = 8;
2197 case 'u':
2198
2199 /* A Unicode escape. We only permit them in strings and characters,
2200 not arbitrarily in the source code, as in some other languages. */
2201 {
2202 int i = 0;
2203 int count = 0;
71b169b8
EZ		 2204
2205 while (++count <= unicode_hex_count)
2206 {
2207 c = READCHAR;
a3ac22e4 2208 /* isdigit and isalpha may be locale-specific, which we don't
71b169b8
EZ		 2209 want. */
2210 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
2211 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
2212 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
2213 else
2214 {
2215 error ("Non-hex digit used for Unicode escape");
2216 break;
2217 }
2218 }
2219
7ea7f636 2220 return i;
71b169b8
EZ		 2221 }
2222
078e7b4a
JB		 2223 default:
2224 return c;
2225 }
2226}
2227
bf5d1a17
GM		 2228/* Read an integer in radix RADIX using READCHARFUN to read
2229 characters. RADIX must be in the interval [2..36]; if it isn't, a
2230 read error is signaled . Value is the integer read. Signals an
2231 error if encountering invalid read syntax or if RADIX is out of
2232 range. */
2233
2234static Lisp_Object
2235read_integer (readcharfun, radix)
2236 Lisp_Object readcharfun;
2237 int radix;
2238{
5e37dc22
GM		 2239 int ndigits = 0, invalid_p, c, sign = 0;
2240 EMACS_INT number = 0;
bf5d1a17
GM		 2241
2242 if (radix < 2 || radix > 36)
2243 invalid_p = 1;
2244 else
2245 {
2246 number = ndigits = invalid_p = 0;
2247 sign = 1;
2248
2249 c = READCHAR;
2250 if (c == '-')
2251 {
2252 c = READCHAR;
2253 sign = -1;
2254 }
2255 else if (c == '+')
2256 c = READCHAR;
177c0ea7 2257
bf5d1a17
GM		 2258 while (c >= 0)
2259 {
2260 int digit;
177c0ea7 2261
bf5d1a17
GM		 2262 if (c >= '0' && c <= '9')
2263 digit = c - '0';
2264 else if (c >= 'a' && c <= 'z')
2265 digit = c - 'a' + 10;
2266 else if (c >= 'A' && c <= 'Z')
2267 digit = c - 'A' + 10;
2268 else
b632fa48
GM		 2269 {
2270 UNREAD (c);
2271 break;
2272 }
bf5d1a17
GM		 2273
2274 if (digit < 0 || digit >= radix)
2275 invalid_p = 1;
2276
2277 number = radix * number + digit;
2278 ++ndigits;
2279 c = READCHAR;
2280 }
2281 }
2282
2283 if (ndigits == 0 || invalid_p)
2284 {
2285 char buf[50];
2286 sprintf (buf, "integer, radix %d", radix);
336d4a9c 2287 invalid_syntax (buf, 0);
bf5d1a17
GM		 2288 }
2289
2290 return make_number (sign * number);
2291}
2292
2293
6428369f
KH		 2294/* If the next token is ')' or ']' or '.', we store that character
2295 in *PCH and the return value is not interesting. Else, we store
17634846
RS		 2296 zero in *PCH and we read and return one lisp object.
2297
2298 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2299
078e7b4a 2300static Lisp_Object
17634846 2301read1 (readcharfun, pch, first_in_list)
078e7b4a 2302 register Lisp_Object readcharfun;
e28552a4 2303 int *pch;
17634846 2304 int first_in_list;
078e7b4a
JB		 2305{
2306 register int c;
4ad679f9 2307 int uninterned_symbol = 0;
1202434b 2308 int multibyte;
4ad679f9 2309
6428369f 2310 *pch = 0;
8792be66 2311 load_each_byte = 0;
078e7b4a
JB		 2312
2313 retry:
2314
1202434b 2315 c = READCHAR_REPORT_MULTIBYTE (&multibyte);
9c97398c
GM		 2316 if (c < 0)
2317 end_of_file_error ();
078e7b4a
JB		 2318
2319 switch (c)
2320 {
2321 case '(':
2322 return read_list (0, readcharfun);
2323
2324 case '[':
c15cfd1f 2325 return read_vector (readcharfun, 0);
078e7b4a
JB		 2326
2327 case ')':
2328 case ']':
078e7b4a 2329 {
6428369f
KH		 2330 *pch = c;
2331 return Qnil;
078e7b4a
JB		 2332 }
2333
2334 case '#':
200f684e 2335 c = READCHAR;
c2390933
RS		 2336 if (c == '^')
2337 {
2338 c = READCHAR;
2339 if (c == '[')
2340 {
2341 Lisp_Object tmp;
c15cfd1f 2342 tmp = read_vector (readcharfun, 0);
d10044c5 2343 if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS)
c2390933 2344 error ("Invalid size char-table");
985773c9 2345 XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE);
c2390933
RS		 2346 return tmp;
2347 }
3701b5de
KH		 2348 else if (c == '^')
2349 {
2350 c = READCHAR;
2351 if (c == '[')
2352 {
2353 Lisp_Object tmp;
1571601b 2354 int depth, size;
8f924df7 2355
c15cfd1f 2356 tmp = read_vector (readcharfun, 0);
1571601b
KH		 2357 if (!INTEGERP (AREF (tmp, 0)))
2358 error ("Invalid depth in char-table");
2359 depth = XINT (AREF (tmp, 0));
2360 if (depth < 1 || depth > 3)
2361 error ("Invalid depth in char-table");
41482d36 2362 size = XVECTOR (tmp)->size - 2;
1571601b 2363 if (chartab_size [depth] != size)
3701b5de 2364 error ("Invalid size char-table");
985773c9 2365 XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
3701b5de
KH		 2366 return tmp;
2367 }
336d4a9c 2368 invalid_syntax ("#^^", 3);
3701b5de 2369 }
336d4a9c 2370 invalid_syntax ("#^", 2);
c2390933
RS		 2371 }
2372 if (c == '&')
2373 {
2374 Lisp_Object length;
2375 length = read1 (readcharfun, pch, first_in_list);
2376 c = READCHAR;
2377 if (c == '"')
2378 {
2379 Lisp_Object tmp, val;
d1ca81d9
AS		 2380 int size_in_chars
2381 = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
2382 / BOOL_VECTOR_BITS_PER_CHAR);
c2390933
RS		 2383
2384 UNREAD (c);
2385 tmp = read1 (readcharfun, pch, first_in_list);
8792be66 2386 if (STRING_MULTIBYTE (tmp)
8f924df7 2387 || (size_in_chars != SCHARS (tmp)
8792be66
KH		 2388 /* We used to print 1 char too many
2389 when the number of bits was a multiple of 8.
2390 Accept such input in case it came from an old
2391 version. */
2392 && ! (XFASTINT (length)
327719ee 2393 == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)))
336d4a9c 2394 invalid_syntax ("#&...", 5);
177c0ea7 2395
c2390933 2396 val = Fmake_bool_vector (length, Qnil);
d5db4077 2397 bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
c2390933 2398 size_in_chars);
67d3b149 2399 /* Clear the extraneous bits in the last byte. */
d1ca81d9 2400 if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
67d3b149 2401 XBOOL_VECTOR (val)->data[size_in_chars - 1]
d1ca81d9 2402 &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
c2390933
RS		 2403 return val;
2404 }
336d4a9c 2405 invalid_syntax ("#&...", 5);
c2390933 2406 }
200f684e
RS		 2407 if (c == '[')
2408 {
2409 /* Accept compiled functions at read-time so that we don't have to
2410 build them using function calls. */
748ef62f 2411 Lisp_Object tmp;
c15cfd1f 2412 tmp = read_vector (readcharfun, 1);
748ef62f
RS		 2413 return Fmake_byte_code (XVECTOR (tmp)->size,
2414 XVECTOR (tmp)->contents);
200f684e 2415 }
748ef62f
RS		 2416 if (c == '(')
2417 {
2418 Lisp_Object tmp;
2419 struct gcpro gcpro1;
e28552a4 2420 int ch;
748ef62f
RS		 2421
2422 /* Read the string itself. */
17634846 2423 tmp = read1 (readcharfun, &ch, 0);
6428369f 2424 if (ch != 0 || !STRINGP (tmp))
336d4a9c 2425 invalid_syntax ("#", 1);
748ef62f
RS		 2426 GCPRO1 (tmp);
2427 /* Read the intervals and their properties. */
2428 while (1)
2429 {
2430 Lisp_Object beg, end, plist;
2431
17634846 2432 beg = read1 (readcharfun, &ch, 0);
7ee3bd7b 2433 end = plist = Qnil;
6428369f
KH		 2434 if (ch == ')')
2435 break;
2436 if (ch == 0)
17634846 2437 end = read1 (readcharfun, &ch, 0);
6428369f 2438 if (ch == 0)
17634846 2439 plist = read1 (readcharfun, &ch, 0);
6428369f 2440 if (ch)
336d4a9c 2441 invalid_syntax ("Invalid string property list", 0);
748ef62f
RS		 2442 Fset_text_properties (beg, end, plist, tmp);
2443 }
2444 UNGCPRO;
2445 return tmp;
2446 }
177c0ea7 2447
20ea2964
RS		 2448 /* #@NUMBER is used to skip NUMBER following characters.
2449 That's used in .elc files to skip over doc strings
2450 and function definitions. */
2451 if (c == '@')
2452 {
2453 int i, nskip = 0;
2454
8792be66 2455 load_each_byte = 1;
20ea2964
RS		 2456 /* Read a decimal integer. */
2457 while ((c = READCHAR) >= 0
2458 && c >= '0' && c <= '9')
2459 {
2460 nskip *= 10;
2461 nskip += c - '0';
2462 }
2463 if (c >= 0)
2464 UNREAD (c);
177c0ea7 2465
8792be66
KH		 2466 if (load_force_doc_strings
2467 && (EQ (readcharfun, Qget_file_char)
2468 || EQ (readcharfun, Qget_emacs_mule_file_char)))
b2a30870
RS		 2469 {
2470 /* If we are supposed to force doc strings into core right now,
2471 record the last string that we skipped,
2472 and record where in the file it comes from. */
c15cfd1f
RS		 2473
2474 /* But first exchange saved_doc_string
2475 with prev_saved_doc_string, so we save two strings. */
2476 {
2477 char *temp = saved_doc_string;
2478 int temp_size = saved_doc_string_size;
68c45bf0 2479 file_offset temp_pos = saved_doc_string_position;
c15cfd1f
RS		 2480 int temp_len = saved_doc_string_length;
2481
2482 saved_doc_string = prev_saved_doc_string;
2483 saved_doc_string_size = prev_saved_doc_string_size;
2484 saved_doc_string_position = prev_saved_doc_string_position;
2485 saved_doc_string_length = prev_saved_doc_string_length;
2486
2487 prev_saved_doc_string = temp;
2488 prev_saved_doc_string_size = temp_size;
2489 prev_saved_doc_string_position = temp_pos;
2490 prev_saved_doc_string_length = temp_len;
2491 }
2492
b2a30870
RS		 2493 if (saved_doc_string_size == 0)
2494 {
2495 saved_doc_string_size = nskip + 100;
11938f10 2496 saved_doc_string = (char *) xmalloc (saved_doc_string_size);
b2a30870
RS		 2497 }
2498 if (nskip > saved_doc_string_size)
2499 {
2500 saved_doc_string_size = nskip + 100;
11938f10
KH		 2501 saved_doc_string = (char *) xrealloc (saved_doc_string,
2502 saved_doc_string_size);
b2a30870
RS		 2503 }
2504
68c45bf0 2505 saved_doc_string_position = file_tell (instream);
b2a30870
RS		 2506
2507 /* Copy that many characters into saved_doc_string. */
2508 for (i = 0; i < nskip && c >= 0; i++)
2509 saved_doc_string[i] = c = READCHAR;
2510
2511 saved_doc_string_length = i;
2512 }
2513 else
b2a30870
RS		 2514 {
2515 /* Skip that many characters. */
2516 for (i = 0; i < nskip && c >= 0; i++)
2517 c = READCHAR;
2518 }
d49f0c1a 2519
8792be66 2520 load_each_byte = 0;
20ea2964
RS		 2521 goto retry;
2522 }
e2518d02
RS		 2523 if (c == '!')
2524 {
2525 /* #! appears at the beginning of an executable file.
2526 Skip the first line. */
225c7a07 2527 while (c != '\n' && c >= 0)
e2518d02
RS		 2528 c = READCHAR;
2529 goto retry;
2530 }
20ea2964
RS		 2531 if (c == '$')
2532 return Vload_file_name;
2b6cae0c
RS		 2533 if (c == '\'')
2534 return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil));
4ad679f9
EN		 2535 /* #:foo is the uninterned symbol named foo. */
2536 if (c == ':')
2537 {
2538 uninterned_symbol = 1;
2539 c = READCHAR;
2540 goto default_label;
2541 }
2542 /* Reader forms that can reuse previously read objects. */
2543 if (c >= '0' && c <= '9')
2544 {
2545 int n = 0;
2546 Lisp_Object tem;
2b6cae0c 2547
4ad679f9
EN		 2548 /* Read a non-negative integer. */
2549 while (c >= '0' && c <= '9')
2550 {
2551 n *= 10;
2552 n += c - '0';
2553 c = READCHAR;
2554 }
2555 /* #n=object returns object, but associates it with n for #n#. */
2556 if (c == '=')
2557 {
9e062b6c
RS		 2558 /* Make a placeholder for #n# to use temporarily */
2559 Lisp_Object placeholder;
2560 Lisp_Object cell;
2561
2562 placeholder = Fcons(Qnil, Qnil);
2563 cell = Fcons (make_number (n), placeholder);
2564 read_objects = Fcons (cell, read_objects);
2565
2566 /* Read the object itself. */
4ad679f9 2567 tem = read0 (readcharfun);
9e062b6c
RS		 2568
2569 /* Now put it everywhere the placeholder was... */
2570 substitute_object_in_subtree (tem, placeholder);
2571
2572 /* ...and #n# will use the real value from now on. */
2573 Fsetcdr (cell, tem);
177c0ea7 2574
4ad679f9
EN		 2575 return tem;
2576 }
2577 /* #n# returns a previously read object. */
2578 if (c == '#')
2579 {
2580 tem = Fassq (make_number (n), read_objects);
2581 if (CONSP (tem))
2582 return XCDR (tem);
2583 /* Fall through to error message. */
2584 }
bf5d1a17
GM		 2585 else if (c == 'r' || c == 'R')
2586 return read_integer (readcharfun, n);
177c0ea7 2587
4ad679f9
EN		 2588 /* Fall through to error message. */
2589 }
bf5d1a17
GM		 2590 else if (c == 'x' || c == 'X')
2591 return read_integer (readcharfun, 16);
2592 else if (c == 'o' || c == 'O')
2593 return read_integer (readcharfun, 8);
2594 else if (c == 'b' || c == 'B')
2595 return read_integer (readcharfun, 2);
20ea2964 2596
200f684e 2597 UNREAD (c);
336d4a9c 2598 invalid_syntax ("#", 1);
078e7b4a
JB		 2599
2600 case ';':
2601 while ((c = READCHAR) >= 0 && c != '\n');
2602 goto retry;
2603
2604 case '\'':
2605 {
2606 return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
2607 }
2608
17634846
RS		 2609 case '`':
2610 if (first_in_list)
9ecb827b
SM		 2611 {
2612 Vold_style_backquotes = Qt;
2613 goto default_label;
2614 }
17634846
RS		 2615 else
2616 {
2617 Lisp_Object value;
2618
0ffbbdeb 2619 new_backquote_flag++;
17634846 2620 value = read0 (readcharfun);
0ffbbdeb 2621 new_backquote_flag--;
17634846
RS		 2622
2623 return Fcons (Qbackquote, Fcons (value, Qnil));
2624 }
2625
2626 case ',':
2627 if (new_backquote_flag)
2628 {
2629 Lisp_Object comma_type = Qnil;
2630 Lisp_Object value;
2631 int ch = READCHAR;
2632
2633 if (ch == '@')
2634 comma_type = Qcomma_at;
2635 else if (ch == '.')
2636 comma_type = Qcomma_dot;
2637 else
2638 {
2639 if (ch >= 0) UNREAD (ch);
2640 comma_type = Qcomma;
2641 }
2642
0ffbbdeb 2643 new_backquote_flag--;
17634846 2644 value = read0 (readcharfun);
0ffbbdeb 2645 new_backquote_flag++;
17634846
RS		 2646 return Fcons (comma_type, Fcons (value, Qnil));
2647 }
2648 else
9ecb827b
SM		 2649 {
2650 Vold_style_backquotes = Qt;
2651 goto default_label;
2652 }
17634846 2653
078e7b4a
JB		 2654 case '?':
2655 {
8792be66 2656 int modifiers;
df9c2be7
KS		 2657 int next_char;
2658 int ok;
f6f79b37 2659
078e7b4a 2660 c = READCHAR;
9c97398c
GM		 2661 if (c < 0)
2662 end_of_file_error ();
078e7b4a 2663
b9284371
KS		 2664 /* Accept `single space' syntax like (list ? x) where the
2665 whitespace character is SPC or TAB.
2666 Other literal whitespace like NL, CR, and FF are not accepted,
2667 as there are well-established escape sequences for these. */
2668 if (c == ' ' || c == '\t')
2669 return make_number (c);
2670
078e7b4a 2671 if (c == '\\')
8792be66
KH		 2672 c = read_escape (readcharfun, 0);
2673 modifiers = c & CHAR_MODIFIER_MASK;
2674 c &= ~CHAR_MODIFIER_MASK;
2675 if (CHAR_BYTE8_P (c))
2676 c = CHAR_TO_BYTE8 (c);
2677 c |= modifiers;
078e7b4a 2678
df9c2be7
KS		 2679 next_char = READCHAR;
2680 if (next_char == '.')
2681 {
2682 /* Only a dotted-pair dot is valid after a char constant. */
2683 int next_next_char = READCHAR;
2684 UNREAD (next_next_char);
2685
2686 ok = (next_next_char <= 040
e613ea97
KH		 2687 || (next_next_char < 0200
2688 && (index ("\"';([#?", next_next_char)
2689 || (!first_in_list && next_next_char == '`')
2690 || (new_backquote_flag && next_next_char == ','))));
df9c2be7
KS		 2691 }
2692 else
2693 {
2694 ok = (next_char <= 040
e613ea97
KH		 2695 || (next_char < 0200
2696 && (index ("\"';()[]#?", next_char)
2697 || (!first_in_list && next_char == '`')
2698 || (new_backquote_flag && next_char == ','))));
df9c2be7
KS		 2699 }
2700 UNREAD (next_char);
336d4a9c
KS		 2701 if (ok)
2702 return make_number (c);
37cd4238 2703
336d4a9c 2704 invalid_syntax ("?", 1);
078e7b4a
JB		 2705 }
2706
00a9a935 2707 case '"':
078e7b4a 2708 {
a742d646
GM		 2709 char *p = read_buffer;
2710 char *end = read_buffer + read_buffer_size;
078e7b4a 2711 register int c;
1571601b
KH		 2712 /* Nonzero if we saw an escape sequence specifying
2713 a multibyte character. */
e7fc914b 2714 int force_multibyte = 0;
1571601b 2715 /* Nonzero if we saw an escape sequence specifying
e7fc914b
KH		 2716 a single-byte character. */
2717 int force_singlebyte = 0;
078e7b4a 2718 int cancel = 0;
5150eeec 2719 int nchars = 0;
078e7b4a
JB		 2720
2721 while ((c = READCHAR) >= 0
2722 && c != '\"')
2723 {
449fea39 2724 if (end - p < MAX_MULTIBYTE_LENGTH)
078e7b4a 2725 {
5d65df0d
GM		 2726 int offset = p - read_buffer;
2727 read_buffer = (char *) xrealloc (read_buffer,
2728 read_buffer_size *= 2);
2729 p = read_buffer + offset;
078e7b4a
JB		 2730 end = read_buffer + read_buffer_size;
2731 }
bed23cb2 2732
078e7b4a 2733 if (c == '\\')
03e88613 2734 {
1571601b 2735 int modifiers;
f6f79b37 2736
8792be66 2737 c = read_escape (readcharfun, 1);
bed23cb2
RS		 2738
2739 /* C is -1 if \ newline has just been seen */
2740 if (c == -1)
03e88613 2741 {
bed23cb2
RS		 2742 if (p == read_buffer)
2743 cancel = 1;
03e88613
RS		 2744 continue;
2745 }
bed23cb2 2746
1571601b
KH		 2747 modifiers = c & CHAR_MODIFIER_MASK;
2748 c = c & ~CHAR_MODIFIER_MASK;
2749
8792be66 2750 if (CHAR_BYTE8_P (c))
e7fc914b 2751 force_singlebyte = 1;
8792be66 2752 else if (! ASCII_CHAR_P (c))
f6f79b37 2753 force_multibyte = 1;
8792be66 2754 else /* i.e. ASCII_CHAR_P (c) */
1571601b
KH		 2755 {
2756 /* Allow `\C- ' and `\C-?'. */
2757 if (modifiers == CHAR_CTL)
2758 {
2759 if (c == ' ')
2760 c = 0, modifiers = 0;
2761 else if (c == '?')
2762 c = 127, modifiers = 0;
2763 }
2764 if (modifiers & CHAR_SHIFT)
2765 {
2766 /* Shift modifier is valid only with [A-Za-z]. */
2767 if (c >= 'A' && c <= 'Z')
2768 modifiers &= ~CHAR_SHIFT;
2769 else if (c >= 'a' && c <= 'z')
2770 c -= ('a' - 'A'), modifiers &= ~CHAR_SHIFT;
2771 }
2772
2773 if (modifiers & CHAR_META)
2774 {
2775 /* Move the meta bit to the right place for a
2776 string. */
2777 modifiers &= ~CHAR_META;
2778 c = BYTE8_TO_CHAR (c | 0x80);
2779 force_singlebyte = 1;
2780 }
2781 }
5150eeec 2782
1571601b
KH		 2783 /* Any modifiers remaining are invalid. */
2784 if (modifiers)
2785 error ("Invalid modifier in string");
2786 p += CHAR_STRING (c, (unsigned char *) p);
078e7b4a 2787 }
8792be66 2788 else
5150eeec 2789 {
1571601b 2790 p += CHAR_STRING (c, (unsigned char *) p);
988f7a0c
KH		 2791 if (CHAR_BYTE8_P (c))
2792 force_singlebyte = 1;
2793 else if (! ASCII_CHAR_P (c))
2794 force_multibyte = 1;
f943104a 2795 }
5150eeec 2796 nchars++;
078e7b4a 2797 }
5150eeec 2798
6f7f43d5 2799 if (c < 0)
9c97398c 2800 end_of_file_error ();
078e7b4a
JB		 2801
2802 /* If purifying, and string starts with \ newline,
2803 return zero instead. This is for doc strings
08564963 2804 that we are really going to find in etc/DOC.nn.nn */
265a9e55 2805 if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
078e7b4a
JB		 2806 return make_number (0);
2807
1571601b
KH		 2808 if (force_multibyte)
2809 /* READ_BUFFER already contains valid multibyte forms. */
5150eeec 2810 ;
1571601b 2811 else if (force_singlebyte)
a742d646 2812 {
1571601b
KH		 2813 nchars = str_as_unibyte (read_buffer, p - read_buffer);
2814 p = read_buffer + nchars;
a742d646 2815 }
e28552a4 2816 else
1571601b 2817 /* Otherwise, READ_BUFFER contains only ASCII. */
5150eeec 2818 ;
e7fc914b 2819
abb13b09
CW		 2820 /* We want readchar_count to be the number of characters, not
2821 bytes. Hence we adjust for multibyte characters in the
2822 string. ... But it doesn't seem to be necessary, because
2823 READCHAR *does* read multibyte characters from buffers. */
2824 /* readchar_count -= (p - read_buffer) - nchars; */
e7fc914b 2825 if (read_pure)
491f16a2 2826 return make_pure_string (read_buffer, nchars, p - read_buffer,
1571601b
KH		 2827 (force_multibyte
2828 || (p - read_buffer != nchars)));
491f16a2 2829 return make_specified_string (read_buffer, nchars, p - read_buffer,
1571601b
KH		 2830 (force_multibyte
2831 || (p - read_buffer != nchars)));
078e7b4a
JB		 2832 }
2833
109d300c
JB		 2834 case '.':
2835 {
109d300c
JB		 2836 int next_char = READCHAR;
2837 UNREAD (next_char);
2838
035eec48 2839 if (next_char <= 040
e613ea97 2840 || (next_char < 0200
95af0924
KS		 2841 && (index ("\"';([#?", next_char)
2842 || (!first_in_list && next_char == '`')
2843 || (new_backquote_flag && next_char == ','))))
109d300c 2844 {
6428369f
KH		 2845 *pch = c;
2846 return Qnil;
109d300c
JB		 2847 }
2848
2849 /* Otherwise, we fall through! Note that the atom-reading loop
2850 below will now loop at least once, assuring that we will not
2851 try to UNREAD two characters in a row. */
2852 }
078e7b4a 2853 default:
17634846 2854 default_label:
88852d45 2855 if (c <= 040) goto retry;
adef3de7
RS		 2856 if (c == 0x8a0) /* NBSP */
2857 goto retry;
078e7b4a 2858 {
38404229 2859 char *p = read_buffer;
481c6336 2860 int quoted = 0;
078e7b4a
JB		 2861
2862 {
38404229 2863 char *end = read_buffer + read_buffer_size;
078e7b4a 2864
6f7f43d5 2865 while (c > 040
adef3de7 2866 && c != 0x8a0 /* NBSP */
e613ea97
KH		 2867 && (c >= 0200
2868 || (!index ("\"';()[]#", c)
2869 && !(!first_in_list && c == '`')
2870 && !(new_backquote_flag && c == ','))))
078e7b4a 2871 {
449fea39 2872 if (end - p < MAX_MULTIBYTE_LENGTH)
078e7b4a 2873 {
5d65df0d
GM		 2874 int offset = p - read_buffer;
2875 read_buffer = (char *) xrealloc (read_buffer,
2876 read_buffer_size *= 2);
2877 p = read_buffer + offset;
078e7b4a
JB		 2878 end = read_buffer + read_buffer_size;
2879 }
177c0ea7 2880
078e7b4a 2881 if (c == '\\')
481c6336
RS		 2882 {
2883 c = READCHAR;
4ab11c09
GM		 2884 if (c == -1)
2885 end_of_file_error ();
481c6336
RS		 2886 quoted = 1;
2887 }
6f7f43d5 2888
1202434b
KH		 2889 if (multibyte)
2890 p += CHAR_STRING (c, p);
2891 else
2892 *p++ = c;
078e7b4a
JB		 2893 c = READCHAR;
2894 }
2895
2896 if (p == end)
2897 {
5d65df0d
GM		 2898 int offset = p - read_buffer;
2899 read_buffer = (char *) xrealloc (read_buffer,
2900 read_buffer_size *= 2);
2901 p = read_buffer + offset;
2902 end = read_buffer + read_buffer_size;
078e7b4a
JB		 2903 }
2904 *p = 0;
2905 if (c >= 0)
2906 UNREAD (c);
2907 }
2908
4ad679f9 2909 if (!quoted && !uninterned_symbol)
481c6336
RS		 2910 {
2911 register char *p1;
2912 register Lisp_Object val;
2913 p1 = read_buffer;
2914 if (*p1 == '+' || *p1 == '-') p1++;
2915 /* Is it an integer? */
2916 if (p1 != p)
2917 {
2918 while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++;
481c6336
RS		 2919 /* Integers can have trailing decimal points. */
2920 if (p1 > read_buffer && p1 < p && *p1 == '.') p1++;
481c6336
RS		 2921 if (p1 == p)
2922 /* It is an integer. */
2923 {
481c6336
RS		 2924 if (p1[-1] == '.')
2925 p1[-1] = '\0';
74214d16
DL		 2926 /* Fixme: if we have strtol, use that, and check
2927 for overflow. */
faca07fb
RS		 2928 if (sizeof (int) == sizeof (EMACS_INT))
2929 XSETINT (val, atoi (read_buffer));
2930 else if (sizeof (long) == sizeof (EMACS_INT))
2931 XSETINT (val, atol (read_buffer));
2932 else
2933 abort ();
481c6336
RS		 2934 return val;
2935 }
2936 }
481c6336 2937 if (isfloat_string (read_buffer))
eb659c41 2938 {
a8972052
PE		 2939 /* Compute NaN and infinities using 0.0 in a variable,
2940 to cope with compilers that think they are smarter
5e24a1f7 2941 than we are. */
3c329963 2942 double zero = 0.0;
a8972052
PE		 2943
2944 double value;
2945
2946 /* Negate the value ourselves. This treats 0, NaNs,
2947 and infinity properly on IEEE floating point hosts,
2948 and works around a common bug where atof ("-0.0")
2949 drops the sign. */
2950 int negative = read_buffer[0] == '-';
2951
2952 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
eb659c41 2953 returns 1, is if the input ends in e+INF or e+NaN. */
a8972052 2954 switch (p[-1])
eb659c41 2955 {
a8972052
PE		 2956 case 'F':
2957 value = 1.0 / zero;
2958 break;
2959 case 'N':
2960 value = zero / zero;
7690cbb0
RS		 2961
2962 /* If that made a "negative" NaN, negate it. */
2963
2964 {
2965 int i;
2966 union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
2967
2968 u_data.d = value;
2969 u_minus_zero.d = - 0.0;
2970 for (i = 0; i < sizeof (double); i++)
2971 if (u_data.c[i] & u_minus_zero.c[i])
2972 {
2973 value = - value;
2974 break;
2975 }
2976 }
2977 /* Now VALUE is a positive NaN. */
a8972052
PE		 2978 break;
2979 default:
2980 value = atof (read_buffer + negative);
2981 break;
eb659c41 2982 }
a8972052
PE		 2983
2984 return make_float (negative ? - value : value);
eb659c41 2985 }
481c6336 2986 }
abb13b09 2987 {
e93abe3d
KH		 2988 Lisp_Object name, result;
2989 EMACS_INT nbytes = p - read_buffer;
2990 EMACS_INT nchars
2991 = (multibyte ? multibyte_chars_in_text (read_buffer, nbytes)
2992 : nbytes);
2993
2994 if (uninterned_symbol && ! NILP (Vpurify_flag))
2995 name = make_pure_string (read_buffer, nchars, nbytes, multibyte);
2996 else
2997 name = make_specified_string (read_buffer, nchars, nbytes,multibyte);
2998 result = (uninterned_symbol ? Fmake_symbol (name)
2999 : Fintern (name, Qnil));
1202434b 3000
abb13b09
CW		 3001 if (EQ (Vread_with_symbol_positions, Qt)
3002 || EQ (Vread_with_symbol_positions, readcharfun))
177c0ea7 3003 Vread_symbol_positions_list =
abb13b09
CW		 3004 /* Kind of a hack; this will probably fail if characters
3005 in the symbol name were escaped. Not really a big
3006 deal, though. */
f74db720
SM		 3007 Fcons (Fcons (result,
3008 make_number (readchar_count
3009 - XFASTINT (Flength (Fsymbol_name (result))))),
abb13b09
CW		 3010 Vread_symbol_positions_list);
3011 return result;
3012 }
078e7b4a
JB		 3013 }
3014 }
3015}
3016\f
9e062b6c
RS		 3017
3018/* List of nodes we've seen during substitute_object_in_subtree. */
3019static Lisp_Object seen_list;
3020
3021static void
3022substitute_object_in_subtree (object, placeholder)
3023 Lisp_Object object;
3024 Lisp_Object placeholder;
3025{
3026 Lisp_Object check_object;
3027
3028 /* We haven't seen any objects when we start. */
3029 seen_list = Qnil;
3030
3031 /* Make all the substitutions. */
3032 check_object
3033 = substitute_object_recurse (object, placeholder, object);
177c0ea7 3034
9e062b6c
RS		 3035 /* Clear seen_list because we're done with it. */
3036 seen_list = Qnil;
3037
3038 /* The returned object here is expected to always eq the
3039 original. */
3040 if (!EQ (check_object, object))
3041 error ("Unexpected mutation error in reader");
3042}
3043
3044/* Feval doesn't get called from here, so no gc protection is needed. */
3045#define SUBSTITUTE(get_val, set_val) \
3046{ \
3047 Lisp_Object old_value = get_val; \
3048 Lisp_Object true_value \
3049 = substitute_object_recurse (object, placeholder,\
3050 old_value); \
3051 \
3052 if (!EQ (old_value, true_value)) \
3053 { \
3054 set_val; \
3055 } \
3056}
3057
3058static Lisp_Object
3059substitute_object_recurse (object, placeholder, subtree)
3060 Lisp_Object object;
3061 Lisp_Object placeholder;
3062 Lisp_Object subtree;
3063{
3064 /* If we find the placeholder, return the target object. */
3065 if (EQ (placeholder, subtree))
3066 return object;
3067
3068 /* If we've been to this node before, don't explore it again. */
3069 if (!EQ (Qnil, Fmemq (subtree, seen_list)))
3070 return subtree;
3071
3072 /* If this node can be the entry point to a cycle, remember that
3073 we've seen it. It can only be such an entry point if it was made
3074 by #n=, which means that we can find it as a value in
3075 read_objects. */
3076 if (!EQ (Qnil, Frassq (subtree, read_objects)))
3077 seen_list = Fcons (subtree, seen_list);
177c0ea7 3078
9e062b6c
RS		 3079 /* Recurse according to subtree's type.
3080 Every branch must return a Lisp_Object. */
3081 switch (XTYPE (subtree))
3082 {
3083 case Lisp_Vectorlike:
3084 {
3085 int i;
7c752c80 3086 int length = XINT (Flength(subtree));
9e062b6c
RS		 3087 for (i = 0; i < length; i++)
3088 {
3089 Lisp_Object idx = make_number (i);
3090 SUBSTITUTE (Faref (subtree, idx),
177c0ea7 3091 Faset (subtree, idx, true_value));
9e062b6c
RS		 3092 }
3093 return subtree;
3094 }
3095
3096 case Lisp_Cons:
3097 {
3098 SUBSTITUTE (Fcar_safe (subtree),
e61b9b87 3099 Fsetcar (subtree, true_value));
9e062b6c 3100 SUBSTITUTE (Fcdr_safe (subtree),
e61b9b87 3101 Fsetcdr (subtree, true_value));
9e062b6c
RS		 3102 return subtree;
3103 }
3104
9e062b6c
RS		 3105 case Lisp_String:
3106 {
3107 /* Check for text properties in each interval.
e61b9b87 3108 substitute_in_interval contains part of the logic. */
9e062b6c 3109
d5db4077 3110 INTERVAL root_interval = STRING_INTERVALS (subtree);
9e062b6c 3111 Lisp_Object arg = Fcons (object, placeholder);
177c0ea7 3112
0d74b006
SM		 3113 traverse_intervals_noorder (root_interval,
3114 &substitute_in_interval, arg);
9e062b6c
RS		 3115
3116 return subtree;
3117 }
9e062b6c
RS		 3118
3119 /* Other types don't recurse any further. */
3120 default:
3121 return subtree;
3122 }
3123}
3124
3125/* Helper function for substitute_object_recurse. */
3126static void
3127substitute_in_interval (interval, arg)
3128 INTERVAL interval;
3129 Lisp_Object arg;
3130{
3131 Lisp_Object object = Fcar (arg);
3132 Lisp_Object placeholder = Fcdr (arg);
3133
3134 SUBSTITUTE(interval->plist, interval->plist = true_value);
3135}
3136
3137\f
078e7b4a
JB		 3138#define LEAD_INT 1
3139#define DOT_CHAR 2
3140#define TRAIL_INT 4
3141#define E_CHAR 8
3142#define EXP_INT 16
3143
3144int
3145isfloat_string (cp)
3146 register char *cp;
3147{
c1a2f60a 3148 register int state;
177c0ea7 3149
d8578e58
RS		 3150 char *start = cp;
3151
078e7b4a
JB		 3152 state = 0;
3153 if (*cp == '+' || *cp == '-')
3154 cp++;
3155
075027b1 3156 if (*cp >= '0' && *cp <= '9')
078e7b4a
JB		 3157 {
3158 state |= LEAD_INT;
075027b1
RS		 3159 while (*cp >= '0' && *cp <= '9')
3160 cp++;
078e7b4a
JB		 3161 }
3162 if (*cp == '.')
3163 {
3164 state |= DOT_CHAR;
3165 cp++;
3166 }
075027b1 3167 if (*cp >= '0' && *cp <= '9')
078e7b4a
JB		 3168 {
3169 state |= TRAIL_INT;
075027b1 3170 while (*cp >= '0' && *cp <= '9')
078e7b4a
JB		 3171 cp++;
3172 }
a35f88bf 3173 if (*cp == 'e' || *cp == 'E')
078e7b4a
JB		 3174 {
3175 state |= E_CHAR;
3176 cp++;
e73997a1
RS		 3177 if (*cp == '+' || *cp == '-')
3178 cp++;
078e7b4a 3179 }
078e7b4a 3180
075027b1 3181 if (*cp >= '0' && *cp <= '9')
078e7b4a
JB		 3182 {
3183 state |= EXP_INT;
075027b1 3184 while (*cp >= '0' && *cp <= '9')
078e7b4a
JB		 3185 cp++;
3186 }
d8578e58
RS		 3187 else if (cp == start)
3188 ;
eb659c41
RS		 3189 else if (cp[-1] == '+' && cp[0] == 'I' && cp[1] == 'N' && cp[2] == 'F')
3190 {
3191 state |= EXP_INT;
3192 cp += 3;
3193 }
3194 else if (cp[-1] == '+' && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
3195 {
3196 state |= EXP_INT;
3197 cp += 3;
3198 }
3199
37579d7c 3200 return (((*cp == 0) || (*cp == ' ') || (*cp == '\t') || (*cp == '\n') || (*cp == '\r') || (*cp == '\f'))
078e7b4a 3201 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
151bdc83 3202 || state == (DOT_CHAR|TRAIL_INT)
078e7b4a 3203 || state == (LEAD_INT|E_CHAR|EXP_INT)
151bdc83
JB		 3204 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
3205 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
078e7b4a 3206}
cc94f3b2 3207
078e7b4a
JB		 3208\f
3209static Lisp_Object
c15cfd1f 3210read_vector (readcharfun, bytecodeflag)
078e7b4a 3211 Lisp_Object readcharfun;
c15cfd1f 3212 int bytecodeflag;
078e7b4a
JB		 3213{
3214 register int i;
3215 register int size;
3216 register Lisp_Object *ptr;
c15cfd1f 3217 register Lisp_Object tem, item, vector;
078e7b4a
JB		 3218 register struct Lisp_Cons *otem;
3219 Lisp_Object len;
3220
3221 tem = read_list (1, readcharfun);
3222 len = Flength (tem);
3223 vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
3224
078e7b4a
JB		 3225 size = XVECTOR (vector)->size;
3226 ptr = XVECTOR (vector)->contents;
3227 for (i = 0; i < size; i++)
3228 {
c15cfd1f
RS		 3229 item = Fcar (tem);
3230 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3231 bytecode object, the docstring containing the bytecode and
3232 constants values must be treated as unibyte and passed to
3233 Fread, to get the actual bytecode string and constants vector. */
3234 if (bytecodeflag && load_force_doc_strings)
3235 {
3236 if (i == COMPILED_BYTECODE)
3237 {
3238 if (!STRINGP (item))
6fa2b890 3239 error ("Invalid byte code");
c15cfd1f
RS		 3240
3241 /* Delay handling the bytecode slot until we know whether
3242 it is lazily-loaded (we can tell by whether the
3243 constants slot is nil). */
3244 ptr[COMPILED_CONSTANTS] = item;
3245 item = Qnil;
3246 }
3247 else if (i == COMPILED_CONSTANTS)
3248 {
3249 Lisp_Object bytestr = ptr[COMPILED_CONSTANTS];
3250
3251 if (NILP (item))
3252 {
3253 /* Coerce string to unibyte (like string-as-unibyte,
3254 but without generating extra garbage and
3255 guaranteeing no change in the contents). */
bee91904 3256 STRING_SET_CHARS (bytestr, SBYTES (bytestr));
d5db4077 3257 STRING_SET_UNIBYTE (bytestr);
c15cfd1f 3258
8792be66 3259 item = Fread (Fcons (bytestr, readcharfun));
c15cfd1f 3260 if (!CONSP (item))
6fa2b890 3261 error ("Invalid byte code");
c15cfd1f
RS		 3262
3263 otem = XCONS (item);
c1d497be
KR		 3264 bytestr = XCAR (item);
3265 item = XCDR (item);
c15cfd1f
RS		 3266 free_cons (otem);
3267 }
3268
3269 /* Now handle the bytecode slot. */
3270 ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;
3271 }
8792be66
KH		 3272 else if (i == COMPILED_DOC_STRING
3273 && STRINGP (item)
3274 && ! STRING_MULTIBYTE (item))
3275 {
3276 if (EQ (readcharfun, Qget_emacs_mule_file_char))
3277 item = Fdecode_coding_string (item, Qemacs_mule, Qnil, Qnil);
3278 else
3279 item = Fstring_as_multibyte (item);
3280 }
c15cfd1f
RS		 3281 }
3282 ptr[i] = read_pure ? Fpurecopy (item) : item;
078e7b4a
JB		 3283 otem = XCONS (tem);
3284 tem = Fcdr (tem);
3285 free_cons (otem);
3286 }
3287 return vector;
3288}
177c0ea7 3289
6f7f43d5
RS		 3290/* FLAG = 1 means check for ] to terminate rather than ) and .
3291 FLAG = -1 means check for starting with defun
078e7b4a
JB		 3292 and make structure pure. */
3293
3294static Lisp_Object
3295read_list (flag, readcharfun)
3296 int flag;
3297 register Lisp_Object readcharfun;
3298{
3299 /* -1 means check next element for defun,
3300 0 means don't check,
3301 1 means already checked and found defun. */
3302 int defunflag = flag < 0 ? -1 : 0;
3303 Lisp_Object val, tail;
3304 register Lisp_Object elt, tem;
3305 struct gcpro gcpro1, gcpro2;
821d417e 3306 /* 0 is the normal case.
b2a30870 3307 1 means this list is a doc reference; replace it with the number 0.
177c0ea7 3308 2 means this list is a doc reference; replace it with the doc string. */
821d417e 3309 int doc_reference = 0;
078e7b4a 3310
17634846
RS		 3311 /* Initialize this to 1 if we are reading a list. */
3312 int first_in_list = flag <= 0;
3313
078e7b4a
JB		 3314 val = Qnil;
3315 tail = Qnil;
3316
3317 while (1)
3318 {
e28552a4 3319 int ch;
078e7b4a 3320 GCPRO2 (val, tail);
17634846 3321 elt = read1 (readcharfun, &ch, first_in_list);
078e7b4a 3322 UNGCPRO;
20ea2964 3323
17634846
RS		 3324 first_in_list = 0;
3325
821d417e 3326 /* While building, if the list starts with #$, treat it specially. */
20ea2964 3327 if (EQ (elt, Vload_file_name)
d49f0c1a 3328 && ! NILP (elt)
821d417e
RS		 3329 && !NILP (Vpurify_flag))
3330 {
3331 if (NILP (Vdoc_file_name))
3332 /* We have not yet called Snarf-documentation, so assume
3333 this file is described in the DOC-MM.NN file
3334 and Snarf-documentation will fill in the right value later.
3335 For now, replace the whole list with 0. */
3336 doc_reference = 1;
3337 else
3338 /* We have already called Snarf-documentation, so make a relative
3339 file name for this file, so it can be found properly
3340 in the installed Lisp directory.
3341 We don't use Fexpand_file_name because that would make
3342 the directory absolute now. */
3343 elt = concat2 (build_string ("../lisp/"),
3344 Ffile_name_nondirectory (elt));
3345 }
b2a30870 3346 else if (EQ (elt, Vload_file_name)
d49f0c1a 3347 && ! NILP (elt)
b2a30870
RS		 3348 && load_force_doc_strings)
3349 doc_reference = 2;
20ea2964 3350
6428369f 3351 if (ch)
078e7b4a
JB		 3352 {
3353 if (flag > 0)
3354 {
6428369f 3355 if (ch == ']')
078e7b4a 3356 return val;
336d4a9c 3357 invalid_syntax (") or . in a vector", 18);
078e7b4a 3358 }
6428369f 3359 if (ch == ')')
078e7b4a 3360 return val;
6428369f 3361 if (ch == '.')
078e7b4a
JB		 3362 {
3363 GCPRO2 (val, tail);
265a9e55 3364 if (!NILP (tail))
f5df591a 3365 XSETCDR (tail, read0 (readcharfun));
078e7b4a
JB		 3366 else
3367 val = read0 (readcharfun);
17634846 3368 read1 (readcharfun, &ch, 0);
078e7b4a 3369 UNGCPRO;
6428369f 3370 if (ch == ')')
821d417e
RS		 3371 {
3372 if (doc_reference == 1)
3373 return make_number (0);
b2a30870
RS		 3374 if (doc_reference == 2)
3375 {
3376 /* Get a doc string from the file we are loading.
8792be66
KH		 3377 If it's in saved_doc_string, get it from there.
3378
3379 Here, we don't know if the string is a
3380 bytecode string or a doc string. As a
3381 bytecode string must be unibyte, we always
3382 return a unibyte string. If it is actually a
3383 doc string, caller must make it
3384 multibyte. */
8f924df7 3385
c1d497be 3386 int pos = XINT (XCDR (val));
c15cfd1f
RS		 3387 /* Position is negative for user variables. */
3388 if (pos < 0) pos = -pos;
b2a30870
RS		 3389 if (pos >= saved_doc_string_position
3390 && pos < (saved_doc_string_position
3391 + saved_doc_string_length))
3392 {
3393 int start = pos - saved_doc_string_position;
3394 int from, to;
3395
3396 /* Process quoting with ^A,
3397 and find the end of the string,
3398 which is marked with ^_ (037). */
3399 for (from = start, to = start;
3400 saved_doc_string[from] != 037;)
3401 {
3402 int c = saved_doc_string[from++];
3403 if (c == 1)
3404 {
3405 c = saved_doc_string[from++];
3406 if (c == 1)
3407 saved_doc_string[to++] = c;
3408 else if (c == '0')
3409 saved_doc_string[to++] = 0;
3410 else if (c == '_')
3411 saved_doc_string[to++] = 037;
3412 }
3413 else
3414 saved_doc_string[to++] = c;
3415 }
3416
8792be66
KH		 3417 return make_unibyte_string (saved_doc_string + start,
3418 to - start);
b2a30870 3419 }
c15cfd1f
RS		 3420 /* Look in prev_saved_doc_string the same way. */
3421 else if (pos >= prev_saved_doc_string_position
3422 && pos < (prev_saved_doc_string_position
3423 + prev_saved_doc_string_length))
3424 {
3425 int start = pos - prev_saved_doc_string_position;
3426 int from, to;
3427
3428 /* Process quoting with ^A,
3429 and find the end of the string,
3430 which is marked with ^_ (037). */
3431 for (from = start, to = start;
3432 prev_saved_doc_string[from] != 037;)
3433 {
3434 int c = prev_saved_doc_string[from++];
3435 if (c == 1)
3436 {
3437 c = prev_saved_doc_string[from++];
3438 if (c == 1)
3439 prev_saved_doc_string[to++] = c;
3440 else if (c == '0')
3441 prev_saved_doc_string[to++] = 0;
3442 else if (c == '_')
3443 prev_saved_doc_string[to++] = 037;
3444 }
3445 else
3446 prev_saved_doc_string[to++] = c;
3447 }
3448
8792be66
KH		 3449 return make_unibyte_string (prev_saved_doc_string
3450 + start,
3451 to - start);
c15cfd1f 3452 }
b2a30870 3453 else
8792be66 3454 return get_doc_string (val, 1, 0);
b2a30870
RS		 3455 }
3456
821d417e
RS		 3457 return val;
3458 }
336d4a9c 3459 invalid_syntax (". in wrong context", 18);
078e7b4a 3460 }
336d4a9c 3461 invalid_syntax ("] in a list", 11);
078e7b4a
JB		 3462 }
3463 tem = (read_pure && flag <= 0
3464 ? pure_cons (elt, Qnil)
3465 : Fcons (elt, Qnil));
265a9e55 3466 if (!NILP (tail))
f5df591a 3467 XSETCDR (tail, tem);
078e7b4a
JB		 3468 else
3469 val = tem;
3470 tail = tem;
3471 if (defunflag < 0)
3472 defunflag = EQ (elt, Qdefun);
3473 else if (defunflag > 0)
3474 read_pure = 1;
3475 }
3476}
3477\f
3478Lisp_Object Vobarray;
3479Lisp_Object initial_obarray;
3480
d007f5c8
RS		 3481/* oblookup stores the bucket number here, for the sake of Funintern. */
3482
3483int oblookup_last_bucket_number;
3484
3485static int hash_string ();
d007f5c8
RS		 3486
3487/* Get an error if OBARRAY is not an obarray.
3488 If it is one, return it. */
3489
078e7b4a
JB		 3490Lisp_Object
3491check_obarray (obarray)
3492 Lisp_Object obarray;
3493{
8878319c 3494 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
078e7b4a
JB		 3495 {
3496 /* If Vobarray is now invalid, force it to be valid. */
3497 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
8878319c 3498 wrong_type_argument (Qvectorp, obarray);
078e7b4a
JB		 3499 }
3500 return obarray;
3501}
3502
d007f5c8
RS		 3503/* Intern the C string STR: return a symbol with that name,
3504 interned in the current obarray. */
078e7b4a
JB		 3505
3506Lisp_Object
3507intern (str)
4b2dd274 3508 const char *str;
078e7b4a
JB		 3509{
3510 Lisp_Object tem;
3511 int len = strlen (str);
153a17b7 3512 Lisp_Object obarray;
078e7b4a 3513
153a17b7 3514 obarray = Vobarray;
cfff016d 3515 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
078e7b4a 3516 obarray = check_obarray (obarray);
e28552a4 3517 tem = oblookup (obarray, str, len, len);
cfff016d 3518 if (SYMBOLP (tem))
078e7b4a 3519 return tem;
87631ef7 3520 return Fintern (make_string (str, len), obarray);
078e7b4a 3521}
4ad679f9
EN		 3522
3523/* Create an uninterned symbol with name STR. */
3524
3525Lisp_Object
3526make_symbol (str)
3527 char *str;
3528{
3529 int len = strlen (str);
3530
3531 return Fmake_symbol ((!NILP (Vpurify_flag)
491f16a2 3532 ? make_pure_string (str, len, len, 0)
4ad679f9
EN		 3533 : make_string (str, len)));
3534}
d007f5c8 3535\f
078e7b4a 3536DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
5de38842
PJ		 3537 doc: /* Return the canonical symbol whose name is STRING.
3538If there is none, one is created by this function and returned.
3539A second optional argument specifies the obarray to use;
3540it defaults to the value of `obarray'. */)
3541 (string, obarray)
9391b698 3542 Lisp_Object string, obarray;
078e7b4a
JB		 3543{
3544 register Lisp_Object tem, sym, *ptr;
3545
265a9e55 3546 if (NILP (obarray)) obarray = Vobarray;
078e7b4a
JB		 3547 obarray = check_obarray (obarray);
3548
b7826503 3549 CHECK_STRING (string);
078e7b4a 3550
d5db4077
KR		 3551 tem = oblookup (obarray, SDATA (string),
3552 SCHARS (string),
3553 SBYTES (string));
cfff016d 3554 if (!INTEGERP (tem))
078e7b4a
JB		 3555 return tem;
3556
265a9e55 3557 if (!NILP (Vpurify_flag))
9391b698
EN		 3558 string = Fpurecopy (string);
3559 sym = Fmake_symbol (string);
44c6c019
GM		 3560
3561 if (EQ (obarray, initial_obarray))
3562 XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
3563 else
3564 XSYMBOL (sym)->interned = SYMBOL_INTERNED;
078e7b4a 3565
d5db4077 3566 if ((SREF (string, 0) == ':')
a458d45d 3567 && EQ (obarray, initial_obarray))
44c6c019
GM		 3568 {
3569 XSYMBOL (sym)->constant = 1;
3570 XSYMBOL (sym)->value = sym;
3571 }
a0549832 3572
078e7b4a 3573 ptr = &XVECTOR (obarray)->contents[XINT (tem)];
cfff016d 3574 if (SYMBOLP (*ptr))
078e7b4a
JB		 3575 XSYMBOL (sym)->next = XSYMBOL (*ptr);
3576 else
3577 XSYMBOL (sym)->next = 0;
3578 *ptr = sym;
3579 return sym;
3580}
3581
3582DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
5de38842
PJ		 3583 doc: /* Return the canonical symbol named NAME, or nil if none exists.
3584NAME may be a string or a symbol. If it is a symbol, that exact
3585symbol is searched for.
3586A second optional argument specifies the obarray to use;
3587it defaults to the value of `obarray'. */)
3588 (name, obarray)
b55048d4 3589 Lisp_Object name, obarray;
078e7b4a 3590{
c2d47f4b 3591 register Lisp_Object tem, string;
078e7b4a 3592
265a9e55 3593 if (NILP (obarray)) obarray = Vobarray;
078e7b4a
JB		 3594 obarray = check_obarray (obarray);
3595
b55048d4
GM		 3596 if (!SYMBOLP (name))
3597 {
b7826503 3598 CHECK_STRING (name);
c2d47f4b 3599 string = name;
b55048d4
GM		 3600 }
3601 else
c2d47f4b 3602 string = SYMBOL_NAME (name);
078e7b4a 3603
c2d47f4b 3604 tem = oblookup (obarray, SDATA (string), SCHARS (string), SBYTES (string));
b55048d4
GM		 3605 if (INTEGERP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
3606 return Qnil;
3607 else
078e7b4a 3608 return tem;
078e7b4a 3609}
d007f5c8
RS		 3610\f
3611DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0,
5de38842
PJ		 3612 doc: /* Delete the symbol named NAME, if any, from OBARRAY.
3613The value is t if a symbol was found and deleted, nil otherwise.
3614NAME may be a string or a symbol. If it is a symbol, that symbol
3615is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3616OBARRAY defaults to the value of the variable `obarray'. */)
3617 (name, obarray)
d007f5c8
RS		 3618 Lisp_Object name, obarray;
3619{
3620 register Lisp_Object string, tem;
3621 int hash;
3622
3623 if (NILP (obarray)) obarray = Vobarray;
3624 obarray = check_obarray (obarray);
3625
3626 if (SYMBOLP (name))
d4c83cae 3627 string = SYMBOL_NAME (name);
d007f5c8
RS		 3628 else
3629 {
b7826503 3630 CHECK_STRING (name);
d007f5c8
RS		 3631 string = name;
3632 }
3633
d5db4077
KR		 3634 tem = oblookup (obarray, SDATA (string),
3635 SCHARS (string),
3636 SBYTES (string));
d007f5c8
RS		 3637 if (INTEGERP (tem))
3638 return Qnil;
3639 /* If arg was a symbol, don't delete anything but that symbol itself. */
3640 if (SYMBOLP (name) && !EQ (name, tem))
3641 return Qnil;
3642
44c6c019
GM		 3643 XSYMBOL (tem)->interned = SYMBOL_UNINTERNED;
3644 XSYMBOL (tem)->constant = 0;
3645 XSYMBOL (tem)->indirect_variable = 0;
ca69c42f 3646
d007f5c8
RS		 3647 hash = oblookup_last_bucket_number;
3648
3649 if (EQ (XVECTOR (obarray)->contents[hash], tem))
b2a30870
RS		 3650 {
3651 if (XSYMBOL (tem)->next)
3652 XSETSYMBOL (XVECTOR (obarray)->contents[hash], XSYMBOL (tem)->next);
3653 else
3654 XSETINT (XVECTOR (obarray)->contents[hash], 0);
3655 }
d007f5c8
RS		 3656 else
3657 {
3658 Lisp_Object tail, following;
3659
3660 for (tail = XVECTOR (obarray)->contents[hash];
3661 XSYMBOL (tail)->next;
3662 tail = following)
3663 {
3664 XSETSYMBOL (following, XSYMBOL (tail)->next);
3665 if (EQ (following, tem))
3666 {
3667 XSYMBOL (tail)->next = XSYMBOL (following)->next;
3668 break;
3669 }
3670 }
3671 }
3672
3673 return Qt;
3674}
3675\f
3676/* Return the symbol in OBARRAY whose names matches the string
e28552a4
RS		 3677 of SIZE characters (SIZE_BYTE bytes) at PTR.
3678 If there is no such symbol in OBARRAY, return nil.
d007f5c8
RS		 3679
3680 Also store the bucket number in oblookup_last_bucket_number. */
078e7b4a
JB		 3681
3682Lisp_Object
e28552a4 3683oblookup (obarray, ptr, size, size_byte)
078e7b4a 3684 Lisp_Object obarray;
4b2dd274 3685 register const char *ptr;
e28552a4 3686 int size, size_byte;
078e7b4a 3687{
7a70b397
RS		 3688 int hash;
3689 int obsize;
078e7b4a
JB		 3690 register Lisp_Object tail;
3691 Lisp_Object bucket, tem;
3692
cfff016d 3693 if (!VECTORP (obarray)
7c79a684 3694 || (obsize = XVECTOR (obarray)->size) == 0)
078e7b4a
JB		 3695 {
3696 obarray = check_obarray (obarray);
3697 obsize = XVECTOR (obarray)->size;
3698 }
519418b3
RS		 3699 /* This is sometimes needed in the middle of GC. */
3700 obsize &= ~ARRAY_MARK_FLAG;
078e7b4a 3701 /* Combining next two lines breaks VMS C 2.3. */
e28552a4 3702 hash = hash_string (ptr, size_byte);
078e7b4a
JB		 3703 hash %= obsize;
3704 bucket = XVECTOR (obarray)->contents[hash];
d007f5c8 3705 oblookup_last_bucket_number = hash;
8bc285a2 3706 if (EQ (bucket, make_number (0)))
078e7b4a 3707 ;
cfff016d 3708 else if (!SYMBOLP (bucket))
078e7b4a 3709 error ("Bad data in guts of obarray"); /* Like CADR error message */
d007f5c8
RS		 3710 else
3711 for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
078e7b4a 3712 {
d5db4077
KR		 3713 if (SBYTES (SYMBOL_NAME (tail)) == size_byte
3714 && SCHARS (SYMBOL_NAME (tail)) == size
3715 && !bcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
078e7b4a
JB		 3716 return tail;
3717 else if (XSYMBOL (tail)->next == 0)
3718 break;
3719 }
1805de4f 3720 XSETINT (tem, hash);
078e7b4a
JB		 3721 return tem;
3722}
3723
3724static int
3725hash_string (ptr, len)
4b2dd274 3726 const unsigned char *ptr;
078e7b4a
JB		 3727 int len;
3728{
4b2dd274
KR		 3729 register const unsigned char *p = ptr;
3730 register const unsigned char *end = p + len;
078e7b4a
JB		 3731 register unsigned char c;
3732 register int hash = 0;
3733
3734 while (p != end)
3735 {
3736 c = *p++;
3737 if (c >= 0140) c -= 40;
3738 hash = ((hash<<3) + (hash>>28) + c);
3739 }
3740 return hash & 07777777777;
3741}
d007f5c8 3742\f
078e7b4a
JB		 3743void
3744map_obarray (obarray, fn, arg)
3745 Lisp_Object obarray;
d5b28a9d 3746 void (*fn) P_ ((Lisp_Object, Lisp_Object));
078e7b4a
JB		 3747 Lisp_Object arg;
3748{
3749 register int i;
3750 register Lisp_Object tail;
b7826503 3751 CHECK_VECTOR (obarray);
078e7b4a
JB		 3752 for (i = XVECTOR (obarray)->size - 1; i >= 0; i--)
3753 {
3754 tail = XVECTOR (obarray)->contents[i];
4f5c4403 3755 if (SYMBOLP (tail))
078e7b4a
JB		 3756 while (1)
3757 {
3758 (*fn) (tail, arg);
3759 if (XSYMBOL (tail)->next == 0)
3760 break;
1805de4f 3761 XSETSYMBOL (tail, XSYMBOL (tail)->next);
078e7b4a
JB		 3762 }
3763 }
3764}
3765
d5b28a9d 3766void
078e7b4a
JB		 3767mapatoms_1 (sym, function)
3768 Lisp_Object sym, function;
3769{
3770 call1 (function, sym);
3771}
3772
3773DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
5de38842
PJ		 3774 doc: /* Call FUNCTION on every symbol in OBARRAY.
3775OBARRAY defaults to the value of `obarray'. */)
3776 (function, obarray)
078e7b4a
JB		 3777 Lisp_Object function, obarray;
3778{
265a9e55 3779 if (NILP (obarray)) obarray = Vobarray;
078e7b4a
JB		 3780 obarray = check_obarray (obarray);
3781
3782 map_obarray (obarray, mapatoms_1, function);
3783 return Qnil;
3784}
3785
5e88a39e 3786#define OBARRAY_SIZE 1511
078e7b4a
JB		 3787
3788void
3789init_obarray ()
3790{
3791 Lisp_Object oblength;
3792 int hash;
3793 Lisp_Object *tem;
3794
baf69866 3795 XSETFASTINT (oblength, OBARRAY_SIZE);
078e7b4a 3796
491f16a2 3797 Qnil = Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
078e7b4a
JB		 3798 Vobarray = Fmake_vector (oblength, make_number (0));
3799 initial_obarray = Vobarray;
3800 staticpro (&initial_obarray);
3801 /* Intern nil in the obarray */
44c6c019
GM		 3802 XSYMBOL (Qnil)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
3803 XSYMBOL (Qnil)->constant = 1;
177c0ea7 3804
078e7b4a
JB		 3805 /* These locals are to kludge around a pyramid compiler bug. */
3806 hash = hash_string ("nil", 3);
3807 /* Separate statement here to avoid VAXC bug. */
3808 hash %= OBARRAY_SIZE;
3809 tem = &XVECTOR (Vobarray)->contents[hash];
3810 *tem = Qnil;
3811
491f16a2 3812 Qunbound = Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
078e7b4a
JB		 3813 XSYMBOL (Qnil)->function = Qunbound;
3814 XSYMBOL (Qunbound)->value = Qunbound;
3815 XSYMBOL (Qunbound)->function = Qunbound;
3816
3817 Qt = intern ("t");
3818 XSYMBOL (Qnil)->value = Qnil;
3819 XSYMBOL (Qnil)->plist = Qnil;
3820 XSYMBOL (Qt)->value = Qt;
44c6c019 3821 XSYMBOL (Qt)->constant = 1;
078e7b4a
JB		 3822
3823 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3824 Vpurify_flag = Qt;
3825
3826 Qvariable_documentation = intern ("variable-documentation");
0f73bb1c 3827 staticpro (&Qvariable_documentation);
078e7b4a 3828
449fea39 3829 read_buffer_size = 100 + MAX_MULTIBYTE_LENGTH;
3cb65b0e 3830 read_buffer = (char *) xmalloc (read_buffer_size);
078e7b4a
JB		 3831}
3832\f
3833void
3834defsubr (sname)
3835 struct Lisp_Subr *sname;
3836{
3837 Lisp_Object sym;
3838 sym = intern (sname->symbol_name);
5a6891e2 3839 XSETPVECTYPE (sname, PVEC_SUBR);
1805de4f 3840 XSETSUBR (XSYMBOL (sym)->function, sname);
078e7b4a
JB		 3841}
3842
3843#ifdef NOTDEF /* use fset in subr.el now */
3844void
3845defalias (sname, string)
3846 struct Lisp_Subr *sname;
3847 char *string;
3848{
3849 Lisp_Object sym;
3850 sym = intern (string);
1805de4f 3851 XSETSUBR (XSYMBOL (sym)->function, sname);
078e7b4a
JB		 3852}
3853#endif /* NOTDEF */
3854
078e7b4a 3855/* Define an "integer variable"; a symbol whose value is forwarded
0f011df0
JB		 3856 to a C variable of type int. Sample call:
3857 DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
078e7b4a 3858void
e9e00ff2 3859defvar_int (namestring, address)
078e7b4a 3860 char *namestring;
31ade731 3861 EMACS_INT *address;
078e7b4a 3862{
1a0f90f7 3863 Lisp_Object sym, val;
078e7b4a 3864 sym = intern (namestring);
1a0f90f7 3865 val = allocate_misc ();
47e28b2c 3866 XMISCTYPE (val) = Lisp_Misc_Intfwd;
fc1e7df5 3867 XINTFWD (val)->intvar = address;
44c6c019 3868 SET_SYMBOL_VALUE (sym, val);
078e7b4a
JB		 3869}
3870
f0529b5b 3871/* Similar but define a variable whose value is t if address contains 1,
0f011df0 3872 nil if address contains 0. */
078e7b4a 3873void
e9e00ff2 3874defvar_bool (namestring, address)
078e7b4a
JB		 3875 char *namestring;
3876 int *address;
078e7b4a 3877{
1a0f90f7 3878 Lisp_Object sym, val;
078e7b4a 3879 sym = intern (namestring);
1a0f90f7 3880 val = allocate_misc ();
47e28b2c 3881 XMISCTYPE (val) = Lisp_Misc_Boolfwd;
fc1e7df5 3882 XBOOLFWD (val)->boolvar = address;
44c6c019 3883 SET_SYMBOL_VALUE (sym, val);
1ffcc3b1 3884 Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
078e7b4a
JB		 3885}
3886
1a0f90f7
KH		 3887/* Similar but define a variable whose value is the Lisp Object stored
3888 at address. Two versions: with and without gc-marking of the C
3889 variable. The nopro version is used when that variable will be
3890 gc-marked for some other reason, since marking the same slot twice
3891 can cause trouble with strings. */
078e7b4a 3892void
1a0f90f7 3893defvar_lisp_nopro (namestring, address)
078e7b4a
JB		 3894 char *namestring;
3895 Lisp_Object *address;
078e7b4a 3896{
1a0f90f7 3897 Lisp_Object sym, val;
078e7b4a 3898 sym = intern (namestring);
1a0f90f7 3899 val = allocate_misc ();
47e28b2c 3900 XMISCTYPE (val) = Lisp_Misc_Objfwd;
fc1e7df5 3901 XOBJFWD (val)->objvar = address;
44c6c019 3902 SET_SYMBOL_VALUE (sym, val);
078e7b4a
JB		 3903}
3904
078e7b4a 3905void
1a0f90f7 3906defvar_lisp (namestring, address)
078e7b4a
JB		 3907 char *namestring;
3908 Lisp_Object *address;
078e7b4a 3909{
1a0f90f7
KH		 3910 defvar_lisp_nopro (namestring, address);
3911 staticpro (address);
078e7b4a
JB		 3912}
3913
950c215d 3914/* Similar but define a variable whose value is the Lisp Object stored
4ac38690 3915 at a particular offset in the current kboard object. */
950c215d
KH		 3916
3917void
4ac38690 3918defvar_kboard (namestring, offset)
950c215d
KH		 3919 char *namestring;
3920 int offset;
3921{
3922 Lisp_Object sym, val;
3923 sym = intern (namestring);
3924 val = allocate_misc ();
47e28b2c 3925 XMISCTYPE (val) = Lisp_Misc_Kboard_Objfwd;
4ac38690 3926 XKBOARD_OBJFWD (val)->offset = offset;
44c6c019 3927 SET_SYMBOL_VALUE (sym, val);
950c215d 3928}
078e7b4a 3929\f
11938f10
KH		 3930/* Record the value of load-path used at the start of dumping
3931 so we can see if the site changed it later during dumping. */
3932static Lisp_Object dump_path;
3933
d5b28a9d 3934void
279499f0 3935init_lread ()
078e7b4a 3936{
46947372 3937 char *normal;
e73997a1 3938 int turn_off_warning = 0;
078e7b4a 3939
279499f0 3940 /* Compute the default load-path. */
46947372
JB		 3941#ifdef CANNOT_DUMP
3942 normal = PATH_LOADSEARCH;
e065a56e 3943 Vload_path = decode_env_path (0, normal);
46947372
JB		 3944#else
3945 if (NILP (Vpurify_flag))
3946 normal = PATH_LOADSEARCH;
279499f0 3947 else
46947372 3948 normal = PATH_DUMPLOADSEARCH;
279499f0 3949
46947372
JB		 3950 /* In a dumped Emacs, we normally have to reset the value of
3951 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3952 uses ../lisp, instead of the path of the installed elisp
3953 libraries. However, if it appears that Vload_path was changed
3954 from the default before dumping, don't override that value. */
4746118a
JB		 3955 if (initialized)
3956 {
4746118a 3957 if (! NILP (Fequal (dump_path, Vload_path)))
80667d53
RS		 3958 {
3959 Vload_path = decode_env_path (0, normal);
74180aa4 3960 if (!NILP (Vinstallation_directory))
80667d53 3961 {
3ddff138
RS		 3962 Lisp_Object tem, tem1, sitelisp;
3963
3964 /* Remove site-lisp dirs from path temporarily and store
3965 them in sitelisp, then conc them on at the end so
3966 they're always first in path. */
3967 sitelisp = Qnil;
3968 while (1)
3969 {
3970 tem = Fcar (Vload_path);
3971 tem1 = Fstring_match (build_string ("site-lisp"),
3972 tem, Qnil);
3973 if (!NILP (tem1))
3974 {
3975 Vload_path = Fcdr (Vload_path);
3976 sitelisp = Fcons (tem, sitelisp);
3977 }
3978 else
3979 break;
3980 }
3981
74180aa4 3982 /* Add to the path the lisp subdir of the
3a3056e5 3983 installation dir, if it exists. */
74180aa4
RS		 3984 tem = Fexpand_file_name (build_string ("lisp"),
3985 Vinstallation_directory);
3a3056e5
RS		 3986 tem1 = Ffile_exists_p (tem);
3987 if (!NILP (tem1))
3988 {
3989 if (NILP (Fmember (tem, Vload_path)))
e73997a1
RS		 3990 {
3991 turn_off_warning = 1;
3ddff138 3992 Vload_path = Fcons (tem, Vload_path);
e73997a1 3993 }
3a3056e5
RS		 3994 }
3995 else
3996 /* That dir doesn't exist, so add the build-time
3997 Lisp dirs instead. */
3998 Vload_path = nconc2 (Vload_path, dump_path);
c478f98c 3999
9fbc0116
RS		 4000 /* Add leim under the installation dir, if it exists. */
4001 tem = Fexpand_file_name (build_string ("leim"),
4002 Vinstallation_directory);
4003 tem1 = Ffile_exists_p (tem);
4004 if (!NILP (tem1))
4005 {
4006 if (NILP (Fmember (tem, Vload_path)))
3ddff138 4007 Vload_path = Fcons (tem, Vload_path);
9fbc0116
RS		 4008 }
4009
88852d45 4010 /* Add site-lisp under the installation dir, if it exists. */
c478f98c
RS		 4011 tem = Fexpand_file_name (build_string ("site-lisp"),
4012 Vinstallation_directory);
4013 tem1 = Ffile_exists_p (tem);
4014 if (!NILP (tem1))
4015 {
4016 if (NILP (Fmember (tem, Vload_path)))
3ddff138 4017 Vload_path = Fcons (tem, Vload_path);
c478f98c 4018 }
0f337465
RS		 4019
4020 /* If Emacs was not built in the source directory,
9fbc0116
RS		 4021 and it is run from where it was built, add to load-path
4022 the lisp, leim and site-lisp dirs under that directory. */
0f337465
RS		 4023
4024 if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
4025 {
33046fc9
RS		 4026 Lisp_Object tem2;
4027
0f337465
RS		 4028 tem = Fexpand_file_name (build_string ("src/Makefile"),
4029 Vinstallation_directory);
4030 tem1 = Ffile_exists_p (tem);
33046fc9
RS		 4031
4032 /* Don't be fooled if they moved the entire source tree
4033 AFTER dumping Emacs. If the build directory is indeed
4034 different from the source dir, src/Makefile.in and
4035 src/Makefile will not be found together. */
4036 tem = Fexpand_file_name (build_string ("src/Makefile.in"),
4037 Vinstallation_directory);
4038 tem2 = Ffile_exists_p (tem);
4039 if (!NILP (tem1) && NILP (tem2))
0f337465
RS		 4040 {
4041 tem = Fexpand_file_name (build_string ("lisp"),
4042 Vsource_directory);
4043
4044 if (NILP (Fmember (tem, Vload_path)))
3ddff138 4045 Vload_path = Fcons (tem, Vload_path);
0f337465 4046
9fbc0116
RS		 4047 tem = Fexpand_file_name (build_string ("leim"),
4048 Vsource_directory);
4049
4050 if (NILP (Fmember (tem, Vload_path)))
3ddff138 4051 Vload_path = Fcons (tem, Vload_path);
9fbc0116 4052
0f337465
RS		 4053 tem = Fexpand_file_name (build_string ("site-lisp"),
4054 Vsource_directory);
4055
4056 if (NILP (Fmember (tem, Vload_path)))
3ddff138 4057 Vload_path = Fcons (tem, Vload_path);
0f337465
RS		 4058 }
4059 }
3ddff138
RS		 4060 if (!NILP (sitelisp))
4061 Vload_path = nconc2 (Fnreverse (sitelisp), Vload_path);
80667d53
RS		 4062 }
4063 }
4746118a
JB		 4064 }
4065 else
11938f10 4066 {
7b396c6c
RS		 4067 /* NORMAL refers to the lisp dir in the source directory. */
4068 /* We used to add ../lisp at the front here, but
4069 that caused trouble because it was copied from dump_path
88852d45 4070 into Vload_path, above, when Vinstallation_directory was non-nil.
7b396c6c
RS		 4071 It should be unnecessary. */
4072 Vload_path = decode_env_path (0, normal);
11938f10
KH		 4073 dump_path = Vload_path;
4074 }
46947372 4075#endif
279499f0 4076
536d6baa 4077#if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
177c0ea7
JB		 4078 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4079 almost never correct, thereby causing a warning to be printed out that
8e6208c5 4080 confuses users. Since PATH_LOADSEARCH is always overridden by the
95af0924 4081 EMACSLOADPATH environment variable below, disable the warning on NT.
f3d5f92d
ST		 4082 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
4083 the "standard" paths may not exist and would be overridden by
4084 EMACSLOADPATH as on NT. Since this depends on how the executable
4085 was build and packaged, turn off the warnings in general */
317073d5 4086
078e7b4a 4087 /* Warn if dirs in the *standard* path don't exist. */
e73997a1
RS		 4088 if (!turn_off_warning)
4089 {
4090 Lisp_Object path_tail;
078e7b4a 4091
e73997a1
RS		 4092 for (path_tail = Vload_path;
4093 !NILP (path_tail);
c1d497be 4094 path_tail = XCDR (path_tail))
e73997a1
RS		 4095 {
4096 Lisp_Object dirfile;
4097 dirfile = Fcar (path_tail);
4098 if (STRINGP (dirfile))
4099 {
4100 dirfile = Fdirectory_file_name (dirfile);
d5db4077 4101 if (access (SDATA (dirfile), 0) < 0)
85496b8c 4102 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
c1d497be 4103 XCAR (path_tail));
e73997a1
RS		 4104 }
4105 }
4106 }
536d6baa 4107#endif /* !(WINDOWSNT || HAVE_CARBON) */
46947372
JB		 4108
4109 /* If the EMACSLOADPATH environment variable is set, use its value.
4110 This doesn't apply if we're dumping. */
ffd9c2a1 4111#ifndef CANNOT_DUMP
46947372
JB		 4112 if (NILP (Vpurify_flag)
4113 && egetenv ("EMACSLOADPATH"))
ffd9c2a1 4114#endif
279499f0 4115 Vload_path = decode_env_path ("EMACSLOADPATH", normal);
279499f0
JB		 4116
4117 Vvalues = Qnil;
4118
078e7b4a 4119 load_in_progress = 0;
4e53f562 4120 Vload_file_name = Qnil;
d2c6be7f
RS		 4121
4122 load_descriptor_list = Qnil;
8f6b0411
RS		 4123
4124 Vstandard_input = Qt;
f74b0705 4125 Vloads_in_progress = Qnil;
078e7b4a
JB		 4126}
4127
85496b8c 4128/* Print a warning, using format string FORMAT, that directory DIRNAME
88852d45 4129 does not exist. Print it on stderr and put it in *Messages*. */
85496b8c 4130
d5b28a9d 4131void
85496b8c
RS		 4132dir_warning (format, dirname)
4133 char *format;
4134 Lisp_Object dirname;
4135{
4136 char *buffer
d5db4077 4137 = (char *) alloca (SCHARS (dirname) + strlen (format) + 5);
85496b8c 4138
d5db4077
KR		 4139 fprintf (stderr, format, SDATA (dirname));
4140 sprintf (buffer, format, SDATA (dirname));
9b69357e
GV		 4141 /* Don't log the warning before we've initialized!! */
4142 if (initialized)
4143 message_dolog (buffer, strlen (buffer), 0, STRING_MULTIBYTE (dirname));
85496b8c
RS		 4144}
4145
078e7b4a 4146void
279499f0 4147syms_of_lread ()
078e7b4a
JB		 4148{
4149 defsubr (&Sread);
4150 defsubr (&Sread_from_string);
4151 defsubr (&Sintern);
4152 defsubr (&Sintern_soft);
d007f5c8 4153 defsubr (&Sunintern);
971a4293 4154 defsubr (&Sget_load_suffixes);
078e7b4a 4155 defsubr (&Sload);
228d4b1c 4156 defsubr (&Seval_buffer);
078e7b4a
JB		 4157 defsubr (&Seval_region);
4158 defsubr (&Sread_char);
4159 defsubr (&Sread_char_exclusive);
078e7b4a 4160 defsubr (&Sread_event);
078e7b4a
JB		 4161 defsubr (&Sget_file_char);
4162 defsubr (&Smapatoms);
86d00812 4163 defsubr (&Slocate_file_internal);
078e7b4a
JB		 4164
4165 DEFVAR_LISP ("obarray", &Vobarray,
5de38842
PJ		 4166 doc: /* Symbol table for use by `intern' and `read'.
4167It is a vector whose length ought to be prime for best results.
4168The vector's contents don't make sense if examined from Lisp programs;
4169to find all the symbols in an obarray, use `mapatoms'. */);
078e7b4a
JB		 4170
4171 DEFVAR_LISP ("values", &Vvalues,
5de38842
PJ		 4172 doc: /* List of values of all expressions which were read, evaluated and printed.
4173Order is reverse chronological. */);
078e7b4a
JB		 4174
4175 DEFVAR_LISP ("standard-input", &Vstandard_input,
5de38842
PJ		 4176 doc: /* Stream for read to get input from.
4177See documentation of `read' for possible values. */);
078e7b4a
JB		 4178 Vstandard_input = Qt;
4179
abb13b09
CW		 4180 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions,
4181 doc: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4182
4183If this variable is a buffer, then only forms read from that buffer
4184will be added to `read-symbol-positions-list'.
4185If this variable is t, then all read forms will be added.
4186The effect of all other values other than nil are not currently
4187defined, although they may be in the future.
4188
4189The positions are relative to the last call to `read' or
4190`read-from-string'. It is probably a bad idea to set this variable at
4191the toplevel; bind it instead. */);
4192 Vread_with_symbol_positions = Qnil;
4193
4194 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list,
d6567030 4195 doc: /* A list mapping read symbols to their positions.
abb13b09
CW		 4196This variable is modified during calls to `read' or
4197`read-from-string', but only when `read-with-symbol-positions' is
4198non-nil.
4199
4200Each element of the list looks like (SYMBOL . CHAR-POSITION), where
d6567030 4201CHAR-POSITION is an integer giving the offset of that occurrence of the
abb13b09
CW		 4202symbol from the position where `read' or `read-from-string' started.
4203
4204Note that a symbol will appear multiple times in this list, if it was
4205read multiple times. The list is in the same order as the symbols
4206were read in. */);
177c0ea7 4207 Vread_symbol_positions_list = Qnil;
abb13b09 4208
078e7b4a 4209 DEFVAR_LISP ("load-path", &Vload_path,
5de38842
PJ		 4210 doc: /* *List of directories to search for files to load.
4211Each element is a string (directory name) or nil (try default directory).
4212Initialized based on EMACSLOADPATH environment variable, if any,
4213otherwise to default specified by file `epaths.h' when Emacs was built. */);
078e7b4a 4214
e61b9b87 4215 DEFVAR_LISP ("load-suffixes", &Vload_suffixes,
971a4293
LT		 4216 doc: /* List of suffixes for (compiled or source) Emacs Lisp files.
4217This list should not include the empty string.
4218`load' and related functions try to append these suffixes, in order,
4219to the specified file name if a Lisp suffix is allowed or required. */);
e61b9b87
SM		 4220 Vload_suffixes = Fcons (build_string (".elc"),
4221 Fcons (build_string (".el"), Qnil));
971a4293
LT		 4222 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes,
4223 doc: /* List of suffixes that indicate representations of \
4224the same file.
4225This list should normally start with the empty string.
4226
4227Enabling Auto Compression mode appends the suffixes in
4228`jka-compr-load-suffixes' to this list and disabling Auto Compression
4229mode removes them again. `load' and related functions use this list to
4230determine whether they should look for compressed versions of a file
4231and, if so, which suffixes they should try to append to the file name
4232in order to do so. However, if you want to customize which suffixes
4233the loading functions recognize as compression suffixes, you should
4234customize `jka-compr-load-suffixes' rather than the present variable. */);
a74d1c97 4235 Vload_file_rep_suffixes = Fcons (empty_unibyte_string, Qnil);
e61b9b87 4236
078e7b4a 4237 DEFVAR_BOOL ("load-in-progress", &load_in_progress,
e0f24100 4238 doc: /* Non-nil if inside of `load'. */);
078e7b4a
JB		 4239
4240 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist,
5de38842 4241 doc: /* An alist of expressions to be evalled when particular files are loaded.
6bb6da3e
AM		 4242Each element looks like (REGEXP-OR-FEATURE FORMS...).
4243
4244REGEXP-OR-FEATURE is either a regular expression to match file names, or
4245a symbol \(a feature name).
4246
4247When `load' is run and the file-name argument matches an element's
4248REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4249REGEXP-OR-FEATURE, the FORMS in the element are executed.
4250
4251An error in FORMS does not undo the load, but does prevent execution of
4252the rest of the FORMS. */);
078e7b4a
JB		 4253 Vafter_load_alist = Qnil;
4254
ae321d28 4255 DEFVAR_LISP ("load-history", &Vload_history,
0fc213e9 4256 doc: /* Alist mapping file names to symbols and features.
5de38842
PJ		 4257Each alist element is a list that starts with a file name,
4258except for one element (optional) that starts with nil and describes
4259definitions evaluated from buffers not visiting files.
6bb6da3e
AM		 4260
4261The file name is absolute and is the true file name (i.e. it doesn't
4262contain symbolic links) of the loaded file.
4263
1bc2cdb1 4264The remaining elements of each list are symbols defined as variables
d642e4f9 4265and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
191c4353
JB		 4266`(defun . FUNCTION)', `(autoload . SYMBOL)', `(defface . SYMBOL)'
4267and `(t . SYMBOL)'. An element `(t . SYMBOL)' precedes an entry
4268`(defun . FUNCTION)', and means that SYMBOL was an autoload before
4269this file redefined it as a function.
0fc213e9 4270
b502a9a1
RS		 4271During preloading, the file name recorded is relative to the main Lisp
4272directory. These file names are converted to absolute at startup. */);
ae321d28
RS		 4273 Vload_history = Qnil;
4274
20ea2964 4275 DEFVAR_LISP ("load-file-name", &Vload_file_name,
5de38842 4276 doc: /* Full name of file being loaded by `load'. */);
20ea2964
RS		 4277 Vload_file_name = Qnil;
4278
4116ab9f 4279 DEFVAR_LISP ("user-init-file", &Vuser_init_file,
5de38842 4280 doc: /* File name, including directory, of user's initialization file.
0a25a201
RS		 4281If the file loaded had extension `.elc', and the corresponding source file
4282exists, this variable contains the name of source file, suitable for use
099de390
JB		 4283by functions like `custom-save-all' which edit the init file.
4284While Emacs loads and evaluates the init file, value is the real name
4285of the file, regardless of whether or not it has the `.elc' extension. */);
4116ab9f
KH		 4286 Vuser_init_file = Qnil;
4287
8a1f1537 4288 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list,
5de38842 4289 doc: /* Used for internal purposes by `load'. */);
ae321d28
RS		 4290 Vcurrent_load_list = Qnil;
4291
84a15045 4292 DEFVAR_LISP ("load-read-function", &Vload_read_function,
5de38842
PJ		 4293 doc: /* Function used by `load' and `eval-region' for reading expressions.
4294The default is nil, which means use the function `read'. */);
84a15045
RS		 4295 Vload_read_function = Qnil;
4296
fe0e03f3 4297 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function,
9b33a603 4298 doc: /* Function called in `load' for loading an Emacs Lisp source file.
5de38842
PJ		 4299This function is for doing code conversion before reading the source file.
4300If nil, loading is done without any code conversion.
4301Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4302 FULLNAME is the full name of FILE.
4303See `load' for the meaning of the remaining arguments. */);
fe0e03f3
KH		 4304 Vload_source_file_function = Qnil;
4305
b2a30870 4306 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings,
5de38842
PJ		 4307 doc: /* Non-nil means `load' should force-load all dynamic doc strings.
4308This is useful when the file being loaded is a temporary copy. */);
b2a30870
RS		 4309 load_force_doc_strings = 0;
4310
94e554db 4311 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte,
5de38842
PJ		 4312 doc: /* Non-nil means `read' converts strings to unibyte whenever possible.
4313This is normally bound by `load' and `eval-buffer' to control `read',
4314and is not meant for users to change. */);
94e554db
RS		 4315 load_convert_to_unibyte = 0;
4316
1521a8fa 4317 DEFVAR_LISP ("source-directory", &Vsource_directory,
5de38842
PJ		 4318 doc: /* Directory in which Emacs sources were found when Emacs was built.
4319You cannot count on them to still be there! */);
a90ba1e2
KH		 4320 Vsource_directory
4321 = Fexpand_file_name (build_string ("../"),
4322 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH)));
4323
4b104c41 4324 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list,
5de38842 4325 doc: /* List of files that were preloaded (when dumping Emacs). */);
4b104c41
RS		 4326 Vpreloaded_file_list = Qnil;
4327
1ffcc3b1 4328 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars,
5de38842 4329 doc: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
1ffcc3b1
DL		 4330 Vbyte_boolean_vars = Qnil;
4331
da84f340 4332 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries,
5de38842
PJ		 4333 doc: /* Non-nil means load dangerous compiled Lisp files.
4334Some versions of XEmacs use different byte codes than Emacs. These
4335incompatible byte codes can make Emacs crash when it tries to execute
4336them. */);
da84f340
GM		 4337 load_dangerous_libraries = 0;
4338
bb970e67 4339 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp,
5de38842
PJ		 4340 doc: /* Regular expression matching safe to load compiled Lisp files.
4341When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4342from the file, and matches them against this regular expression.
4343When the regular expression matches, the file is considered to be safe
4344to load. See also `load-dangerous-libraries'. */);
bb970e67 4345 Vbytecomp_version_regexp
f2e7d5eb 4346 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
da84f340 4347
3f39f996
RS		 4348 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list,
4349 doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4350 Veval_buffer_list = Qnil;
4351
5aa273b0
SM		 4352 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes,
4353 doc: /* Set to non-nil when `read' encounters an old-style backquote. */);
4354 Vold_style_backquotes = Qnil;
1d064697
SM		 4355 Qold_style_backquotes = intern ("old-style-backquotes");
4356 staticpro (&Qold_style_backquotes);
5aa273b0 4357
a90ba1e2
KH		 4358 /* Vsource_directory was initialized in init_lread. */
4359
d2c6be7f
RS		 4360 load_descriptor_list = Qnil;
4361 staticpro (&load_descriptor_list);
4362
8a1f1537
RS		 4363 Qcurrent_load_list = intern ("current-load-list");
4364 staticpro (&Qcurrent_load_list);
4365
078e7b4a
JB		 4366 Qstandard_input = intern ("standard-input");
4367 staticpro (&Qstandard_input);
4368
4369 Qread_char = intern ("read-char");
4370 staticpro (&Qread_char);
4371
4372 Qget_file_char = intern ("get-file-char");
4373 staticpro (&Qget_file_char);
7bd279cd 4374
8792be66
KH		 4375 Qget_emacs_mule_file_char = intern ("get-emacs-mule-file-char");
4376 staticpro (&Qget_emacs_mule_file_char);
4377
4378 Qload_force_doc_strings = intern ("load-force-doc-strings");
4379 staticpro (&Qload_force_doc_strings);
4380
17634846
RS		 4381 Qbackquote = intern ("`");
4382 staticpro (&Qbackquote);
4383 Qcomma = intern (",");
4384 staticpro (&Qcomma);
4385 Qcomma_at = intern (",@");
4386 staticpro (&Qcomma_at);
4387 Qcomma_dot = intern (",.");
4388 staticpro (&Qcomma_dot);
4389
74549846
RS		 4390 Qinhibit_file_name_operation = intern ("inhibit-file-name-operation");
4391 staticpro (&Qinhibit_file_name_operation);
4392
7bd279cd
RS		 4393 Qascii_character = intern ("ascii-character");
4394 staticpro (&Qascii_character);
c2225d00 4395
2b6cae0c
RS		 4396 Qfunction = intern ("function");
4397 staticpro (&Qfunction);
4398
c2225d00
RS		 4399 Qload = intern ("load");
4400 staticpro (&Qload);
20ea2964
RS		 4401
4402 Qload_file_name = intern ("load-file-name");
4403 staticpro (&Qload_file_name);
11938f10 4404
3f39f996
RS		 4405 Qeval_buffer_list = intern ("eval-buffer-list");
4406 staticpro (&Qeval_buffer_list);
4407
6bb6da3e
AM		 4408 Qfile_truename = intern ("file-truename");
4409 staticpro (&Qfile_truename) ;
4410
4411 Qdo_after_load_evaluation = intern ("do-after-load-evaluation");
4412 staticpro (&Qdo_after_load_evaluation) ;
4413
11938f10 4414 staticpro (&dump_path);
4ad679f9
EN		 4415
4416 staticpro (&read_objects);
4417 read_objects = Qnil;
9e062b6c 4418 staticpro (&seen_list);
f153db13 4419 seen_list = Qnil;
177c0ea7 4420
7ee3bd7b
GM		 4421 Vloads_in_progress = Qnil;
4422 staticpro (&Vloads_in_progress);
078e7b4a 4423}
6b61353c
KH		 4424
4425/* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4426 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.