Don't call the same hook twice due to obsolete aliases
[emacs.git] / src / lread.c
blobdbaadce4b407ad045510e80a695e6958a42a04d9
1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2017 Free Software Foundation,
4 Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 /* Tell globals.h to define tables needed by init_obarray. */
22 #define DEFINE_SYMBOLS
24 #include <config.h>
25 #include "sysstdio.h"
26 #include <stdlib.h>
27 #include <sys/types.h>
28 #include <sys/stat.h>
29 #include <sys/file.h>
30 #include <errno.h>
31 #include <math.h>
32 #include <stat-time.h>
33 #include "lisp.h"
34 #include "dispextern.h"
35 #include "intervals.h"
36 #include "character.h"
37 #include "buffer.h"
38 #include "charset.h"
39 #include <epaths.h>
40 #include "commands.h"
41 #include "keyboard.h"
42 #include "systime.h"
43 #include "termhooks.h"
44 #include "blockinput.h"
45 #include <c-ctype.h>
47 #ifdef MSDOS
48 #include "msdos.h"
49 #if __DJGPP__ == 2 && __DJGPP_MINOR__ < 5
50 # define INFINITY __builtin_inf()
51 # define NAN __builtin_nan("")
52 #endif
53 #endif
55 #ifdef HAVE_NS
56 #include "nsterm.h"
57 #endif
59 #include <unistd.h>
61 #ifdef HAVE_SETLOCALE
62 #include <locale.h>
63 #endif /* HAVE_SETLOCALE */
65 #include <fcntl.h>
67 #ifdef HAVE_FSEEKO
68 #define file_offset off_t
69 #define file_tell ftello
70 #else
71 #define file_offset long
72 #define file_tell ftell
73 #endif
75 /* The objects or placeholders read with the #n=object form.
77 A hash table maps a number to either a placeholder (while the
78 object is still being parsed, in case it's referenced within its
79 own definition) or to the completed object. With small integers
80 for keys, it's effectively little more than a vector, but it'll
81 manage any needed resizing for us.
83 The variable must be reset to an empty hash table before all
84 top-level calls to read0. In between calls, it may be an empty
85 hash table left unused from the previous call (to reduce
86 allocations), or nil. */
87 static Lisp_Object read_objects_map;
89 /* The recursive objects read with the #n=object form.
91 Objects that might have circular references are stored here, so
92 that recursive substitution knows not to keep processing them
93 multiple times.
95 Only objects that are completely processed, including substituting
96 references to themselves (but not necessarily replacing
97 placeholders for other objects still being read), are stored.
99 A hash table is used for efficient lookups of keys. We don't care
100 what the value slots hold. The variable must be set to an empty
101 hash table before all top-level calls to read0. In between calls,
102 it may be an empty hash table left unused from the previous call
103 (to reduce allocations), or nil. */
104 static Lisp_Object read_objects_completed;
106 /* File and lookahead for get-file-char and get-emacs-mule-file-char
107 to read from. Used by Fload. */
108 static struct infile
110 /* The input stream. */
111 FILE *stream;
113 /* Lookahead byte count. */
114 signed char lookahead;
116 /* Lookahead bytes, in reverse order. Keep these here because it is
117 not portable to ungetc more than one byte at a time. */
118 unsigned char buf[MAX_MULTIBYTE_LENGTH - 1];
119 } *infile;
121 /* For use within read-from-string (this reader is non-reentrant!!) */
122 static ptrdiff_t read_from_string_index;
123 static ptrdiff_t read_from_string_index_byte;
124 static ptrdiff_t read_from_string_limit;
126 /* Number of characters read in the current call to Fread or
127 Fread_from_string. */
128 static EMACS_INT readchar_count;
130 /* This contains the last string skipped with #@. */
131 static char *saved_doc_string;
132 /* Length of buffer allocated in saved_doc_string. */
133 static ptrdiff_t saved_doc_string_size;
134 /* Length of actual data in saved_doc_string. */
135 static ptrdiff_t saved_doc_string_length;
136 /* This is the file position that string came from. */
137 static file_offset saved_doc_string_position;
139 /* This contains the previous string skipped with #@.
140 We copy it from saved_doc_string when a new string
141 is put in saved_doc_string. */
142 static char *prev_saved_doc_string;
143 /* Length of buffer allocated in prev_saved_doc_string. */
144 static ptrdiff_t prev_saved_doc_string_size;
145 /* Length of actual data in prev_saved_doc_string. */
146 static ptrdiff_t prev_saved_doc_string_length;
147 /* This is the file position that string came from. */
148 static file_offset prev_saved_doc_string_position;
150 /* True means inside a new-style backquote
151 with no surrounding parentheses.
152 Fread initializes this to false, so we need not specbind it
153 or worry about what happens to it when there is an error. */
154 static bool new_backquote_flag;
156 /* A list of file names for files being loaded in Fload. Used to
157 check for recursive loads. */
159 static Lisp_Object Vloads_in_progress;
161 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
162 Lisp_Object);
164 static void readevalloop (Lisp_Object, struct infile *, Lisp_Object, bool,
165 Lisp_Object, Lisp_Object,
166 Lisp_Object, Lisp_Object);
168 /* Functions that read one byte from the current source READCHARFUN
169 or unreads one byte. If the integer argument C is -1, it returns
170 one read byte, or -1 when there's no more byte in the source. If C
171 is 0 or positive, it unreads C, and the return value is not
172 interesting. */
174 static int readbyte_for_lambda (int, Lisp_Object);
175 static int readbyte_from_file (int, Lisp_Object);
176 static int readbyte_from_string (int, Lisp_Object);
178 /* Handle unreading and rereading of characters.
179 Write READCHAR to read a character,
180 UNREAD(c) to unread c to be read again.
182 These macros correctly read/unread multibyte characters. */
184 #define READCHAR readchar (readcharfun, NULL)
185 #define UNREAD(c) unreadchar (readcharfun, c)
187 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
188 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
190 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
191 Qlambda, or a cons, we use this to keep an unread character because
192 a file stream can't handle multibyte-char unreading. The value -1
193 means that there's no unread character. */
194 static int unread_char;
196 static int
197 readchar (Lisp_Object readcharfun, bool *multibyte)
199 Lisp_Object tem;
200 register int c;
201 int (*readbyte) (int, Lisp_Object);
202 unsigned char buf[MAX_MULTIBYTE_LENGTH];
203 int i, len;
204 bool emacs_mule_encoding = 0;
206 if (multibyte)
207 *multibyte = 0;
209 readchar_count++;
211 if (BUFFERP (readcharfun))
213 register struct buffer *inbuffer = XBUFFER (readcharfun);
215 ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
217 if (! BUFFER_LIVE_P (inbuffer))
218 return -1;
220 if (pt_byte >= BUF_ZV_BYTE (inbuffer))
221 return -1;
223 if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
225 /* Fetch the character code from the buffer. */
226 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
227 BUF_INC_POS (inbuffer, pt_byte);
228 c = STRING_CHAR (p);
229 if (multibyte)
230 *multibyte = 1;
232 else
234 c = BUF_FETCH_BYTE (inbuffer, pt_byte);
235 if (! ASCII_CHAR_P (c))
236 c = BYTE8_TO_CHAR (c);
237 pt_byte++;
239 SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
241 return c;
243 if (MARKERP (readcharfun))
245 register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
247 ptrdiff_t bytepos = marker_byte_position (readcharfun);
249 if (bytepos >= BUF_ZV_BYTE (inbuffer))
250 return -1;
252 if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
254 /* Fetch the character code from the buffer. */
255 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
256 BUF_INC_POS (inbuffer, bytepos);
257 c = STRING_CHAR (p);
258 if (multibyte)
259 *multibyte = 1;
261 else
263 c = BUF_FETCH_BYTE (inbuffer, bytepos);
264 if (! ASCII_CHAR_P (c))
265 c = BYTE8_TO_CHAR (c);
266 bytepos++;
269 XMARKER (readcharfun)->bytepos = bytepos;
270 XMARKER (readcharfun)->charpos++;
272 return c;
275 if (EQ (readcharfun, Qlambda))
277 readbyte = readbyte_for_lambda;
278 goto read_multibyte;
281 if (EQ (readcharfun, Qget_file_char))
283 readbyte = readbyte_from_file;
284 goto read_multibyte;
287 if (STRINGP (readcharfun))
289 if (read_from_string_index >= read_from_string_limit)
290 c = -1;
291 else if (STRING_MULTIBYTE (readcharfun))
293 if (multibyte)
294 *multibyte = 1;
295 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun,
296 read_from_string_index,
297 read_from_string_index_byte);
299 else
301 c = SREF (readcharfun, read_from_string_index_byte);
302 read_from_string_index++;
303 read_from_string_index_byte++;
305 return c;
308 if (CONSP (readcharfun) && STRINGP (XCAR (readcharfun)))
310 /* This is the case that read_vector is reading from a unibyte
311 string that contains a byte sequence previously skipped
312 because of #@NUMBER. The car part of readcharfun is that
313 string, and the cdr part is a value of readcharfun given to
314 read_vector. */
315 readbyte = readbyte_from_string;
316 if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
317 emacs_mule_encoding = 1;
318 goto read_multibyte;
321 if (EQ (readcharfun, Qget_emacs_mule_file_char))
323 readbyte = readbyte_from_file;
324 emacs_mule_encoding = 1;
325 goto read_multibyte;
328 tem = call0 (readcharfun);
330 if (NILP (tem))
331 return -1;
332 return XINT (tem);
334 read_multibyte:
335 if (unread_char >= 0)
337 c = unread_char;
338 unread_char = -1;
339 return c;
341 c = (*readbyte) (-1, readcharfun);
342 if (c < 0)
343 return c;
344 if (multibyte)
345 *multibyte = 1;
346 if (ASCII_CHAR_P (c))
347 return c;
348 if (emacs_mule_encoding)
349 return read_emacs_mule_char (c, readbyte, readcharfun);
350 i = 0;
351 buf[i++] = c;
352 len = BYTES_BY_CHAR_HEAD (c);
353 while (i < len)
355 buf[i++] = c = (*readbyte) (-1, readcharfun);
356 if (c < 0 || ! TRAILING_CODE_P (c))
358 for (i -= c < 0; 0 < --i; )
359 (*readbyte) (buf[i], readcharfun);
360 return BYTE8_TO_CHAR (buf[0]);
363 return STRING_CHAR (buf);
366 #define FROM_FILE_P(readcharfun) \
367 (EQ (readcharfun, Qget_file_char) \
368 || EQ (readcharfun, Qget_emacs_mule_file_char))
370 static void
371 skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
373 if (FROM_FILE_P (readcharfun))
375 block_input (); /* FIXME: Not sure if it's needed. */
376 fseek (infile->stream, n - infile->lookahead, SEEK_CUR);
377 unblock_input ();
378 infile->lookahead = 0;
380 else
381 { /* We're not reading directly from a file. In that case, it's difficult
382 to reliably count bytes, since these are usually meant for the file's
383 encoding, whereas we're now typically in the internal encoding.
384 But luckily, skip_dyn_bytes is used to skip over a single
385 dynamic-docstring (or dynamic byte-code) which is always quoted such
386 that \037 is the final char. */
387 int c;
388 do {
389 c = READCHAR;
390 } while (c >= 0 && c != '\037');
394 static void
395 skip_dyn_eof (Lisp_Object readcharfun)
397 if (FROM_FILE_P (readcharfun))
399 block_input (); /* FIXME: Not sure if it's needed. */
400 fseek (infile->stream, 0, SEEK_END);
401 unblock_input ();
402 infile->lookahead = 0;
404 else
405 while (READCHAR >= 0);
408 /* Unread the character C in the way appropriate for the stream READCHARFUN.
409 If the stream is a user function, call it with the char as argument. */
411 static void
412 unreadchar (Lisp_Object readcharfun, int c)
414 readchar_count--;
415 if (c == -1)
416 /* Don't back up the pointer if we're unreading the end-of-input mark,
417 since readchar didn't advance it when we read it. */
419 else if (BUFFERP (readcharfun))
421 struct buffer *b = XBUFFER (readcharfun);
422 ptrdiff_t charpos = BUF_PT (b);
423 ptrdiff_t bytepos = BUF_PT_BYTE (b);
425 if (! NILP (BVAR (b, enable_multibyte_characters)))
426 BUF_DEC_POS (b, bytepos);
427 else
428 bytepos--;
430 SET_BUF_PT_BOTH (b, charpos - 1, bytepos);
432 else if (MARKERP (readcharfun))
434 struct buffer *b = XMARKER (readcharfun)->buffer;
435 ptrdiff_t bytepos = XMARKER (readcharfun)->bytepos;
437 XMARKER (readcharfun)->charpos--;
438 if (! NILP (BVAR (b, enable_multibyte_characters)))
439 BUF_DEC_POS (b, bytepos);
440 else
441 bytepos--;
443 XMARKER (readcharfun)->bytepos = bytepos;
445 else if (STRINGP (readcharfun))
447 read_from_string_index--;
448 read_from_string_index_byte
449 = string_char_to_byte (readcharfun, read_from_string_index);
451 else if (CONSP (readcharfun) && STRINGP (XCAR (readcharfun)))
453 unread_char = c;
455 else if (EQ (readcharfun, Qlambda))
457 unread_char = c;
459 else if (FROM_FILE_P (readcharfun))
461 unread_char = c;
463 else
464 call1 (readcharfun, make_number (c));
467 static int
468 readbyte_for_lambda (int c, Lisp_Object readcharfun)
470 return read_bytecode_char (c >= 0);
474 static int
475 readbyte_from_stdio (void)
477 if (infile->lookahead)
478 return infile->buf[--infile->lookahead];
480 int c;
481 FILE *instream = infile->stream;
483 block_input ();
485 /* Interrupted reads have been observed while reading over the network. */
486 while ((c = getc_unlocked (instream)) == EOF && errno == EINTR
487 && ferror_unlocked (instream))
489 unblock_input ();
490 maybe_quit ();
491 block_input ();
492 clearerr_unlocked (instream);
495 unblock_input ();
497 return (c == EOF ? -1 : c);
500 static int
501 readbyte_from_file (int c, Lisp_Object readcharfun)
503 if (c >= 0)
505 eassert (infile->lookahead < sizeof infile->buf);
506 infile->buf[infile->lookahead++] = c;
507 return 0;
510 return readbyte_from_stdio ();
513 static int
514 readbyte_from_string (int c, Lisp_Object readcharfun)
516 Lisp_Object string = XCAR (readcharfun);
518 if (c >= 0)
520 read_from_string_index--;
521 read_from_string_index_byte
522 = string_char_to_byte (string, read_from_string_index);
525 if (read_from_string_index >= read_from_string_limit)
526 c = -1;
527 else
528 FETCH_STRING_CHAR_ADVANCE (c, string,
529 read_from_string_index,
530 read_from_string_index_byte);
531 return c;
535 /* Read one non-ASCII character from INFILE. The character is
536 encoded in `emacs-mule' and the first byte is already read in
537 C. */
539 static int
540 read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun)
542 /* Emacs-mule coding uses at most 4-byte for one character. */
543 unsigned char buf[4];
544 int len = emacs_mule_bytes[c];
545 struct charset *charset;
546 int i;
547 unsigned code;
549 if (len == 1)
550 /* C is not a valid leading-code of `emacs-mule'. */
551 return BYTE8_TO_CHAR (c);
553 i = 0;
554 buf[i++] = c;
555 while (i < len)
557 buf[i++] = c = (*readbyte) (-1, readcharfun);
558 if (c < 0xA0)
560 for (i -= c < 0; 0 < --i; )
561 (*readbyte) (buf[i], readcharfun);
562 return BYTE8_TO_CHAR (buf[0]);
566 if (len == 2)
568 charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
569 code = buf[1] & 0x7F;
571 else if (len == 3)
573 if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
574 || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
576 charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
577 code = buf[2] & 0x7F;
579 else
581 charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
582 code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
585 else
587 charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
588 code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
590 c = DECODE_CHAR (charset, code);
591 if (c < 0)
592 Fsignal (Qinvalid_read_syntax,
593 list1 (build_string ("invalid multibyte form")));
594 return c;
598 /* An in-progress substitution of OBJECT for PLACEHOLDER. */
599 struct subst
601 Lisp_Object object;
602 Lisp_Object placeholder;
604 /* Hash table of subobjects of OBJECT that might be circular. If
605 Qt, all such objects might be circular. */
606 Lisp_Object completed;
608 /* List of subobjects of OBJECT that have already been visited. */
609 Lisp_Object seen;
612 static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
613 Lisp_Object);
614 static Lisp_Object read0 (Lisp_Object);
615 static Lisp_Object read1 (Lisp_Object, int *, bool);
617 static Lisp_Object read_list (bool, Lisp_Object);
618 static Lisp_Object read_vector (Lisp_Object, bool);
620 static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object);
621 static void substitute_in_interval (INTERVAL, void *);
624 /* Get a character from the tty. */
626 /* Read input events until we get one that's acceptable for our purposes.
628 If NO_SWITCH_FRAME, switch-frame events are stashed
629 until we get a character we like, and then stuffed into
630 unread_switch_frame.
632 If ASCII_REQUIRED, check function key events to see
633 if the unmodified version of the symbol has a Qascii_character
634 property, and use that character, if present.
636 If ERROR_NONASCII, signal an error if the input we
637 get isn't an ASCII character with modifiers. If it's false but
638 ASCII_REQUIRED is true, just re-read until we get an ASCII
639 character.
641 If INPUT_METHOD, invoke the current input method
642 if the character warrants that.
644 If SECONDS is a number, wait that many seconds for input, and
645 return Qnil if no input arrives within that time. */
647 static Lisp_Object
648 read_filtered_event (bool no_switch_frame, bool ascii_required,
649 bool error_nonascii, bool input_method, Lisp_Object seconds)
651 Lisp_Object val, delayed_switch_frame;
652 struct timespec end_time;
654 #ifdef HAVE_WINDOW_SYSTEM
655 if (display_hourglass_p)
656 cancel_hourglass ();
657 #endif
659 delayed_switch_frame = Qnil;
661 /* Compute timeout. */
662 if (NUMBERP (seconds))
664 double duration = XFLOATINT (seconds);
665 struct timespec wait_time = dtotimespec (duration);
666 end_time = timespec_add (current_timespec (), wait_time);
669 /* Read until we get an acceptable event. */
670 retry:
672 val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0,
673 NUMBERP (seconds) ? &end_time : NULL);
674 while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */
676 if (BUFFERP (val))
677 goto retry;
679 /* `switch-frame' events are put off until after the next ASCII
680 character. This is better than signaling an error just because
681 the last characters were typed to a separate minibuffer frame,
682 for example. Eventually, some code which can deal with
683 switch-frame events will read it and process it. */
684 if (no_switch_frame
685 && EVENT_HAS_PARAMETERS (val)
686 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
688 delayed_switch_frame = val;
689 goto retry;
692 if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
694 /* Convert certain symbols to their ASCII equivalents. */
695 if (SYMBOLP (val))
697 Lisp_Object tem, tem1;
698 tem = Fget (val, Qevent_symbol_element_mask);
699 if (!NILP (tem))
701 tem1 = Fget (Fcar (tem), Qascii_character);
702 /* Merge this symbol's modifier bits
703 with the ASCII equivalent of its basic code. */
704 if (!NILP (tem1))
705 XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
709 /* If we don't have a character now, deal with it appropriately. */
710 if (!INTEGERP (val))
712 if (error_nonascii)
714 Vunread_command_events = list1 (val);
715 error ("Non-character input-event");
717 else
718 goto retry;
722 if (! NILP (delayed_switch_frame))
723 unread_switch_frame = delayed_switch_frame;
725 #if 0
727 #ifdef HAVE_WINDOW_SYSTEM
728 if (display_hourglass_p)
729 start_hourglass ();
730 #endif
732 #endif
734 return val;
737 DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
738 doc: /* Read a character from the command input (keyboard or macro).
739 It is returned as a number.
740 If the character has modifiers, they are resolved and reflected to the
741 character code if possible (e.g. C-SPC -> 0).
743 If the user generates an event which is not a character (i.e. a mouse
744 click or function key event), `read-char' signals an error. As an
745 exception, switch-frame events are put off until non-character events
746 can be read.
747 If you want to read non-character events, or ignore them, call
748 `read-event' or `read-char-exclusive' instead.
750 If the optional argument PROMPT is non-nil, display that as a prompt.
751 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
752 input method is turned on in the current buffer, that input method
753 is used for reading a character.
754 If the optional argument SECONDS is non-nil, it should be a number
755 specifying the maximum number of seconds to wait for input. If no
756 input arrives in that time, return nil. SECONDS may be a
757 floating-point value. */)
758 (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
760 Lisp_Object val;
762 if (! NILP (prompt))
763 message_with_string ("%s", prompt, 0);
764 val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
766 return (NILP (val) ? Qnil
767 : make_number (char_resolve_modifier_mask (XINT (val))));
770 DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
771 doc: /* Read an event object from the input stream.
772 If the optional argument PROMPT is non-nil, display that as a prompt.
773 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
774 input method is turned on in the current buffer, that input method
775 is used for reading a character.
776 If the optional argument SECONDS is non-nil, it should be a number
777 specifying the maximum number of seconds to wait for input. If no
778 input arrives in that time, return nil. SECONDS may be a
779 floating-point value. */)
780 (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
782 if (! NILP (prompt))
783 message_with_string ("%s", prompt, 0);
784 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
787 DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
788 doc: /* Read a character from the command input (keyboard or macro).
789 It is returned as a number. Non-character events are ignored.
790 If the character has modifiers, they are resolved and reflected to the
791 character code if possible (e.g. C-SPC -> 0).
793 If the optional argument PROMPT is non-nil, display that as a prompt.
794 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
795 input method is turned on in the current buffer, that input method
796 is used for reading a character.
797 If the optional argument SECONDS is non-nil, it should be a number
798 specifying the maximum number of seconds to wait for input. If no
799 input arrives in that time, return nil. SECONDS may be a
800 floating-point value. */)
801 (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
803 Lisp_Object val;
805 if (! NILP (prompt))
806 message_with_string ("%s", prompt, 0);
808 val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
810 return (NILP (val) ? Qnil
811 : make_number (char_resolve_modifier_mask (XINT (val))));
814 DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
815 doc: /* Don't use this yourself. */)
816 (void)
818 if (!infile)
819 error ("get-file-char misused");
820 return make_number (readbyte_from_stdio ());
826 /* Return true if the lisp code read using READCHARFUN defines a non-nil
827 `lexical-binding' file variable. After returning, the stream is
828 positioned following the first line, if it is a comment or #! line,
829 otherwise nothing is read. */
831 static bool
832 lisp_file_lexically_bound_p (Lisp_Object readcharfun)
834 int ch = READCHAR;
836 if (ch == '#')
838 ch = READCHAR;
839 if (ch != '!')
841 UNREAD (ch);
842 UNREAD ('#');
843 return 0;
845 while (ch != '\n' && ch != EOF)
846 ch = READCHAR;
847 if (ch == '\n') ch = READCHAR;
848 /* It is OK to leave the position after a #! line, since
849 that is what read1 does. */
852 if (ch != ';')
853 /* The first line isn't a comment, just give up. */
855 UNREAD (ch);
856 return 0;
858 else
859 /* Look for an appropriate file-variable in the first line. */
861 bool rv = 0;
862 enum {
863 NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX
864 } beg_end_state = NOMINAL;
865 bool in_file_vars = 0;
867 #define UPDATE_BEG_END_STATE(ch) \
868 if (beg_end_state == NOMINAL) \
869 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
870 else if (beg_end_state == AFTER_FIRST_DASH) \
871 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
872 else if (beg_end_state == AFTER_ASTERIX) \
874 if (ch == '-') \
875 in_file_vars = !in_file_vars; \
876 beg_end_state = NOMINAL; \
879 /* Skip until we get to the file vars, if any. */
882 ch = READCHAR;
883 UPDATE_BEG_END_STATE (ch);
885 while (!in_file_vars && ch != '\n' && ch != EOF);
887 while (in_file_vars)
889 char var[100], val[100];
890 unsigned i;
892 ch = READCHAR;
894 /* Read a variable name. */
895 while (ch == ' ' || ch == '\t')
896 ch = READCHAR;
898 i = 0;
899 while (ch != ':' && ch != '\n' && ch != EOF && in_file_vars)
901 if (i < sizeof var - 1)
902 var[i++] = ch;
903 UPDATE_BEG_END_STATE (ch);
904 ch = READCHAR;
907 /* Stop scanning if no colon was found before end marker. */
908 if (!in_file_vars || ch == '\n' || ch == EOF)
909 break;
911 while (i > 0 && (var[i - 1] == ' ' || var[i - 1] == '\t'))
912 i--;
913 var[i] = '\0';
915 if (ch == ':')
917 /* Read a variable value. */
918 ch = READCHAR;
920 while (ch == ' ' || ch == '\t')
921 ch = READCHAR;
923 i = 0;
924 while (ch != ';' && ch != '\n' && ch != EOF && in_file_vars)
926 if (i < sizeof val - 1)
927 val[i++] = ch;
928 UPDATE_BEG_END_STATE (ch);
929 ch = READCHAR;
931 if (! in_file_vars)
932 /* The value was terminated by an end-marker, which remove. */
933 i -= 3;
934 while (i > 0 && (val[i - 1] == ' ' || val[i - 1] == '\t'))
935 i--;
936 val[i] = '\0';
938 if (strcmp (var, "lexical-binding") == 0)
939 /* This is it... */
941 rv = (strcmp (val, "nil") != 0);
942 break;
947 while (ch != '\n' && ch != EOF)
948 ch = READCHAR;
950 return rv;
954 /* Value is a version number of byte compiled code if the file
955 associated with file descriptor FD is a compiled Lisp file that's
956 safe to load. Only files compiled with Emacs are safe to load.
957 Files compiled with XEmacs can lead to a crash in Fbyte_code
958 because of an incompatible change in the byte compiler. */
960 static int
961 safe_to_load_version (int fd)
963 char buf[512];
964 int nbytes, i;
965 int version = 1;
967 /* Read the first few bytes from the file, and look for a line
968 specifying the byte compiler version used. */
969 nbytes = emacs_read_quit (fd, buf, sizeof buf);
970 if (nbytes > 0)
972 /* Skip to the next newline, skipping over the initial `ELC'
973 with NUL bytes following it, but note the version. */
974 for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
975 if (i == 4)
976 version = buf[i];
978 if (i >= nbytes
979 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
980 buf + i, nbytes - i) < 0)
981 version = 0;
984 lseek (fd, 0, SEEK_SET);
985 return version;
989 /* Callback for record_unwind_protect. Restore the old load list OLD,
990 after loading a file successfully. */
992 static void
993 record_load_unwind (Lisp_Object old)
995 Vloads_in_progress = old;
998 /* This handler function is used via internal_condition_case_1. */
1000 static Lisp_Object
1001 load_error_handler (Lisp_Object data)
1003 return Qnil;
1006 static void
1007 load_warn_old_style_backquotes (Lisp_Object file)
1009 if (!NILP (Vlread_old_style_backquotes))
1011 AUTO_STRING (format, "Loading `%s': old-style backquotes detected!");
1012 CALLN (Fmessage, format, file);
1016 static void
1017 load_warn_unescaped_character_literals (Lisp_Object file)
1019 if (NILP (Vlread_unescaped_character_literals)) return;
1020 CHECK_CONS (Vlread_unescaped_character_literals);
1021 Lisp_Object format =
1022 build_string ("Loading `%s': unescaped character literals %s detected!");
1023 Lisp_Object separator = build_string (", ");
1024 Lisp_Object inner_format = build_string ("`?%c'");
1025 CALLN (Fmessage,
1026 format, file,
1027 Fmapconcat (list3 (Qlambda, list1 (Qchar),
1028 list3 (Qformat, inner_format, Qchar)),
1029 Fsort (Vlread_unescaped_character_literals, Qlss),
1030 separator));
1033 DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
1034 doc: /* Return the suffixes that `load' should try if a suffix is \
1035 required.
1036 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
1037 (void)
1039 Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext;
1040 while (CONSP (suffixes))
1042 Lisp_Object exts = Vload_file_rep_suffixes;
1043 suffix = XCAR (suffixes);
1044 suffixes = XCDR (suffixes);
1045 while (CONSP (exts))
1047 ext = XCAR (exts);
1048 exts = XCDR (exts);
1049 lst = Fcons (concat2 (suffix, ext), lst);
1052 return Fnreverse (lst);
1055 /* Returns true if STRING ends with SUFFIX */
1056 static bool
1057 suffix_p (Lisp_Object string, const char *suffix)
1059 ptrdiff_t suffix_len = strlen (suffix);
1060 ptrdiff_t string_len = SBYTES (string);
1062 return string_len >= suffix_len && !strcmp (SSDATA (string) + string_len - suffix_len, suffix);
1065 static void
1066 close_infile_unwind (void *arg)
1068 FILE *stream = arg;
1069 eassert (infile == NULL || infile->stream == stream);
1070 infile = NULL;
1071 fclose (stream);
1074 DEFUN ("load", Fload, Sload, 1, 5, 0,
1075 doc: /* Execute a file of Lisp code named FILE.
1076 First try FILE with `.elc' appended, then try with `.el', then try
1077 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
1078 then try FILE unmodified (the exact suffixes in the exact order are
1079 determined by `load-suffixes'). Environment variable references in
1080 FILE are replaced with their values by calling `substitute-in-file-name'.
1081 This function searches the directories in `load-path'.
1083 If optional second arg NOERROR is non-nil,
1084 report no error if FILE doesn't exist.
1085 Print messages at start and end of loading unless
1086 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1087 overrides that).
1088 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1089 suffixes to the specified name FILE.
1090 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1091 the suffix `.elc' or `.el' or the module suffix; don't accept just
1092 FILE unless it ends in one of those suffixes or includes a directory name.
1094 If NOSUFFIX is nil, then if a file could not be found, try looking for
1095 a different representation of the file by adding non-empty suffixes to
1096 its name, before trying another file. Emacs uses this feature to find
1097 compressed versions of files when Auto Compression mode is enabled.
1098 If NOSUFFIX is non-nil, disable this feature.
1100 The suffixes that this function tries out, when NOSUFFIX is nil, are
1101 given by the return value of `get-load-suffixes' and the values listed
1102 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1103 return value of `get-load-suffixes' is used, i.e. the file name is
1104 required to have a non-empty suffix.
1106 When searching suffixes, this function normally stops at the first
1107 one that exists. If the option `load-prefer-newer' is non-nil,
1108 however, it tries all suffixes, and uses whichever file is the newest.
1110 Loading a file records its definitions, and its `provide' and
1111 `require' calls, in an element of `load-history' whose
1112 car is the file name loaded. See `load-history'.
1114 While the file is in the process of being loaded, the variable
1115 `load-in-progress' is non-nil and the variable `load-file-name'
1116 is bound to the file's name.
1118 Return t if the file exists and loads successfully. */)
1119 (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage,
1120 Lisp_Object nosuffix, Lisp_Object must_suffix)
1122 FILE *stream;
1123 int fd;
1124 int fd_index UNINIT;
1125 ptrdiff_t count = SPECPDL_INDEX ();
1126 Lisp_Object found, efound, hist_file_name;
1127 /* True means we printed the ".el is newer" message. */
1128 bool newer = 0;
1129 /* True means we are loading a compiled file. */
1130 bool compiled = 0;
1131 Lisp_Object handler;
1132 bool safe_p = 1;
1133 const char *fmode = "r" FOPEN_TEXT;
1134 int version;
1136 CHECK_STRING (file);
1138 /* If file name is magic, call the handler. */
1139 /* This shouldn't be necessary any more now that `openp' handles it right.
1140 handler = Ffind_file_name_handler (file, Qload);
1141 if (!NILP (handler))
1142 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1144 /* The presence of this call is the result of a historical accident:
1145 it used to be in every file-operation and when it got removed
1146 everywhere, it accidentally stayed here. Since then, enough people
1147 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1148 that it seemed risky to remove. */
1149 if (! NILP (noerror))
1151 file = internal_condition_case_1 (Fsubstitute_in_file_name, file,
1152 Qt, load_error_handler);
1153 if (NILP (file))
1154 return Qnil;
1156 else
1157 file = Fsubstitute_in_file_name (file);
1159 /* Avoid weird lossage with null string as arg,
1160 since it would try to load a directory as a Lisp file. */
1161 if (SCHARS (file) == 0)
1163 fd = -1;
1164 errno = ENOENT;
1166 else
1168 Lisp_Object suffixes;
1169 found = Qnil;
1171 if (! NILP (must_suffix))
1173 /* Don't insist on adding a suffix if FILE already ends with one. */
1174 if (suffix_p (file, ".el")
1175 || suffix_p (file, ".elc")
1176 #ifdef HAVE_MODULES
1177 || suffix_p (file, MODULES_SUFFIX)
1178 #endif
1180 must_suffix = Qnil;
1181 /* Don't insist on adding a suffix
1182 if the argument includes a directory name. */
1183 else if (! NILP (Ffile_name_directory (file)))
1184 must_suffix = Qnil;
1187 if (!NILP (nosuffix))
1188 suffixes = Qnil;
1189 else
1191 suffixes = Fget_load_suffixes ();
1192 if (NILP (must_suffix))
1193 suffixes = CALLN (Fappend, suffixes, Vload_file_rep_suffixes);
1196 fd = openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer);
1199 if (fd == -1)
1201 if (NILP (noerror))
1202 report_file_error ("Cannot open load file", file);
1203 return Qnil;
1206 /* Tell startup.el whether or not we found the user's init file. */
1207 if (EQ (Qt, Vuser_init_file))
1208 Vuser_init_file = found;
1210 /* If FD is -2, that means openp found a magic file. */
1211 if (fd == -2)
1213 if (NILP (Fequal (found, file)))
1214 /* If FOUND is a different file name from FILE,
1215 find its handler even if we have already inhibited
1216 the `load' operation on FILE. */
1217 handler = Ffind_file_name_handler (found, Qt);
1218 else
1219 handler = Ffind_file_name_handler (found, Qload);
1220 if (! NILP (handler))
1221 return call5 (handler, Qload, found, noerror, nomessage, Qt);
1222 #ifdef DOS_NT
1223 /* Tramp has to deal with semi-broken packages that prepend
1224 drive letters to remote files. For that reason, Tramp
1225 catches file operations that test for file existence, which
1226 makes openp think X:/foo.elc files are remote. However,
1227 Tramp does not catch `load' operations for such files, so we
1228 end up with a nil as the `load' handler above. If we would
1229 continue with fd = -2, we will behave wrongly, and in
1230 particular try reading a .elc file in the "rt" mode instead
1231 of "rb". See bug #9311 for the results. To work around
1232 this, we try to open the file locally, and go with that if it
1233 succeeds. */
1234 fd = emacs_open (SSDATA (ENCODE_FILE (found)), O_RDONLY, 0);
1235 if (fd == -1)
1236 fd = -2;
1237 #endif
1240 if (0 <= fd)
1242 fd_index = SPECPDL_INDEX ();
1243 record_unwind_protect_int (close_file_unwind, fd);
1246 #ifdef HAVE_MODULES
1247 if (suffix_p (found, MODULES_SUFFIX))
1248 return unbind_to (count, Fmodule_load (found));
1249 #endif
1251 /* Check if we're stuck in a recursive load cycle.
1253 2000-09-21: It's not possible to just check for the file loaded
1254 being a member of Vloads_in_progress. This fails because of the
1255 way the byte compiler currently works; `provide's are not
1256 evaluated, see font-lock.el/jit-lock.el as an example. This
1257 leads to a certain amount of ``normal'' recursion.
1259 Also, just loading a file recursively is not always an error in
1260 the general case; the second load may do something different. */
1262 int load_count = 0;
1263 Lisp_Object tem;
1264 for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
1265 if (!NILP (Fequal (found, XCAR (tem))) && (++load_count > 3))
1266 signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
1267 record_unwind_protect (record_load_unwind, Vloads_in_progress);
1268 Vloads_in_progress = Fcons (found, Vloads_in_progress);
1271 /* All loads are by default dynamic, unless the file itself specifies
1272 otherwise using a file-variable in the first line. This is bound here
1273 so that it takes effect whether or not we use
1274 Vload_source_file_function. */
1275 specbind (Qlexical_binding, Qnil);
1277 /* Get the name for load-history. */
1278 hist_file_name = (! NILP (Vpurify_flag)
1279 ? concat2 (Ffile_name_directory (file),
1280 Ffile_name_nondirectory (found))
1281 : found) ;
1283 version = -1;
1285 /* Check for the presence of old-style quotes and warn about them. */
1286 specbind (Qlread_old_style_backquotes, Qnil);
1287 record_unwind_protect (load_warn_old_style_backquotes, file);
1289 /* Check for the presence of unescaped character literals and warn
1290 about them. */
1291 specbind (Qlread_unescaped_character_literals, Qnil);
1292 record_unwind_protect (load_warn_unescaped_character_literals, file);
1294 int is_elc;
1295 if ((is_elc = suffix_p (found, ".elc")) != 0
1296 /* version = 1 means the file is empty, in which case we can
1297 treat it as not byte-compiled. */
1298 || (fd >= 0 && (version = safe_to_load_version (fd)) > 1))
1299 /* Load .elc files directly, but not when they are
1300 remote and have no handler! */
1302 if (fd != -2)
1304 struct stat s1, s2;
1305 int result;
1307 if (version < 0
1308 && ! (version = safe_to_load_version (fd)))
1310 safe_p = 0;
1311 if (!load_dangerous_libraries)
1312 error ("File `%s' was not compiled in Emacs", SDATA (found));
1313 else if (!NILP (nomessage) && !force_load_messages)
1314 message_with_string ("File `%s' not compiled in Emacs", found, 1);
1317 compiled = 1;
1319 efound = ENCODE_FILE (found);
1320 fmode = "r" FOPEN_BINARY;
1322 /* openp already checked for newness, no point doing it again.
1323 FIXME would be nice to get a message when openp
1324 ignores suffix order due to load_prefer_newer. */
1325 if (!load_prefer_newer && is_elc)
1327 result = stat (SSDATA (efound), &s1);
1328 if (result == 0)
1330 SSET (efound, SBYTES (efound) - 1, 0);
1331 result = stat (SSDATA (efound), &s2);
1332 SSET (efound, SBYTES (efound) - 1, 'c');
1335 if (result == 0
1336 && timespec_cmp (get_stat_mtime (&s1), get_stat_mtime (&s2)) < 0)
1338 /* Make the progress messages mention that source is newer. */
1339 newer = 1;
1341 /* If we won't print another message, mention this anyway. */
1342 if (!NILP (nomessage) && !force_load_messages)
1344 Lisp_Object msg_file;
1345 msg_file = Fsubstring (found, make_number (0), make_number (-1));
1346 message_with_string ("Source file `%s' newer than byte-compiled file",
1347 msg_file, 1);
1350 } /* !load_prefer_newer */
1353 else
1355 /* We are loading a source file (*.el). */
1356 if (!NILP (Vload_source_file_function))
1358 Lisp_Object val;
1360 if (fd >= 0)
1362 emacs_close (fd);
1363 clear_unwind_protect (fd_index);
1365 val = call4 (Vload_source_file_function, found, hist_file_name,
1366 NILP (noerror) ? Qnil : Qt,
1367 (NILP (nomessage) || force_load_messages) ? Qnil : Qt);
1368 return unbind_to (count, val);
1372 if (fd < 0)
1374 /* We somehow got here with fd == -2, meaning the file is deemed
1375 to be remote. Don't even try to reopen the file locally;
1376 just force a failure. */
1377 stream = NULL;
1378 errno = EINVAL;
1380 else
1382 #ifdef WINDOWSNT
1383 emacs_close (fd);
1384 clear_unwind_protect (fd_index);
1385 efound = ENCODE_FILE (found);
1386 stream = emacs_fopen (SSDATA (efound), fmode);
1387 #else
1388 stream = fdopen (fd, fmode);
1389 #endif
1391 if (! stream)
1392 report_file_error ("Opening stdio stream", file);
1393 set_unwind_protect_ptr (fd_index, close_infile_unwind, stream);
1395 if (! NILP (Vpurify_flag))
1396 Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list);
1398 if (NILP (nomessage) || force_load_messages)
1400 if (!safe_p)
1401 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1402 file, 1);
1403 else if (!compiled)
1404 message_with_string ("Loading %s (source)...", file, 1);
1405 else if (newer)
1406 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1407 file, 1);
1408 else /* The typical case; compiled file newer than source file. */
1409 message_with_string ("Loading %s...", file, 1);
1412 specbind (Qload_file_name, found);
1413 specbind (Qinhibit_file_name_operation, Qnil);
1414 specbind (Qload_in_progress, Qt);
1416 struct infile input;
1417 input.stream = stream;
1418 input.lookahead = 0;
1419 infile = &input;
1421 if (lisp_file_lexically_bound_p (Qget_file_char))
1422 Fset (Qlexical_binding, Qt);
1424 if (! version || version >= 22)
1425 readevalloop (Qget_file_char, &input, hist_file_name,
1426 0, Qnil, Qnil, Qnil, Qnil);
1427 else
1429 /* We can't handle a file which was compiled with
1430 byte-compile-dynamic by older version of Emacs. */
1431 specbind (Qload_force_doc_strings, Qt);
1432 readevalloop (Qget_emacs_mule_file_char, &input, hist_file_name,
1433 0, Qnil, Qnil, Qnil, Qnil);
1435 unbind_to (count, Qnil);
1437 /* Run any eval-after-load forms for this file. */
1438 if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
1439 call1 (Qdo_after_load_evaluation, hist_file_name) ;
1441 xfree (saved_doc_string);
1442 saved_doc_string = 0;
1443 saved_doc_string_size = 0;
1445 xfree (prev_saved_doc_string);
1446 prev_saved_doc_string = 0;
1447 prev_saved_doc_string_size = 0;
1449 if (!noninteractive && (NILP (nomessage) || force_load_messages))
1451 if (!safe_p)
1452 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1453 file, 1);
1454 else if (!compiled)
1455 message_with_string ("Loading %s (source)...done", file, 1);
1456 else if (newer)
1457 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1458 file, 1);
1459 else /* The typical case; compiled file newer than source file. */
1460 message_with_string ("Loading %s...done", file, 1);
1463 return Qt;
1466 static bool
1467 complete_filename_p (Lisp_Object pathname)
1469 const unsigned char *s = SDATA (pathname);
1470 return (IS_DIRECTORY_SEP (s[0])
1471 || (SCHARS (pathname) > 2
1472 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2])));
1475 DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
1476 doc: /* Search for FILENAME through PATH.
1477 Returns the file's name in absolute form, or nil if not found.
1478 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1479 file name when searching.
1480 If non-nil, PREDICATE is used instead of `file-readable-p'.
1481 PREDICATE can also be an integer to pass to the faccessat(2) function,
1482 in which case file-name-handlers are ignored.
1483 This function will normally skip directories, so if you want it to find
1484 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1485 (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate)
1487 Lisp_Object file;
1488 int fd = openp (path, filename, suffixes, &file, predicate, false);
1489 if (NILP (predicate) && fd >= 0)
1490 emacs_close (fd);
1491 return file;
1494 /* Search for a file whose name is STR, looking in directories
1495 in the Lisp list PATH, and trying suffixes from SUFFIX.
1496 On success, return a file descriptor (or 1 or -2 as described below).
1497 On failure, return -1 and set errno.
1499 SUFFIXES is a list of strings containing possible suffixes.
1500 The empty suffix is automatically added if the list is empty.
1502 PREDICATE t means the files are binary.
1503 PREDICATE non-nil and non-t means don't open the files,
1504 just look for one that satisfies the predicate. In this case,
1505 return -2 on success. The predicate can be a lisp function or
1506 an integer to pass to `access' (in which case file-name-handlers
1507 are ignored).
1509 If STOREPTR is nonzero, it points to a slot where the name of
1510 the file actually found should be stored as a Lisp string.
1511 nil is stored there on failure.
1513 If the file we find is remote, return -2
1514 but store the found remote file name in *STOREPTR.
1516 If NEWER is true, try all SUFFIXes and return the result for the
1517 newest file that exists. Does not apply to remote files,
1518 or if a non-nil and non-t PREDICATE is specified. */
1521 openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1522 Lisp_Object *storeptr, Lisp_Object predicate, bool newer)
1524 ptrdiff_t fn_size = 100;
1525 char buf[100];
1526 char *fn = buf;
1527 bool absolute;
1528 ptrdiff_t want_length;
1529 Lisp_Object filename;
1530 Lisp_Object string, tail, encoded_fn, save_string;
1531 ptrdiff_t max_suffix_len = 0;
1532 int last_errno = ENOENT;
1533 int save_fd = -1;
1534 USE_SAFE_ALLOCA;
1536 /* The last-modified time of the newest matching file found.
1537 Initialize it to something less than all valid timestamps. */
1538 struct timespec save_mtime = make_timespec (TYPE_MINIMUM (time_t), -1);
1540 CHECK_STRING (str);
1542 for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
1544 CHECK_STRING_CAR (tail);
1545 max_suffix_len = max (max_suffix_len,
1546 SBYTES (XCAR (tail)));
1549 string = filename = encoded_fn = save_string = Qnil;
1551 if (storeptr)
1552 *storeptr = Qnil;
1554 absolute = complete_filename_p (str);
1556 for (; CONSP (path); path = XCDR (path))
1558 ptrdiff_t baselen, prefixlen;
1560 filename = Fexpand_file_name (str, XCAR (path));
1561 if (!complete_filename_p (filename))
1562 /* If there are non-absolute elts in PATH (eg "."). */
1563 /* Of course, this could conceivably lose if luser sets
1564 default-directory to be something non-absolute... */
1566 filename = Fexpand_file_name (filename, BVAR (current_buffer, directory));
1567 if (!complete_filename_p (filename))
1568 /* Give up on this path element! */
1569 continue;
1572 /* Calculate maximum length of any filename made from
1573 this path element/specified file name and any possible suffix. */
1574 want_length = max_suffix_len + SBYTES (filename);
1575 if (fn_size <= want_length)
1577 fn_size = 100 + want_length;
1578 fn = SAFE_ALLOCA (fn_size);
1581 /* Copy FILENAME's data to FN but remove starting /: if any. */
1582 prefixlen = ((SCHARS (filename) > 2
1583 && SREF (filename, 0) == '/'
1584 && SREF (filename, 1) == ':')
1585 ? 2 : 0);
1586 baselen = SBYTES (filename) - prefixlen;
1587 memcpy (fn, SDATA (filename) + prefixlen, baselen);
1589 /* Loop over suffixes. */
1590 for (tail = NILP (suffixes) ? list1 (empty_unibyte_string) : suffixes;
1591 CONSP (tail); tail = XCDR (tail))
1593 Lisp_Object suffix = XCAR (tail);
1594 ptrdiff_t fnlen, lsuffix = SBYTES (suffix);
1595 Lisp_Object handler;
1597 /* Make complete filename by appending SUFFIX. */
1598 memcpy (fn + baselen, SDATA (suffix), lsuffix + 1);
1599 fnlen = baselen + lsuffix;
1601 /* Check that the file exists and is not a directory. */
1602 /* We used to only check for handlers on non-absolute file names:
1603 if (absolute)
1604 handler = Qnil;
1605 else
1606 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1607 It's not clear why that was the case and it breaks things like
1608 (load "/bar.el") where the file is actually "/bar.el.gz". */
1609 /* make_string has its own ideas on when to return a unibyte
1610 string and when a multibyte string, but we know better.
1611 We must have a unibyte string when dumping, since
1612 file-name encoding is shaky at best at that time, and in
1613 particular default-file-name-coding-system is reset
1614 several times during loadup. We therefore don't want to
1615 encode the file before passing it to file I/O library
1616 functions. */
1617 if (!STRING_MULTIBYTE (filename) && !STRING_MULTIBYTE (suffix))
1618 string = make_unibyte_string (fn, fnlen);
1619 else
1620 string = make_string (fn, fnlen);
1621 handler = Ffind_file_name_handler (string, Qfile_exists_p);
1622 if ((!NILP (handler) || (!NILP (predicate) && !EQ (predicate, Qt)))
1623 && !NATNUMP (predicate))
1625 bool exists;
1626 if (NILP (predicate) || EQ (predicate, Qt))
1627 exists = !NILP (Ffile_readable_p (string));
1628 else
1630 Lisp_Object tmp = call1 (predicate, string);
1631 if (NILP (tmp))
1632 exists = false;
1633 else if (EQ (tmp, Qdir_ok)
1634 || NILP (Ffile_directory_p (string)))
1635 exists = true;
1636 else
1638 exists = false;
1639 last_errno = EISDIR;
1643 if (exists)
1645 /* We succeeded; return this descriptor and filename. */
1646 if (storeptr)
1647 *storeptr = string;
1648 SAFE_FREE ();
1649 return -2;
1652 else
1654 int fd;
1655 const char *pfn;
1656 struct stat st;
1658 encoded_fn = ENCODE_FILE (string);
1659 pfn = SSDATA (encoded_fn);
1661 /* Check that we can access or open it. */
1662 if (NATNUMP (predicate))
1664 fd = -1;
1665 if (INT_MAX < XFASTINT (predicate))
1666 last_errno = EINVAL;
1667 else if (faccessat (AT_FDCWD, pfn, XFASTINT (predicate),
1668 AT_EACCESS)
1669 == 0)
1671 if (file_directory_p (pfn))
1672 last_errno = EISDIR;
1673 else
1674 fd = 1;
1677 else
1679 fd = emacs_open (pfn, O_RDONLY, 0);
1680 if (fd < 0)
1682 if (errno != ENOENT)
1683 last_errno = errno;
1685 else
1687 int err = (fstat (fd, &st) != 0 ? errno
1688 : S_ISDIR (st.st_mode) ? EISDIR : 0);
1689 if (err)
1691 last_errno = err;
1692 emacs_close (fd);
1693 fd = -1;
1698 if (fd >= 0)
1700 if (newer && !NATNUMP (predicate))
1702 struct timespec mtime = get_stat_mtime (&st);
1704 if (timespec_cmp (mtime, save_mtime) <= 0)
1705 emacs_close (fd);
1706 else
1708 if (0 <= save_fd)
1709 emacs_close (save_fd);
1710 save_fd = fd;
1711 save_mtime = mtime;
1712 save_string = string;
1715 else
1717 /* We succeeded; return this descriptor and filename. */
1718 if (storeptr)
1719 *storeptr = string;
1720 SAFE_FREE ();
1721 return fd;
1725 /* No more suffixes. Return the newest. */
1726 if (0 <= save_fd && ! CONSP (XCDR (tail)))
1728 if (storeptr)
1729 *storeptr = save_string;
1730 SAFE_FREE ();
1731 return save_fd;
1735 if (absolute)
1736 break;
1739 SAFE_FREE ();
1740 errno = last_errno;
1741 return -1;
1745 /* Merge the list we've accumulated of globals from the current input source
1746 into the load_history variable. The details depend on whether
1747 the source has an associated file name or not.
1749 FILENAME is the file name that we are loading from.
1751 ENTIRE is true if loading that entire file, false if evaluating
1752 part of it. */
1754 static void
1755 build_load_history (Lisp_Object filename, bool entire)
1757 Lisp_Object tail, prev, newelt;
1758 Lisp_Object tem, tem2;
1759 bool foundit = 0;
1761 tail = Vload_history;
1762 prev = Qnil;
1764 while (CONSP (tail))
1766 tem = XCAR (tail);
1768 /* Find the feature's previous assoc list... */
1769 if (!NILP (Fequal (filename, Fcar (tem))))
1771 foundit = 1;
1773 /* If we're loading the entire file, remove old data. */
1774 if (entire)
1776 if (NILP (prev))
1777 Vload_history = XCDR (tail);
1778 else
1779 Fsetcdr (prev, XCDR (tail));
1782 /* Otherwise, cons on new symbols that are not already members. */
1783 else
1785 tem2 = Vcurrent_load_list;
1787 while (CONSP (tem2))
1789 newelt = XCAR (tem2);
1791 if (NILP (Fmember (newelt, tem)))
1792 Fsetcar (tail, Fcons (XCAR (tem),
1793 Fcons (newelt, XCDR (tem))));
1795 tem2 = XCDR (tem2);
1796 maybe_quit ();
1800 else
1801 prev = tail;
1802 tail = XCDR (tail);
1803 maybe_quit ();
1806 /* If we're loading an entire file, cons the new assoc onto the
1807 front of load-history, the most-recently-loaded position. Also
1808 do this if we didn't find an existing member for the file. */
1809 if (entire || !foundit)
1810 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
1811 Vload_history);
1814 static void
1815 readevalloop_1 (int old)
1817 load_convert_to_unibyte = old;
1820 /* Signal an `end-of-file' error, if possible with file name
1821 information. */
1823 static _Noreturn void
1824 end_of_file_error (void)
1826 if (STRINGP (Vload_file_name))
1827 xsignal1 (Qend_of_file, Vload_file_name);
1829 xsignal0 (Qend_of_file);
1832 static Lisp_Object
1833 readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand)
1835 /* If we macroexpand the toplevel form non-recursively and it ends
1836 up being a `progn' (or if it was a progn to start), treat each
1837 form in the progn as a top-level form. This way, if one form in
1838 the progn defines a macro, that macro is in effect when we expand
1839 the remaining forms. See similar code in bytecomp.el. */
1840 val = call2 (macroexpand, val, Qnil);
1841 if (EQ (CAR_SAFE (val), Qprogn))
1843 Lisp_Object subforms = XCDR (val);
1845 for (val = Qnil; CONSP (subforms); subforms = XCDR (subforms))
1846 val = readevalloop_eager_expand_eval (XCAR (subforms),
1847 macroexpand);
1849 else
1850 val = eval_sub (call2 (macroexpand, val, Qt));
1851 return val;
1854 /* UNIBYTE specifies how to set load_convert_to_unibyte
1855 for this invocation.
1856 READFUN, if non-nil, is used instead of `read'.
1858 START, END specify region to read in current buffer (from eval-region).
1859 If the input is not from a buffer, they must be nil. */
1861 static void
1862 readevalloop (Lisp_Object readcharfun,
1863 struct infile *infile0,
1864 Lisp_Object sourcename,
1865 bool printflag,
1866 Lisp_Object unibyte, Lisp_Object readfun,
1867 Lisp_Object start, Lisp_Object end)
1869 int c;
1870 Lisp_Object val;
1871 ptrdiff_t count = SPECPDL_INDEX ();
1872 struct buffer *b = 0;
1873 bool continue_reading_p;
1874 Lisp_Object lex_bound;
1875 /* True if reading an entire buffer. */
1876 bool whole_buffer = 0;
1877 /* True on the first time around. */
1878 bool first_sexp = 1;
1879 Lisp_Object macroexpand = intern ("internal-macroexpand-for-load");
1881 if (NILP (Ffboundp (macroexpand))
1882 /* Don't macroexpand in .elc files, since it should have been done
1883 already. We actually don't know whether we're in a .elc file or not,
1884 so we use circumstantial evidence: .el files normally go through
1885 Vload_source_file_function -> load-with-code-conversion
1886 -> eval-buffer. */
1887 || EQ (readcharfun, Qget_file_char)
1888 || EQ (readcharfun, Qget_emacs_mule_file_char))
1889 macroexpand = Qnil;
1891 if (MARKERP (readcharfun))
1893 if (NILP (start))
1894 start = readcharfun;
1897 if (BUFFERP (readcharfun))
1898 b = XBUFFER (readcharfun);
1899 else if (MARKERP (readcharfun))
1900 b = XMARKER (readcharfun)->buffer;
1902 /* We assume START is nil when input is not from a buffer. */
1903 if (! NILP (start) && !b)
1904 emacs_abort ();
1906 specbind (Qstandard_input, readcharfun);
1907 specbind (Qcurrent_load_list, Qnil);
1908 record_unwind_protect_int (readevalloop_1, load_convert_to_unibyte);
1909 load_convert_to_unibyte = !NILP (unibyte);
1911 /* If lexical binding is active (either because it was specified in
1912 the file's header, or via a buffer-local variable), create an empty
1913 lexical environment, otherwise, turn off lexical binding. */
1914 lex_bound = find_symbol_value (Qlexical_binding);
1915 specbind (Qinternal_interpreter_environment,
1916 (NILP (lex_bound) || EQ (lex_bound, Qunbound)
1917 ? Qnil : list1 (Qt)));
1919 /* Try to ensure sourcename is a truename, except whilst preloading. */
1920 if (NILP (Vpurify_flag)
1921 && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))
1922 && !NILP (Ffboundp (Qfile_truename)))
1923 sourcename = call1 (Qfile_truename, sourcename) ;
1925 LOADHIST_ATTACH (sourcename);
1927 continue_reading_p = 1;
1928 while (continue_reading_p)
1930 ptrdiff_t count1 = SPECPDL_INDEX ();
1932 if (b != 0 && !BUFFER_LIVE_P (b))
1933 error ("Reading from killed buffer");
1935 if (!NILP (start))
1937 /* Switch to the buffer we are reading from. */
1938 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1939 set_buffer_internal (b);
1941 /* Save point in it. */
1942 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1943 /* Save ZV in it. */
1944 record_unwind_protect (save_restriction_restore, save_restriction_save ());
1945 /* Those get unbound after we read one expression. */
1947 /* Set point and ZV around stuff to be read. */
1948 Fgoto_char (start);
1949 if (!NILP (end))
1950 Fnarrow_to_region (make_number (BEGV), end);
1952 /* Just for cleanliness, convert END to a marker
1953 if it is an integer. */
1954 if (INTEGERP (end))
1955 end = Fpoint_max_marker ();
1958 /* On the first cycle, we can easily test here
1959 whether we are reading the whole buffer. */
1960 if (b && first_sexp)
1961 whole_buffer = (BUF_PT (b) == BUF_BEG (b) && BUF_ZV (b) == BUF_Z (b));
1963 infile = infile0;
1964 read_next:
1965 c = READCHAR;
1966 if (c == ';')
1968 while ((c = READCHAR) != '\n' && c != -1);
1969 goto read_next;
1971 if (c < 0)
1973 unbind_to (count1, Qnil);
1974 break;
1977 /* Ignore whitespace here, so we can detect eof. */
1978 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r'
1979 || c == NO_BREAK_SPACE)
1980 goto read_next;
1982 if (! HASH_TABLE_P (read_objects_map)
1983 || XHASH_TABLE (read_objects_map)->count)
1984 read_objects_map
1985 = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE,
1986 DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
1987 Qnil, false);
1988 if (! HASH_TABLE_P (read_objects_completed)
1989 || XHASH_TABLE (read_objects_completed)->count)
1990 read_objects_completed
1991 = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE,
1992 DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
1993 Qnil, false);
1994 if (!NILP (Vpurify_flag) && c == '(')
1996 val = read_list (0, readcharfun);
1998 else
2000 UNREAD (c);
2001 if (!NILP (readfun))
2003 val = call1 (readfun, readcharfun);
2005 /* If READCHARFUN has set point to ZV, we should
2006 stop reading, even if the form read sets point
2007 to a different value when evaluated. */
2008 if (BUFFERP (readcharfun))
2010 struct buffer *buf = XBUFFER (readcharfun);
2011 if (BUF_PT (buf) == BUF_ZV (buf))
2012 continue_reading_p = 0;
2015 else if (! NILP (Vload_read_function))
2016 val = call1 (Vload_read_function, readcharfun);
2017 else
2018 val = read_internal_start (readcharfun, Qnil, Qnil);
2020 /* Empty hashes can be reused; otherwise, reset on next call. */
2021 if (HASH_TABLE_P (read_objects_map)
2022 && XHASH_TABLE (read_objects_map)->count > 0)
2023 read_objects_map = Qnil;
2024 if (HASH_TABLE_P (read_objects_completed)
2025 && XHASH_TABLE (read_objects_completed)->count > 0)
2026 read_objects_completed = Qnil;
2028 if (!NILP (start) && continue_reading_p)
2029 start = Fpoint_marker ();
2031 /* Restore saved point and BEGV. */
2032 unbind_to (count1, Qnil);
2034 /* Now eval what we just read. */
2035 if (!NILP (macroexpand))
2036 val = readevalloop_eager_expand_eval (val, macroexpand);
2037 else
2038 val = eval_sub (val);
2040 if (printflag)
2042 Vvalues = Fcons (val, Vvalues);
2043 if (EQ (Vstandard_output, Qt))
2044 Fprin1 (val, Qnil);
2045 else
2046 Fprint (val, Qnil);
2049 first_sexp = 0;
2052 build_load_history (sourcename,
2053 infile0 || whole_buffer);
2055 unbind_to (count, Qnil);
2058 DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
2059 doc: /* Execute the accessible portion of current buffer as Lisp code.
2060 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
2061 When called from a Lisp program (i.e., not interactively), this
2062 function accepts up to five optional arguments:
2063 BUFFER is the buffer to evaluate (nil means use current buffer),
2064 or a name of a buffer (a string).
2065 PRINTFLAG controls printing of output by any output functions in the
2066 evaluated code, such as `print', `princ', and `prin1':
2067 a value of nil means discard it; anything else is the stream to print to.
2068 See Info node `(elisp)Output Streams' for details on streams.
2069 FILENAME specifies the file name to use for `load-history'.
2070 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
2071 invocation.
2072 DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
2073 evaluated code should work normally even if PRINTFLAG is nil, in
2074 which case the output is displayed in the echo area.
2076 This function preserves the position of point. */)
2077 (Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print)
2079 ptrdiff_t count = SPECPDL_INDEX ();
2080 Lisp_Object tem, buf;
2082 if (NILP (buffer))
2083 buf = Fcurrent_buffer ();
2084 else
2085 buf = Fget_buffer (buffer);
2086 if (NILP (buf))
2087 error ("No such buffer");
2089 if (NILP (printflag) && NILP (do_allow_print))
2090 tem = Qsymbolp;
2091 else
2092 tem = printflag;
2094 if (NILP (filename))
2095 filename = BVAR (XBUFFER (buf), filename);
2097 specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
2098 specbind (Qstandard_output, tem);
2099 record_unwind_protect (save_excursion_restore, save_excursion_save ());
2100 BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
2101 specbind (Qlexical_binding, lisp_file_lexically_bound_p (buf) ? Qt : Qnil);
2102 BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
2103 readevalloop (buf, 0, filename,
2104 !NILP (printflag), unibyte, Qnil, Qnil, Qnil);
2105 unbind_to (count, Qnil);
2107 return Qnil;
2110 DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r",
2111 doc: /* Execute the region as Lisp code.
2112 When called from programs, expects two arguments,
2113 giving starting and ending indices in the current buffer
2114 of the text to be executed.
2115 Programs can pass third argument PRINTFLAG which controls output:
2116 a value of nil means discard it; anything else is stream for printing it.
2117 See Info node `(elisp)Output Streams' for details on streams.
2118 Also the fourth argument READ-FUNCTION, if non-nil, is used
2119 instead of `read' to read each expression. It gets one argument
2120 which is the input stream for reading characters.
2122 This function does not move point. */)
2123 (Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function)
2125 /* FIXME: Do the eval-sexp-add-defvars dance! */
2126 ptrdiff_t count = SPECPDL_INDEX ();
2127 Lisp_Object tem, cbuf;
2129 cbuf = Fcurrent_buffer ();
2131 if (NILP (printflag))
2132 tem = Qsymbolp;
2133 else
2134 tem = printflag;
2135 specbind (Qstandard_output, tem);
2136 specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
2138 /* `readevalloop' calls functions which check the type of start and end. */
2139 readevalloop (cbuf, 0, BVAR (XBUFFER (cbuf), filename),
2140 !NILP (printflag), Qnil, read_function,
2141 start, end);
2143 return unbind_to (count, Qnil);
2147 DEFUN ("read", Fread, Sread, 0, 1, 0,
2148 doc: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2149 If STREAM is nil, use the value of `standard-input' (which see).
2150 STREAM or the value of `standard-input' may be:
2151 a buffer (read from point and advance it)
2152 a marker (read from where it points and advance it)
2153 a function (call it with no arguments for each character,
2154 call it with a char as argument to push a char back)
2155 a string (takes text from string, starting at the beginning)
2156 t (read text line using minibuffer and use it, or read from
2157 standard input in batch mode). */)
2158 (Lisp_Object stream)
2160 if (NILP (stream))
2161 stream = Vstandard_input;
2162 if (EQ (stream, Qt))
2163 stream = Qread_char;
2164 if (EQ (stream, Qread_char))
2165 /* FIXME: ?! When is this used !? */
2166 return call1 (intern ("read-minibuffer"),
2167 build_string ("Lisp expression: "));
2169 return read_internal_start (stream, Qnil, Qnil);
2172 DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
2173 doc: /* Read one Lisp expression which is represented as text by STRING.
2174 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2175 FINAL-STRING-INDEX is an integer giving the position of the next
2176 remaining character in STRING. START and END optionally delimit
2177 a substring of STRING from which to read; they default to 0 and
2178 \(length STRING) respectively. Negative values are counted from
2179 the end of STRING. */)
2180 (Lisp_Object string, Lisp_Object start, Lisp_Object end)
2182 Lisp_Object ret;
2183 CHECK_STRING (string);
2184 /* `read_internal_start' sets `read_from_string_index'. */
2185 ret = read_internal_start (string, start, end);
2186 return Fcons (ret, make_number (read_from_string_index));
2189 /* Function to set up the global context we need in toplevel read
2190 calls. START and END only used when STREAM is a string. */
2191 static Lisp_Object
2192 read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
2194 Lisp_Object retval;
2196 readchar_count = 0;
2197 new_backquote_flag = 0;
2198 /* We can get called from readevalloop which may have set these
2199 already. */
2200 if (! HASH_TABLE_P (read_objects_map)
2201 || XHASH_TABLE (read_objects_map)->count)
2202 read_objects_map
2203 = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
2204 DEFAULT_REHASH_THRESHOLD, Qnil, false);
2205 if (! HASH_TABLE_P (read_objects_completed)
2206 || XHASH_TABLE (read_objects_completed)->count)
2207 read_objects_completed
2208 = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
2209 DEFAULT_REHASH_THRESHOLD, Qnil, false);
2210 if (EQ (Vread_with_symbol_positions, Qt)
2211 || EQ (Vread_with_symbol_positions, stream))
2212 Vread_symbol_positions_list = Qnil;
2214 if (STRINGP (stream)
2215 || ((CONSP (stream) && STRINGP (XCAR (stream)))))
2217 ptrdiff_t startval, endval;
2218 Lisp_Object string;
2220 if (STRINGP (stream))
2221 string = stream;
2222 else
2223 string = XCAR (stream);
2225 validate_subarray (string, start, end, SCHARS (string),
2226 &startval, &endval);
2228 read_from_string_index = startval;
2229 read_from_string_index_byte = string_char_to_byte (string, startval);
2230 read_from_string_limit = endval;
2233 retval = read0 (stream);
2234 if (EQ (Vread_with_symbol_positions, Qt)
2235 || EQ (Vread_with_symbol_positions, stream))
2236 Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
2237 /* Empty hashes can be reused; otherwise, reset on next call. */
2238 if (HASH_TABLE_P (read_objects_map)
2239 && XHASH_TABLE (read_objects_map)->count > 0)
2240 read_objects_map = Qnil;
2241 if (HASH_TABLE_P (read_objects_completed)
2242 && XHASH_TABLE (read_objects_completed)->count > 0)
2243 read_objects_completed = Qnil;
2244 return retval;
2248 /* Signal Qinvalid_read_syntax error.
2249 S is error string of length N (if > 0) */
2251 static _Noreturn void
2252 invalid_syntax (const char *s)
2254 xsignal1 (Qinvalid_read_syntax, build_string (s));
2258 /* Use this for recursive reads, in contexts where internal tokens
2259 are not allowed. */
2261 static Lisp_Object
2262 read0 (Lisp_Object readcharfun)
2264 register Lisp_Object val;
2265 int c;
2267 val = read1 (readcharfun, &c, 0);
2268 if (!c)
2269 return val;
2271 xsignal1 (Qinvalid_read_syntax,
2272 Fmake_string (make_number (1), make_number (c)));
2275 /* Grow a read buffer BUF that contains OFFSET useful bytes of data,
2276 by at least MAX_MULTIBYTE_LENGTH bytes. Update *BUF_ADDR and
2277 *BUF_SIZE accordingly; 0 <= OFFSET <= *BUF_SIZE. If *BUF_ADDR is
2278 initially null, BUF is on the stack: copy its data to the new heap
2279 buffer. Otherwise, BUF must equal *BUF_ADDR and can simply be
2280 reallocated. Either way, remember the heap allocation (which is at
2281 pdl slot COUNT) so that it can be freed when unwinding the stack.*/
2283 static char *
2284 grow_read_buffer (char *buf, ptrdiff_t offset,
2285 char **buf_addr, ptrdiff_t *buf_size, ptrdiff_t count)
2287 char *p = xpalloc (*buf_addr, buf_size, MAX_MULTIBYTE_LENGTH, -1, 1);
2288 if (!*buf_addr)
2290 memcpy (p, buf, offset);
2291 record_unwind_protect_ptr (xfree, p);
2293 else
2294 set_unwind_protect_ptr (count, xfree, p);
2295 *buf_addr = p;
2296 return p;
2299 /* Return the scalar value that has the Unicode character name NAME.
2300 Raise 'invalid-read-syntax' if there is no such character. */
2301 static int
2302 character_name_to_code (char const *name, ptrdiff_t name_len)
2304 /* For "U+XXXX", pass the leading '+' to string_to_number to reject
2305 monstrosities like "U+-0000". */
2306 Lisp_Object code
2307 = (name[0] == 'U' && name[1] == '+'
2308 ? string_to_number (name + 1, 16, false)
2309 : call2 (Qchar_from_name, make_unibyte_string (name, name_len), Qt));
2311 if (! RANGED_INTEGERP (0, code, MAX_UNICODE_CHAR)
2312 || char_surrogate_p (XINT (code)))
2314 AUTO_STRING (format, "\\N{%s}");
2315 AUTO_STRING_WITH_LEN (namestr, name, name_len);
2316 xsignal1 (Qinvalid_read_syntax, CALLN (Fformat, format, namestr));
2319 return XINT (code);
2322 /* Bound on the length of a Unicode character name. As of
2323 Unicode 9.0.0 the maximum is 83, so this should be safe. */
2324 enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND = 200 };
2326 /* Read a \-escape sequence, assuming we already read the `\'.
2327 If the escape sequence forces unibyte, return eight-bit char. */
2329 static int
2330 read_escape (Lisp_Object readcharfun, bool stringp)
2332 int c = READCHAR;
2333 /* \u allows up to four hex digits, \U up to eight. Default to the
2334 behavior for \u, and change this value in the case that \U is seen. */
2335 int unicode_hex_count = 4;
2337 switch (c)
2339 case -1:
2340 end_of_file_error ();
2342 case 'a':
2343 return '\007';
2344 case 'b':
2345 return '\b';
2346 case 'd':
2347 return 0177;
2348 case 'e':
2349 return 033;
2350 case 'f':
2351 return '\f';
2352 case 'n':
2353 return '\n';
2354 case 'r':
2355 return '\r';
2356 case 't':
2357 return '\t';
2358 case 'v':
2359 return '\v';
2360 case '\n':
2361 return -1;
2362 case ' ':
2363 if (stringp)
2364 return -1;
2365 return ' ';
2367 case 'M':
2368 c = READCHAR;
2369 if (c != '-')
2370 error ("Invalid escape character syntax");
2371 c = READCHAR;
2372 if (c == '\\')
2373 c = read_escape (readcharfun, 0);
2374 return c | meta_modifier;
2376 case 'S':
2377 c = READCHAR;
2378 if (c != '-')
2379 error ("Invalid escape character syntax");
2380 c = READCHAR;
2381 if (c == '\\')
2382 c = read_escape (readcharfun, 0);
2383 return c | shift_modifier;
2385 case 'H':
2386 c = READCHAR;
2387 if (c != '-')
2388 error ("Invalid escape character syntax");
2389 c = READCHAR;
2390 if (c == '\\')
2391 c = read_escape (readcharfun, 0);
2392 return c | hyper_modifier;
2394 case 'A':
2395 c = READCHAR;
2396 if (c != '-')
2397 error ("Invalid escape character syntax");
2398 c = READCHAR;
2399 if (c == '\\')
2400 c = read_escape (readcharfun, 0);
2401 return c | alt_modifier;
2403 case 's':
2404 c = READCHAR;
2405 if (stringp || c != '-')
2407 UNREAD (c);
2408 return ' ';
2410 c = READCHAR;
2411 if (c == '\\')
2412 c = read_escape (readcharfun, 0);
2413 return c | super_modifier;
2415 case 'C':
2416 c = READCHAR;
2417 if (c != '-')
2418 error ("Invalid escape character syntax");
2419 FALLTHROUGH;
2420 case '^':
2421 c = READCHAR;
2422 if (c == '\\')
2423 c = read_escape (readcharfun, 0);
2424 if ((c & ~CHAR_MODIFIER_MASK) == '?')
2425 return 0177 | (c & CHAR_MODIFIER_MASK);
2426 else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
2427 return c | ctrl_modifier;
2428 /* ASCII control chars are made from letters (both cases),
2429 as well as the non-letters within 0100...0137. */
2430 else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
2431 return (c & (037 | ~0177));
2432 else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
2433 return (c & (037 | ~0177));
2434 else
2435 return c | ctrl_modifier;
2437 case '0':
2438 case '1':
2439 case '2':
2440 case '3':
2441 case '4':
2442 case '5':
2443 case '6':
2444 case '7':
2445 /* An octal escape, as in ANSI C. */
2447 register int i = c - '0';
2448 register int count = 0;
2449 while (++count < 3)
2451 if ((c = READCHAR) >= '0' && c <= '7')
2453 i *= 8;
2454 i += c - '0';
2456 else
2458 UNREAD (c);
2459 break;
2463 if (i >= 0x80 && i < 0x100)
2464 i = BYTE8_TO_CHAR (i);
2465 return i;
2468 case 'x':
2469 /* A hex escape, as in ANSI C. */
2471 unsigned int i = 0;
2472 int count = 0;
2473 while (1)
2475 c = READCHAR;
2476 int digit = char_hexdigit (c);
2477 if (digit < 0)
2479 UNREAD (c);
2480 break;
2482 i = (i << 4) + digit;
2483 /* Allow hex escapes as large as ?\xfffffff, because some
2484 packages use them to denote characters with modifiers. */
2485 if ((CHAR_META | (CHAR_META - 1)) < i)
2486 error ("Hex character out of range: \\x%x...", i);
2487 count += count < 3;
2490 if (count < 3 && i >= 0x80)
2491 return BYTE8_TO_CHAR (i);
2492 return i;
2495 case 'U':
2496 /* Post-Unicode-2.0: Up to eight hex chars. */
2497 unicode_hex_count = 8;
2498 FALLTHROUGH;
2499 case 'u':
2501 /* A Unicode escape. We only permit them in strings and characters,
2502 not arbitrarily in the source code, as in some other languages. */
2504 unsigned int i = 0;
2505 int count = 0;
2507 while (++count <= unicode_hex_count)
2509 c = READCHAR;
2510 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2511 want. */
2512 int digit = char_hexdigit (c);
2513 if (digit < 0)
2514 error ("Non-hex digit used for Unicode escape");
2515 i = (i << 4) + digit;
2517 if (i > 0x10FFFF)
2518 error ("Non-Unicode character: 0x%x", i);
2519 return i;
2522 case 'N':
2523 /* Named character. */
2525 c = READCHAR;
2526 if (c != '{')
2527 invalid_syntax ("Expected opening brace after \\N");
2528 char name[UNICODE_CHARACTER_NAME_LENGTH_BOUND + 1];
2529 bool whitespace = false;
2530 ptrdiff_t length = 0;
2531 while (true)
2533 c = READCHAR;
2534 if (c < 0)
2535 end_of_file_error ();
2536 if (c == '}')
2537 break;
2538 if (! (0 < c && c < 0x80))
2540 AUTO_STRING (format,
2541 "Invalid character U+%04X in character name");
2542 xsignal1 (Qinvalid_read_syntax,
2543 CALLN (Fformat, format, make_natnum (c)));
2545 /* Treat multiple adjacent whitespace characters as a
2546 single space character. This makes it easier to use
2547 character names in e.g. multi-line strings. */
2548 if (c_isspace (c))
2550 if (whitespace)
2551 continue;
2552 c = ' ';
2553 whitespace = true;
2555 else
2556 whitespace = false;
2557 name[length++] = c;
2558 if (length >= sizeof name)
2559 invalid_syntax ("Character name too long");
2561 if (length == 0)
2562 invalid_syntax ("Empty character name");
2563 name[length] = '\0';
2565 /* character_name_to_code can invoke read1, recursively.
2566 This is why read1's buffer is not static. */
2567 return character_name_to_code (name, length);
2570 default:
2571 return c;
2575 /* Return the digit that CHARACTER stands for in the given BASE.
2576 Return -1 if CHARACTER is out of range for BASE,
2577 and -2 if CHARACTER is not valid for any supported BASE. */
2578 static int
2579 digit_to_number (int character, int base)
2581 int digit;
2583 if ('0' <= character && character <= '9')
2584 digit = character - '0';
2585 else if ('a' <= character && character <= 'z')
2586 digit = character - 'a' + 10;
2587 else if ('A' <= character && character <= 'Z')
2588 digit = character - 'A' + 10;
2589 else
2590 return -2;
2592 return digit < base ? digit : -1;
2595 /* Read an integer in radix RADIX using READCHARFUN to read
2596 characters. RADIX must be in the interval [2..36]; if it isn't, a
2597 read error is signaled . Value is the integer read. Signals an
2598 error if encountering invalid read syntax or if RADIX is out of
2599 range. */
2601 static Lisp_Object
2602 read_integer (Lisp_Object readcharfun, EMACS_INT radix)
2604 /* Room for sign, leading 0, other digits, trailing null byte.
2605 Also, room for invalid syntax diagnostic. */
2606 char buf[max (1 + 1 + UINTMAX_WIDTH + 1,
2607 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT))];
2609 int valid = -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2611 if (radix < 2 || radix > 36)
2612 valid = 0;
2613 else
2615 char *p = buf;
2616 int c, digit;
2618 c = READCHAR;
2619 if (c == '-' || c == '+')
2621 *p++ = c;
2622 c = READCHAR;
2625 if (c == '0')
2627 *p++ = c;
2628 valid = 1;
2630 /* Ignore redundant leading zeros, so the buffer doesn't
2631 fill up with them. */
2633 c = READCHAR;
2634 while (c == '0');
2637 while ((digit = digit_to_number (c, radix)) >= -1)
2639 if (digit == -1)
2640 valid = 0;
2641 if (valid < 0)
2642 valid = 1;
2644 if (p < buf + sizeof buf - 1)
2645 *p++ = c;
2646 else
2647 valid = 0;
2649 c = READCHAR;
2652 UNREAD (c);
2653 *p = '\0';
2656 if (valid != 1)
2658 sprintf (buf, "integer, radix %"pI"d", radix);
2659 invalid_syntax (buf);
2662 return string_to_number (buf, radix, 0);
2666 /* If the next token is ')' or ']' or '.', we store that character
2667 in *PCH and the return value is not interesting. Else, we store
2668 zero in *PCH and we read and return one lisp object.
2670 FIRST_IN_LIST is true if this is the first element of a list. */
2672 static Lisp_Object
2673 read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
2675 int c;
2676 bool uninterned_symbol = false;
2677 bool multibyte;
2678 char stackbuf[MAX_ALLOCA];
2679 current_thread->stack_top = stackbuf;
2681 *pch = 0;
2683 retry:
2685 c = READCHAR_REPORT_MULTIBYTE (&multibyte);
2686 if (c < 0)
2687 end_of_file_error ();
2689 switch (c)
2691 case '(':
2692 return read_list (0, readcharfun);
2694 case '[':
2695 return read_vector (readcharfun, 0);
2697 case ')':
2698 case ']':
2700 *pch = c;
2701 return Qnil;
2704 case '#':
2705 c = READCHAR;
2706 if (c == 's')
2708 c = READCHAR;
2709 if (c == '(')
2711 /* Accept extended format for hash tables (extensible to
2712 other types), e.g.
2713 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2714 Lisp_Object tmp = read_list (0, readcharfun);
2715 Lisp_Object head = CAR_SAFE (tmp);
2716 Lisp_Object data = Qnil;
2717 Lisp_Object val = Qnil;
2718 /* The size is 2 * number of allowed keywords to
2719 make-hash-table. */
2720 Lisp_Object params[12];
2721 Lisp_Object ht;
2722 Lisp_Object key = Qnil;
2723 int param_count = 0;
2725 if (!EQ (head, Qhash_table))
2727 ptrdiff_t size = XINT (Flength (tmp));
2728 Lisp_Object record = Fmake_record (CAR_SAFE (tmp),
2729 make_number (size - 1),
2730 Qnil);
2731 for (int i = 1; i < size; i++)
2733 tmp = Fcdr (tmp);
2734 ASET (record, i, Fcar (tmp));
2736 return record;
2739 tmp = CDR_SAFE (tmp);
2741 /* This is repetitive but fast and simple. */
2742 params[param_count] = QCsize;
2743 params[param_count + 1] = Fplist_get (tmp, Qsize);
2744 if (!NILP (params[param_count + 1]))
2745 param_count += 2;
2747 params[param_count] = QCtest;
2748 params[param_count + 1] = Fplist_get (tmp, Qtest);
2749 if (!NILP (params[param_count + 1]))
2750 param_count += 2;
2752 params[param_count] = QCweakness;
2753 params[param_count + 1] = Fplist_get (tmp, Qweakness);
2754 if (!NILP (params[param_count + 1]))
2755 param_count += 2;
2757 params[param_count] = QCrehash_size;
2758 params[param_count + 1] = Fplist_get (tmp, Qrehash_size);
2759 if (!NILP (params[param_count + 1]))
2760 param_count += 2;
2762 params[param_count] = QCrehash_threshold;
2763 params[param_count + 1] = Fplist_get (tmp, Qrehash_threshold);
2764 if (!NILP (params[param_count + 1]))
2765 param_count += 2;
2767 params[param_count] = QCpurecopy;
2768 params[param_count + 1] = Fplist_get (tmp, Qpurecopy);
2769 if (!NILP (params[param_count + 1]))
2770 param_count += 2;
2772 /* This is the hash table data. */
2773 data = Fplist_get (tmp, Qdata);
2775 /* Now use params to make a new hash table and fill it. */
2776 ht = Fmake_hash_table (param_count, params);
2778 while (CONSP (data))
2780 key = XCAR (data);
2781 data = XCDR (data);
2782 if (!CONSP (data))
2783 error ("Odd number of elements in hash table data");
2784 val = XCAR (data);
2785 data = XCDR (data);
2786 Fputhash (key, val, ht);
2789 return ht;
2791 UNREAD (c);
2792 invalid_syntax ("#");
2794 if (c == '^')
2796 c = READCHAR;
2797 if (c == '[')
2799 Lisp_Object tmp;
2800 tmp = read_vector (readcharfun, 0);
2801 if (ASIZE (tmp) < CHAR_TABLE_STANDARD_SLOTS)
2802 error ("Invalid size char-table");
2803 XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE);
2804 return tmp;
2806 else if (c == '^')
2808 c = READCHAR;
2809 if (c == '[')
2811 /* Sub char-table can't be read as a regular
2812 vector because of a two C integer fields. */
2813 Lisp_Object tbl, tmp = read_list (1, readcharfun);
2814 ptrdiff_t size = XINT (Flength (tmp));
2815 int i, depth, min_char;
2816 struct Lisp_Cons *cell;
2818 if (size == 0)
2819 error ("Zero-sized sub char-table");
2821 if (! RANGED_INTEGERP (1, XCAR (tmp), 3))
2822 error ("Invalid depth in sub char-table");
2823 depth = XINT (XCAR (tmp));
2824 if (chartab_size[depth] != size - 2)
2825 error ("Invalid size in sub char-table");
2826 cell = XCONS (tmp), tmp = XCDR (tmp), size--;
2827 free_cons (cell);
2829 if (! RANGED_INTEGERP (0, XCAR (tmp), MAX_CHAR))
2830 error ("Invalid minimum character in sub-char-table");
2831 min_char = XINT (XCAR (tmp));
2832 cell = XCONS (tmp), tmp = XCDR (tmp), size--;
2833 free_cons (cell);
2835 tbl = make_uninit_sub_char_table (depth, min_char);
2836 for (i = 0; i < size; i++)
2838 XSUB_CHAR_TABLE (tbl)->contents[i] = XCAR (tmp);
2839 cell = XCONS (tmp), tmp = XCDR (tmp);
2840 free_cons (cell);
2842 return tbl;
2844 invalid_syntax ("#^^");
2846 invalid_syntax ("#^");
2848 if (c == '&')
2850 Lisp_Object length;
2851 length = read1 (readcharfun, pch, first_in_list);
2852 c = READCHAR;
2853 if (c == '"')
2855 Lisp_Object tmp, val;
2856 EMACS_INT size_in_chars = bool_vector_bytes (XFASTINT (length));
2857 unsigned char *data;
2859 UNREAD (c);
2860 tmp = read1 (readcharfun, pch, first_in_list);
2861 if (STRING_MULTIBYTE (tmp)
2862 || (size_in_chars != SCHARS (tmp)
2863 /* We used to print 1 char too many
2864 when the number of bits was a multiple of 8.
2865 Accept such input in case it came from an old
2866 version. */
2867 && ! (XFASTINT (length)
2868 == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)))
2869 invalid_syntax ("#&...");
2871 val = make_uninit_bool_vector (XFASTINT (length));
2872 data = bool_vector_uchar_data (val);
2873 memcpy (data, SDATA (tmp), size_in_chars);
2874 /* Clear the extraneous bits in the last byte. */
2875 if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
2876 data[size_in_chars - 1]
2877 &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
2878 return val;
2880 invalid_syntax ("#&...");
2882 if (c == '[')
2884 /* Accept compiled functions at read-time so that we don't have to
2885 build them using function calls. */
2886 Lisp_Object tmp;
2887 struct Lisp_Vector *vec;
2888 tmp = read_vector (readcharfun, 1);
2889 vec = XVECTOR (tmp);
2890 if (vec->header.size == 0)
2891 invalid_syntax ("Empty byte-code object");
2892 make_byte_code (vec);
2893 return tmp;
2895 if (c == '(')
2897 Lisp_Object tmp;
2898 int ch;
2900 /* Read the string itself. */
2901 tmp = read1 (readcharfun, &ch, 0);
2902 if (ch != 0 || !STRINGP (tmp))
2903 invalid_syntax ("#");
2904 /* Read the intervals and their properties. */
2905 while (1)
2907 Lisp_Object beg, end, plist;
2909 beg = read1 (readcharfun, &ch, 0);
2910 end = plist = Qnil;
2911 if (ch == ')')
2912 break;
2913 if (ch == 0)
2914 end = read1 (readcharfun, &ch, 0);
2915 if (ch == 0)
2916 plist = read1 (readcharfun, &ch, 0);
2917 if (ch)
2918 invalid_syntax ("Invalid string property list");
2919 Fset_text_properties (beg, end, plist, tmp);
2922 return tmp;
2925 /* #@NUMBER is used to skip NUMBER following bytes.
2926 That's used in .elc files to skip over doc strings
2927 and function definitions. */
2928 if (c == '@')
2930 enum { extra = 100 };
2931 ptrdiff_t i, nskip = 0, digits = 0;
2933 /* Read a decimal integer. */
2934 while ((c = READCHAR) >= 0
2935 && c >= '0' && c <= '9')
2937 if ((STRING_BYTES_BOUND - extra) / 10 <= nskip)
2938 string_overflow ();
2939 digits++;
2940 nskip *= 10;
2941 nskip += c - '0';
2942 if (digits == 2 && nskip == 0)
2943 { /* We've just seen #@00, which means "skip to end". */
2944 skip_dyn_eof (readcharfun);
2945 return Qnil;
2948 if (nskip > 0)
2949 /* We can't use UNREAD here, because in the code below we side-step
2950 READCHAR. Instead, assume the first char after #@NNN occupies
2951 a single byte, which is the case normally since it's just
2952 a space. */
2953 nskip--;
2954 else
2955 UNREAD (c);
2957 if (load_force_doc_strings
2958 && (FROM_FILE_P (readcharfun)))
2960 /* If we are supposed to force doc strings into core right now,
2961 record the last string that we skipped,
2962 and record where in the file it comes from. */
2964 /* But first exchange saved_doc_string
2965 with prev_saved_doc_string, so we save two strings. */
2967 char *temp = saved_doc_string;
2968 ptrdiff_t temp_size = saved_doc_string_size;
2969 file_offset temp_pos = saved_doc_string_position;
2970 ptrdiff_t temp_len = saved_doc_string_length;
2972 saved_doc_string = prev_saved_doc_string;
2973 saved_doc_string_size = prev_saved_doc_string_size;
2974 saved_doc_string_position = prev_saved_doc_string_position;
2975 saved_doc_string_length = prev_saved_doc_string_length;
2977 prev_saved_doc_string = temp;
2978 prev_saved_doc_string_size = temp_size;
2979 prev_saved_doc_string_position = temp_pos;
2980 prev_saved_doc_string_length = temp_len;
2983 if (saved_doc_string_size == 0)
2985 saved_doc_string = xmalloc (nskip + extra);
2986 saved_doc_string_size = nskip + extra;
2988 if (nskip > saved_doc_string_size)
2990 saved_doc_string = xrealloc (saved_doc_string, nskip + extra);
2991 saved_doc_string_size = nskip + extra;
2994 FILE *instream = infile->stream;
2995 saved_doc_string_position = (file_tell (instream)
2996 - infile->lookahead);
2998 /* Copy that many bytes into saved_doc_string. */
2999 i = 0;
3000 for (int n = min (nskip, infile->lookahead); 0 < n; n--)
3001 saved_doc_string[i++]
3002 = c = infile->buf[--infile->lookahead];
3003 block_input ();
3004 for (; i < nskip && 0 <= c; i++)
3005 saved_doc_string[i] = c = getc_unlocked (instream);
3006 unblock_input ();
3008 saved_doc_string_length = i;
3010 else
3011 /* Skip that many bytes. */
3012 skip_dyn_bytes (readcharfun, nskip);
3014 goto retry;
3016 if (c == '!')
3018 /* #! appears at the beginning of an executable file.
3019 Skip the first line. */
3020 while (c != '\n' && c >= 0)
3021 c = READCHAR;
3022 goto retry;
3024 if (c == '$')
3025 return Vload_file_name;
3026 if (c == '\'')
3027 return list2 (Qfunction, read0 (readcharfun));
3028 /* #:foo is the uninterned symbol named foo. */
3029 if (c == ':')
3031 uninterned_symbol = true;
3032 c = READCHAR;
3033 if (!(c > 040
3034 && c != NO_BREAK_SPACE
3035 && (c >= 0200
3036 || strchr ("\"';()[]#`,", c) == NULL)))
3038 /* No symbol character follows, this is the empty
3039 symbol. */
3040 UNREAD (c);
3041 return Fmake_symbol (empty_unibyte_string);
3043 goto read_symbol;
3045 /* ## is the empty symbol. */
3046 if (c == '#')
3047 return Fintern (empty_unibyte_string, Qnil);
3048 /* Reader forms that can reuse previously read objects. */
3049 if (c >= '0' && c <= '9')
3051 EMACS_INT n = 0;
3052 Lisp_Object tem;
3053 bool overflow = false;
3055 /* Read a non-negative integer. */
3056 while (c >= '0' && c <= '9')
3058 overflow |= INT_MULTIPLY_WRAPV (n, 10, &n);
3059 overflow |= INT_ADD_WRAPV (n, c - '0', &n);
3060 c = READCHAR;
3063 if (!overflow && n <= MOST_POSITIVE_FIXNUM)
3065 if (c == 'r' || c == 'R')
3066 return read_integer (readcharfun, n);
3068 if (! NILP (Vread_circle))
3070 /* #n=object returns object, but associates it with
3071 n for #n#. */
3072 if (c == '=')
3074 /* Make a placeholder for #n# to use temporarily. */
3075 /* Note: We used to use AUTO_CONS to allocate
3076 placeholder, but that is a bad idea, since it
3077 will place a stack-allocated cons cell into
3078 the list in read_objects_map, which is a
3079 staticpro'd global variable, and thus each of
3080 its elements is marked during each GC. A
3081 stack-allocated object will become garbled
3082 when its stack slot goes out of scope, and
3083 some other function reuses it for entirely
3084 different purposes, which will cause crashes
3085 in GC. */
3086 Lisp_Object placeholder = Fcons (Qnil, Qnil);
3087 struct Lisp_Hash_Table *h
3088 = XHASH_TABLE (read_objects_map);
3089 EMACS_UINT hash;
3090 Lisp_Object number = make_number (n);
3092 ptrdiff_t i = hash_lookup (h, number, &hash);
3093 if (i >= 0)
3094 /* Not normal, but input could be malformed. */
3095 set_hash_value_slot (h, i, placeholder);
3096 else
3097 hash_put (h, number, placeholder, hash);
3099 /* Read the object itself. */
3100 tem = read0 (readcharfun);
3102 /* If it can be recursive, remember it for
3103 future substitutions. */
3104 if (! SYMBOLP (tem)
3105 && ! NUMBERP (tem)
3106 && ! (STRINGP (tem) && !string_intervals (tem)))
3108 struct Lisp_Hash_Table *h2
3109 = XHASH_TABLE (read_objects_completed);
3110 i = hash_lookup (h2, tem, &hash);
3111 eassert (i < 0);
3112 hash_put (h2, tem, Qnil, hash);
3115 /* Now put it everywhere the placeholder was... */
3116 if (CONSP (tem))
3118 Fsetcar (placeholder, XCAR (tem));
3119 Fsetcdr (placeholder, XCDR (tem));
3120 return placeholder;
3122 else
3124 Flread__substitute_object_in_subtree
3125 (tem, placeholder, read_objects_completed);
3127 /* ...and #n# will use the real value from now on. */
3128 i = hash_lookup (h, number, &hash);
3129 eassert (i >= 0);
3130 set_hash_value_slot (h, i, tem);
3132 return tem;
3136 /* #n# returns a previously read object. */
3137 if (c == '#')
3139 struct Lisp_Hash_Table *h
3140 = XHASH_TABLE (read_objects_map);
3141 ptrdiff_t i = hash_lookup (h, make_number (n), NULL);
3142 if (i >= 0)
3143 return HASH_VALUE (h, i);
3147 /* Fall through to error message. */
3149 else if (c == 'x' || c == 'X')
3150 return read_integer (readcharfun, 16);
3151 else if (c == 'o' || c == 'O')
3152 return read_integer (readcharfun, 8);
3153 else if (c == 'b' || c == 'B')
3154 return read_integer (readcharfun, 2);
3156 UNREAD (c);
3157 invalid_syntax ("#");
3159 case ';':
3160 while ((c = READCHAR) >= 0 && c != '\n');
3161 goto retry;
3163 case '\'':
3164 return list2 (Qquote, read0 (readcharfun));
3166 case '`':
3168 int next_char = READCHAR;
3169 UNREAD (next_char);
3170 /* Transition from old-style to new-style:
3171 If we see "(`" it used to mean old-style, which usually works
3172 fine because ` should almost never appear in such a position
3173 for new-style. But occasionally we need "(`" to mean new
3174 style, so we try to distinguish the two by the fact that we
3175 can either write "( `foo" or "(` foo", where the first
3176 intends to use new-style whereas the second intends to use
3177 old-style. For Emacs-25, we should completely remove this
3178 first_in_list exception (old-style can still be obtained via
3179 "(\`" anyway). */
3180 if (!new_backquote_flag && first_in_list && next_char == ' ')
3182 Vlread_old_style_backquotes = Qt;
3183 goto default_label;
3185 else
3187 Lisp_Object value;
3188 bool saved_new_backquote_flag = new_backquote_flag;
3190 new_backquote_flag = 1;
3191 value = read0 (readcharfun);
3192 new_backquote_flag = saved_new_backquote_flag;
3194 return list2 (Qbackquote, value);
3197 case ',':
3199 int next_char = READCHAR;
3200 UNREAD (next_char);
3201 /* Transition from old-style to new-style:
3202 It used to be impossible to have a new-style , other than within
3203 a new-style `. This is sufficient when ` and , are used in the
3204 normal way, but ` and , can also appear in args to macros that
3205 will not interpret them in the usual way, in which case , may be
3206 used without any ` anywhere near.
3207 So we now use the same heuristic as for backquote: old-style
3208 unquotes are only recognized when first on a list, and when
3209 followed by a space.
3210 Because it's more difficult to peek 2 chars ahead, a new-style
3211 ,@ can still not be used outside of a `, unless it's in the middle
3212 of a list. */
3213 if (new_backquote_flag
3214 || !first_in_list
3215 || (next_char != ' ' && next_char != '@'))
3217 Lisp_Object comma_type = Qnil;
3218 Lisp_Object value;
3219 int ch = READCHAR;
3221 if (ch == '@')
3222 comma_type = Qcomma_at;
3223 else if (ch == '.')
3224 comma_type = Qcomma_dot;
3225 else
3227 if (ch >= 0) UNREAD (ch);
3228 comma_type = Qcomma;
3231 value = read0 (readcharfun);
3232 return list2 (comma_type, value);
3234 else
3236 Vlread_old_style_backquotes = Qt;
3237 goto default_label;
3240 case '?':
3242 int modifiers;
3243 int next_char;
3244 bool ok;
3246 c = READCHAR;
3247 if (c < 0)
3248 end_of_file_error ();
3250 /* Accept `single space' syntax like (list ? x) where the
3251 whitespace character is SPC or TAB.
3252 Other literal whitespace like NL, CR, and FF are not accepted,
3253 as there are well-established escape sequences for these. */
3254 if (c == ' ' || c == '\t')
3255 return make_number (c);
3257 if (c == '(' || c == ')' || c == '[' || c == ']'
3258 || c == '"' || c == ';')
3260 CHECK_LIST (Vlread_unescaped_character_literals);
3261 Lisp_Object char_obj = make_natnum (c);
3262 if (NILP (Fmemq (char_obj, Vlread_unescaped_character_literals)))
3263 Vlread_unescaped_character_literals =
3264 Fcons (char_obj, Vlread_unescaped_character_literals);
3267 if (c == '\\')
3268 c = read_escape (readcharfun, 0);
3269 modifiers = c & CHAR_MODIFIER_MASK;
3270 c &= ~CHAR_MODIFIER_MASK;
3271 if (CHAR_BYTE8_P (c))
3272 c = CHAR_TO_BYTE8 (c);
3273 c |= modifiers;
3275 next_char = READCHAR;
3276 ok = (next_char <= 040
3277 || (next_char < 0200
3278 && strchr ("\"';()[]#?`,.", next_char) != NULL));
3279 UNREAD (next_char);
3280 if (ok)
3281 return make_number (c);
3283 invalid_syntax ("?");
3286 case '"':
3288 ptrdiff_t count = SPECPDL_INDEX ();
3289 char *read_buffer = stackbuf;
3290 ptrdiff_t read_buffer_size = sizeof stackbuf;
3291 char *heapbuf = NULL;
3292 char *p = read_buffer;
3293 char *end = read_buffer + read_buffer_size;
3294 int ch;
3295 /* True if we saw an escape sequence specifying
3296 a multibyte character. */
3297 bool force_multibyte = false;
3298 /* True if we saw an escape sequence specifying
3299 a single-byte character. */
3300 bool force_singlebyte = false;
3301 bool cancel = false;
3302 ptrdiff_t nchars = 0;
3304 while ((ch = READCHAR) >= 0
3305 && ch != '\"')
3307 if (end - p < MAX_MULTIBYTE_LENGTH)
3309 ptrdiff_t offset = p - read_buffer;
3310 read_buffer = grow_read_buffer (read_buffer, offset,
3311 &heapbuf, &read_buffer_size,
3312 count);
3313 p = read_buffer + offset;
3314 end = read_buffer + read_buffer_size;
3317 if (ch == '\\')
3319 int modifiers;
3321 ch = read_escape (readcharfun, 1);
3323 /* CH is -1 if \ newline or \ space has just been seen. */
3324 if (ch == -1)
3326 if (p == read_buffer)
3327 cancel = true;
3328 continue;
3331 modifiers = ch & CHAR_MODIFIER_MASK;
3332 ch = ch & ~CHAR_MODIFIER_MASK;
3334 if (CHAR_BYTE8_P (ch))
3335 force_singlebyte = true;
3336 else if (! ASCII_CHAR_P (ch))
3337 force_multibyte = true;
3338 else /* I.e. ASCII_CHAR_P (ch). */
3340 /* Allow `\C- ' and `\C-?'. */
3341 if (modifiers == CHAR_CTL)
3343 if (ch == ' ')
3344 ch = 0, modifiers = 0;
3345 else if (ch == '?')
3346 ch = 127, modifiers = 0;
3348 if (modifiers & CHAR_SHIFT)
3350 /* Shift modifier is valid only with [A-Za-z]. */
3351 if (ch >= 'A' && ch <= 'Z')
3352 modifiers &= ~CHAR_SHIFT;
3353 else if (ch >= 'a' && ch <= 'z')
3354 ch -= ('a' - 'A'), modifiers &= ~CHAR_SHIFT;
3357 if (modifiers & CHAR_META)
3359 /* Move the meta bit to the right place for a
3360 string. */
3361 modifiers &= ~CHAR_META;
3362 ch = BYTE8_TO_CHAR (ch | 0x80);
3363 force_singlebyte = true;
3367 /* Any modifiers remaining are invalid. */
3368 if (modifiers)
3369 error ("Invalid modifier in string");
3370 p += CHAR_STRING (ch, (unsigned char *) p);
3372 else
3374 p += CHAR_STRING (ch, (unsigned char *) p);
3375 if (CHAR_BYTE8_P (ch))
3376 force_singlebyte = true;
3377 else if (! ASCII_CHAR_P (ch))
3378 force_multibyte = true;
3380 nchars++;
3383 if (ch < 0)
3384 end_of_file_error ();
3386 /* If purifying, and string starts with \ newline,
3387 return zero instead. This is for doc strings
3388 that we are really going to find in etc/DOC.nn.nn. */
3389 if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
3390 return unbind_to (count, make_number (0));
3392 if (! force_multibyte && force_singlebyte)
3394 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3395 forms. Convert it to unibyte. */
3396 nchars = str_as_unibyte ((unsigned char *) read_buffer,
3397 p - read_buffer);
3398 p = read_buffer + nchars;
3401 Lisp_Object result
3402 = make_specified_string (read_buffer, nchars, p - read_buffer,
3403 (force_multibyte
3404 || (p - read_buffer != nchars)));
3405 return unbind_to (count, result);
3408 case '.':
3410 int next_char = READCHAR;
3411 UNREAD (next_char);
3413 if (next_char <= 040
3414 || (next_char < 0200
3415 && strchr ("\"';([#?`,", next_char) != NULL))
3417 *pch = c;
3418 return Qnil;
3421 /* The atom-reading loop below will now loop at least once,
3422 assuring that we will not try to UNREAD two characters in a
3423 row. */
3424 FALLTHROUGH;
3425 default:
3426 default_label:
3427 if (c <= 040) goto retry;
3428 if (c == NO_BREAK_SPACE)
3429 goto retry;
3431 read_symbol:
3433 ptrdiff_t count = SPECPDL_INDEX ();
3434 char *read_buffer = stackbuf;
3435 ptrdiff_t read_buffer_size = sizeof stackbuf;
3436 char *heapbuf = NULL;
3437 char *p = read_buffer;
3438 char *end = read_buffer + read_buffer_size;
3439 bool quoted = false;
3440 EMACS_INT start_position = readchar_count - 1;
3444 if (end - p < MAX_MULTIBYTE_LENGTH + 1)
3446 ptrdiff_t offset = p - read_buffer;
3447 read_buffer = grow_read_buffer (read_buffer, offset,
3448 &heapbuf, &read_buffer_size,
3449 count);
3450 p = read_buffer + offset;
3451 end = read_buffer + read_buffer_size;
3454 if (c == '\\')
3456 c = READCHAR;
3457 if (c == -1)
3458 end_of_file_error ();
3459 quoted = true;
3462 if (multibyte)
3463 p += CHAR_STRING (c, (unsigned char *) p);
3464 else
3465 *p++ = c;
3466 c = READCHAR;
3468 while (c > 040
3469 && c != NO_BREAK_SPACE
3470 && (c >= 0200
3471 || strchr ("\"';()[]#`,", c) == NULL));
3473 *p = 0;
3474 UNREAD (c);
3476 if (!quoted && !uninterned_symbol)
3478 Lisp_Object result = string_to_number (read_buffer, 10, 0);
3479 if (! NILP (result))
3480 return unbind_to (count, result);
3482 if (!quoted && multibyte)
3484 int ch = STRING_CHAR ((unsigned char *) read_buffer);
3485 switch (ch)
3487 case 0x2018: /* LEFT SINGLE QUOTATION MARK */
3488 case 0x2019: /* RIGHT SINGLE QUOTATION MARK */
3489 case 0x201B: /* SINGLE HIGH-REVERSED-9 QUOTATION MARK */
3490 case 0x201C: /* LEFT DOUBLE QUOTATION MARK */
3491 case 0x201D: /* RIGHT DOUBLE QUOTATION MARK */
3492 case 0x201F: /* DOUBLE HIGH-REVERSED-9 QUOTATION MARK */
3493 case 0x301E: /* DOUBLE PRIME QUOTATION MARK */
3494 case 0xFF02: /* FULLWIDTH QUOTATION MARK */
3495 case 0xFF07: /* FULLWIDTH APOSTROPHE */
3496 xsignal2 (Qinvalid_read_syntax, build_string ("strange quote"),
3497 CALLN (Fstring, make_number (ch)));
3501 Lisp_Object result;
3502 ptrdiff_t nbytes = p - read_buffer;
3503 ptrdiff_t nchars
3504 = (multibyte
3505 ? multibyte_chars_in_text ((unsigned char *) read_buffer,
3506 nbytes)
3507 : nbytes);
3509 if (uninterned_symbol)
3511 Lisp_Object name
3512 = ((! NILP (Vpurify_flag)
3513 ? make_pure_string : make_specified_string)
3514 (read_buffer, nchars, nbytes, multibyte));
3515 result = Fmake_symbol (name);
3517 else
3519 /* Don't create the string object for the name unless
3520 we're going to retain it in a new symbol.
3522 Like intern_1 but supports multibyte names. */
3523 Lisp_Object obarray = check_obarray (Vobarray);
3524 Lisp_Object tem = oblookup (obarray, read_buffer,
3525 nchars, nbytes);
3527 if (SYMBOLP (tem))
3528 result = tem;
3529 else
3531 Lisp_Object name
3532 = make_specified_string (read_buffer, nchars, nbytes,
3533 multibyte);
3534 result = intern_driver (name, obarray, tem);
3538 if (EQ (Vread_with_symbol_positions, Qt)
3539 || EQ (Vread_with_symbol_positions, readcharfun))
3540 Vread_symbol_positions_list
3541 = Fcons (Fcons (result, make_number (start_position)),
3542 Vread_symbol_positions_list);
3543 return unbind_to (count, result);
3549 DEFUN ("lread--substitute-object-in-subtree",
3550 Flread__substitute_object_in_subtree,
3551 Slread__substitute_object_in_subtree, 3, 3, 0,
3552 doc: /* In OBJECT, replace every occurrence of PLACEHOLDER with OBJECT.
3553 COMPLETED is a hash table of objects that might be circular, or is t
3554 if any object might be circular. */)
3555 (Lisp_Object object, Lisp_Object placeholder, Lisp_Object completed)
3557 struct subst subst = { object, placeholder, completed, Qnil };
3558 Lisp_Object check_object = substitute_object_recurse (&subst, object);
3560 /* The returned object here is expected to always eq the
3561 original. */
3562 if (!EQ (check_object, object))
3563 error ("Unexpected mutation error in reader");
3564 return Qnil;
3567 static Lisp_Object
3568 substitute_object_recurse (struct subst *subst, Lisp_Object subtree)
3570 /* If we find the placeholder, return the target object. */
3571 if (EQ (subst->placeholder, subtree))
3572 return subst->object;
3574 /* For common object types that can't contain other objects, don't
3575 bother looking them up; we're done. */
3576 if (SYMBOLP (subtree)
3577 || (STRINGP (subtree) && !string_intervals (subtree))
3578 || NUMBERP (subtree))
3579 return subtree;
3581 /* If we've been to this node before, don't explore it again. */
3582 if (!EQ (Qnil, Fmemq (subtree, subst->seen)))
3583 return subtree;
3585 /* If this node can be the entry point to a cycle, remember that
3586 we've seen it. It can only be such an entry point if it was made
3587 by #n=, which means that we can find it as a value in
3588 COMPLETED. */
3589 if (EQ (subst->completed, Qt)
3590 || hash_lookup (XHASH_TABLE (subst->completed), subtree, NULL) >= 0)
3591 subst->seen = Fcons (subtree, subst->seen);
3593 /* Recurse according to subtree's type.
3594 Every branch must return a Lisp_Object. */
3595 switch (XTYPE (subtree))
3597 case Lisp_Vectorlike:
3599 ptrdiff_t i = 0, length = 0;
3600 if (BOOL_VECTOR_P (subtree))
3601 return subtree; /* No sub-objects anyway. */
3602 else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
3603 || COMPILEDP (subtree) || HASH_TABLE_P (subtree)
3604 || RECORDP (subtree))
3605 length = PVSIZE (subtree);
3606 else if (VECTORP (subtree))
3607 length = ASIZE (subtree);
3608 else
3609 /* An unknown pseudovector may contain non-Lisp fields, so we
3610 can't just blindly traverse all its fields. We used to call
3611 `Flength' which signaled `sequencep', so I just preserved this
3612 behavior. */
3613 wrong_type_argument (Qsequencep, subtree);
3615 if (SUB_CHAR_TABLE_P (subtree))
3616 i = 2;
3617 for ( ; i < length; i++)
3618 ASET (subtree, i,
3619 substitute_object_recurse (subst, AREF (subtree, i)));
3620 return subtree;
3623 case Lisp_Cons:
3624 XSETCAR (subtree, substitute_object_recurse (subst, XCAR (subtree)));
3625 XSETCDR (subtree, substitute_object_recurse (subst, XCDR (subtree)));
3626 return subtree;
3628 case Lisp_String:
3630 /* Check for text properties in each interval.
3631 substitute_in_interval contains part of the logic. */
3633 INTERVAL root_interval = string_intervals (subtree);
3634 traverse_intervals_noorder (root_interval,
3635 substitute_in_interval, subst);
3636 return subtree;
3639 /* Other types don't recurse any further. */
3640 default:
3641 return subtree;
3645 /* Helper function for substitute_object_recurse. */
3646 static void
3647 substitute_in_interval (INTERVAL interval, void *arg)
3649 set_interval_plist (interval,
3650 substitute_object_recurse (arg, interval->plist));
3654 /* Convert STRING to a number, assuming base BASE. Return a fixnum if
3655 STRING has integer syntax and fits in a fixnum, else return the
3656 nearest float if STRING has either floating point or integer syntax
3657 and BASE is 10, else return nil. If IGNORE_TRAILING, consider just
3658 the longest prefix of STRING that has valid floating point syntax.
3659 Signal an overflow if BASE is not 10 and the number has integer
3660 syntax but does not fit. */
3662 Lisp_Object
3663 string_to_number (char const *string, int base, bool ignore_trailing)
3665 char const *cp = string;
3666 bool float_syntax = 0;
3667 double value = 0;
3669 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3670 IEEE floating point hosts, and works around a formerly-common bug where
3671 atof ("-0.0") drops the sign. */
3672 bool negative = *cp == '-';
3674 bool signedp = negative || *cp == '+';
3675 cp += signedp;
3677 enum { INTOVERFLOW = 1, LEAD_INT = 2, DOT_CHAR = 4, TRAIL_INT = 8,
3678 E_EXP = 16 };
3679 int state = 0;
3680 int leading_digit = digit_to_number (*cp, base);
3681 uintmax_t n = leading_digit;
3682 if (leading_digit >= 0)
3684 state |= LEAD_INT;
3685 for (int digit; 0 <= (digit = digit_to_number (*++cp, base)); )
3687 if (INT_MULTIPLY_OVERFLOW (n, base))
3688 state |= INTOVERFLOW;
3689 n *= base;
3690 if (INT_ADD_OVERFLOW (n, digit))
3691 state |= INTOVERFLOW;
3692 n += digit;
3695 if (*cp == '.')
3697 state |= DOT_CHAR;
3698 cp++;
3701 if (base == 10)
3703 if ('0' <= *cp && *cp <= '9')
3705 state |= TRAIL_INT;
3707 cp++;
3708 while ('0' <= *cp && *cp <= '9');
3710 if (*cp == 'e' || *cp == 'E')
3712 char const *ecp = cp;
3713 cp++;
3714 if (*cp == '+' || *cp == '-')
3715 cp++;
3716 if ('0' <= *cp && *cp <= '9')
3718 state |= E_EXP;
3720 cp++;
3721 while ('0' <= *cp && *cp <= '9');
3723 else if (cp[-1] == '+'
3724 && cp[0] == 'I' && cp[1] == 'N' && cp[2] == 'F')
3726 state |= E_EXP;
3727 cp += 3;
3728 value = INFINITY;
3730 else if (cp[-1] == '+'
3731 && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
3733 state |= E_EXP;
3734 cp += 3;
3735 /* NAN is a "positive" NaN on all known Emacs hosts. */
3736 value = NAN;
3738 else
3739 cp = ecp;
3742 float_syntax = ((state & (DOT_CHAR|TRAIL_INT)) == (DOT_CHAR|TRAIL_INT)
3743 || (state & ~INTOVERFLOW) == (LEAD_INT|E_EXP));
3746 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3747 any prefix that matches. Otherwise, the entire string must match. */
3748 if (! (ignore_trailing
3749 ? ((state & LEAD_INT) != 0 || float_syntax)
3750 : (!*cp && ((state & ~(INTOVERFLOW | DOT_CHAR)) == LEAD_INT
3751 || float_syntax))))
3752 return Qnil;
3754 /* If the number uses integer and not float syntax, and is in C-language
3755 range, use its value, preferably as a fixnum. */
3756 if (leading_digit >= 0 && ! float_syntax)
3758 if (state & INTOVERFLOW)
3760 /* Unfortunately there's no simple and accurate way to convert
3761 non-base-10 numbers that are out of C-language range. */
3762 if (base != 10)
3763 xsignal1 (Qoverflow_error, build_string (string));
3765 else if (n <= (negative ? -MOST_NEGATIVE_FIXNUM : MOST_POSITIVE_FIXNUM))
3767 EMACS_INT signed_n = n;
3768 return make_number (negative ? -signed_n : signed_n);
3770 else
3771 value = n;
3774 /* Either the number uses float syntax, or it does not fit into a fixnum.
3775 Convert it from string to floating point, unless the value is already
3776 known because it is an infinity, a NAN, or its absolute value fits in
3777 uintmax_t. */
3778 if (! value)
3779 value = atof (string + signedp);
3781 return make_float (negative ? -value : value);
3785 static Lisp_Object
3786 read_vector (Lisp_Object readcharfun, bool bytecodeflag)
3788 ptrdiff_t i, size;
3789 Lisp_Object *ptr;
3790 Lisp_Object tem, item, vector;
3791 struct Lisp_Cons *otem;
3792 Lisp_Object len;
3794 tem = read_list (1, readcharfun);
3795 len = Flength (tem);
3796 vector = Fmake_vector (len, Qnil);
3798 size = ASIZE (vector);
3799 ptr = XVECTOR (vector)->contents;
3800 for (i = 0; i < size; i++)
3802 item = Fcar (tem);
3803 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3804 bytecode object, the docstring containing the bytecode and
3805 constants values must be treated as unibyte and passed to
3806 Fread, to get the actual bytecode string and constants vector. */
3807 if (bytecodeflag && load_force_doc_strings)
3809 if (i == COMPILED_BYTECODE)
3811 if (!STRINGP (item))
3812 error ("Invalid byte code");
3814 /* Delay handling the bytecode slot until we know whether
3815 it is lazily-loaded (we can tell by whether the
3816 constants slot is nil). */
3817 ASET (vector, COMPILED_CONSTANTS, item);
3818 item = Qnil;
3820 else if (i == COMPILED_CONSTANTS)
3822 Lisp_Object bytestr = ptr[COMPILED_CONSTANTS];
3824 if (NILP (item))
3826 /* Coerce string to unibyte (like string-as-unibyte,
3827 but without generating extra garbage and
3828 guaranteeing no change in the contents). */
3829 STRING_SET_CHARS (bytestr, SBYTES (bytestr));
3830 STRING_SET_UNIBYTE (bytestr);
3832 item = Fread (Fcons (bytestr, readcharfun));
3833 if (!CONSP (item))
3834 error ("Invalid byte code");
3836 otem = XCONS (item);
3837 bytestr = XCAR (item);
3838 item = XCDR (item);
3839 free_cons (otem);
3842 /* Now handle the bytecode slot. */
3843 ASET (vector, COMPILED_BYTECODE, bytestr);
3845 else if (i == COMPILED_DOC_STRING
3846 && STRINGP (item)
3847 && ! STRING_MULTIBYTE (item))
3849 if (EQ (readcharfun, Qget_emacs_mule_file_char))
3850 item = Fdecode_coding_string (item, Qemacs_mule, Qnil, Qnil);
3851 else
3852 item = Fstring_as_multibyte (item);
3855 ASET (vector, i, item);
3856 otem = XCONS (tem);
3857 tem = Fcdr (tem);
3858 free_cons (otem);
3860 return vector;
3863 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3865 static Lisp_Object
3866 read_list (bool flag, Lisp_Object readcharfun)
3868 Lisp_Object val, tail;
3869 Lisp_Object elt, tem;
3870 /* 0 is the normal case.
3871 1 means this list is a doc reference; replace it with the number 0.
3872 2 means this list is a doc reference; replace it with the doc string. */
3873 int doc_reference = 0;
3875 /* Initialize this to 1 if we are reading a list. */
3876 bool first_in_list = flag <= 0;
3878 val = Qnil;
3879 tail = Qnil;
3881 while (1)
3883 int ch;
3884 elt = read1 (readcharfun, &ch, first_in_list);
3886 first_in_list = 0;
3888 /* While building, if the list starts with #$, treat it specially. */
3889 if (EQ (elt, Vload_file_name)
3890 && ! NILP (elt)
3891 && !NILP (Vpurify_flag))
3893 if (NILP (Vdoc_file_name))
3894 /* We have not yet called Snarf-documentation, so assume
3895 this file is described in the DOC file
3896 and Snarf-documentation will fill in the right value later.
3897 For now, replace the whole list with 0. */
3898 doc_reference = 1;
3899 else
3900 /* We have already called Snarf-documentation, so make a relative
3901 file name for this file, so it can be found properly
3902 in the installed Lisp directory.
3903 We don't use Fexpand_file_name because that would make
3904 the directory absolute now. */
3906 AUTO_STRING (dot_dot_lisp, "../lisp/");
3907 elt = concat2 (dot_dot_lisp, Ffile_name_nondirectory (elt));
3910 else if (EQ (elt, Vload_file_name)
3911 && ! NILP (elt)
3912 && load_force_doc_strings)
3913 doc_reference = 2;
3915 if (ch)
3917 if (flag > 0)
3919 if (ch == ']')
3920 return val;
3921 invalid_syntax (") or . in a vector");
3923 if (ch == ')')
3924 return val;
3925 if (ch == '.')
3927 if (!NILP (tail))
3928 XSETCDR (tail, read0 (readcharfun));
3929 else
3930 val = read0 (readcharfun);
3931 read1 (readcharfun, &ch, 0);
3933 if (ch == ')')
3935 if (doc_reference == 1)
3936 return make_number (0);
3937 if (doc_reference == 2 && INTEGERP (XCDR (val)))
3939 char *saved = NULL;
3940 file_offset saved_position;
3941 /* Get a doc string from the file we are loading.
3942 If it's in saved_doc_string, get it from there.
3944 Here, we don't know if the string is a
3945 bytecode string or a doc string. As a
3946 bytecode string must be unibyte, we always
3947 return a unibyte string. If it is actually a
3948 doc string, caller must make it
3949 multibyte. */
3951 /* Position is negative for user variables. */
3952 EMACS_INT pos = eabs (XINT (XCDR (val)));
3953 if (pos >= saved_doc_string_position
3954 && pos < (saved_doc_string_position
3955 + saved_doc_string_length))
3957 saved = saved_doc_string;
3958 saved_position = saved_doc_string_position;
3960 /* Look in prev_saved_doc_string the same way. */
3961 else if (pos >= prev_saved_doc_string_position
3962 && pos < (prev_saved_doc_string_position
3963 + prev_saved_doc_string_length))
3965 saved = prev_saved_doc_string;
3966 saved_position = prev_saved_doc_string_position;
3968 if (saved)
3970 ptrdiff_t start = pos - saved_position;
3971 ptrdiff_t from, to;
3973 /* Process quoting with ^A,
3974 and find the end of the string,
3975 which is marked with ^_ (037). */
3976 for (from = start, to = start;
3977 saved[from] != 037;)
3979 int c = saved[from++];
3980 if (c == 1)
3982 c = saved[from++];
3983 saved[to++] = (c == 1 ? c
3984 : c == '0' ? 0
3985 : c == '_' ? 037
3986 : c);
3988 else
3989 saved[to++] = c;
3992 return make_unibyte_string (saved + start,
3993 to - start);
3995 else
3996 return get_doc_string (val, 1, 0);
3999 return val;
4001 invalid_syntax (". in wrong context");
4003 invalid_syntax ("] in a list");
4005 tem = list1 (elt);
4006 if (!NILP (tail))
4007 XSETCDR (tail, tem);
4008 else
4009 val = tem;
4010 tail = tem;
4014 static Lisp_Object initial_obarray;
4016 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
4018 static size_t oblookup_last_bucket_number;
4020 /* Get an error if OBARRAY is not an obarray.
4021 If it is one, return it. */
4023 Lisp_Object
4024 check_obarray (Lisp_Object obarray)
4026 /* We don't want to signal a wrong-type-argument error when we are
4027 shutting down due to a fatal error, and we don't want to hit
4028 assertions in VECTORP and ASIZE if the fatal error was during GC. */
4029 if (!fatal_error_in_progress
4030 && (!VECTORP (obarray) || ASIZE (obarray) == 0))
4032 /* If Vobarray is now invalid, force it to be valid. */
4033 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
4034 wrong_type_argument (Qvectorp, obarray);
4036 return obarray;
4039 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
4041 static Lisp_Object
4042 intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
4044 Lisp_Object *ptr;
4046 XSYMBOL (sym)->interned = (EQ (obarray, initial_obarray)
4047 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
4048 : SYMBOL_INTERNED);
4050 if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray))
4052 make_symbol_constant (sym);
4053 XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
4054 SET_SYMBOL_VAL (XSYMBOL (sym), sym);
4057 ptr = aref_addr (obarray, XINT (index));
4058 set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL);
4059 *ptr = sym;
4060 return sym;
4063 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
4065 Lisp_Object
4066 intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index)
4068 return intern_sym (Fmake_symbol (string), obarray, index);
4071 /* Intern the C string STR: return a symbol with that name,
4072 interned in the current obarray. */
4074 Lisp_Object
4075 intern_1 (const char *str, ptrdiff_t len)
4077 Lisp_Object obarray = check_obarray (Vobarray);
4078 Lisp_Object tem = oblookup (obarray, str, len, len);
4080 return (SYMBOLP (tem) ? tem
4081 /* The above `oblookup' was done on the basis of nchars==nbytes, so
4082 the string has to be unibyte. */
4083 : intern_driver (make_unibyte_string (str, len),
4084 obarray, tem));
4087 Lisp_Object
4088 intern_c_string_1 (const char *str, ptrdiff_t len)
4090 Lisp_Object obarray = check_obarray (Vobarray);
4091 Lisp_Object tem = oblookup (obarray, str, len, len);
4093 if (!SYMBOLP (tem))
4095 /* Creating a non-pure string from a string literal not implemented yet.
4096 We could just use make_string here and live with the extra copy. */
4097 eassert (!NILP (Vpurify_flag));
4098 tem = intern_driver (make_pure_c_string (str, len), obarray, tem);
4100 return tem;
4103 static void
4104 define_symbol (Lisp_Object sym, char const *str)
4106 ptrdiff_t len = strlen (str);
4107 Lisp_Object string = make_pure_c_string (str, len);
4108 init_symbol (sym, string);
4110 /* Qunbound is uninterned, so that it's not confused with any symbol
4111 'unbound' created by a Lisp program. */
4112 if (! EQ (sym, Qunbound))
4114 Lisp_Object bucket = oblookup (initial_obarray, str, len, len);
4115 eassert (INTEGERP (bucket));
4116 intern_sym (sym, initial_obarray, bucket);
4120 DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
4121 doc: /* Return the canonical symbol whose name is STRING.
4122 If there is none, one is created by this function and returned.
4123 A second optional argument specifies the obarray to use;
4124 it defaults to the value of `obarray'. */)
4125 (Lisp_Object string, Lisp_Object obarray)
4127 Lisp_Object tem;
4129 obarray = check_obarray (NILP (obarray) ? Vobarray : obarray);
4130 CHECK_STRING (string);
4132 tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string));
4133 if (!SYMBOLP (tem))
4134 tem = intern_driver (NILP (Vpurify_flag) ? string : Fpurecopy (string),
4135 obarray, tem);
4136 return tem;
4139 DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
4140 doc: /* Return the canonical symbol named NAME, or nil if none exists.
4141 NAME may be a string or a symbol. If it is a symbol, that exact
4142 symbol is searched for.
4143 A second optional argument specifies the obarray to use;
4144 it defaults to the value of `obarray'. */)
4145 (Lisp_Object name, Lisp_Object obarray)
4147 register Lisp_Object tem, string;
4149 if (NILP (obarray)) obarray = Vobarray;
4150 obarray = check_obarray (obarray);
4152 if (!SYMBOLP (name))
4154 CHECK_STRING (name);
4155 string = name;
4157 else
4158 string = SYMBOL_NAME (name);
4160 tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string));
4161 if (INTEGERP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
4162 return Qnil;
4163 else
4164 return tem;
4167 DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0,
4168 doc: /* Delete the symbol named NAME, if any, from OBARRAY.
4169 The value is t if a symbol was found and deleted, nil otherwise.
4170 NAME may be a string or a symbol. If it is a symbol, that symbol
4171 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
4172 OBARRAY, if nil, defaults to the value of the variable `obarray'.
4173 usage: (unintern NAME OBARRAY) */)
4174 (Lisp_Object name, Lisp_Object obarray)
4176 register Lisp_Object string, tem;
4177 size_t hash;
4179 if (NILP (obarray)) obarray = Vobarray;
4180 obarray = check_obarray (obarray);
4182 if (SYMBOLP (name))
4183 string = SYMBOL_NAME (name);
4184 else
4186 CHECK_STRING (name);
4187 string = name;
4190 tem = oblookup (obarray, SSDATA (string),
4191 SCHARS (string),
4192 SBYTES (string));
4193 if (INTEGERP (tem))
4194 return Qnil;
4195 /* If arg was a symbol, don't delete anything but that symbol itself. */
4196 if (SYMBOLP (name) && !EQ (name, tem))
4197 return Qnil;
4199 /* There are plenty of other symbols which will screw up the Emacs
4200 session if we unintern them, as well as even more ways to use
4201 `setq' or `fset' or whatnot to make the Emacs session
4202 unusable. Let's not go down this silly road. --Stef */
4203 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
4204 error ("Attempt to unintern t or nil"); */
4206 XSYMBOL (tem)->interned = SYMBOL_UNINTERNED;
4208 hash = oblookup_last_bucket_number;
4210 if (EQ (AREF (obarray, hash), tem))
4212 if (XSYMBOL (tem)->next)
4214 Lisp_Object sym;
4215 XSETSYMBOL (sym, XSYMBOL (tem)->next);
4216 ASET (obarray, hash, sym);
4218 else
4219 ASET (obarray, hash, make_number (0));
4221 else
4223 Lisp_Object tail, following;
4225 for (tail = AREF (obarray, hash);
4226 XSYMBOL (tail)->next;
4227 tail = following)
4229 XSETSYMBOL (following, XSYMBOL (tail)->next);
4230 if (EQ (following, tem))
4232 set_symbol_next (tail, XSYMBOL (following)->next);
4233 break;
4238 return Qt;
4241 /* Return the symbol in OBARRAY whose names matches the string
4242 of SIZE characters (SIZE_BYTE bytes) at PTR.
4243 If there is no such symbol, return the integer bucket number of
4244 where the symbol would be if it were present.
4246 Also store the bucket number in oblookup_last_bucket_number. */
4248 Lisp_Object
4249 oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff_t size_byte)
4251 size_t hash;
4252 size_t obsize;
4253 register Lisp_Object tail;
4254 Lisp_Object bucket, tem;
4256 obarray = check_obarray (obarray);
4257 /* This is sometimes needed in the middle of GC. */
4258 obsize = gc_asize (obarray);
4259 hash = hash_string (ptr, size_byte) % obsize;
4260 bucket = AREF (obarray, hash);
4261 oblookup_last_bucket_number = hash;
4262 if (EQ (bucket, make_number (0)))
4264 else if (!SYMBOLP (bucket))
4265 error ("Bad data in guts of obarray"); /* Like CADR error message. */
4266 else
4267 for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
4269 if (SBYTES (SYMBOL_NAME (tail)) == size_byte
4270 && SCHARS (SYMBOL_NAME (tail)) == size
4271 && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
4272 return tail;
4273 else if (XSYMBOL (tail)->next == 0)
4274 break;
4276 XSETINT (tem, hash);
4277 return tem;
4280 void
4281 map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
4283 ptrdiff_t i;
4284 register Lisp_Object tail;
4285 CHECK_VECTOR (obarray);
4286 for (i = ASIZE (obarray) - 1; i >= 0; i--)
4288 tail = AREF (obarray, i);
4289 if (SYMBOLP (tail))
4290 while (1)
4292 (*fn) (tail, arg);
4293 if (XSYMBOL (tail)->next == 0)
4294 break;
4295 XSETSYMBOL (tail, XSYMBOL (tail)->next);
4300 static void
4301 mapatoms_1 (Lisp_Object sym, Lisp_Object function)
4303 call1 (function, sym);
4306 DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
4307 doc: /* Call FUNCTION on every symbol in OBARRAY.
4308 OBARRAY defaults to the value of `obarray'. */)
4309 (Lisp_Object function, Lisp_Object obarray)
4311 if (NILP (obarray)) obarray = Vobarray;
4312 obarray = check_obarray (obarray);
4314 map_obarray (obarray, mapatoms_1, function);
4315 return Qnil;
4318 #define OBARRAY_SIZE 15121
4320 void
4321 init_obarray (void)
4323 Vobarray = Fmake_vector (make_number (OBARRAY_SIZE), make_number (0));
4324 initial_obarray = Vobarray;
4325 staticpro (&initial_obarray);
4327 for (int i = 0; i < ARRAYELTS (lispsym); i++)
4328 define_symbol (builtin_lisp_symbol (i), defsym_name[i]);
4330 DEFSYM (Qunbound, "unbound");
4332 DEFSYM (Qnil, "nil");
4333 SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
4334 make_symbol_constant (Qnil);
4335 XSYMBOL (Qnil)->declared_special = true;
4337 DEFSYM (Qt, "t");
4338 SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
4339 make_symbol_constant (Qt);
4340 XSYMBOL (Qt)->declared_special = true;
4342 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4343 Vpurify_flag = Qt;
4345 DEFSYM (Qvariable_documentation, "variable-documentation");
4348 void
4349 defsubr (struct Lisp_Subr *sname)
4351 Lisp_Object sym, tem;
4352 sym = intern_c_string (sname->symbol_name);
4353 XSETPVECTYPE (sname, PVEC_SUBR);
4354 XSETSUBR (tem, sname);
4355 set_symbol_function (sym, tem);
4358 #ifdef NOTDEF /* Use fset in subr.el now! */
4359 void
4360 defalias (struct Lisp_Subr *sname, char *string)
4362 Lisp_Object sym;
4363 sym = intern (string);
4364 XSETSUBR (XSYMBOL (sym)->function, sname);
4366 #endif /* NOTDEF */
4368 /* Define an "integer variable"; a symbol whose value is forwarded to a
4369 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4370 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4371 void
4372 defvar_int (struct Lisp_Intfwd *i_fwd,
4373 const char *namestring, EMACS_INT *address)
4375 Lisp_Object sym;
4376 sym = intern_c_string (namestring);
4377 i_fwd->type = Lisp_Fwd_Int;
4378 i_fwd->intvar = address;
4379 XSYMBOL (sym)->declared_special = 1;
4380 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4381 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd);
4384 /* Similar but define a variable whose value is t if address contains 1,
4385 nil if address contains 0. */
4386 void
4387 defvar_bool (struct Lisp_Boolfwd *b_fwd,
4388 const char *namestring, bool *address)
4390 Lisp_Object sym;
4391 sym = intern_c_string (namestring);
4392 b_fwd->type = Lisp_Fwd_Bool;
4393 b_fwd->boolvar = address;
4394 XSYMBOL (sym)->declared_special = 1;
4395 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4396 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd);
4397 Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
4400 /* Similar but define a variable whose value is the Lisp Object stored
4401 at address. Two versions: with and without gc-marking of the C
4402 variable. The nopro version is used when that variable will be
4403 gc-marked for some other reason, since marking the same slot twice
4404 can cause trouble with strings. */
4405 void
4406 defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd,
4407 const char *namestring, Lisp_Object *address)
4409 Lisp_Object sym;
4410 sym = intern_c_string (namestring);
4411 o_fwd->type = Lisp_Fwd_Obj;
4412 o_fwd->objvar = address;
4413 XSYMBOL (sym)->declared_special = 1;
4414 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4415 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
4418 void
4419 defvar_lisp (struct Lisp_Objfwd *o_fwd,
4420 const char *namestring, Lisp_Object *address)
4422 defvar_lisp_nopro (o_fwd, namestring, address);
4423 staticpro (address);
4426 /* Similar but define a variable whose value is the Lisp Object stored
4427 at a particular offset in the current kboard object. */
4429 void
4430 defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd,
4431 const char *namestring, int offset)
4433 Lisp_Object sym;
4434 sym = intern_c_string (namestring);
4435 ko_fwd->type = Lisp_Fwd_Kboard_Obj;
4436 ko_fwd->offset = offset;
4437 XSYMBOL (sym)->declared_special = 1;
4438 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4439 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
4442 /* Check that the elements of lpath exist. */
4444 static void
4445 load_path_check (Lisp_Object lpath)
4447 Lisp_Object path_tail;
4449 /* The only elements that might not exist are those from
4450 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4451 it exists. */
4452 for (path_tail = lpath; !NILP (path_tail); path_tail = XCDR (path_tail))
4454 Lisp_Object dirfile;
4455 dirfile = Fcar (path_tail);
4456 if (STRINGP (dirfile))
4458 dirfile = Fdirectory_file_name (dirfile);
4459 if (! file_accessible_directory_p (dirfile))
4460 dir_warning ("Lisp directory", XCAR (path_tail));
4465 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4466 This does not include the standard site-lisp directories
4467 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4468 but it does (unless no_site_lisp is set) include site-lisp
4469 directories in the source/build directories if those exist and we
4470 are running uninstalled.
4472 Uses the following logic:
4473 If CANNOT_DUMP:
4474 If Vinstallation_directory is not nil (ie, running uninstalled),
4475 use PATH_DUMPLOADSEARCH (ie, build path). Else use PATH_LOADSEARCH.
4476 The remainder is what happens when dumping works:
4477 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4478 Otherwise use PATH_LOADSEARCH.
4480 If !initialized, then just return PATH_DUMPLOADSEARCH.
4481 If initialized:
4482 If Vinstallation_directory is not nil (ie, running uninstalled):
4483 If installation-dir/lisp exists and not already a member,
4484 we must be running uninstalled. Reset the load-path
4485 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4486 refers to the eventual installation directories. Since we
4487 are not yet installed, we should not use them, even if they exist.)
4488 If installation-dir/lisp does not exist, just add
4489 PATH_DUMPLOADSEARCH at the end instead.
4490 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4491 and not already a member) at the front.
4492 If installation-dir != source-dir (ie running an uninstalled,
4493 out-of-tree build) AND install-dir/src/Makefile exists BUT
4494 install-dir/src/Makefile.in does NOT exist (this is a sanity
4495 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4497 static Lisp_Object
4498 load_path_default (void)
4500 Lisp_Object lpath = Qnil;
4501 const char *normal;
4503 #ifdef CANNOT_DUMP
4504 #ifdef HAVE_NS
4505 const char *loadpath = ns_load_path ();
4506 #endif
4508 normal = PATH_LOADSEARCH;
4509 if (!NILP (Vinstallation_directory)) normal = PATH_DUMPLOADSEARCH;
4511 #ifdef HAVE_NS
4512 lpath = decode_env_path (0, loadpath ? loadpath : normal, 0);
4513 #else
4514 lpath = decode_env_path (0, normal, 0);
4515 #endif
4517 #else /* !CANNOT_DUMP */
4519 normal = NILP (Vpurify_flag) ? PATH_LOADSEARCH : PATH_DUMPLOADSEARCH;
4521 if (initialized)
4523 #ifdef HAVE_NS
4524 const char *loadpath = ns_load_path ();
4525 lpath = decode_env_path (0, loadpath ? loadpath : normal, 0);
4526 #else
4527 lpath = decode_env_path (0, normal, 0);
4528 #endif
4529 if (!NILP (Vinstallation_directory))
4531 Lisp_Object tem, tem1;
4533 /* Add to the path the lisp subdir of the installation
4534 dir, if it is accessible. Note: in out-of-tree builds,
4535 this directory is empty save for Makefile. */
4536 tem = Fexpand_file_name (build_string ("lisp"),
4537 Vinstallation_directory);
4538 tem1 = Ffile_accessible_directory_p (tem);
4539 if (!NILP (tem1))
4541 if (NILP (Fmember (tem, lpath)))
4543 /* We are running uninstalled. The default load-path
4544 points to the eventual installed lisp directories.
4545 We should not use those now, even if they exist,
4546 so start over from a clean slate. */
4547 lpath = list1 (tem);
4550 else
4551 /* That dir doesn't exist, so add the build-time
4552 Lisp dirs instead. */
4554 Lisp_Object dump_path =
4555 decode_env_path (0, PATH_DUMPLOADSEARCH, 0);
4556 lpath = nconc2 (lpath, dump_path);
4559 /* Add site-lisp under the installation dir, if it exists. */
4560 if (!no_site_lisp)
4562 tem = Fexpand_file_name (build_string ("site-lisp"),
4563 Vinstallation_directory);
4564 tem1 = Ffile_accessible_directory_p (tem);
4565 if (!NILP (tem1))
4567 if (NILP (Fmember (tem, lpath)))
4568 lpath = Fcons (tem, lpath);
4572 /* If Emacs was not built in the source directory,
4573 and it is run from where it was built, add to load-path
4574 the lisp and site-lisp dirs under that directory. */
4576 if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
4578 Lisp_Object tem2;
4580 tem = Fexpand_file_name (build_string ("src/Makefile"),
4581 Vinstallation_directory);
4582 tem1 = Ffile_exists_p (tem);
4584 /* Don't be fooled if they moved the entire source tree
4585 AFTER dumping Emacs. If the build directory is indeed
4586 different from the source dir, src/Makefile.in and
4587 src/Makefile will not be found together. */
4588 tem = Fexpand_file_name (build_string ("src/Makefile.in"),
4589 Vinstallation_directory);
4590 tem2 = Ffile_exists_p (tem);
4591 if (!NILP (tem1) && NILP (tem2))
4593 tem = Fexpand_file_name (build_string ("lisp"),
4594 Vsource_directory);
4596 if (NILP (Fmember (tem, lpath)))
4597 lpath = Fcons (tem, lpath);
4599 if (!no_site_lisp)
4601 tem = Fexpand_file_name (build_string ("site-lisp"),
4602 Vsource_directory);
4603 tem1 = Ffile_accessible_directory_p (tem);
4604 if (!NILP (tem1))
4606 if (NILP (Fmember (tem, lpath)))
4607 lpath = Fcons (tem, lpath);
4611 } /* Vinstallation_directory != Vsource_directory */
4613 } /* if Vinstallation_directory */
4615 else /* !initialized */
4617 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4618 source directory. We used to add ../lisp (ie the lisp dir in
4619 the build directory) at the front here, but that should not
4620 be necessary, since in out of tree builds lisp/ is empty, save
4621 for Makefile. */
4622 lpath = decode_env_path (0, normal, 0);
4624 #endif /* !CANNOT_DUMP */
4626 return lpath;
4629 void
4630 init_lread (void)
4632 if (NILP (Vpurify_flag) && !NILP (Ffboundp (Qfile_truename)))
4633 Vsource_directory = call1 (Qfile_truename, Vsource_directory);
4635 /* First, set Vload_path. */
4637 /* Ignore EMACSLOADPATH when dumping. */
4638 #ifdef CANNOT_DUMP
4639 bool use_loadpath = true;
4640 #else
4641 bool use_loadpath = NILP (Vpurify_flag);
4642 #endif
4644 if (use_loadpath && egetenv ("EMACSLOADPATH"))
4646 Vload_path = decode_env_path ("EMACSLOADPATH", 0, 1);
4648 /* Check (non-nil) user-supplied elements. */
4649 load_path_check (Vload_path);
4651 /* If no nils in the environment variable, use as-is.
4652 Otherwise, replace any nils with the default. */
4653 if (! NILP (Fmemq (Qnil, Vload_path)))
4655 Lisp_Object elem, elpath = Vload_path;
4656 Lisp_Object default_lpath = load_path_default ();
4658 /* Check defaults, before adding site-lisp. */
4659 load_path_check (default_lpath);
4661 /* Add the site-lisp directories to the front of the default. */
4662 if (!no_site_lisp && PATH_SITELOADSEARCH[0] != '\0')
4664 Lisp_Object sitelisp;
4665 sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0);
4666 if (! NILP (sitelisp))
4667 default_lpath = nconc2 (sitelisp, default_lpath);
4670 Vload_path = Qnil;
4672 /* Replace nils from EMACSLOADPATH by default. */
4673 while (CONSP (elpath))
4675 elem = XCAR (elpath);
4676 elpath = XCDR (elpath);
4677 Vload_path = CALLN (Fappend, Vload_path,
4678 NILP (elem) ? default_lpath : list1 (elem));
4680 } /* Fmemq (Qnil, Vload_path) */
4682 else
4684 Vload_path = load_path_default ();
4686 /* Check before adding site-lisp directories.
4687 The install should have created them, but they are not
4688 required, so no need to warn if they are absent.
4689 Or we might be running before installation. */
4690 load_path_check (Vload_path);
4692 /* Add the site-lisp directories at the front. */
4693 if (initialized && !no_site_lisp && PATH_SITELOADSEARCH[0] != '\0')
4695 Lisp_Object sitelisp;
4696 sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0);
4697 if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path);
4701 Vvalues = Qnil;
4703 load_in_progress = 0;
4704 Vload_file_name = Qnil;
4705 Vstandard_input = Qt;
4706 Vloads_in_progress = Qnil;
4709 /* Print a warning that directory intended for use USE and with name
4710 DIRNAME cannot be accessed. On entry, errno should correspond to
4711 the access failure. Print the warning on stderr and put it in
4712 *Messages*. */
4714 void
4715 dir_warning (char const *use, Lisp_Object dirname)
4717 static char const format[] = "Warning: %s '%s': %s\n";
4718 char *diagnostic = emacs_strerror (errno);
4719 fprintf (stderr, format, use, SSDATA (ENCODE_SYSTEM (dirname)), diagnostic);
4721 /* Don't log the warning before we've initialized!! */
4722 if (initialized)
4724 ptrdiff_t diaglen = strlen (diagnostic);
4725 AUTO_STRING_WITH_LEN (diag, diagnostic, diaglen);
4726 if (! NILP (Vlocale_coding_system))
4728 Lisp_Object s
4729 = code_convert_string_norecord (diag, Vlocale_coding_system, false);
4730 diagnostic = SSDATA (s);
4731 diaglen = SBYTES (s);
4733 USE_SAFE_ALLOCA;
4734 char *buffer = SAFE_ALLOCA (sizeof format - 3 * (sizeof "%s" - 1)
4735 + strlen (use) + SBYTES (dirname) + diaglen);
4736 ptrdiff_t message_len = esprintf (buffer, format, use, SSDATA (dirname),
4737 diagnostic);
4738 message_dolog (buffer, message_len, 0, STRING_MULTIBYTE (dirname));
4739 SAFE_FREE ();
4743 void
4744 syms_of_lread (void)
4746 defsubr (&Sread);
4747 defsubr (&Sread_from_string);
4748 defsubr (&Slread__substitute_object_in_subtree);
4749 defsubr (&Sintern);
4750 defsubr (&Sintern_soft);
4751 defsubr (&Sunintern);
4752 defsubr (&Sget_load_suffixes);
4753 defsubr (&Sload);
4754 defsubr (&Seval_buffer);
4755 defsubr (&Seval_region);
4756 defsubr (&Sread_char);
4757 defsubr (&Sread_char_exclusive);
4758 defsubr (&Sread_event);
4759 defsubr (&Sget_file_char);
4760 defsubr (&Smapatoms);
4761 defsubr (&Slocate_file_internal);
4763 DEFVAR_LISP ("obarray", Vobarray,
4764 doc: /* Symbol table for use by `intern' and `read'.
4765 It is a vector whose length ought to be prime for best results.
4766 The vector's contents don't make sense if examined from Lisp programs;
4767 to find all the symbols in an obarray, use `mapatoms'. */);
4769 DEFVAR_LISP ("values", Vvalues,
4770 doc: /* List of values of all expressions which were read, evaluated and printed.
4771 Order is reverse chronological. */);
4772 XSYMBOL (intern ("values"))->declared_special = 0;
4774 DEFVAR_LISP ("standard-input", Vstandard_input,
4775 doc: /* Stream for read to get input from.
4776 See documentation of `read' for possible values. */);
4777 Vstandard_input = Qt;
4779 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions,
4780 doc: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4782 If this variable is a buffer, then only forms read from that buffer
4783 will be added to `read-symbol-positions-list'.
4784 If this variable is t, then all read forms will be added.
4785 The effect of all other values other than nil are not currently
4786 defined, although they may be in the future.
4788 The positions are relative to the last call to `read' or
4789 `read-from-string'. It is probably a bad idea to set this variable at
4790 the toplevel; bind it instead. */);
4791 Vread_with_symbol_positions = Qnil;
4793 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list,
4794 doc: /* A list mapping read symbols to their positions.
4795 This variable is modified during calls to `read' or
4796 `read-from-string', but only when `read-with-symbol-positions' is
4797 non-nil.
4799 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4800 CHAR-POSITION is an integer giving the offset of that occurrence of the
4801 symbol from the position where `read' or `read-from-string' started.
4803 Note that a symbol will appear multiple times in this list, if it was
4804 read multiple times. The list is in the same order as the symbols
4805 were read in. */);
4806 Vread_symbol_positions_list = Qnil;
4808 DEFVAR_LISP ("read-circle", Vread_circle,
4809 doc: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4810 Vread_circle = Qt;
4812 DEFVAR_LISP ("load-path", Vload_path,
4813 doc: /* List of directories to search for files to load.
4814 Each element is a string (directory file name) or nil (meaning
4815 `default-directory').
4816 This list is consulted by the `require' function.
4817 Initialized during startup as described in Info node `(elisp)Library Search'.
4818 Use `directory-file-name' when adding items to this path. However, Lisp
4819 programs that process this list should tolerate directories both with
4820 and without trailing slashes. */);
4822 DEFVAR_LISP ("load-suffixes", Vload_suffixes,
4823 doc: /* List of suffixes for Emacs Lisp files and dynamic modules.
4824 This list includes suffixes for both compiled and source Emacs Lisp files.
4825 This list should not include the empty string.
4826 `load' and related functions try to append these suffixes, in order,
4827 to the specified file name if a suffix is allowed or required. */);
4828 #ifdef HAVE_MODULES
4829 Vload_suffixes = list3 (build_pure_c_string (".elc"),
4830 build_pure_c_string (".el"),
4831 build_pure_c_string (MODULES_SUFFIX));
4832 #else
4833 Vload_suffixes = list2 (build_pure_c_string (".elc"),
4834 build_pure_c_string (".el"));
4835 #endif
4836 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix,
4837 doc: /* Suffix of loadable module file, or nil of modules are not supported. */);
4838 #ifdef HAVE_MODULES
4839 Vmodule_file_suffix = build_pure_c_string (MODULES_SUFFIX);
4840 #else
4841 Vmodule_file_suffix = Qnil;
4842 #endif
4843 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
4844 doc: /* List of suffixes that indicate representations of \
4845 the same file.
4846 This list should normally start with the empty string.
4848 Enabling Auto Compression mode appends the suffixes in
4849 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4850 mode removes them again. `load' and related functions use this list to
4851 determine whether they should look for compressed versions of a file
4852 and, if so, which suffixes they should try to append to the file name
4853 in order to do so. However, if you want to customize which suffixes
4854 the loading functions recognize as compression suffixes, you should
4855 customize `jka-compr-load-suffixes' rather than the present variable. */);
4856 Vload_file_rep_suffixes = list1 (empty_unibyte_string);
4858 DEFVAR_BOOL ("load-in-progress", load_in_progress,
4859 doc: /* Non-nil if inside of `load'. */);
4860 DEFSYM (Qload_in_progress, "load-in-progress");
4862 DEFVAR_LISP ("after-load-alist", Vafter_load_alist,
4863 doc: /* An alist of functions to be evalled when particular files are loaded.
4864 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4866 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4867 a symbol (a feature name).
4869 When `load' is run and the file-name argument matches an element's
4870 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4871 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4873 An error in FORMS does not undo the load, but does prevent execution of
4874 the rest of the FORMS. */);
4875 Vafter_load_alist = Qnil;
4877 DEFVAR_LISP ("load-history", Vload_history,
4878 doc: /* Alist mapping loaded file names to symbols and features.
4879 Each alist element should be a list (FILE-NAME ENTRIES...), where
4880 FILE-NAME is the name of a file that has been loaded into Emacs.
4881 The file name is absolute and true (i.e. it doesn't contain symlinks).
4882 As an exception, one of the alist elements may have FILE-NAME nil,
4883 for symbols and features not associated with any file.
4885 The remaining ENTRIES in the alist element describe the functions and
4886 variables defined in that file, the features provided, and the
4887 features required. Each entry has the form `(provide . FEATURE)',
4888 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4889 `(defface . SYMBOL)', `(define-type . SYMBOL)',
4890 `(cl-defmethod METHOD SPECIALIZERS)', or `(t . SYMBOL)'.
4891 Entries like `(t . SYMBOL)' may precede a `(defun . FUNCTION)' entry,
4892 and means that SYMBOL was an autoload before this file redefined it
4893 as a function. In addition, entries may also be single symbols,
4894 which means that symbol was defined by `defvar' or `defconst'.
4896 During preloading, the file name recorded is relative to the main Lisp
4897 directory. These file names are converted to absolute at startup. */);
4898 Vload_history = Qnil;
4900 DEFVAR_LISP ("load-file-name", Vload_file_name,
4901 doc: /* Full name of file being loaded by `load'. */);
4902 Vload_file_name = Qnil;
4904 DEFVAR_LISP ("user-init-file", Vuser_init_file,
4905 doc: /* File name, including directory, of user's initialization file.
4906 If the file loaded had extension `.elc', and the corresponding source file
4907 exists, this variable contains the name of source file, suitable for use
4908 by functions like `custom-save-all' which edit the init file.
4909 While Emacs loads and evaluates the init file, value is the real name
4910 of the file, regardless of whether or not it has the `.elc' extension. */);
4911 Vuser_init_file = Qnil;
4913 DEFVAR_LISP ("current-load-list", Vcurrent_load_list,
4914 doc: /* Used for internal purposes by `load'. */);
4915 Vcurrent_load_list = Qnil;
4917 DEFVAR_LISP ("load-read-function", Vload_read_function,
4918 doc: /* Function used by `load' and `eval-region' for reading expressions.
4919 Called with a single argument (the stream from which to read).
4920 The default is to use the function `read'. */);
4921 DEFSYM (Qread, "read");
4922 Vload_read_function = Qread;
4924 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function,
4925 doc: /* Function called in `load' to load an Emacs Lisp source file.
4926 The value should be a function for doing code conversion before
4927 reading a source file. It can also be nil, in which case loading is
4928 done without any code conversion.
4930 If the value is a function, it is called with four arguments,
4931 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4932 the file to load, FILE is the non-absolute name (for messages etc.),
4933 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4934 `load'. The function should return t if the file was loaded. */);
4935 Vload_source_file_function = Qnil;
4937 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings,
4938 doc: /* Non-nil means `load' should force-load all dynamic doc strings.
4939 This is useful when the file being loaded is a temporary copy. */);
4940 load_force_doc_strings = 0;
4942 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte,
4943 doc: /* Non-nil means `read' converts strings to unibyte whenever possible.
4944 This is normally bound by `load' and `eval-buffer' to control `read',
4945 and is not meant for users to change. */);
4946 load_convert_to_unibyte = 0;
4948 DEFVAR_LISP ("source-directory", Vsource_directory,
4949 doc: /* Directory in which Emacs sources were found when Emacs was built.
4950 You cannot count on them to still be there! */);
4951 Vsource_directory
4952 = Fexpand_file_name (build_string ("../"),
4953 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0)));
4955 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list,
4956 doc: /* List of files that were preloaded (when dumping Emacs). */);
4957 Vpreloaded_file_list = Qnil;
4959 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars,
4960 doc: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4961 Vbyte_boolean_vars = Qnil;
4963 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries,
4964 doc: /* Non-nil means load dangerous compiled Lisp files.
4965 Some versions of XEmacs use different byte codes than Emacs. These
4966 incompatible byte codes can make Emacs crash when it tries to execute
4967 them. */);
4968 load_dangerous_libraries = 0;
4970 DEFVAR_BOOL ("force-load-messages", force_load_messages,
4971 doc: /* Non-nil means force printing messages when loading Lisp files.
4972 This overrides the value of the NOMESSAGE argument to `load'. */);
4973 force_load_messages = 0;
4975 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp,
4976 doc: /* Regular expression matching safe to load compiled Lisp files.
4977 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4978 from the file, and matches them against this regular expression.
4979 When the regular expression matches, the file is considered to be safe
4980 to load. See also `load-dangerous-libraries'. */);
4981 Vbytecomp_version_regexp
4982 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4984 DEFSYM (Qlexical_binding, "lexical-binding");
4985 DEFVAR_LISP ("lexical-binding", Vlexical_binding,
4986 doc: /* Whether to use lexical binding when evaluating code.
4987 Non-nil means that the code in the current buffer should be evaluated
4988 with lexical binding.
4989 This variable is automatically set from the file variables of an
4990 interpreted Lisp file read using `load'. Unlike other file local
4991 variables, this must be set in the first line of a file. */);
4992 Vlexical_binding = Qnil;
4993 Fmake_variable_buffer_local (Qlexical_binding);
4995 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list,
4996 doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4997 Veval_buffer_list = Qnil;
4999 DEFVAR_LISP ("lread--old-style-backquotes", Vlread_old_style_backquotes,
5000 doc: /* Set to non-nil when `read' encounters an old-style backquote.
5001 For internal use only. */);
5002 Vlread_old_style_backquotes = Qnil;
5003 DEFSYM (Qlread_old_style_backquotes, "lread--old-style-backquotes");
5005 DEFVAR_LISP ("lread--unescaped-character-literals",
5006 Vlread_unescaped_character_literals,
5007 doc: /* List of deprecated unescaped character literals encountered by `read'.
5008 For internal use only. */);
5009 Vlread_unescaped_character_literals = Qnil;
5010 DEFSYM (Qlread_unescaped_character_literals,
5011 "lread--unescaped-character-literals");
5013 DEFSYM (Qlss, "<");
5014 DEFSYM (Qchar, "char");
5015 DEFSYM (Qformat, "format");
5017 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer,
5018 doc: /* Non-nil means `load' prefers the newest version of a file.
5019 This applies when a filename suffix is not explicitly specified and
5020 `load' is trying various possible suffixes (see `load-suffixes' and
5021 `load-file-rep-suffixes'). Normally, it stops at the first file
5022 that exists unless you explicitly specify one or the other. If this
5023 option is non-nil, it checks all suffixes and uses whichever file is
5024 newest.
5025 Note that if you customize this, obviously it will not affect files
5026 that are loaded before your customizations are read! */);
5027 load_prefer_newer = 0;
5029 /* Vsource_directory was initialized in init_lread. */
5031 DEFSYM (Qcurrent_load_list, "current-load-list");
5032 DEFSYM (Qstandard_input, "standard-input");
5033 DEFSYM (Qread_char, "read-char");
5034 DEFSYM (Qget_file_char, "get-file-char");
5036 /* Used instead of Qget_file_char while loading *.elc files compiled
5037 by Emacs 21 or older. */
5038 DEFSYM (Qget_emacs_mule_file_char, "get-emacs-mule-file-char");
5040 DEFSYM (Qload_force_doc_strings, "load-force-doc-strings");
5042 DEFSYM (Qbackquote, "`");
5043 DEFSYM (Qcomma, ",");
5044 DEFSYM (Qcomma_at, ",@");
5045 DEFSYM (Qcomma_dot, ",.");
5047 DEFSYM (Qinhibit_file_name_operation, "inhibit-file-name-operation");
5048 DEFSYM (Qascii_character, "ascii-character");
5049 DEFSYM (Qfunction, "function");
5050 DEFSYM (Qload, "load");
5051 DEFSYM (Qload_file_name, "load-file-name");
5052 DEFSYM (Qeval_buffer_list, "eval-buffer-list");
5053 DEFSYM (Qfile_truename, "file-truename");
5054 DEFSYM (Qdir_ok, "dir-ok");
5055 DEFSYM (Qdo_after_load_evaluation, "do-after-load-evaluation");
5057 staticpro (&read_objects_map);
5058 read_objects_map = Qnil;
5059 staticpro (&read_objects_completed);
5060 read_objects_completed = Qnil;
5062 Vloads_in_progress = Qnil;
5063 staticpro (&Vloads_in_progress);
5065 DEFSYM (Qhash_table, "hash-table");
5066 DEFSYM (Qdata, "data");
5067 DEFSYM (Qtest, "test");
5068 DEFSYM (Qsize, "size");
5069 DEFSYM (Qpurecopy, "purecopy");
5070 DEFSYM (Qweakness, "weakness");
5071 DEFSYM (Qrehash_size, "rehash-size");
5072 DEFSYM (Qrehash_threshold, "rehash-threshold");
5074 DEFSYM (Qchar_from_name, "char-from-name");