1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2018 Free Software Foundation,
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 <https://www.gnu.org/licenses/>. */
21 /* Tell globals.h to define tables needed by init_obarray. */
22 #define DEFINE_SYMBOLS
27 #include <sys/types.h>
32 #include <stat-time.h>
34 #include "dispextern.h"
35 #include "intervals.h"
36 #include "character.h"
43 #include "termhooks.h"
44 #include "blockinput.h"
49 #if __DJGPP__ == 2 && __DJGPP_MINOR__ < 5
50 # define INFINITY __builtin_inf()
51 # define NAN __builtin_nan("")
63 #endif /* HAVE_SETLOCALE */
68 #define file_offset off_t
69 #define file_tell ftello
71 #define file_offset long
72 #define file_tell ftell
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
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. */
110 /* The input 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];
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 with no surrounding
151 parentheses. Fread initializes this to the value of
152 `force_new_style_backquotes', so we need not specbind it or worry
153 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
),
164 static void readevalloop (Lisp_Object
, struct infile
*, Lisp_Object
, bool,
165 Lisp_Object
, Lisp_Object
,
166 Lisp_Object
, Lisp_Object
);
168 static void build_load_history (Lisp_Object
, bool);
170 /* Functions that read one byte from the current source READCHARFUN
171 or unreads one byte. If the integer argument C is -1, it returns
172 one read byte, or -1 when there's no more byte in the source. If C
173 is 0 or positive, it unreads C, and the return value is not
176 static int readbyte_for_lambda (int, Lisp_Object
);
177 static int readbyte_from_file (int, Lisp_Object
);
178 static int readbyte_from_string (int, Lisp_Object
);
180 /* Handle unreading and rereading of characters.
181 Write READCHAR to read a character,
182 UNREAD(c) to unread c to be read again.
184 These macros correctly read/unread multibyte characters. */
186 #define READCHAR readchar (readcharfun, NULL)
187 #define UNREAD(c) unreadchar (readcharfun, c)
189 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
190 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
192 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
193 Qlambda, or a cons, we use this to keep an unread character because
194 a file stream can't handle multibyte-char unreading. The value -1
195 means that there's no unread character. */
196 static int unread_char
;
199 readchar (Lisp_Object readcharfun
, bool *multibyte
)
203 int (*readbyte
) (int, Lisp_Object
);
204 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
206 bool emacs_mule_encoding
= 0;
213 if (BUFFERP (readcharfun
))
215 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
217 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
219 if (! BUFFER_LIVE_P (inbuffer
))
222 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
225 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
227 /* Fetch the character code from the buffer. */
228 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
229 BUF_INC_POS (inbuffer
, pt_byte
);
236 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
237 if (! ASCII_CHAR_P (c
))
238 c
= BYTE8_TO_CHAR (c
);
241 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
245 if (MARKERP (readcharfun
))
247 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
249 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
251 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
254 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
256 /* Fetch the character code from the buffer. */
257 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
258 BUF_INC_POS (inbuffer
, bytepos
);
265 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
266 if (! ASCII_CHAR_P (c
))
267 c
= BYTE8_TO_CHAR (c
);
271 XMARKER (readcharfun
)->bytepos
= bytepos
;
272 XMARKER (readcharfun
)->charpos
++;
277 if (EQ (readcharfun
, Qlambda
))
279 readbyte
= readbyte_for_lambda
;
283 if (EQ (readcharfun
, Qget_file_char
))
285 readbyte
= readbyte_from_file
;
289 if (STRINGP (readcharfun
))
291 if (read_from_string_index
>= read_from_string_limit
)
293 else if (STRING_MULTIBYTE (readcharfun
))
297 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
298 read_from_string_index
,
299 read_from_string_index_byte
);
303 c
= SREF (readcharfun
, read_from_string_index_byte
);
304 read_from_string_index
++;
305 read_from_string_index_byte
++;
310 if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
312 /* This is the case that read_vector is reading from a unibyte
313 string that contains a byte sequence previously skipped
314 because of #@NUMBER. The car part of readcharfun is that
315 string, and the cdr part is a value of readcharfun given to
317 readbyte
= readbyte_from_string
;
318 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
319 emacs_mule_encoding
= 1;
323 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
325 readbyte
= readbyte_from_file
;
326 emacs_mule_encoding
= 1;
330 tem
= call0 (readcharfun
);
337 if (unread_char
>= 0)
343 c
= (*readbyte
) (-1, readcharfun
);
348 if (ASCII_CHAR_P (c
))
350 if (emacs_mule_encoding
)
351 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
354 len
= BYTES_BY_CHAR_HEAD (c
);
357 buf
[i
++] = c
= (*readbyte
) (-1, readcharfun
);
358 if (c
< 0 || ! TRAILING_CODE_P (c
))
360 for (i
-= c
< 0; 0 < --i
; )
361 (*readbyte
) (buf
[i
], readcharfun
);
362 return BYTE8_TO_CHAR (buf
[0]);
365 return STRING_CHAR (buf
);
368 #define FROM_FILE_P(readcharfun) \
369 (EQ (readcharfun, Qget_file_char) \
370 || EQ (readcharfun, Qget_emacs_mule_file_char))
373 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
375 if (FROM_FILE_P (readcharfun
))
377 block_input (); /* FIXME: Not sure if it's needed. */
378 fseek (infile
->stream
, n
- infile
->lookahead
, SEEK_CUR
);
380 infile
->lookahead
= 0;
383 { /* We're not reading directly from a file. In that case, it's difficult
384 to reliably count bytes, since these are usually meant for the file's
385 encoding, whereas we're now typically in the internal encoding.
386 But luckily, skip_dyn_bytes is used to skip over a single
387 dynamic-docstring (or dynamic byte-code) which is always quoted such
388 that \037 is the final char. */
392 } while (c
>= 0 && c
!= '\037');
397 skip_dyn_eof (Lisp_Object readcharfun
)
399 if (FROM_FILE_P (readcharfun
))
401 block_input (); /* FIXME: Not sure if it's needed. */
402 fseek (infile
->stream
, 0, SEEK_END
);
404 infile
->lookahead
= 0;
407 while (READCHAR
>= 0);
410 /* Unread the character C in the way appropriate for the stream READCHARFUN.
411 If the stream is a user function, call it with the char as argument. */
414 unreadchar (Lisp_Object readcharfun
, int c
)
418 /* Don't back up the pointer if we're unreading the end-of-input mark,
419 since readchar didn't advance it when we read it. */
421 else if (BUFFERP (readcharfun
))
423 struct buffer
*b
= XBUFFER (readcharfun
);
424 ptrdiff_t charpos
= BUF_PT (b
);
425 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
427 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
428 BUF_DEC_POS (b
, bytepos
);
432 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
434 else if (MARKERP (readcharfun
))
436 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
437 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
439 XMARKER (readcharfun
)->charpos
--;
440 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
441 BUF_DEC_POS (b
, bytepos
);
445 XMARKER (readcharfun
)->bytepos
= bytepos
;
447 else if (STRINGP (readcharfun
))
449 read_from_string_index
--;
450 read_from_string_index_byte
451 = string_char_to_byte (readcharfun
, read_from_string_index
);
453 else if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
457 else if (EQ (readcharfun
, Qlambda
))
461 else if (FROM_FILE_P (readcharfun
))
466 call1 (readcharfun
, make_number (c
));
470 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
472 return read_bytecode_char (c
>= 0);
477 readbyte_from_stdio (void)
479 if (infile
->lookahead
)
480 return infile
->buf
[--infile
->lookahead
];
483 FILE *instream
= infile
->stream
;
487 /* Interrupted reads have been observed while reading over the network. */
488 while ((c
= getc_unlocked (instream
)) == EOF
&& errno
== EINTR
489 && ferror_unlocked (instream
))
494 clearerr_unlocked (instream
);
499 return (c
== EOF
? -1 : c
);
503 readbyte_from_file (int c
, Lisp_Object readcharfun
)
507 eassert (infile
->lookahead
< sizeof infile
->buf
);
508 infile
->buf
[infile
->lookahead
++] = c
;
512 return readbyte_from_stdio ();
516 readbyte_from_string (int c
, Lisp_Object readcharfun
)
518 Lisp_Object string
= XCAR (readcharfun
);
522 read_from_string_index
--;
523 read_from_string_index_byte
524 = string_char_to_byte (string
, read_from_string_index
);
527 if (read_from_string_index
>= read_from_string_limit
)
530 FETCH_STRING_CHAR_ADVANCE (c
, string
,
531 read_from_string_index
,
532 read_from_string_index_byte
);
537 /* Read one non-ASCII character from INFILE. The character is
538 encoded in `emacs-mule' and the first byte is already read in
542 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
544 /* Emacs-mule coding uses at most 4-byte for one character. */
545 unsigned char buf
[4];
546 int len
= emacs_mule_bytes
[c
];
547 struct charset
*charset
;
552 /* C is not a valid leading-code of `emacs-mule'. */
553 return BYTE8_TO_CHAR (c
);
559 buf
[i
++] = c
= (*readbyte
) (-1, readcharfun
);
562 for (i
-= c
< 0; 0 < --i
; )
563 (*readbyte
) (buf
[i
], readcharfun
);
564 return BYTE8_TO_CHAR (buf
[0]);
570 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
571 code
= buf
[1] & 0x7F;
575 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
576 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
578 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
579 code
= buf
[2] & 0x7F;
583 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
584 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
589 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
590 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
592 c
= DECODE_CHAR (charset
, code
);
594 Fsignal (Qinvalid_read_syntax
,
595 list1 (build_string ("invalid multibyte form")));
600 /* An in-progress substitution of OBJECT for PLACEHOLDER. */
604 Lisp_Object placeholder
;
606 /* Hash table of subobjects of OBJECT that might be circular. If
607 Qt, all such objects might be circular. */
608 Lisp_Object completed
;
610 /* List of subobjects of OBJECT that have already been visited. */
614 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
616 static Lisp_Object
read0 (Lisp_Object
);
617 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
619 static Lisp_Object
read_list (bool, Lisp_Object
);
620 static Lisp_Object
read_vector (Lisp_Object
, bool);
622 static Lisp_Object
substitute_object_recurse (struct subst
*, Lisp_Object
);
623 static void substitute_in_interval (INTERVAL
, void *);
626 /* Get a character from the tty. */
628 /* Read input events until we get one that's acceptable for our purposes.
630 If NO_SWITCH_FRAME, switch-frame events are stashed
631 until we get a character we like, and then stuffed into
634 If ASCII_REQUIRED, check function key events to see
635 if the unmodified version of the symbol has a Qascii_character
636 property, and use that character, if present.
638 If ERROR_NONASCII, signal an error if the input we
639 get isn't an ASCII character with modifiers. If it's false but
640 ASCII_REQUIRED is true, just re-read until we get an ASCII
643 If INPUT_METHOD, invoke the current input method
644 if the character warrants that.
646 If SECONDS is a number, wait that many seconds for input, and
647 return Qnil if no input arrives within that time. */
650 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
651 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
653 Lisp_Object val
, delayed_switch_frame
;
654 struct timespec end_time
;
656 #ifdef HAVE_WINDOW_SYSTEM
657 if (display_hourglass_p
)
661 delayed_switch_frame
= Qnil
;
663 /* Compute timeout. */
664 if (NUMBERP (seconds
))
666 double duration
= XFLOATINT (seconds
);
667 struct timespec wait_time
= dtotimespec (duration
);
668 end_time
= timespec_add (current_timespec (), wait_time
);
671 /* Read until we get an acceptable event. */
674 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
675 NUMBERP (seconds
) ? &end_time
: NULL
);
676 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
681 /* `switch-frame' events are put off until after the next ASCII
682 character. This is better than signaling an error just because
683 the last characters were typed to a separate minibuffer frame,
684 for example. Eventually, some code which can deal with
685 switch-frame events will read it and process it. */
687 && EVENT_HAS_PARAMETERS (val
)
688 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
690 delayed_switch_frame
= val
;
694 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
696 /* Convert certain symbols to their ASCII equivalents. */
699 Lisp_Object tem
, tem1
;
700 tem
= Fget (val
, Qevent_symbol_element_mask
);
703 tem1
= Fget (Fcar (tem
), Qascii_character
);
704 /* Merge this symbol's modifier bits
705 with the ASCII equivalent of its basic code. */
707 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
711 /* If we don't have a character now, deal with it appropriately. */
716 Vunread_command_events
= list1 (val
);
717 error ("Non-character input-event");
724 if (! NILP (delayed_switch_frame
))
725 unread_switch_frame
= delayed_switch_frame
;
729 #ifdef HAVE_WINDOW_SYSTEM
730 if (display_hourglass_p
)
739 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
740 doc
: /* Read a character from the command input (keyboard or macro).
741 It is returned as a number.
742 If the character has modifiers, they are resolved and reflected to the
743 character code if possible (e.g. C-SPC -> 0).
745 If the user generates an event which is not a character (i.e. a mouse
746 click or function key event), `read-char' signals an error. As an
747 exception, switch-frame events are put off until non-character events
749 If you want to read non-character events, or ignore them, call
750 `read-event' or `read-char-exclusive' instead.
752 If the optional argument PROMPT is non-nil, display that as a prompt.
753 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
754 input method is turned on in the current buffer, that input method
755 is used for reading a character.
756 If the optional argument SECONDS is non-nil, it should be a number
757 specifying the maximum number of seconds to wait for input. If no
758 input arrives in that time, return nil. SECONDS may be a
759 floating-point value. */)
760 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
765 message_with_string ("%s", prompt
, 0);
766 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
768 return (NILP (val
) ? Qnil
769 : make_number (char_resolve_modifier_mask (XINT (val
))));
772 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
773 doc
: /* Read an event object from the input stream.
774 If the optional argument PROMPT is non-nil, display that as a prompt.
775 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
776 input method is turned on in the current buffer, that input method
777 is used for reading a character.
778 If the optional argument SECONDS is non-nil, it should be a number
779 specifying the maximum number of seconds to wait for input. If no
780 input arrives in that time, return nil. SECONDS may be a
781 floating-point value. */)
782 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
785 message_with_string ("%s", prompt
, 0);
786 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
789 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
790 doc
: /* Read a character from the command input (keyboard or macro).
791 It is returned as a number. Non-character events are ignored.
792 If the character has modifiers, they are resolved and reflected to the
793 character code if possible (e.g. C-SPC -> 0).
795 If the optional argument PROMPT is non-nil, display that as a prompt.
796 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
797 input method is turned on in the current buffer, that input method
798 is used for reading a character.
799 If the optional argument SECONDS is non-nil, it should be a number
800 specifying the maximum number of seconds to wait for input. If no
801 input arrives in that time, return nil. SECONDS may be a
802 floating-point value. */)
803 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
808 message_with_string ("%s", prompt
, 0);
810 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
812 return (NILP (val
) ? Qnil
813 : make_number (char_resolve_modifier_mask (XINT (val
))));
816 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
817 doc
: /* Don't use this yourself. */)
821 error ("get-file-char misused");
822 return make_number (readbyte_from_stdio ());
828 /* Return true if the lisp code read using READCHARFUN defines a non-nil
829 `lexical-binding' file variable. After returning, the stream is
830 positioned following the first line, if it is a comment or #! line,
831 otherwise nothing is read. */
834 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
847 while (ch
!= '\n' && ch
!= EOF
)
849 if (ch
== '\n') ch
= READCHAR
;
850 /* It is OK to leave the position after a #! line, since
851 that is what read1 does. */
855 /* The first line isn't a comment, just give up. */
861 /* Look for an appropriate file-variable in the first line. */
865 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
866 } beg_end_state
= NOMINAL
;
867 bool in_file_vars
= 0;
869 #define UPDATE_BEG_END_STATE(ch) \
870 if (beg_end_state == NOMINAL) \
871 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
872 else if (beg_end_state == AFTER_FIRST_DASH) \
873 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
874 else if (beg_end_state == AFTER_ASTERIX) \
877 in_file_vars = !in_file_vars; \
878 beg_end_state = NOMINAL; \
881 /* Skip until we get to the file vars, if any. */
885 UPDATE_BEG_END_STATE (ch
);
887 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
891 char var
[100], val
[100];
896 /* Read a variable name. */
897 while (ch
== ' ' || ch
== '\t')
901 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
903 if (i
< sizeof var
- 1)
905 UPDATE_BEG_END_STATE (ch
);
909 /* Stop scanning if no colon was found before end marker. */
910 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
913 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
919 /* Read a variable value. */
922 while (ch
== ' ' || ch
== '\t')
926 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
928 if (i
< sizeof val
- 1)
930 UPDATE_BEG_END_STATE (ch
);
934 /* The value was terminated by an end-marker, which remove. */
936 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
940 if (strcmp (var
, "lexical-binding") == 0)
943 rv
= (strcmp (val
, "nil") != 0);
949 while (ch
!= '\n' && ch
!= EOF
)
956 /* Value is a version number of byte compiled code if the file
957 associated with file descriptor FD is a compiled Lisp file that's
958 safe to load. Only files compiled with Emacs are safe to load.
959 Files compiled with XEmacs can lead to a crash in Fbyte_code
960 because of an incompatible change in the byte compiler. */
963 safe_to_load_version (int fd
)
969 /* Read the first few bytes from the file, and look for a line
970 specifying the byte compiler version used. */
971 nbytes
= emacs_read_quit (fd
, buf
, sizeof buf
);
974 /* Skip to the next newline, skipping over the initial `ELC'
975 with NUL bytes following it, but note the version. */
976 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
981 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
982 buf
+ i
, nbytes
- i
) < 0)
986 lseek (fd
, 0, SEEK_SET
);
991 /* Callback for record_unwind_protect. Restore the old load list OLD,
992 after loading a file successfully. */
995 record_load_unwind (Lisp_Object old
)
997 Vloads_in_progress
= old
;
1000 /* This handler function is used via internal_condition_case_1. */
1003 load_error_handler (Lisp_Object data
)
1008 static _Noreturn
void
1009 load_error_old_style_backquotes (void)
1011 if (NILP (Vload_file_name
))
1012 xsignal1 (Qerror
, build_string ("Old-style backquotes detected!"));
1015 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
1016 xsignal1 (Qerror
, CALLN (Fformat_message
, format
, Vload_file_name
));
1021 load_warn_unescaped_character_literals (Lisp_Object file
)
1023 if (NILP (Vlread_unescaped_character_literals
)) return;
1024 CHECK_CONS (Vlread_unescaped_character_literals
);
1025 Lisp_Object format
=
1026 build_string ("Loading `%s': unescaped character literals %s detected!");
1027 Lisp_Object separator
= build_string (", ");
1028 Lisp_Object inner_format
= build_string ("`?%c'");
1031 Fmapconcat (list3 (Qlambda
, list1 (Qchar
),
1032 list3 (Qformat
, inner_format
, Qchar
)),
1033 Fsort (Vlread_unescaped_character_literals
, Qlss
),
1037 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
1038 doc
: /* Return the suffixes that `load' should try if a suffix is \
1040 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
1043 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
1044 while (CONSP (suffixes
))
1046 Lisp_Object exts
= Vload_file_rep_suffixes
;
1047 suffix
= XCAR (suffixes
);
1048 suffixes
= XCDR (suffixes
);
1049 while (CONSP (exts
))
1053 lst
= Fcons (concat2 (suffix
, ext
), lst
);
1056 return Fnreverse (lst
);
1059 /* Returns true if STRING ends with SUFFIX */
1061 suffix_p (Lisp_Object string
, const char *suffix
)
1063 ptrdiff_t suffix_len
= strlen (suffix
);
1064 ptrdiff_t string_len
= SBYTES (string
);
1066 return string_len
>= suffix_len
&& !strcmp (SSDATA (string
) + string_len
- suffix_len
, suffix
);
1070 close_infile_unwind (void *arg
)
1073 eassert (infile
== NULL
|| infile
->stream
== stream
);
1078 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1079 doc
: /* Execute a file of Lisp code named FILE.
1080 First try FILE with `.elc' appended, then try with `.el', then try
1081 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
1082 then try FILE unmodified (the exact suffixes in the exact order are
1083 determined by `load-suffixes'). Environment variable references in
1084 FILE are replaced with their values by calling `substitute-in-file-name'.
1085 This function searches the directories in `load-path'.
1087 If optional second arg NOERROR is non-nil,
1088 report no error if FILE doesn't exist.
1089 Print messages at start and end of loading unless
1090 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1092 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1093 suffixes to the specified name FILE.
1094 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1095 the suffix `.elc' or `.el' or the module suffix; don't accept just
1096 FILE unless it ends in one of those suffixes or includes a directory name.
1098 If NOSUFFIX is nil, then if a file could not be found, try looking for
1099 a different representation of the file by adding non-empty suffixes to
1100 its name, before trying another file. Emacs uses this feature to find
1101 compressed versions of files when Auto Compression mode is enabled.
1102 If NOSUFFIX is non-nil, disable this feature.
1104 The suffixes that this function tries out, when NOSUFFIX is nil, are
1105 given by the return value of `get-load-suffixes' and the values listed
1106 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1107 return value of `get-load-suffixes' is used, i.e. the file name is
1108 required to have a non-empty suffix.
1110 When searching suffixes, this function normally stops at the first
1111 one that exists. If the option `load-prefer-newer' is non-nil,
1112 however, it tries all suffixes, and uses whichever file is the newest.
1114 Loading a file records its definitions, and its `provide' and
1115 `require' calls, in an element of `load-history' whose
1116 car is the file name loaded. See `load-history'.
1118 While the file is in the process of being loaded, the variable
1119 `load-in-progress' is non-nil and the variable `load-file-name'
1120 is bound to the file's name.
1122 Return t if the file exists and loads successfully. */)
1123 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1124 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1126 FILE *stream UNINIT
;
1128 int fd_index UNINIT
;
1129 ptrdiff_t count
= SPECPDL_INDEX ();
1130 Lisp_Object found
, efound
, hist_file_name
;
1131 /* True means we printed the ".el is newer" message. */
1133 /* True means we are loading a compiled file. */
1135 Lisp_Object handler
;
1137 const char *fmode
= "r" FOPEN_TEXT
;
1140 CHECK_STRING (file
);
1142 /* If file name is magic, call the handler. */
1143 /* This shouldn't be necessary any more now that `openp' handles it right.
1144 handler = Ffind_file_name_handler (file, Qload);
1145 if (!NILP (handler))
1146 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1148 /* The presence of this call is the result of a historical accident:
1149 it used to be in every file-operation and when it got removed
1150 everywhere, it accidentally stayed here. Since then, enough people
1151 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1152 that it seemed risky to remove. */
1153 if (! NILP (noerror
))
1155 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1156 Qt
, load_error_handler
);
1161 file
= Fsubstitute_in_file_name (file
);
1163 /* Avoid weird lossage with null string as arg,
1164 since it would try to load a directory as a Lisp file. */
1165 if (SCHARS (file
) == 0)
1172 Lisp_Object suffixes
;
1175 if (! NILP (must_suffix
))
1177 /* Don't insist on adding a suffix if FILE already ends with one. */
1178 if (suffix_p (file
, ".el")
1179 || suffix_p (file
, ".elc")
1181 || suffix_p (file
, MODULES_SUFFIX
)
1185 /* Don't insist on adding a suffix
1186 if the argument includes a directory name. */
1187 else if (! NILP (Ffile_name_directory (file
)))
1191 if (!NILP (nosuffix
))
1195 suffixes
= Fget_load_suffixes ();
1196 if (NILP (must_suffix
))
1197 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1200 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1206 report_file_error ("Cannot open load file", file
);
1210 /* Tell startup.el whether or not we found the user's init file. */
1211 if (EQ (Qt
, Vuser_init_file
))
1212 Vuser_init_file
= found
;
1214 /* If FD is -2, that means openp found a magic file. */
1217 if (NILP (Fequal (found
, file
)))
1218 /* If FOUND is a different file name from FILE,
1219 find its handler even if we have already inhibited
1220 the `load' operation on FILE. */
1221 handler
= Ffind_file_name_handler (found
, Qt
);
1223 handler
= Ffind_file_name_handler (found
, Qload
);
1224 if (! NILP (handler
))
1225 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1227 /* Tramp has to deal with semi-broken packages that prepend
1228 drive letters to remote files. For that reason, Tramp
1229 catches file operations that test for file existence, which
1230 makes openp think X:/foo.elc files are remote. However,
1231 Tramp does not catch `load' operations for such files, so we
1232 end up with a nil as the `load' handler above. If we would
1233 continue with fd = -2, we will behave wrongly, and in
1234 particular try reading a .elc file in the "rt" mode instead
1235 of "rb". See bug #9311 for the results. To work around
1236 this, we try to open the file locally, and go with that if it
1238 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1246 fd_index
= SPECPDL_INDEX ();
1247 record_unwind_protect_int (close_file_unwind
, fd
);
1251 bool is_module
= suffix_p (found
, MODULES_SUFFIX
);
1253 bool is_module
= false;
1256 /* Check if we're stuck in a recursive load cycle.
1258 2000-09-21: It's not possible to just check for the file loaded
1259 being a member of Vloads_in_progress. This fails because of the
1260 way the byte compiler currently works; `provide's are not
1261 evaluated, see font-lock.el/jit-lock.el as an example. This
1262 leads to a certain amount of ``normal'' recursion.
1264 Also, just loading a file recursively is not always an error in
1265 the general case; the second load may do something different. */
1269 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1270 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1271 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1272 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1273 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1276 /* All loads are by default dynamic, unless the file itself specifies
1277 otherwise using a file-variable in the first line. This is bound here
1278 so that it takes effect whether or not we use
1279 Vload_source_file_function. */
1280 specbind (Qlexical_binding
, Qnil
);
1282 /* Get the name for load-history. */
1283 hist_file_name
= (! NILP (Vpurify_flag
)
1284 ? concat2 (Ffile_name_directory (file
),
1285 Ffile_name_nondirectory (found
))
1290 /* Check for the presence of unescaped character literals and warn
1292 specbind (Qlread_unescaped_character_literals
, Qnil
);
1293 record_unwind_protect (load_warn_unescaped_character_literals
, file
);
1296 if ((is_elc
= suffix_p (found
, ".elc")) != 0
1297 /* version = 1 means the file is empty, in which case we can
1298 treat it as not byte-compiled. */
1299 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 1))
1300 /* Load .elc files directly, but not when they are
1301 remote and have no handler! */
1309 && ! (version
= safe_to_load_version (fd
)))
1312 if (!load_dangerous_libraries
)
1313 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1314 else if (!NILP (nomessage
) && !force_load_messages
)
1315 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1320 efound
= ENCODE_FILE (found
);
1321 fmode
= "r" FOPEN_BINARY
;
1323 /* openp already checked for newness, no point doing it again.
1324 FIXME would be nice to get a message when openp
1325 ignores suffix order due to load_prefer_newer. */
1326 if (!load_prefer_newer
&& is_elc
)
1328 result
= stat (SSDATA (efound
), &s1
);
1331 SSET (efound
, SBYTES (efound
) - 1, 0);
1332 result
= stat (SSDATA (efound
), &s2
);
1333 SSET (efound
, SBYTES (efound
) - 1, 'c');
1337 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1339 /* Make the progress messages mention that source is newer. */
1342 /* If we won't print another message, mention this anyway. */
1343 if (!NILP (nomessage
) && !force_load_messages
)
1345 Lisp_Object msg_file
;
1346 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1347 message_with_string ("Source file `%s' newer than byte-compiled file",
1351 } /* !load_prefer_newer */
1354 else if (!is_module
)
1356 /* We are loading a source file (*.el). */
1357 if (!NILP (Vload_source_file_function
))
1364 clear_unwind_protect (fd_index
);
1366 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1367 NILP (noerror
) ? Qnil
: Qt
,
1368 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1369 return unbind_to (count
, val
);
1375 /* We somehow got here with fd == -2, meaning the file is deemed
1376 to be remote. Don't even try to reopen the file locally;
1377 just force a failure. */
1381 else if (!is_module
)
1385 clear_unwind_protect (fd_index
);
1386 efound
= ENCODE_FILE (found
);
1387 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1389 stream
= fdopen (fd
, fmode
);
1395 /* `module-load' uses the file name, so we can close the stream
1400 clear_unwind_protect (fd_index
);
1406 report_file_error ("Opening stdio stream", file
);
1407 set_unwind_protect_ptr (fd_index
, close_infile_unwind
, stream
);
1410 if (! NILP (Vpurify_flag
))
1411 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1413 if (NILP (nomessage
) || force_load_messages
)
1416 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1419 message_with_string ("Loading %s (module)...", file
, 1);
1421 message_with_string ("Loading %s (source)...", file
, 1);
1423 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1425 else /* The typical case; compiled file newer than source file. */
1426 message_with_string ("Loading %s...", file
, 1);
1429 specbind (Qload_file_name
, found
);
1430 specbind (Qinhibit_file_name_operation
, Qnil
);
1431 specbind (Qload_in_progress
, Qt
);
1436 specbind (Qcurrent_load_list
, Qnil
);
1437 LOADHIST_ATTACH (found
);
1438 Fmodule_load (found
);
1439 build_load_history (found
, true);
1441 /* This cannot happen. */
1447 struct infile input
;
1448 input
.stream
= stream
;
1449 input
.lookahead
= 0;
1452 if (lisp_file_lexically_bound_p (Qget_file_char
))
1453 Fset (Qlexical_binding
, Qt
);
1455 if (! version
|| version
>= 22)
1456 readevalloop (Qget_file_char
, &input
, hist_file_name
,
1457 0, Qnil
, Qnil
, Qnil
, Qnil
);
1460 /* We can't handle a file which was compiled with
1461 byte-compile-dynamic by older version of Emacs. */
1462 specbind (Qload_force_doc_strings
, Qt
);
1463 readevalloop (Qget_emacs_mule_file_char
, &input
, hist_file_name
,
1464 0, Qnil
, Qnil
, Qnil
, Qnil
);
1467 unbind_to (count
, Qnil
);
1469 /* Run any eval-after-load forms for this file. */
1470 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1471 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1473 xfree (saved_doc_string
);
1474 saved_doc_string
= 0;
1475 saved_doc_string_size
= 0;
1477 xfree (prev_saved_doc_string
);
1478 prev_saved_doc_string
= 0;
1479 prev_saved_doc_string_size
= 0;
1481 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1484 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1487 message_with_string ("Loading %s (module)...done", file
, 1);
1489 message_with_string ("Loading %s (source)...done", file
, 1);
1491 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1493 else /* The typical case; compiled file newer than source file. */
1494 message_with_string ("Loading %s...done", file
, 1);
1501 complete_filename_p (Lisp_Object pathname
)
1503 const unsigned char *s
= SDATA (pathname
);
1504 return (IS_DIRECTORY_SEP (s
[0])
1505 || (SCHARS (pathname
) > 2
1506 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1509 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1510 doc
: /* Search for FILENAME through PATH.
1511 Returns the file's name in absolute form, or nil if not found.
1512 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1513 file name when searching.
1514 If non-nil, PREDICATE is used instead of `file-readable-p'.
1515 PREDICATE can also be an integer to pass to the faccessat(2) function,
1516 in which case file-name-handlers are ignored.
1517 This function will normally skip directories, so if you want it to find
1518 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1519 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1522 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1523 if (NILP (predicate
) && fd
>= 0)
1528 /* Search for a file whose name is STR, looking in directories
1529 in the Lisp list PATH, and trying suffixes from SUFFIX.
1530 On success, return a file descriptor (or 1 or -2 as described below).
1531 On failure, return -1 and set errno.
1533 SUFFIXES is a list of strings containing possible suffixes.
1534 The empty suffix is automatically added if the list is empty.
1536 PREDICATE t means the files are binary.
1537 PREDICATE non-nil and non-t means don't open the files,
1538 just look for one that satisfies the predicate. In this case,
1539 return -2 on success. The predicate can be a lisp function or
1540 an integer to pass to `access' (in which case file-name-handlers
1543 If STOREPTR is nonzero, it points to a slot where the name of
1544 the file actually found should be stored as a Lisp string.
1545 nil is stored there on failure.
1547 If the file we find is remote, return -2
1548 but store the found remote file name in *STOREPTR.
1550 If NEWER is true, try all SUFFIXes and return the result for the
1551 newest file that exists. Does not apply to remote files,
1552 or if a non-nil and non-t PREDICATE is specified. */
1555 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1556 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1558 ptrdiff_t fn_size
= 100;
1562 ptrdiff_t want_length
;
1563 Lisp_Object filename
;
1564 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1565 ptrdiff_t max_suffix_len
= 0;
1566 int last_errno
= ENOENT
;
1570 /* The last-modified time of the newest matching file found.
1571 Initialize it to something less than all valid timestamps. */
1572 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1576 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1578 CHECK_STRING_CAR (tail
);
1579 max_suffix_len
= max (max_suffix_len
,
1580 SBYTES (XCAR (tail
)));
1583 string
= filename
= encoded_fn
= save_string
= Qnil
;
1588 absolute
= complete_filename_p (str
);
1590 for (; CONSP (path
); path
= XCDR (path
))
1592 ptrdiff_t baselen
, prefixlen
;
1594 filename
= Fexpand_file_name (str
, XCAR (path
));
1595 if (!complete_filename_p (filename
))
1596 /* If there are non-absolute elts in PATH (eg "."). */
1597 /* Of course, this could conceivably lose if luser sets
1598 default-directory to be something non-absolute... */
1600 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1601 if (!complete_filename_p (filename
))
1602 /* Give up on this path element! */
1606 /* Calculate maximum length of any filename made from
1607 this path element/specified file name and any possible suffix. */
1608 want_length
= max_suffix_len
+ SBYTES (filename
);
1609 if (fn_size
<= want_length
)
1611 fn_size
= 100 + want_length
;
1612 fn
= SAFE_ALLOCA (fn_size
);
1615 /* Copy FILENAME's data to FN but remove starting /: if any. */
1616 prefixlen
= ((SCHARS (filename
) > 2
1617 && SREF (filename
, 0) == '/'
1618 && SREF (filename
, 1) == ':')
1620 baselen
= SBYTES (filename
) - prefixlen
;
1621 memcpy (fn
, SDATA (filename
) + prefixlen
, baselen
);
1623 /* Loop over suffixes. */
1624 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1625 CONSP (tail
); tail
= XCDR (tail
))
1627 Lisp_Object suffix
= XCAR (tail
);
1628 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1629 Lisp_Object handler
;
1631 /* Make complete filename by appending SUFFIX. */
1632 memcpy (fn
+ baselen
, SDATA (suffix
), lsuffix
+ 1);
1633 fnlen
= baselen
+ lsuffix
;
1635 /* Check that the file exists and is not a directory. */
1636 /* We used to only check for handlers on non-absolute file names:
1640 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1641 It's not clear why that was the case and it breaks things like
1642 (load "/bar.el") where the file is actually "/bar.el.gz". */
1643 /* make_string has its own ideas on when to return a unibyte
1644 string and when a multibyte string, but we know better.
1645 We must have a unibyte string when dumping, since
1646 file-name encoding is shaky at best at that time, and in
1647 particular default-file-name-coding-system is reset
1648 several times during loadup. We therefore don't want to
1649 encode the file before passing it to file I/O library
1651 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1652 string
= make_unibyte_string (fn
, fnlen
);
1654 string
= make_string (fn
, fnlen
);
1655 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1656 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1657 && !NATNUMP (predicate
))
1660 if (NILP (predicate
) || EQ (predicate
, Qt
))
1661 exists
= !NILP (Ffile_readable_p (string
));
1664 Lisp_Object tmp
= call1 (predicate
, string
);
1667 else if (EQ (tmp
, Qdir_ok
)
1668 || NILP (Ffile_directory_p (string
)))
1673 last_errno
= EISDIR
;
1679 /* We succeeded; return this descriptor and filename. */
1692 encoded_fn
= ENCODE_FILE (string
);
1693 pfn
= SSDATA (encoded_fn
);
1695 /* Check that we can access or open it. */
1696 if (NATNUMP (predicate
))
1699 if (INT_MAX
< XFASTINT (predicate
))
1700 last_errno
= EINVAL
;
1701 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1705 if (file_directory_p (encoded_fn
))
1706 last_errno
= EISDIR
;
1713 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1716 if (errno
!= ENOENT
)
1721 int err
= (fstat (fd
, &st
) != 0 ? errno
1722 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1734 if (newer
&& !NATNUMP (predicate
))
1736 struct timespec mtime
= get_stat_mtime (&st
);
1738 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1743 emacs_close (save_fd
);
1746 save_string
= string
;
1751 /* We succeeded; return this descriptor and filename. */
1759 /* No more suffixes. Return the newest. */
1760 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1763 *storeptr
= save_string
;
1779 /* Merge the list we've accumulated of globals from the current input source
1780 into the load_history variable. The details depend on whether
1781 the source has an associated file name or not.
1783 FILENAME is the file name that we are loading from.
1785 ENTIRE is true if loading that entire file, false if evaluating
1789 build_load_history (Lisp_Object filename
, bool entire
)
1791 Lisp_Object tail
, prev
, newelt
;
1792 Lisp_Object tem
, tem2
;
1795 tail
= Vload_history
;
1798 while (CONSP (tail
))
1802 /* Find the feature's previous assoc list... */
1803 if (!NILP (Fequal (filename
, Fcar (tem
))))
1807 /* If we're loading the entire file, remove old data. */
1811 Vload_history
= XCDR (tail
);
1813 Fsetcdr (prev
, XCDR (tail
));
1816 /* Otherwise, cons on new symbols that are not already members. */
1819 tem2
= Vcurrent_load_list
;
1821 while (CONSP (tem2
))
1823 newelt
= XCAR (tem2
);
1825 if (NILP (Fmember (newelt
, tem
)))
1826 Fsetcar (tail
, Fcons (XCAR (tem
),
1827 Fcons (newelt
, XCDR (tem
))));
1840 /* If we're loading an entire file, cons the new assoc onto the
1841 front of load-history, the most-recently-loaded position. Also
1842 do this if we didn't find an existing member for the file. */
1843 if (entire
|| !foundit
)
1844 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1849 readevalloop_1 (int old
)
1851 load_convert_to_unibyte
= old
;
1854 /* Signal an `end-of-file' error, if possible with file name
1857 static _Noreturn
void
1858 end_of_file_error (void)
1860 if (STRINGP (Vload_file_name
))
1861 xsignal1 (Qend_of_file
, Vload_file_name
);
1863 xsignal0 (Qend_of_file
);
1867 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1869 /* If we macroexpand the toplevel form non-recursively and it ends
1870 up being a `progn' (or if it was a progn to start), treat each
1871 form in the progn as a top-level form. This way, if one form in
1872 the progn defines a macro, that macro is in effect when we expand
1873 the remaining forms. See similar code in bytecomp.el. */
1874 val
= call2 (macroexpand
, val
, Qnil
);
1875 if (EQ (CAR_SAFE (val
), Qprogn
))
1877 Lisp_Object subforms
= XCDR (val
);
1879 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1880 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1884 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1888 /* UNIBYTE specifies how to set load_convert_to_unibyte
1889 for this invocation.
1890 READFUN, if non-nil, is used instead of `read'.
1892 START, END specify region to read in current buffer (from eval-region).
1893 If the input is not from a buffer, they must be nil. */
1896 readevalloop (Lisp_Object readcharfun
,
1897 struct infile
*infile0
,
1898 Lisp_Object sourcename
,
1900 Lisp_Object unibyte
, Lisp_Object readfun
,
1901 Lisp_Object start
, Lisp_Object end
)
1905 ptrdiff_t count
= SPECPDL_INDEX ();
1906 struct buffer
*b
= 0;
1907 bool continue_reading_p
;
1908 Lisp_Object lex_bound
;
1909 /* True if reading an entire buffer. */
1910 bool whole_buffer
= 0;
1911 /* True on the first time around. */
1912 bool first_sexp
= 1;
1913 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1915 if (NILP (Ffboundp (macroexpand
))
1916 /* Don't macroexpand in .elc files, since it should have been done
1917 already. We actually don't know whether we're in a .elc file or not,
1918 so we use circumstantial evidence: .el files normally go through
1919 Vload_source_file_function -> load-with-code-conversion
1921 || EQ (readcharfun
, Qget_file_char
)
1922 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1925 if (MARKERP (readcharfun
))
1928 start
= readcharfun
;
1931 if (BUFFERP (readcharfun
))
1932 b
= XBUFFER (readcharfun
);
1933 else if (MARKERP (readcharfun
))
1934 b
= XMARKER (readcharfun
)->buffer
;
1936 /* We assume START is nil when input is not from a buffer. */
1937 if (! NILP (start
) && !b
)
1940 specbind (Qstandard_input
, readcharfun
);
1941 specbind (Qcurrent_load_list
, Qnil
);
1942 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1943 load_convert_to_unibyte
= !NILP (unibyte
);
1945 /* If lexical binding is active (either because it was specified in
1946 the file's header, or via a buffer-local variable), create an empty
1947 lexical environment, otherwise, turn off lexical binding. */
1948 lex_bound
= find_symbol_value (Qlexical_binding
);
1949 specbind (Qinternal_interpreter_environment
,
1950 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1951 ? Qnil
: list1 (Qt
)));
1953 /* Try to ensure sourcename is a truename, except whilst preloading. */
1954 if (NILP (Vpurify_flag
)
1955 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1956 && !NILP (Ffboundp (Qfile_truename
)))
1957 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1959 LOADHIST_ATTACH (sourcename
);
1961 continue_reading_p
= 1;
1962 while (continue_reading_p
)
1964 ptrdiff_t count1
= SPECPDL_INDEX ();
1966 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1967 error ("Reading from killed buffer");
1971 /* Switch to the buffer we are reading from. */
1972 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1973 set_buffer_internal (b
);
1975 /* Save point in it. */
1976 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1977 /* Save ZV in it. */
1978 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1979 /* Those get unbound after we read one expression. */
1981 /* Set point and ZV around stuff to be read. */
1984 Fnarrow_to_region (make_number (BEGV
), end
);
1986 /* Just for cleanliness, convert END to a marker
1987 if it is an integer. */
1989 end
= Fpoint_max_marker ();
1992 /* On the first cycle, we can easily test here
1993 whether we are reading the whole buffer. */
1994 if (b
&& first_sexp
)
1995 whole_buffer
= (BUF_PT (b
) == BUF_BEG (b
) && BUF_ZV (b
) == BUF_Z (b
));
2002 while ((c
= READCHAR
) != '\n' && c
!= -1);
2007 unbind_to (count1
, Qnil
);
2011 /* Ignore whitespace here, so we can detect eof. */
2012 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
2013 || c
== NO_BREAK_SPACE
)
2016 if (! HASH_TABLE_P (read_objects_map
)
2017 || XHASH_TABLE (read_objects_map
)->count
)
2019 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
,
2020 DEFAULT_REHASH_SIZE
, DEFAULT_REHASH_THRESHOLD
,
2022 if (! HASH_TABLE_P (read_objects_completed
)
2023 || XHASH_TABLE (read_objects_completed
)->count
)
2024 read_objects_completed
2025 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
,
2026 DEFAULT_REHASH_SIZE
, DEFAULT_REHASH_THRESHOLD
,
2028 if (!NILP (Vpurify_flag
) && c
== '(')
2030 val
= read_list (0, readcharfun
);
2035 if (!NILP (readfun
))
2037 val
= call1 (readfun
, readcharfun
);
2039 /* If READCHARFUN has set point to ZV, we should
2040 stop reading, even if the form read sets point
2041 to a different value when evaluated. */
2042 if (BUFFERP (readcharfun
))
2044 struct buffer
*buf
= XBUFFER (readcharfun
);
2045 if (BUF_PT (buf
) == BUF_ZV (buf
))
2046 continue_reading_p
= 0;
2049 else if (! NILP (Vload_read_function
))
2050 val
= call1 (Vload_read_function
, readcharfun
);
2052 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
2054 /* Empty hashes can be reused; otherwise, reset on next call. */
2055 if (HASH_TABLE_P (read_objects_map
)
2056 && XHASH_TABLE (read_objects_map
)->count
> 0)
2057 read_objects_map
= Qnil
;
2058 if (HASH_TABLE_P (read_objects_completed
)
2059 && XHASH_TABLE (read_objects_completed
)->count
> 0)
2060 read_objects_completed
= Qnil
;
2062 if (!NILP (start
) && continue_reading_p
)
2063 start
= Fpoint_marker ();
2065 /* Restore saved point and BEGV. */
2066 unbind_to (count1
, Qnil
);
2068 /* Now eval what we just read. */
2069 if (!NILP (macroexpand
))
2070 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
2072 val
= eval_sub (val
);
2076 Vvalues
= Fcons (val
, Vvalues
);
2077 if (EQ (Vstandard_output
, Qt
))
2086 build_load_history (sourcename
,
2087 infile0
|| whole_buffer
);
2089 unbind_to (count
, Qnil
);
2092 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
2093 doc
: /* Execute the accessible portion of current buffer as Lisp code.
2094 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
2095 When called from a Lisp program (i.e., not interactively), this
2096 function accepts up to five optional arguments:
2097 BUFFER is the buffer to evaluate (nil means use current buffer),
2098 or a name of a buffer (a string).
2099 PRINTFLAG controls printing of output by any output functions in the
2100 evaluated code, such as `print', `princ', and `prin1':
2101 a value of nil means discard it; anything else is the stream to print to.
2102 See Info node `(elisp)Output Streams' for details on streams.
2103 FILENAME specifies the file name to use for `load-history'.
2104 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
2106 DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
2107 evaluated code should work normally even if PRINTFLAG is nil, in
2108 which case the output is displayed in the echo area.
2110 This function preserves the position of point. */)
2111 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
2113 ptrdiff_t count
= SPECPDL_INDEX ();
2114 Lisp_Object tem
, buf
;
2117 buf
= Fcurrent_buffer ();
2119 buf
= Fget_buffer (buffer
);
2121 error ("No such buffer");
2123 if (NILP (printflag
) && NILP (do_allow_print
))
2128 if (NILP (filename
))
2129 filename
= BVAR (XBUFFER (buf
), filename
);
2131 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
2132 specbind (Qstandard_output
, tem
);
2133 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
2134 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2135 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
2136 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2137 readevalloop (buf
, 0, filename
,
2138 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
2139 unbind_to (count
, Qnil
);
2144 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2145 doc
: /* Execute the region as Lisp code.
2146 When called from programs, expects two arguments,
2147 giving starting and ending indices in the current buffer
2148 of the text to be executed.
2149 Programs can pass third argument PRINTFLAG which controls output:
2150 a value of nil means discard it; anything else is stream for printing it.
2151 See Info node `(elisp)Output Streams' for details on streams.
2152 Also the fourth argument READ-FUNCTION, if non-nil, is used
2153 instead of `read' to read each expression. It gets one argument
2154 which is the input stream for reading characters.
2156 This function does not move point. */)
2157 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2159 /* FIXME: Do the eval-sexp-add-defvars dance! */
2160 ptrdiff_t count
= SPECPDL_INDEX ();
2161 Lisp_Object tem
, cbuf
;
2163 cbuf
= Fcurrent_buffer ();
2165 if (NILP (printflag
))
2169 specbind (Qstandard_output
, tem
);
2170 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2172 /* `readevalloop' calls functions which check the type of start and end. */
2173 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2174 !NILP (printflag
), Qnil
, read_function
,
2177 return unbind_to (count
, Qnil
);
2181 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2182 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2183 If STREAM is nil, use the value of `standard-input' (which see).
2184 STREAM or the value of `standard-input' may be:
2185 a buffer (read from point and advance it)
2186 a marker (read from where it points and advance it)
2187 a function (call it with no arguments for each character,
2188 call it with a char as argument to push a char back)
2189 a string (takes text from string, starting at the beginning)
2190 t (read text line using minibuffer and use it, or read from
2191 standard input in batch mode). */)
2192 (Lisp_Object stream
)
2195 stream
= Vstandard_input
;
2196 if (EQ (stream
, Qt
))
2197 stream
= Qread_char
;
2198 if (EQ (stream
, Qread_char
))
2199 /* FIXME: ?! When is this used !? */
2200 return call1 (intern ("read-minibuffer"),
2201 build_string ("Lisp expression: "));
2203 return read_internal_start (stream
, Qnil
, Qnil
);
2206 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2207 doc
: /* Read one Lisp expression which is represented as text by STRING.
2208 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2209 FINAL-STRING-INDEX is an integer giving the position of the next
2210 remaining character in STRING. START and END optionally delimit
2211 a substring of STRING from which to read; they default to 0 and
2212 \(length STRING) respectively. Negative values are counted from
2213 the end of STRING. */)
2214 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2217 CHECK_STRING (string
);
2218 /* `read_internal_start' sets `read_from_string_index'. */
2219 ret
= read_internal_start (string
, start
, end
);
2220 return Fcons (ret
, make_number (read_from_string_index
));
2223 /* Function to set up the global context we need in toplevel read
2224 calls. START and END only used when STREAM is a string. */
2226 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2231 new_backquote_flag
= force_new_style_backquotes
;
2232 /* We can get called from readevalloop which may have set these
2234 if (! HASH_TABLE_P (read_objects_map
)
2235 || XHASH_TABLE (read_objects_map
)->count
)
2237 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
, DEFAULT_REHASH_SIZE
,
2238 DEFAULT_REHASH_THRESHOLD
, Qnil
, false);
2239 if (! HASH_TABLE_P (read_objects_completed
)
2240 || XHASH_TABLE (read_objects_completed
)->count
)
2241 read_objects_completed
2242 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
, DEFAULT_REHASH_SIZE
,
2243 DEFAULT_REHASH_THRESHOLD
, Qnil
, false);
2244 if (EQ (Vread_with_symbol_positions
, Qt
)
2245 || EQ (Vread_with_symbol_positions
, stream
))
2246 Vread_symbol_positions_list
= Qnil
;
2248 if (STRINGP (stream
)
2249 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2251 ptrdiff_t startval
, endval
;
2254 if (STRINGP (stream
))
2257 string
= XCAR (stream
);
2259 validate_subarray (string
, start
, end
, SCHARS (string
),
2260 &startval
, &endval
);
2262 read_from_string_index
= startval
;
2263 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2264 read_from_string_limit
= endval
;
2267 retval
= read0 (stream
);
2268 if (EQ (Vread_with_symbol_positions
, Qt
)
2269 || EQ (Vread_with_symbol_positions
, stream
))
2270 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2271 /* Empty hashes can be reused; otherwise, reset on next call. */
2272 if (HASH_TABLE_P (read_objects_map
)
2273 && XHASH_TABLE (read_objects_map
)->count
> 0)
2274 read_objects_map
= Qnil
;
2275 if (HASH_TABLE_P (read_objects_completed
)
2276 && XHASH_TABLE (read_objects_completed
)->count
> 0)
2277 read_objects_completed
= Qnil
;
2282 /* Signal Qinvalid_read_syntax error.
2283 S is error string of length N (if > 0) */
2285 static _Noreturn
void
2286 invalid_syntax (const char *s
)
2288 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2292 /* Use this for recursive reads, in contexts where internal tokens
2296 read0 (Lisp_Object readcharfun
)
2298 register Lisp_Object val
;
2301 val
= read1 (readcharfun
, &c
, 0);
2305 xsignal1 (Qinvalid_read_syntax
,
2306 Fmake_string (make_number (1), make_number (c
), Qnil
));
2309 /* Grow a read buffer BUF that contains OFFSET useful bytes of data,
2310 by at least MAX_MULTIBYTE_LENGTH bytes. Update *BUF_ADDR and
2311 *BUF_SIZE accordingly; 0 <= OFFSET <= *BUF_SIZE. If *BUF_ADDR is
2312 initially null, BUF is on the stack: copy its data to the new heap
2313 buffer. Otherwise, BUF must equal *BUF_ADDR and can simply be
2314 reallocated. Either way, remember the heap allocation (which is at
2315 pdl slot COUNT) so that it can be freed when unwinding the stack.*/
2318 grow_read_buffer (char *buf
, ptrdiff_t offset
,
2319 char **buf_addr
, ptrdiff_t *buf_size
, ptrdiff_t count
)
2321 char *p
= xpalloc (*buf_addr
, buf_size
, MAX_MULTIBYTE_LENGTH
, -1, 1);
2324 memcpy (p
, buf
, offset
);
2325 record_unwind_protect_ptr (xfree
, p
);
2328 set_unwind_protect_ptr (count
, xfree
, p
);
2333 /* Return the scalar value that has the Unicode character name NAME.
2334 Raise 'invalid-read-syntax' if there is no such character. */
2336 character_name_to_code (char const *name
, ptrdiff_t name_len
)
2338 /* For "U+XXXX", pass the leading '+' to string_to_number to reject
2339 monstrosities like "U+-0000". */
2341 = (name
[0] == 'U' && name
[1] == '+'
2342 ? string_to_number (name
+ 1, 16, false)
2343 : call2 (Qchar_from_name
, make_unibyte_string (name
, name_len
), Qt
));
2345 if (! RANGED_INTEGERP (0, code
, MAX_UNICODE_CHAR
)
2346 || char_surrogate_p (XINT (code
)))
2348 AUTO_STRING (format
, "\\N{%s}");
2349 AUTO_STRING_WITH_LEN (namestr
, name
, name_len
);
2350 xsignal1 (Qinvalid_read_syntax
, CALLN (Fformat
, format
, namestr
));
2356 /* Bound on the length of a Unicode character name. As of
2357 Unicode 9.0.0 the maximum is 83, so this should be safe. */
2358 enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND
= 200 };
2360 /* Read a \-escape sequence, assuming we already read the `\'.
2361 If the escape sequence forces unibyte, return eight-bit char. */
2364 read_escape (Lisp_Object readcharfun
, bool stringp
)
2367 /* \u allows up to four hex digits, \U up to eight. Default to the
2368 behavior for \u, and change this value in the case that \U is seen. */
2369 int unicode_hex_count
= 4;
2374 end_of_file_error ();
2404 error ("Invalid escape character syntax");
2407 c
= read_escape (readcharfun
, 0);
2408 return c
| meta_modifier
;
2413 error ("Invalid escape character syntax");
2416 c
= read_escape (readcharfun
, 0);
2417 return c
| shift_modifier
;
2422 error ("Invalid escape character syntax");
2425 c
= read_escape (readcharfun
, 0);
2426 return c
| hyper_modifier
;
2431 error ("Invalid escape character syntax");
2434 c
= read_escape (readcharfun
, 0);
2435 return c
| alt_modifier
;
2439 if (stringp
|| c
!= '-')
2446 c
= read_escape (readcharfun
, 0);
2447 return c
| super_modifier
;
2452 error ("Invalid escape character syntax");
2457 c
= read_escape (readcharfun
, 0);
2458 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2459 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2460 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2461 return c
| ctrl_modifier
;
2462 /* ASCII control chars are made from letters (both cases),
2463 as well as the non-letters within 0100...0137. */
2464 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2465 return (c
& (037 | ~0177));
2466 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2467 return (c
& (037 | ~0177));
2469 return c
| ctrl_modifier
;
2479 /* An octal escape, as in ANSI C. */
2481 register int i
= c
- '0';
2482 register int count
= 0;
2485 if ((c
= READCHAR
) >= '0' && c
<= '7')
2497 if (i
>= 0x80 && i
< 0x100)
2498 i
= BYTE8_TO_CHAR (i
);
2503 /* A hex escape, as in ANSI C. */
2510 int digit
= char_hexdigit (c
);
2516 i
= (i
<< 4) + digit
;
2517 /* Allow hex escapes as large as ?\xfffffff, because some
2518 packages use them to denote characters with modifiers. */
2519 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2520 error ("Hex character out of range: \\x%x...", i
);
2524 if (count
< 3 && i
>= 0x80)
2525 return BYTE8_TO_CHAR (i
);
2530 /* Post-Unicode-2.0: Up to eight hex chars. */
2531 unicode_hex_count
= 8;
2535 /* A Unicode escape. We only permit them in strings and characters,
2536 not arbitrarily in the source code, as in some other languages. */
2541 while (++count
<= unicode_hex_count
)
2544 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2546 int digit
= char_hexdigit (c
);
2548 error ("Non-hex digit used for Unicode escape");
2549 i
= (i
<< 4) + digit
;
2552 error ("Non-Unicode character: 0x%x", i
);
2557 /* Named character. */
2561 invalid_syntax ("Expected opening brace after \\N");
2562 char name
[UNICODE_CHARACTER_NAME_LENGTH_BOUND
+ 1];
2563 bool whitespace
= false;
2564 ptrdiff_t length
= 0;
2569 end_of_file_error ();
2572 if (! (0 < c
&& c
< 0x80))
2574 AUTO_STRING (format
,
2575 "Invalid character U+%04X in character name");
2576 xsignal1 (Qinvalid_read_syntax
,
2577 CALLN (Fformat
, format
, make_natnum (c
)));
2579 /* Treat multiple adjacent whitespace characters as a
2580 single space character. This makes it easier to use
2581 character names in e.g. multi-line strings. */
2592 if (length
>= sizeof name
)
2593 invalid_syntax ("Character name too long");
2596 invalid_syntax ("Empty character name");
2597 name
[length
] = '\0';
2599 /* character_name_to_code can invoke read1, recursively.
2600 This is why read1's buffer is not static. */
2601 return character_name_to_code (name
, length
);
2609 /* Return the digit that CHARACTER stands for in the given BASE.
2610 Return -1 if CHARACTER is out of range for BASE,
2611 and -2 if CHARACTER is not valid for any supported BASE. */
2613 digit_to_number (int character
, int base
)
2617 if ('0' <= character
&& character
<= '9')
2618 digit
= character
- '0';
2619 else if ('a' <= character
&& character
<= 'z')
2620 digit
= character
- 'a' + 10;
2621 else if ('A' <= character
&& character
<= 'Z')
2622 digit
= character
- 'A' + 10;
2626 return digit
< base
? digit
: -1;
2629 /* Read an integer in radix RADIX using READCHARFUN to read
2630 characters. RADIX must be in the interval [2..36]; if it isn't, a
2631 read error is signaled . Value is the integer read. Signals an
2632 error if encountering invalid read syntax or if RADIX is out of
2636 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2638 /* Room for sign, leading 0, other digits, trailing null byte.
2639 Also, room for invalid syntax diagnostic. */
2640 char buf
[max (1 + 1 + UINTMAX_WIDTH
+ 1,
2641 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2643 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2645 if (radix
< 2 || radix
> 36)
2653 if (c
== '-' || c
== '+')
2664 /* Ignore redundant leading zeros, so the buffer doesn't
2665 fill up with them. */
2671 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2678 if (p
< buf
+ sizeof buf
- 1)
2692 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2693 invalid_syntax (buf
);
2696 return string_to_number (buf
, radix
, 0);
2700 /* If the next token is ')' or ']' or '.', we store that character
2701 in *PCH and the return value is not interesting. Else, we store
2702 zero in *PCH and we read and return one lisp object.
2704 FIRST_IN_LIST is true if this is the first element of a list. */
2707 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2710 bool uninterned_symbol
= false;
2712 char stackbuf
[MAX_ALLOCA
];
2713 current_thread
->stack_top
= stackbuf
;
2719 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2721 end_of_file_error ();
2726 return read_list (0, readcharfun
);
2729 return read_vector (readcharfun
, 0);
2745 /* Accept extended format for hash tables (extensible to
2747 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2748 Lisp_Object tmp
= read_list (0, readcharfun
);
2749 Lisp_Object head
= CAR_SAFE (tmp
);
2750 Lisp_Object data
= Qnil
;
2751 Lisp_Object val
= Qnil
;
2752 /* The size is 2 * number of allowed keywords to
2754 Lisp_Object params
[12];
2756 Lisp_Object key
= Qnil
;
2757 int param_count
= 0;
2759 if (!EQ (head
, Qhash_table
))
2761 ptrdiff_t size
= XINT (Flength (tmp
));
2762 Lisp_Object record
= Fmake_record (CAR_SAFE (tmp
),
2763 make_number (size
- 1),
2765 for (int i
= 1; i
< size
; i
++)
2768 ASET (record
, i
, Fcar (tmp
));
2773 tmp
= CDR_SAFE (tmp
);
2775 /* This is repetitive but fast and simple. */
2776 params
[param_count
] = QCsize
;
2777 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2778 if (!NILP (params
[param_count
+ 1]))
2781 params
[param_count
] = QCtest
;
2782 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2783 if (!NILP (params
[param_count
+ 1]))
2786 params
[param_count
] = QCweakness
;
2787 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2788 if (!NILP (params
[param_count
+ 1]))
2791 params
[param_count
] = QCrehash_size
;
2792 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2793 if (!NILP (params
[param_count
+ 1]))
2796 params
[param_count
] = QCrehash_threshold
;
2797 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2798 if (!NILP (params
[param_count
+ 1]))
2801 params
[param_count
] = QCpurecopy
;
2802 params
[param_count
+ 1] = Fplist_get (tmp
, Qpurecopy
);
2803 if (!NILP (params
[param_count
+ 1]))
2806 /* This is the hash table data. */
2807 data
= Fplist_get (tmp
, Qdata
);
2809 /* Now use params to make a new hash table and fill it. */
2810 ht
= Fmake_hash_table (param_count
, params
);
2812 while (CONSP (data
))
2817 error ("Odd number of elements in hash table data");
2820 Fputhash (key
, val
, ht
);
2826 invalid_syntax ("#");
2834 tmp
= read_vector (readcharfun
, 0);
2835 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2836 error ("Invalid size char-table");
2837 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2845 /* Sub char-table can't be read as a regular
2846 vector because of a two C integer fields. */
2847 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2848 ptrdiff_t size
= XINT (Flength (tmp
));
2849 int i
, depth
, min_char
;
2850 struct Lisp_Cons
*cell
;
2853 error ("Zero-sized sub char-table");
2855 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2856 error ("Invalid depth in sub char-table");
2857 depth
= XINT (XCAR (tmp
));
2858 if (chartab_size
[depth
] != size
- 2)
2859 error ("Invalid size in sub char-table");
2860 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2863 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2864 error ("Invalid minimum character in sub-char-table");
2865 min_char
= XINT (XCAR (tmp
));
2866 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2869 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2870 for (i
= 0; i
< size
; i
++)
2872 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2873 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2878 invalid_syntax ("#^^");
2880 invalid_syntax ("#^");
2885 length
= read1 (readcharfun
, pch
, first_in_list
);
2889 Lisp_Object tmp
, val
;
2890 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2891 unsigned char *data
;
2894 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2895 if (STRING_MULTIBYTE (tmp
)
2896 || (size_in_chars
!= SCHARS (tmp
)
2897 /* We used to print 1 char too many
2898 when the number of bits was a multiple of 8.
2899 Accept such input in case it came from an old
2901 && ! (XFASTINT (length
)
2902 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2903 invalid_syntax ("#&...");
2905 val
= make_uninit_bool_vector (XFASTINT (length
));
2906 data
= bool_vector_uchar_data (val
);
2907 memcpy (data
, SDATA (tmp
), size_in_chars
);
2908 /* Clear the extraneous bits in the last byte. */
2909 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2910 data
[size_in_chars
- 1]
2911 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2914 invalid_syntax ("#&...");
2918 /* Accept compiled functions at read-time so that we don't have to
2919 build them using function calls. */
2921 struct Lisp_Vector
*vec
;
2922 tmp
= read_vector (readcharfun
, 1);
2923 vec
= XVECTOR (tmp
);
2924 if (vec
->header
.size
== 0)
2925 invalid_syntax ("Empty byte-code object");
2926 make_byte_code (vec
);
2934 /* Read the string itself. */
2935 tmp
= read1 (readcharfun
, &ch
, 0);
2936 if (ch
!= 0 || !STRINGP (tmp
))
2937 invalid_syntax ("#");
2938 /* Read the intervals and their properties. */
2941 Lisp_Object beg
, end
, plist
;
2943 beg
= read1 (readcharfun
, &ch
, 0);
2948 end
= read1 (readcharfun
, &ch
, 0);
2950 plist
= read1 (readcharfun
, &ch
, 0);
2952 invalid_syntax ("Invalid string property list");
2953 Fset_text_properties (beg
, end
, plist
, tmp
);
2959 /* #@NUMBER is used to skip NUMBER following bytes.
2960 That's used in .elc files to skip over doc strings
2961 and function definitions. */
2964 enum { extra
= 100 };
2965 ptrdiff_t i
, nskip
= 0, digits
= 0;
2967 /* Read a decimal integer. */
2968 while ((c
= READCHAR
) >= 0
2969 && c
>= '0' && c
<= '9')
2971 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2976 if (digits
== 2 && nskip
== 0)
2977 { /* We've just seen #@00, which means "skip to end". */
2978 skip_dyn_eof (readcharfun
);
2983 /* We can't use UNREAD here, because in the code below we side-step
2984 READCHAR. Instead, assume the first char after #@NNN occupies
2985 a single byte, which is the case normally since it's just
2991 if (load_force_doc_strings
2992 && (FROM_FILE_P (readcharfun
)))
2994 /* If we are supposed to force doc strings into core right now,
2995 record the last string that we skipped,
2996 and record where in the file it comes from. */
2998 /* But first exchange saved_doc_string
2999 with prev_saved_doc_string, so we save two strings. */
3001 char *temp
= saved_doc_string
;
3002 ptrdiff_t temp_size
= saved_doc_string_size
;
3003 file_offset temp_pos
= saved_doc_string_position
;
3004 ptrdiff_t temp_len
= saved_doc_string_length
;
3006 saved_doc_string
= prev_saved_doc_string
;
3007 saved_doc_string_size
= prev_saved_doc_string_size
;
3008 saved_doc_string_position
= prev_saved_doc_string_position
;
3009 saved_doc_string_length
= prev_saved_doc_string_length
;
3011 prev_saved_doc_string
= temp
;
3012 prev_saved_doc_string_size
= temp_size
;
3013 prev_saved_doc_string_position
= temp_pos
;
3014 prev_saved_doc_string_length
= temp_len
;
3017 if (saved_doc_string_size
== 0)
3019 saved_doc_string
= xmalloc (nskip
+ extra
);
3020 saved_doc_string_size
= nskip
+ extra
;
3022 if (nskip
> saved_doc_string_size
)
3024 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
3025 saved_doc_string_size
= nskip
+ extra
;
3028 FILE *instream
= infile
->stream
;
3029 saved_doc_string_position
= (file_tell (instream
)
3030 - infile
->lookahead
);
3032 /* Copy that many bytes into saved_doc_string. */
3034 for (int n
= min (nskip
, infile
->lookahead
); 0 < n
; n
--)
3035 saved_doc_string
[i
++]
3036 = c
= infile
->buf
[--infile
->lookahead
];
3038 for (; i
< nskip
&& 0 <= c
; i
++)
3039 saved_doc_string
[i
] = c
= getc_unlocked (instream
);
3042 saved_doc_string_length
= i
;
3045 /* Skip that many bytes. */
3046 skip_dyn_bytes (readcharfun
, nskip
);
3052 /* #! appears at the beginning of an executable file.
3053 Skip the first line. */
3054 while (c
!= '\n' && c
>= 0)
3059 return Vload_file_name
;
3061 return list2 (Qfunction
, read0 (readcharfun
));
3062 /* #:foo is the uninterned symbol named foo. */
3065 uninterned_symbol
= true;
3068 && c
!= NO_BREAK_SPACE
3070 || strchr ("\"';()[]#`,", c
) == NULL
)))
3072 /* No symbol character follows, this is the empty
3075 return Fmake_symbol (empty_unibyte_string
);
3079 /* ## is the empty symbol. */
3081 return Fintern (empty_unibyte_string
, Qnil
);
3082 /* Reader forms that can reuse previously read objects. */
3083 if (c
>= '0' && c
<= '9')
3087 bool overflow
= false;
3089 /* Read a non-negative integer. */
3090 while (c
>= '0' && c
<= '9')
3092 overflow
|= INT_MULTIPLY_WRAPV (n
, 10, &n
);
3093 overflow
|= INT_ADD_WRAPV (n
, c
- '0', &n
);
3097 if (!overflow
&& n
<= MOST_POSITIVE_FIXNUM
)
3099 if (c
== 'r' || c
== 'R')
3100 return read_integer (readcharfun
, n
);
3102 if (! NILP (Vread_circle
))
3104 /* #n=object returns object, but associates it with
3108 /* Make a placeholder for #n# to use temporarily. */
3109 /* Note: We used to use AUTO_CONS to allocate
3110 placeholder, but that is a bad idea, since it
3111 will place a stack-allocated cons cell into
3112 the list in read_objects_map, which is a
3113 staticpro'd global variable, and thus each of
3114 its elements is marked during each GC. A
3115 stack-allocated object will become garbled
3116 when its stack slot goes out of scope, and
3117 some other function reuses it for entirely
3118 different purposes, which will cause crashes
3120 Lisp_Object placeholder
= Fcons (Qnil
, Qnil
);
3121 struct Lisp_Hash_Table
*h
3122 = XHASH_TABLE (read_objects_map
);
3124 Lisp_Object number
= make_number (n
);
3126 ptrdiff_t i
= hash_lookup (h
, number
, &hash
);
3128 /* Not normal, but input could be malformed. */
3129 set_hash_value_slot (h
, i
, placeholder
);
3131 hash_put (h
, number
, placeholder
, hash
);
3133 /* Read the object itself. */
3134 tem
= read0 (readcharfun
);
3136 /* If it can be recursive, remember it for
3137 future substitutions. */
3140 && ! (STRINGP (tem
) && !string_intervals (tem
)))
3142 struct Lisp_Hash_Table
*h2
3143 = XHASH_TABLE (read_objects_completed
);
3144 i
= hash_lookup (h2
, tem
, &hash
);
3146 hash_put (h2
, tem
, Qnil
, hash
);
3149 /* Now put it everywhere the placeholder was... */
3152 Fsetcar (placeholder
, XCAR (tem
));
3153 Fsetcdr (placeholder
, XCDR (tem
));
3158 Flread__substitute_object_in_subtree
3159 (tem
, placeholder
, read_objects_completed
);
3161 /* ...and #n# will use the real value from now on. */
3162 i
= hash_lookup (h
, number
, &hash
);
3164 set_hash_value_slot (h
, i
, tem
);
3170 /* #n# returns a previously read object. */
3173 struct Lisp_Hash_Table
*h
3174 = XHASH_TABLE (read_objects_map
);
3175 ptrdiff_t i
= hash_lookup (h
, make_number (n
), NULL
);
3177 return HASH_VALUE (h
, i
);
3181 /* Fall through to error message. */
3183 else if (c
== 'x' || c
== 'X')
3184 return read_integer (readcharfun
, 16);
3185 else if (c
== 'o' || c
== 'O')
3186 return read_integer (readcharfun
, 8);
3187 else if (c
== 'b' || c
== 'B')
3188 return read_integer (readcharfun
, 2);
3191 invalid_syntax ("#");
3194 while ((c
= READCHAR
) >= 0 && c
!= '\n');
3198 return list2 (Qquote
, read0 (readcharfun
));
3202 int next_char
= READCHAR
;
3204 /* Transition from old-style to new-style:
3205 If we see "(`" it used to mean old-style, which usually works
3206 fine because ` should almost never appear in such a position
3207 for new-style. But occasionally we need "(`" to mean new
3208 style, so we try to distinguish the two by the fact that we
3209 can either write "( `foo" or "(` foo", where the first
3210 intends to use new-style whereas the second intends to use
3211 old-style. For Emacs-25, we should completely remove this
3212 first_in_list exception (old-style can still be obtained via
3214 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
3215 load_error_old_style_backquotes ();
3219 bool saved_new_backquote_flag
= new_backquote_flag
;
3221 new_backquote_flag
= 1;
3222 value
= read0 (readcharfun
);
3223 new_backquote_flag
= saved_new_backquote_flag
;
3225 return list2 (Qbackquote
, value
);
3230 int next_char
= READCHAR
;
3232 /* Transition from old-style to new-style:
3233 It used to be impossible to have a new-style , other than within
3234 a new-style `. This is sufficient when ` and , are used in the
3235 normal way, but ` and , can also appear in args to macros that
3236 will not interpret them in the usual way, in which case , may be
3237 used without any ` anywhere near.
3238 So we now use the same heuristic as for backquote: old-style
3239 unquotes are only recognized when first on a list, and when
3240 followed by a space.
3241 Because it's more difficult to peek 2 chars ahead, a new-style
3242 ,@ can still not be used outside of a `, unless it's in the middle
3244 if (new_backquote_flag
3246 || (next_char
!= ' ' && next_char
!= '@'))
3248 Lisp_Object comma_type
= Qnil
;
3253 comma_type
= Qcomma_at
;
3255 comma_type
= Qcomma_dot
;
3258 if (ch
>= 0) UNREAD (ch
);
3259 comma_type
= Qcomma
;
3262 value
= read0 (readcharfun
);
3263 return list2 (comma_type
, value
);
3266 load_error_old_style_backquotes ();
3276 end_of_file_error ();
3278 /* Accept `single space' syntax like (list ? x) where the
3279 whitespace character is SPC or TAB.
3280 Other literal whitespace like NL, CR, and FF are not accepted,
3281 as there are well-established escape sequences for these. */
3282 if (c
== ' ' || c
== '\t')
3283 return make_number (c
);
3285 if (c
== '(' || c
== ')' || c
== '[' || c
== ']'
3286 || c
== '"' || c
== ';')
3288 CHECK_LIST (Vlread_unescaped_character_literals
);
3289 Lisp_Object char_obj
= make_natnum (c
);
3290 if (NILP (Fmemq (char_obj
, Vlread_unescaped_character_literals
)))
3291 Vlread_unescaped_character_literals
=
3292 Fcons (char_obj
, Vlread_unescaped_character_literals
);
3296 c
= read_escape (readcharfun
, 0);
3297 modifiers
= c
& CHAR_MODIFIER_MASK
;
3298 c
&= ~CHAR_MODIFIER_MASK
;
3299 if (CHAR_BYTE8_P (c
))
3300 c
= CHAR_TO_BYTE8 (c
);
3303 next_char
= READCHAR
;
3304 ok
= (next_char
<= 040
3305 || (next_char
< 0200
3306 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3309 return make_number (c
);
3311 invalid_syntax ("?");
3316 ptrdiff_t count
= SPECPDL_INDEX ();
3317 char *read_buffer
= stackbuf
;
3318 ptrdiff_t read_buffer_size
= sizeof stackbuf
;
3319 char *heapbuf
= NULL
;
3320 char *p
= read_buffer
;
3321 char *end
= read_buffer
+ read_buffer_size
;
3323 /* True if we saw an escape sequence specifying
3324 a multibyte character. */
3325 bool force_multibyte
= false;
3326 /* True if we saw an escape sequence specifying
3327 a single-byte character. */
3328 bool force_singlebyte
= false;
3329 bool cancel
= false;
3330 ptrdiff_t nchars
= 0;
3332 while ((ch
= READCHAR
) >= 0
3335 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3337 ptrdiff_t offset
= p
- read_buffer
;
3338 read_buffer
= grow_read_buffer (read_buffer
, offset
,
3339 &heapbuf
, &read_buffer_size
,
3341 p
= read_buffer
+ offset
;
3342 end
= read_buffer
+ read_buffer_size
;
3349 ch
= read_escape (readcharfun
, 1);
3351 /* CH is -1 if \ newline or \ space has just been seen. */
3354 if (p
== read_buffer
)
3359 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3360 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3362 if (CHAR_BYTE8_P (ch
))
3363 force_singlebyte
= true;
3364 else if (! ASCII_CHAR_P (ch
))
3365 force_multibyte
= true;
3366 else /* I.e. ASCII_CHAR_P (ch). */
3368 /* Allow `\C- ' and `\C-?'. */
3369 if (modifiers
== CHAR_CTL
)
3372 ch
= 0, modifiers
= 0;
3374 ch
= 127, modifiers
= 0;
3376 if (modifiers
& CHAR_SHIFT
)
3378 /* Shift modifier is valid only with [A-Za-z]. */
3379 if (ch
>= 'A' && ch
<= 'Z')
3380 modifiers
&= ~CHAR_SHIFT
;
3381 else if (ch
>= 'a' && ch
<= 'z')
3382 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3385 if (modifiers
& CHAR_META
)
3387 /* Move the meta bit to the right place for a
3389 modifiers
&= ~CHAR_META
;
3390 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3391 force_singlebyte
= true;
3395 /* Any modifiers remaining are invalid. */
3397 error ("Invalid modifier in string");
3398 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3402 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3403 if (CHAR_BYTE8_P (ch
))
3404 force_singlebyte
= true;
3405 else if (! ASCII_CHAR_P (ch
))
3406 force_multibyte
= true;
3412 end_of_file_error ();
3414 /* If purifying, and string starts with \ newline,
3415 return zero instead. This is for doc strings
3416 that we are really going to find in etc/DOC.nn.nn. */
3417 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3418 return unbind_to (count
, make_number (0));
3420 if (! force_multibyte
&& force_singlebyte
)
3422 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3423 forms. Convert it to unibyte. */
3424 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3426 p
= read_buffer
+ nchars
;
3430 = make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3432 || (p
- read_buffer
!= nchars
)));
3433 return unbind_to (count
, result
);
3438 int next_char
= READCHAR
;
3441 if (next_char
<= 040
3442 || (next_char
< 0200
3443 && strchr ("\"';([#?`,", next_char
) != NULL
))
3449 /* The atom-reading loop below will now loop at least once,
3450 assuring that we will not try to UNREAD two characters in a
3454 if (c
<= 040) goto retry
;
3455 if (c
== NO_BREAK_SPACE
)
3460 ptrdiff_t count
= SPECPDL_INDEX ();
3461 char *read_buffer
= stackbuf
;
3462 ptrdiff_t read_buffer_size
= sizeof stackbuf
;
3463 char *heapbuf
= NULL
;
3464 char *p
= read_buffer
;
3465 char *end
= read_buffer
+ read_buffer_size
;
3466 bool quoted
= false;
3467 EMACS_INT start_position
= readchar_count
- 1;
3471 if (end
- p
< MAX_MULTIBYTE_LENGTH
+ 1)
3473 ptrdiff_t offset
= p
- read_buffer
;
3474 read_buffer
= grow_read_buffer (read_buffer
, offset
,
3475 &heapbuf
, &read_buffer_size
,
3477 p
= read_buffer
+ offset
;
3478 end
= read_buffer
+ read_buffer_size
;
3485 end_of_file_error ();
3490 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3496 && c
!= NO_BREAK_SPACE
3498 || strchr ("\"';()[]#`,", c
) == NULL
));
3503 if (!quoted
&& !uninterned_symbol
)
3505 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3506 if (! NILP (result
))
3507 return unbind_to (count
, result
);
3509 if (!quoted
&& multibyte
)
3511 int ch
= STRING_CHAR ((unsigned char *) read_buffer
);
3512 if (confusable_symbol_character_p (ch
))
3513 xsignal2 (Qinvalid_read_syntax
, build_string ("strange quote"),
3514 CALLN (Fstring
, make_number (ch
)));
3518 ptrdiff_t nbytes
= p
- read_buffer
;
3521 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3525 if (uninterned_symbol
)
3528 = ((! NILP (Vpurify_flag
)
3529 ? make_pure_string
: make_specified_string
)
3530 (read_buffer
, nchars
, nbytes
, multibyte
));
3531 result
= Fmake_symbol (name
);
3535 /* Don't create the string object for the name unless
3536 we're going to retain it in a new symbol.
3538 Like intern_1 but supports multibyte names. */
3539 Lisp_Object obarray
= check_obarray (Vobarray
);
3540 Lisp_Object tem
= oblookup (obarray
, read_buffer
,
3548 = make_specified_string (read_buffer
, nchars
, nbytes
,
3550 result
= intern_driver (name
, obarray
, tem
);
3554 if (EQ (Vread_with_symbol_positions
, Qt
)
3555 || EQ (Vread_with_symbol_positions
, readcharfun
))
3556 Vread_symbol_positions_list
3557 = Fcons (Fcons (result
, make_number (start_position
)),
3558 Vread_symbol_positions_list
);
3559 return unbind_to (count
, result
);
3565 DEFUN ("lread--substitute-object-in-subtree",
3566 Flread__substitute_object_in_subtree
,
3567 Slread__substitute_object_in_subtree
, 3, 3, 0,
3568 doc
: /* In OBJECT, replace every occurrence of PLACEHOLDER with OBJECT.
3569 COMPLETED is a hash table of objects that might be circular, or is t
3570 if any object might be circular. */)
3571 (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object completed
)
3573 struct subst subst
= { object
, placeholder
, completed
, Qnil
};
3574 Lisp_Object check_object
= substitute_object_recurse (&subst
, object
);
3576 /* The returned object here is expected to always eq the
3578 if (!EQ (check_object
, object
))
3579 error ("Unexpected mutation error in reader");
3584 substitute_object_recurse (struct subst
*subst
, Lisp_Object subtree
)
3586 /* If we find the placeholder, return the target object. */
3587 if (EQ (subst
->placeholder
, subtree
))
3588 return subst
->object
;
3590 /* For common object types that can't contain other objects, don't
3591 bother looking them up; we're done. */
3592 if (SYMBOLP (subtree
)
3593 || (STRINGP (subtree
) && !string_intervals (subtree
))
3594 || NUMBERP (subtree
))
3597 /* If we've been to this node before, don't explore it again. */
3598 if (!EQ (Qnil
, Fmemq (subtree
, subst
->seen
)))
3601 /* If this node can be the entry point to a cycle, remember that
3602 we've seen it. It can only be such an entry point if it was made
3603 by #n=, which means that we can find it as a value in
3605 if (EQ (subst
->completed
, Qt
)
3606 || hash_lookup (XHASH_TABLE (subst
->completed
), subtree
, NULL
) >= 0)
3607 subst
->seen
= Fcons (subtree
, subst
->seen
);
3609 /* Recurse according to subtree's type.
3610 Every branch must return a Lisp_Object. */
3611 switch (XTYPE (subtree
))
3613 case Lisp_Vectorlike
:
3615 ptrdiff_t i
= 0, length
= 0;
3616 if (BOOL_VECTOR_P (subtree
))
3617 return subtree
; /* No sub-objects anyway. */
3618 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3619 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
)
3620 || RECORDP (subtree
))
3621 length
= PVSIZE (subtree
);
3622 else if (VECTORP (subtree
))
3623 length
= ASIZE (subtree
);
3625 /* An unknown pseudovector may contain non-Lisp fields, so we
3626 can't just blindly traverse all its fields. We used to call
3627 `Flength' which signaled `sequencep', so I just preserved this
3629 wrong_type_argument (Qsequencep
, subtree
);
3631 if (SUB_CHAR_TABLE_P (subtree
))
3633 for ( ; i
< length
; i
++)
3635 substitute_object_recurse (subst
, AREF (subtree
, i
)));
3640 XSETCAR (subtree
, substitute_object_recurse (subst
, XCAR (subtree
)));
3641 XSETCDR (subtree
, substitute_object_recurse (subst
, XCDR (subtree
)));
3646 /* Check for text properties in each interval.
3647 substitute_in_interval contains part of the logic. */
3649 INTERVAL root_interval
= string_intervals (subtree
);
3650 traverse_intervals_noorder (root_interval
,
3651 substitute_in_interval
, subst
);
3655 /* Other types don't recurse any further. */
3661 /* Helper function for substitute_object_recurse. */
3663 substitute_in_interval (INTERVAL interval
, void *arg
)
3665 set_interval_plist (interval
,
3666 substitute_object_recurse (arg
, interval
->plist
));
3670 /* Convert STRING to a number, assuming base BASE. Return a fixnum if
3671 STRING has integer syntax and fits in a fixnum, else return the
3672 nearest float if STRING has either floating point or integer syntax
3673 and BASE is 10, else return nil. If IGNORE_TRAILING, consider just
3674 the longest prefix of STRING that has valid floating point syntax.
3675 Signal an overflow if BASE is not 10 and the number has integer
3676 syntax but does not fit. */
3679 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3681 char const *cp
= string
;
3682 bool float_syntax
= 0;
3685 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3686 IEEE floating point hosts, and works around a formerly-common bug where
3687 atof ("-0.0") drops the sign. */
3688 bool negative
= *cp
== '-';
3690 bool signedp
= negative
|| *cp
== '+';
3693 enum { INTOVERFLOW
= 1, LEAD_INT
= 2, DOT_CHAR
= 4, TRAIL_INT
= 8,
3696 int leading_digit
= digit_to_number (*cp
, base
);
3697 uintmax_t n
= leading_digit
;
3698 if (leading_digit
>= 0)
3701 for (int digit
; 0 <= (digit
= digit_to_number (*++cp
, base
)); )
3703 if (INT_MULTIPLY_OVERFLOW (n
, base
))
3704 state
|= INTOVERFLOW
;
3706 if (INT_ADD_OVERFLOW (n
, digit
))
3707 state
|= INTOVERFLOW
;
3719 if ('0' <= *cp
&& *cp
<= '9')
3724 while ('0' <= *cp
&& *cp
<= '9');
3726 if (*cp
== 'e' || *cp
== 'E')
3728 char const *ecp
= cp
;
3730 if (*cp
== '+' || *cp
== '-')
3732 if ('0' <= *cp
&& *cp
<= '9')
3737 while ('0' <= *cp
&& *cp
<= '9');
3739 else if (cp
[-1] == '+'
3740 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3746 else if (cp
[-1] == '+'
3747 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3751 /* NAN is a "positive" NaN on all known Emacs hosts. */
3758 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3759 || (state
& ~INTOVERFLOW
) == (LEAD_INT
|E_EXP
));
3762 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3763 any prefix that matches. Otherwise, the entire string must match. */
3764 if (! (ignore_trailing
3765 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3766 : (!*cp
&& ((state
& ~(INTOVERFLOW
| DOT_CHAR
)) == LEAD_INT
3770 /* If the number uses integer and not float syntax, and is in C-language
3771 range, use its value, preferably as a fixnum. */
3772 if (leading_digit
>= 0 && ! float_syntax
)
3774 if (state
& INTOVERFLOW
)
3776 /* Unfortunately there's no simple and accurate way to convert
3777 non-base-10 numbers that are out of C-language range. */
3779 xsignal1 (Qoverflow_error
, build_string (string
));
3781 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3783 EMACS_INT signed_n
= n
;
3784 return make_number (negative
? -signed_n
: signed_n
);
3790 /* Either the number uses float syntax, or it does not fit into a fixnum.
3791 Convert it from string to floating point, unless the value is already
3792 known because it is an infinity, a NAN, or its absolute value fits in
3795 value
= atof (string
+ signedp
);
3797 return make_float (negative
? -value
: value
);
3802 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3806 Lisp_Object tem
, item
, vector
;
3807 struct Lisp_Cons
*otem
;
3810 tem
= read_list (1, readcharfun
);
3811 len
= Flength (tem
);
3812 vector
= Fmake_vector (len
, Qnil
);
3814 size
= ASIZE (vector
);
3815 ptr
= XVECTOR (vector
)->contents
;
3816 for (i
= 0; i
< size
; i
++)
3819 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3820 bytecode object, the docstring containing the bytecode and
3821 constants values must be treated as unibyte and passed to
3822 Fread, to get the actual bytecode string and constants vector. */
3823 if (bytecodeflag
&& load_force_doc_strings
)
3825 if (i
== COMPILED_BYTECODE
)
3827 if (!STRINGP (item
))
3828 error ("Invalid byte code");
3830 /* Delay handling the bytecode slot until we know whether
3831 it is lazily-loaded (we can tell by whether the
3832 constants slot is nil). */
3833 ASET (vector
, COMPILED_CONSTANTS
, item
);
3836 else if (i
== COMPILED_CONSTANTS
)
3838 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3842 /* Coerce string to unibyte (like string-as-unibyte,
3843 but without generating extra garbage and
3844 guaranteeing no change in the contents). */
3845 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3846 STRING_SET_UNIBYTE (bytestr
);
3848 item
= Fread (Fcons (bytestr
, readcharfun
));
3850 error ("Invalid byte code");
3852 otem
= XCONS (item
);
3853 bytestr
= XCAR (item
);
3858 /* Now handle the bytecode slot. */
3859 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3861 else if (i
== COMPILED_DOC_STRING
3863 && ! STRING_MULTIBYTE (item
))
3865 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3866 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3868 item
= Fstring_as_multibyte (item
);
3871 ASET (vector
, i
, item
);
3879 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3882 read_list (bool flag
, Lisp_Object readcharfun
)
3884 Lisp_Object val
, tail
;
3885 Lisp_Object elt
, tem
;
3886 /* 0 is the normal case.
3887 1 means this list is a doc reference; replace it with the number 0.
3888 2 means this list is a doc reference; replace it with the doc string. */
3889 int doc_reference
= 0;
3891 /* Initialize this to 1 if we are reading a list. */
3892 bool first_in_list
= flag
<= 0;
3900 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3904 /* While building, if the list starts with #$, treat it specially. */
3905 if (EQ (elt
, Vload_file_name
)
3907 && !NILP (Vpurify_flag
))
3909 if (NILP (Vdoc_file_name
))
3910 /* We have not yet called Snarf-documentation, so assume
3911 this file is described in the DOC file
3912 and Snarf-documentation will fill in the right value later.
3913 For now, replace the whole list with 0. */
3916 /* We have already called Snarf-documentation, so make a relative
3917 file name for this file, so it can be found properly
3918 in the installed Lisp directory.
3919 We don't use Fexpand_file_name because that would make
3920 the directory absolute now. */
3922 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3923 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3926 else if (EQ (elt
, Vload_file_name
)
3928 && load_force_doc_strings
)
3937 invalid_syntax (") or . in a vector");
3944 XSETCDR (tail
, read0 (readcharfun
));
3946 val
= read0 (readcharfun
);
3947 read1 (readcharfun
, &ch
, 0);
3951 if (doc_reference
== 1)
3952 return make_number (0);
3953 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3956 file_offset saved_position
;
3957 /* Get a doc string from the file we are loading.
3958 If it's in saved_doc_string, get it from there.
3960 Here, we don't know if the string is a
3961 bytecode string or a doc string. As a
3962 bytecode string must be unibyte, we always
3963 return a unibyte string. If it is actually a
3964 doc string, caller must make it
3967 /* Position is negative for user variables. */
3968 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3969 if (pos
>= saved_doc_string_position
3970 && pos
< (saved_doc_string_position
3971 + saved_doc_string_length
))
3973 saved
= saved_doc_string
;
3974 saved_position
= saved_doc_string_position
;
3976 /* Look in prev_saved_doc_string the same way. */
3977 else if (pos
>= prev_saved_doc_string_position
3978 && pos
< (prev_saved_doc_string_position
3979 + prev_saved_doc_string_length
))
3981 saved
= prev_saved_doc_string
;
3982 saved_position
= prev_saved_doc_string_position
;
3986 ptrdiff_t start
= pos
- saved_position
;
3989 /* Process quoting with ^A,
3990 and find the end of the string,
3991 which is marked with ^_ (037). */
3992 for (from
= start
, to
= start
;
3993 saved
[from
] != 037;)
3995 int c
= saved
[from
++];
3999 saved
[to
++] = (c
== 1 ? c
4008 return make_unibyte_string (saved
+ start
,
4012 return get_doc_string (val
, 1, 0);
4017 invalid_syntax (". in wrong context");
4019 invalid_syntax ("] in a list");
4023 XSETCDR (tail
, tem
);
4030 static Lisp_Object initial_obarray
;
4032 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
4034 static size_t oblookup_last_bucket_number
;
4036 /* Get an error if OBARRAY is not an obarray.
4037 If it is one, return it. */
4040 check_obarray (Lisp_Object obarray
)
4042 /* We don't want to signal a wrong-type-argument error when we are
4043 shutting down due to a fatal error, and we don't want to hit
4044 assertions in VECTORP and ASIZE if the fatal error was during GC. */
4045 if (!fatal_error_in_progress
4046 && (!VECTORP (obarray
) || ASIZE (obarray
) == 0))
4048 /* If Vobarray is now invalid, force it to be valid. */
4049 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
4050 wrong_type_argument (Qvectorp
, obarray
);
4055 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
4058 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
4062 XSYMBOL (sym
)->u
.s
.interned
= (EQ (obarray
, initial_obarray
)
4063 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
4066 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
4068 make_symbol_constant (sym
);
4069 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_PLAINVAL
;
4070 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
4073 ptr
= aref_addr (obarray
, XINT (index
));
4074 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
4079 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
4082 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
4084 return intern_sym (Fmake_symbol (string
), obarray
, index
);
4087 /* Intern the C string STR: return a symbol with that name,
4088 interned in the current obarray. */
4091 intern_1 (const char *str
, ptrdiff_t len
)
4093 Lisp_Object obarray
= check_obarray (Vobarray
);
4094 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
4096 return (SYMBOLP (tem
) ? tem
4097 /* The above `oblookup' was done on the basis of nchars==nbytes, so
4098 the string has to be unibyte. */
4099 : intern_driver (make_unibyte_string (str
, len
),
4104 intern_c_string_1 (const char *str
, ptrdiff_t len
)
4106 Lisp_Object obarray
= check_obarray (Vobarray
);
4107 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
4111 /* Creating a non-pure string from a string literal not implemented yet.
4112 We could just use make_string here and live with the extra copy. */
4113 eassert (!NILP (Vpurify_flag
));
4114 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
4120 define_symbol (Lisp_Object sym
, char const *str
)
4122 ptrdiff_t len
= strlen (str
);
4123 Lisp_Object string
= make_pure_c_string (str
, len
);
4124 init_symbol (sym
, string
);
4126 /* Qunbound is uninterned, so that it's not confused with any symbol
4127 'unbound' created by a Lisp program. */
4128 if (! EQ (sym
, Qunbound
))
4130 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
4131 eassert (INTEGERP (bucket
));
4132 intern_sym (sym
, initial_obarray
, bucket
);
4136 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
4137 doc
: /* Return the canonical symbol whose name is STRING.
4138 If there is none, one is created by this function and returned.
4139 A second optional argument specifies the obarray to use;
4140 it defaults to the value of `obarray'. */)
4141 (Lisp_Object string
, Lisp_Object obarray
)
4145 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
4146 CHECK_STRING (string
);
4148 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
4150 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
4155 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
4156 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
4157 NAME may be a string or a symbol. If it is a symbol, that exact
4158 symbol is searched for.
4159 A second optional argument specifies the obarray to use;
4160 it defaults to the value of `obarray'. */)
4161 (Lisp_Object name
, Lisp_Object obarray
)
4163 register Lisp_Object tem
, string
;
4165 if (NILP (obarray
)) obarray
= Vobarray
;
4166 obarray
= check_obarray (obarray
);
4168 if (!SYMBOLP (name
))
4170 CHECK_STRING (name
);
4174 string
= SYMBOL_NAME (name
);
4176 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
4177 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
4183 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
4184 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
4185 The value is t if a symbol was found and deleted, nil otherwise.
4186 NAME may be a string or a symbol. If it is a symbol, that symbol
4187 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
4188 OBARRAY, if nil, defaults to the value of the variable `obarray'.
4189 usage: (unintern NAME OBARRAY) */)
4190 (Lisp_Object name
, Lisp_Object obarray
)
4192 register Lisp_Object string
, tem
;
4195 if (NILP (obarray
)) obarray
= Vobarray
;
4196 obarray
= check_obarray (obarray
);
4199 string
= SYMBOL_NAME (name
);
4202 CHECK_STRING (name
);
4206 tem
= oblookup (obarray
, SSDATA (string
),
4211 /* If arg was a symbol, don't delete anything but that symbol itself. */
4212 if (SYMBOLP (name
) && !EQ (name
, tem
))
4215 /* There are plenty of other symbols which will screw up the Emacs
4216 session if we unintern them, as well as even more ways to use
4217 `setq' or `fset' or whatnot to make the Emacs session
4218 unusable. Let's not go down this silly road. --Stef */
4219 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
4220 error ("Attempt to unintern t or nil"); */
4222 XSYMBOL (tem
)->u
.s
.interned
= SYMBOL_UNINTERNED
;
4224 hash
= oblookup_last_bucket_number
;
4226 if (EQ (AREF (obarray
, hash
), tem
))
4228 if (XSYMBOL (tem
)->u
.s
.next
)
4231 XSETSYMBOL (sym
, XSYMBOL (tem
)->u
.s
.next
);
4232 ASET (obarray
, hash
, sym
);
4235 ASET (obarray
, hash
, make_number (0));
4239 Lisp_Object tail
, following
;
4241 for (tail
= AREF (obarray
, hash
);
4242 XSYMBOL (tail
)->u
.s
.next
;
4245 XSETSYMBOL (following
, XSYMBOL (tail
)->u
.s
.next
);
4246 if (EQ (following
, tem
))
4248 set_symbol_next (tail
, XSYMBOL (following
)->u
.s
.next
);
4257 /* Return the symbol in OBARRAY whose names matches the string
4258 of SIZE characters (SIZE_BYTE bytes) at PTR.
4259 If there is no such symbol, return the integer bucket number of
4260 where the symbol would be if it were present.
4262 Also store the bucket number in oblookup_last_bucket_number. */
4265 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
4269 register Lisp_Object tail
;
4270 Lisp_Object bucket
, tem
;
4272 obarray
= check_obarray (obarray
);
4273 /* This is sometimes needed in the middle of GC. */
4274 obsize
= gc_asize (obarray
);
4275 hash
= hash_string (ptr
, size_byte
) % obsize
;
4276 bucket
= AREF (obarray
, hash
);
4277 oblookup_last_bucket_number
= hash
;
4278 if (EQ (bucket
, make_number (0)))
4280 else if (!SYMBOLP (bucket
))
4281 error ("Bad data in guts of obarray"); /* Like CADR error message. */
4283 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->u
.s
.next
))
4285 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
4286 && SCHARS (SYMBOL_NAME (tail
)) == size
4287 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
4289 else if (XSYMBOL (tail
)->u
.s
.next
== 0)
4292 XSETINT (tem
, hash
);
4297 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
4300 register Lisp_Object tail
;
4301 CHECK_VECTOR (obarray
);
4302 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
4304 tail
= AREF (obarray
, i
);
4309 if (XSYMBOL (tail
)->u
.s
.next
== 0)
4311 XSETSYMBOL (tail
, XSYMBOL (tail
)->u
.s
.next
);
4317 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4319 call1 (function
, sym
);
4322 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4323 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4324 OBARRAY defaults to the value of `obarray'. */)
4325 (Lisp_Object function
, Lisp_Object obarray
)
4327 if (NILP (obarray
)) obarray
= Vobarray
;
4328 obarray
= check_obarray (obarray
);
4330 map_obarray (obarray
, mapatoms_1
, function
);
4334 #define OBARRAY_SIZE 15121
4339 Vobarray
= Fmake_vector (make_number (OBARRAY_SIZE
), make_number (0));
4340 initial_obarray
= Vobarray
;
4341 staticpro (&initial_obarray
);
4343 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4344 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4346 DEFSYM (Qunbound
, "unbound");
4348 DEFSYM (Qnil
, "nil");
4349 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4350 make_symbol_constant (Qnil
);
4351 XSYMBOL (Qnil
)->u
.s
.declared_special
= true;
4354 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4355 make_symbol_constant (Qt
);
4356 XSYMBOL (Qt
)->u
.s
.declared_special
= true;
4358 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4361 DEFSYM (Qvariable_documentation
, "variable-documentation");
4365 defsubr (struct Lisp_Subr
*sname
)
4367 Lisp_Object sym
, tem
;
4368 sym
= intern_c_string (sname
->symbol_name
);
4369 XSETPVECTYPE (sname
, PVEC_SUBR
);
4370 XSETSUBR (tem
, sname
);
4371 set_symbol_function (sym
, tem
);
4374 #ifdef NOTDEF /* Use fset in subr.el now! */
4376 defalias (struct Lisp_Subr
*sname
, char *string
)
4379 sym
= intern (string
);
4380 XSETSUBR (XSYMBOL (sym
)->u
.s
.function
, sname
);
4384 /* Define an "integer variable"; a symbol whose value is forwarded to a
4385 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4386 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4388 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4389 const char *namestring
, EMACS_INT
*address
)
4392 sym
= intern_c_string (namestring
);
4393 i_fwd
->type
= Lisp_Fwd_Int
;
4394 i_fwd
->intvar
= address
;
4395 XSYMBOL (sym
)->u
.s
.declared_special
= true;
4396 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_FORWARDED
;
4397 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4400 /* Similar but define a variable whose value is t if address contains 1,
4401 nil if address contains 0. */
4403 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4404 const char *namestring
, bool *address
)
4407 sym
= intern_c_string (namestring
);
4408 b_fwd
->type
= Lisp_Fwd_Bool
;
4409 b_fwd
->boolvar
= address
;
4410 XSYMBOL (sym
)->u
.s
.declared_special
= true;
4411 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_FORWARDED
;
4412 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4413 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4416 /* Similar but define a variable whose value is the Lisp Object stored
4417 at address. Two versions: with and without gc-marking of the C
4418 variable. The nopro version is used when that variable will be
4419 gc-marked for some other reason, since marking the same slot twice
4420 can cause trouble with strings. */
4422 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4423 const char *namestring
, Lisp_Object
*address
)
4426 sym
= intern_c_string (namestring
);
4427 o_fwd
->type
= Lisp_Fwd_Obj
;
4428 o_fwd
->objvar
= address
;
4429 XSYMBOL (sym
)->u
.s
.declared_special
= true;
4430 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_FORWARDED
;
4431 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4435 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4436 const char *namestring
, Lisp_Object
*address
)
4438 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4439 staticpro (address
);
4442 /* Similar but define a variable whose value is the Lisp Object stored
4443 at a particular offset in the current kboard object. */
4446 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4447 const char *namestring
, int offset
)
4450 sym
= intern_c_string (namestring
);
4451 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4452 ko_fwd
->offset
= offset
;
4453 XSYMBOL (sym
)->u
.s
.declared_special
= true;
4454 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_FORWARDED
;
4455 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4458 /* Check that the elements of lpath exist. */
4461 load_path_check (Lisp_Object lpath
)
4463 Lisp_Object path_tail
;
4465 /* The only elements that might not exist are those from
4466 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4468 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4470 Lisp_Object dirfile
;
4471 dirfile
= Fcar (path_tail
);
4472 if (STRINGP (dirfile
))
4474 dirfile
= Fdirectory_file_name (dirfile
);
4475 if (! file_accessible_directory_p (dirfile
))
4476 dir_warning ("Lisp directory", XCAR (path_tail
));
4481 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4482 This does not include the standard site-lisp directories
4483 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4484 but it does (unless no_site_lisp is set) include site-lisp
4485 directories in the source/build directories if those exist and we
4486 are running uninstalled.
4488 Uses the following logic:
4490 If Vinstallation_directory is not nil (ie, running uninstalled),
4491 use PATH_DUMPLOADSEARCH (ie, build path). Else use PATH_LOADSEARCH.
4492 The remainder is what happens when dumping works:
4493 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4494 Otherwise use PATH_LOADSEARCH.
4496 If !initialized, then just return PATH_DUMPLOADSEARCH.
4498 If Vinstallation_directory is not nil (ie, running uninstalled):
4499 If installation-dir/lisp exists and not already a member,
4500 we must be running uninstalled. Reset the load-path
4501 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4502 refers to the eventual installation directories. Since we
4503 are not yet installed, we should not use them, even if they exist.)
4504 If installation-dir/lisp does not exist, just add
4505 PATH_DUMPLOADSEARCH at the end instead.
4506 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4507 and not already a member) at the front.
4508 If installation-dir != source-dir (ie running an uninstalled,
4509 out-of-tree build) AND install-dir/src/Makefile exists BUT
4510 install-dir/src/Makefile.in does NOT exist (this is a sanity
4511 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4514 load_path_default (void)
4516 Lisp_Object lpath
= Qnil
;
4521 const char *loadpath
= ns_load_path ();
4524 normal
= PATH_LOADSEARCH
;
4525 if (!NILP (Vinstallation_directory
)) normal
= PATH_DUMPLOADSEARCH
;
4528 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4530 lpath
= decode_env_path (0, normal
, 0);
4533 #else /* !CANNOT_DUMP */
4535 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4540 const char *loadpath
= ns_load_path ();
4541 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4543 lpath
= decode_env_path (0, normal
, 0);
4545 if (!NILP (Vinstallation_directory
))
4547 Lisp_Object tem
, tem1
;
4549 /* Add to the path the lisp subdir of the installation
4550 dir, if it is accessible. Note: in out-of-tree builds,
4551 this directory is empty save for Makefile. */
4552 tem
= Fexpand_file_name (build_string ("lisp"),
4553 Vinstallation_directory
);
4554 tem1
= Ffile_accessible_directory_p (tem
);
4557 if (NILP (Fmember (tem
, lpath
)))
4559 /* We are running uninstalled. The default load-path
4560 points to the eventual installed lisp directories.
4561 We should not use those now, even if they exist,
4562 so start over from a clean slate. */
4563 lpath
= list1 (tem
);
4567 /* That dir doesn't exist, so add the build-time
4568 Lisp dirs instead. */
4570 Lisp_Object dump_path
=
4571 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4572 lpath
= nconc2 (lpath
, dump_path
);
4575 /* Add site-lisp under the installation dir, if it exists. */
4578 tem
= Fexpand_file_name (build_string ("site-lisp"),
4579 Vinstallation_directory
);
4580 tem1
= Ffile_accessible_directory_p (tem
);
4583 if (NILP (Fmember (tem
, lpath
)))
4584 lpath
= Fcons (tem
, lpath
);
4588 /* If Emacs was not built in the source directory,
4589 and it is run from where it was built, add to load-path
4590 the lisp and site-lisp dirs under that directory. */
4592 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4596 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4597 Vinstallation_directory
);
4598 tem1
= Ffile_exists_p (tem
);
4600 /* Don't be fooled if they moved the entire source tree
4601 AFTER dumping Emacs. If the build directory is indeed
4602 different from the source dir, src/Makefile.in and
4603 src/Makefile will not be found together. */
4604 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4605 Vinstallation_directory
);
4606 tem2
= Ffile_exists_p (tem
);
4607 if (!NILP (tem1
) && NILP (tem2
))
4609 tem
= Fexpand_file_name (build_string ("lisp"),
4612 if (NILP (Fmember (tem
, lpath
)))
4613 lpath
= Fcons (tem
, lpath
);
4617 tem
= Fexpand_file_name (build_string ("site-lisp"),
4619 tem1
= Ffile_accessible_directory_p (tem
);
4622 if (NILP (Fmember (tem
, lpath
)))
4623 lpath
= Fcons (tem
, lpath
);
4627 } /* Vinstallation_directory != Vsource_directory */
4629 } /* if Vinstallation_directory */
4631 else /* !initialized */
4633 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4634 source directory. We used to add ../lisp (ie the lisp dir in
4635 the build directory) at the front here, but that should not
4636 be necessary, since in out of tree builds lisp/ is empty, save
4638 lpath
= decode_env_path (0, normal
, 0);
4640 #endif /* !CANNOT_DUMP */
4648 if (NILP (Vpurify_flag
) && !NILP (Ffboundp (Qfile_truename
)))
4649 Vsource_directory
= call1 (Qfile_truename
, Vsource_directory
);
4651 /* First, set Vload_path. */
4653 /* Ignore EMACSLOADPATH when dumping. */
4655 bool use_loadpath
= true;
4657 bool use_loadpath
= NILP (Vpurify_flag
);
4660 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4662 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4664 /* Check (non-nil) user-supplied elements. */
4665 load_path_check (Vload_path
);
4667 /* If no nils in the environment variable, use as-is.
4668 Otherwise, replace any nils with the default. */
4669 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4671 Lisp_Object elem
, elpath
= Vload_path
;
4672 Lisp_Object default_lpath
= load_path_default ();
4674 /* Check defaults, before adding site-lisp. */
4675 load_path_check (default_lpath
);
4677 /* Add the site-lisp directories to the front of the default. */
4678 if (!no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4680 Lisp_Object sitelisp
;
4681 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4682 if (! NILP (sitelisp
))
4683 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4688 /* Replace nils from EMACSLOADPATH by default. */
4689 while (CONSP (elpath
))
4691 elem
= XCAR (elpath
);
4692 elpath
= XCDR (elpath
);
4693 Vload_path
= CALLN (Fappend
, Vload_path
,
4694 NILP (elem
) ? default_lpath
: list1 (elem
));
4696 } /* Fmemq (Qnil, Vload_path) */
4700 Vload_path
= load_path_default ();
4702 /* Check before adding site-lisp directories.
4703 The install should have created them, but they are not
4704 required, so no need to warn if they are absent.
4705 Or we might be running before installation. */
4706 load_path_check (Vload_path
);
4708 /* Add the site-lisp directories at the front. */
4709 if (initialized
&& !no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4711 Lisp_Object sitelisp
;
4712 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4713 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4719 load_in_progress
= 0;
4720 Vload_file_name
= Qnil
;
4721 Vstandard_input
= Qt
;
4722 Vloads_in_progress
= Qnil
;
4725 /* Print a warning that directory intended for use USE and with name
4726 DIRNAME cannot be accessed. On entry, errno should correspond to
4727 the access failure. Print the warning on stderr and put it in
4731 dir_warning (char const *use
, Lisp_Object dirname
)
4733 static char const format
[] = "Warning: %s '%s': %s\n";
4734 char *diagnostic
= emacs_strerror (errno
);
4735 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)), diagnostic
);
4737 /* Don't log the warning before we've initialized!! */
4740 ptrdiff_t diaglen
= strlen (diagnostic
);
4741 AUTO_STRING_WITH_LEN (diag
, diagnostic
, diaglen
);
4742 if (! NILP (Vlocale_coding_system
))
4745 = code_convert_string_norecord (diag
, Vlocale_coding_system
, false);
4746 diagnostic
= SSDATA (s
);
4747 diaglen
= SBYTES (s
);
4750 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4751 + strlen (use
) + SBYTES (dirname
) + diaglen
);
4752 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4754 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4760 syms_of_lread (void)
4763 defsubr (&Sread_from_string
);
4764 defsubr (&Slread__substitute_object_in_subtree
);
4766 defsubr (&Sintern_soft
);
4767 defsubr (&Sunintern
);
4768 defsubr (&Sget_load_suffixes
);
4770 defsubr (&Seval_buffer
);
4771 defsubr (&Seval_region
);
4772 defsubr (&Sread_char
);
4773 defsubr (&Sread_char_exclusive
);
4774 defsubr (&Sread_event
);
4775 defsubr (&Sget_file_char
);
4776 defsubr (&Smapatoms
);
4777 defsubr (&Slocate_file_internal
);
4779 DEFVAR_LISP ("obarray", Vobarray
,
4780 doc
: /* Symbol table for use by `intern' and `read'.
4781 It is a vector whose length ought to be prime for best results.
4782 The vector's contents don't make sense if examined from Lisp programs;
4783 to find all the symbols in an obarray, use `mapatoms'. */);
4785 DEFVAR_LISP ("values", Vvalues
,
4786 doc
: /* List of values of all expressions which were read, evaluated and printed.
4787 Order is reverse chronological. */);
4788 XSYMBOL (intern ("values"))->u
.s
.declared_special
= false;
4790 DEFVAR_LISP ("standard-input", Vstandard_input
,
4791 doc
: /* Stream for read to get input from.
4792 See documentation of `read' for possible values. */);
4793 Vstandard_input
= Qt
;
4795 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4796 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4798 If this variable is a buffer, then only forms read from that buffer
4799 will be added to `read-symbol-positions-list'.
4800 If this variable is t, then all read forms will be added.
4801 The effect of all other values other than nil are not currently
4802 defined, although they may be in the future.
4804 The positions are relative to the last call to `read' or
4805 `read-from-string'. It is probably a bad idea to set this variable at
4806 the toplevel; bind it instead. */);
4807 Vread_with_symbol_positions
= Qnil
;
4809 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4810 doc
: /* A list mapping read symbols to their positions.
4811 This variable is modified during calls to `read' or
4812 `read-from-string', but only when `read-with-symbol-positions' is
4815 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4816 CHAR-POSITION is an integer giving the offset of that occurrence of the
4817 symbol from the position where `read' or `read-from-string' started.
4819 Note that a symbol will appear multiple times in this list, if it was
4820 read multiple times. The list is in the same order as the symbols
4822 Vread_symbol_positions_list
= Qnil
;
4824 DEFVAR_LISP ("read-circle", Vread_circle
,
4825 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4828 DEFVAR_LISP ("load-path", Vload_path
,
4829 doc
: /* List of directories to search for files to load.
4830 Each element is a string (directory file name) or nil (meaning
4831 `default-directory').
4832 This list is consulted by the `require' function.
4833 Initialized during startup as described in Info node `(elisp)Library Search'.
4834 Use `directory-file-name' when adding items to this path. However, Lisp
4835 programs that process this list should tolerate directories both with
4836 and without trailing slashes. */);
4838 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4839 doc
: /* List of suffixes for Emacs Lisp files and dynamic modules.
4840 This list includes suffixes for both compiled and source Emacs Lisp files.
4841 This list should not include the empty string.
4842 `load' and related functions try to append these suffixes, in order,
4843 to the specified file name if a suffix is allowed or required. */);
4845 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4846 build_pure_c_string (".el"),
4847 build_pure_c_string (MODULES_SUFFIX
));
4849 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4850 build_pure_c_string (".el"));
4852 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix
,
4853 doc
: /* Suffix of loadable module file, or nil if modules are not supported. */);
4855 Vmodule_file_suffix
= build_pure_c_string (MODULES_SUFFIX
);
4857 Vmodule_file_suffix
= Qnil
;
4859 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4860 doc
: /* List of suffixes that indicate representations of \
4862 This list should normally start with the empty string.
4864 Enabling Auto Compression mode appends the suffixes in
4865 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4866 mode removes them again. `load' and related functions use this list to
4867 determine whether they should look for compressed versions of a file
4868 and, if so, which suffixes they should try to append to the file name
4869 in order to do so. However, if you want to customize which suffixes
4870 the loading functions recognize as compression suffixes, you should
4871 customize `jka-compr-load-suffixes' rather than the present variable. */);
4872 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4874 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4875 doc
: /* Non-nil if inside of `load'. */);
4876 DEFSYM (Qload_in_progress
, "load-in-progress");
4878 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4879 doc
: /* An alist of functions to be evalled when particular files are loaded.
4880 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4882 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4883 a symbol (a feature name).
4885 When `load' is run and the file-name argument matches an element's
4886 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4887 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4889 An error in FORMS does not undo the load, but does prevent execution of
4890 the rest of the FORMS. */);
4891 Vafter_load_alist
= Qnil
;
4893 DEFVAR_LISP ("load-history", Vload_history
,
4894 doc
: /* Alist mapping loaded file names to symbols and features.
4895 Each alist element should be a list (FILE-NAME ENTRIES...), where
4896 FILE-NAME is the name of a file that has been loaded into Emacs.
4897 The file name is absolute and true (i.e. it doesn't contain symlinks).
4898 As an exception, one of the alist elements may have FILE-NAME nil,
4899 for symbols and features not associated with any file.
4901 The remaining ENTRIES in the alist element describe the functions and
4902 variables defined in that file, the features provided, and the
4903 features required. Each entry has the form `(provide . FEATURE)',
4904 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4905 `(defface . SYMBOL)', `(define-type . SYMBOL)',
4906 `(cl-defmethod METHOD SPECIALIZERS)', or `(t . SYMBOL)'.
4907 Entries like `(t . SYMBOL)' may precede a `(defun . FUNCTION)' entry,
4908 and means that SYMBOL was an autoload before this file redefined it
4909 as a function. In addition, entries may also be single symbols,
4910 which means that symbol was defined by `defvar' or `defconst'.
4912 During preloading, the file name recorded is relative to the main Lisp
4913 directory. These file names are converted to absolute at startup. */);
4914 Vload_history
= Qnil
;
4916 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4917 doc
: /* Full name of file being loaded by `load'. */);
4918 Vload_file_name
= Qnil
;
4920 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4921 doc
: /* File name, including directory, of user's initialization file.
4922 If the file loaded had extension `.elc', and the corresponding source file
4923 exists, this variable contains the name of source file, suitable for use
4924 by functions like `custom-save-all' which edit the init file.
4925 While Emacs loads and evaluates any init file, value is the real name
4926 of the file, regardless of whether or not it has the `.elc' extension. */);
4927 Vuser_init_file
= Qnil
;
4929 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4930 doc
: /* Used for internal purposes by `load'. */);
4931 Vcurrent_load_list
= Qnil
;
4933 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4934 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4935 Called with a single argument (the stream from which to read).
4936 The default is to use the function `read'. */);
4937 DEFSYM (Qread
, "read");
4938 Vload_read_function
= Qread
;
4940 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4941 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4942 The value should be a function for doing code conversion before
4943 reading a source file. It can also be nil, in which case loading is
4944 done without any code conversion.
4946 If the value is a function, it is called with four arguments,
4947 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4948 the file to load, FILE is the non-absolute name (for messages etc.),
4949 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4950 `load'. The function should return t if the file was loaded. */);
4951 Vload_source_file_function
= Qnil
;
4953 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4954 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4955 This is useful when the file being loaded is a temporary copy. */);
4956 load_force_doc_strings
= 0;
4958 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4959 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4960 This is normally bound by `load' and `eval-buffer' to control `read',
4961 and is not meant for users to change. */);
4962 load_convert_to_unibyte
= 0;
4964 DEFVAR_LISP ("source-directory", Vsource_directory
,
4965 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4966 You cannot count on them to still be there! */);
4968 = Fexpand_file_name (build_string ("../"),
4969 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4971 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4972 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4973 Vpreloaded_file_list
= Qnil
;
4975 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4976 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4977 Vbyte_boolean_vars
= Qnil
;
4979 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4980 doc
: /* Non-nil means load dangerous compiled Lisp files.
4981 Some versions of XEmacs use different byte codes than Emacs. These
4982 incompatible byte codes can make Emacs crash when it tries to execute
4984 load_dangerous_libraries
= 0;
4986 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4987 doc
: /* Non-nil means force printing messages when loading Lisp files.
4988 This overrides the value of the NOMESSAGE argument to `load'. */);
4989 force_load_messages
= 0;
4991 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4992 doc
: /* Regular expression matching safe to load compiled Lisp files.
4993 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4994 from the file, and matches them against this regular expression.
4995 When the regular expression matches, the file is considered to be safe
4996 to load. See also `load-dangerous-libraries'. */);
4997 Vbytecomp_version_regexp
4998 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
5000 DEFSYM (Qlexical_binding
, "lexical-binding");
5001 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
5002 doc
: /* Whether to use lexical binding when evaluating code.
5003 Non-nil means that the code in the current buffer should be evaluated
5004 with lexical binding.
5005 This variable is automatically set from the file variables of an
5006 interpreted Lisp file read using `load'. Unlike other file local
5007 variables, this must be set in the first line of a file. */);
5008 Vlexical_binding
= Qnil
;
5009 Fmake_variable_buffer_local (Qlexical_binding
);
5011 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
5012 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
5013 Veval_buffer_list
= Qnil
;
5015 DEFVAR_LISP ("lread--unescaped-character-literals",
5016 Vlread_unescaped_character_literals
,
5017 doc
: /* List of deprecated unescaped character literals encountered by `read'.
5018 For internal use only. */);
5019 Vlread_unescaped_character_literals
= Qnil
;
5020 DEFSYM (Qlread_unescaped_character_literals
,
5021 "lread--unescaped-character-literals");
5024 DEFSYM (Qchar
, "char");
5025 DEFSYM (Qformat
, "format");
5027 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
5028 doc
: /* Non-nil means `load' prefers the newest version of a file.
5029 This applies when a filename suffix is not explicitly specified and
5030 `load' is trying various possible suffixes (see `load-suffixes' and
5031 `load-file-rep-suffixes'). Normally, it stops at the first file
5032 that exists unless you explicitly specify one or the other. If this
5033 option is non-nil, it checks all suffixes and uses whichever file is
5035 Note that if you customize this, obviously it will not affect files
5036 that are loaded before your customizations are read! */);
5037 load_prefer_newer
= 0;
5039 DEFVAR_BOOL ("force-new-style-backquotes", force_new_style_backquotes
,
5040 doc
: /* Non-nil means to always use the current syntax for backquotes.
5041 If nil, `load' and `read' raise errors when encountering some
5042 old-style variants of backquote and comma. If non-nil, these
5043 constructs are always interpreted as described in the Info node
5044 `(elisp)Backquotes', even if that interpretation is incompatible with
5045 previous versions of Emacs. Setting this variable to non-nil makes
5046 Emacs compatible with the behavior planned for Emacs 28. In Emacs 28,
5047 this variable will become obsolete. */);
5048 force_new_style_backquotes
= false;
5050 /* Vsource_directory was initialized in init_lread. */
5052 DEFSYM (Qcurrent_load_list
, "current-load-list");
5053 DEFSYM (Qstandard_input
, "standard-input");
5054 DEFSYM (Qread_char
, "read-char");
5055 DEFSYM (Qget_file_char
, "get-file-char");
5057 /* Used instead of Qget_file_char while loading *.elc files compiled
5058 by Emacs 21 or older. */
5059 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
5061 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
5063 DEFSYM (Qbackquote
, "`");
5064 DEFSYM (Qcomma
, ",");
5065 DEFSYM (Qcomma_at
, ",@");
5066 DEFSYM (Qcomma_dot
, ",.");
5068 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
5069 DEFSYM (Qascii_character
, "ascii-character");
5070 DEFSYM (Qfunction
, "function");
5071 DEFSYM (Qload
, "load");
5072 DEFSYM (Qload_file_name
, "load-file-name");
5073 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
5074 DEFSYM (Qfile_truename
, "file-truename");
5075 DEFSYM (Qdir_ok
, "dir-ok");
5076 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
5078 staticpro (&read_objects_map
);
5079 read_objects_map
= Qnil
;
5080 staticpro (&read_objects_completed
);
5081 read_objects_completed
= Qnil
;
5083 Vloads_in_progress
= Qnil
;
5084 staticpro (&Vloads_in_progress
);
5086 DEFSYM (Qhash_table
, "hash-table");
5087 DEFSYM (Qdata
, "data");
5088 DEFSYM (Qtest
, "test");
5089 DEFSYM (Qsize
, "size");
5090 DEFSYM (Qpurecopy
, "purecopy");
5091 DEFSYM (Qweakness
, "weakness");
5092 DEFSYM (Qrehash_size
, "rehash-size");
5093 DEFSYM (Qrehash_threshold
, "rehash-threshold");
5095 DEFSYM (Qchar_from_name
, "char-from-name");