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