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 /* Functions that read one byte from the current source READCHARFUN
169 or unreads one byte. If the integer argument C is -1, it returns
170 one read byte, or -1 when there's no more byte in the source. If C
171 is 0 or positive, it unreads C, and the return value is not
174 static int readbyte_for_lambda (int, Lisp_Object
);
175 static int readbyte_from_file (int, Lisp_Object
);
176 static int readbyte_from_string (int, Lisp_Object
);
178 /* Handle unreading and rereading of characters.
179 Write READCHAR to read a character,
180 UNREAD(c) to unread c to be read again.
182 These macros correctly read/unread multibyte characters. */
184 #define READCHAR readchar (readcharfun, NULL)
185 #define UNREAD(c) unreadchar (readcharfun, c)
187 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
188 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
190 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
191 Qlambda, or a cons, we use this to keep an unread character because
192 a file stream can't handle multibyte-char unreading. The value -1
193 means that there's no unread character. */
194 static int unread_char
;
197 readchar (Lisp_Object readcharfun
, bool *multibyte
)
201 int (*readbyte
) (int, Lisp_Object
);
202 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
204 bool emacs_mule_encoding
= 0;
211 if (BUFFERP (readcharfun
))
213 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
215 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
217 if (! BUFFER_LIVE_P (inbuffer
))
220 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
223 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
225 /* Fetch the character code from the buffer. */
226 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
227 BUF_INC_POS (inbuffer
, pt_byte
);
234 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
235 if (! ASCII_CHAR_P (c
))
236 c
= BYTE8_TO_CHAR (c
);
239 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
243 if (MARKERP (readcharfun
))
245 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
247 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
249 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
252 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
254 /* Fetch the character code from the buffer. */
255 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
256 BUF_INC_POS (inbuffer
, bytepos
);
263 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
264 if (! ASCII_CHAR_P (c
))
265 c
= BYTE8_TO_CHAR (c
);
269 XMARKER (readcharfun
)->bytepos
= bytepos
;
270 XMARKER (readcharfun
)->charpos
++;
275 if (EQ (readcharfun
, Qlambda
))
277 readbyte
= readbyte_for_lambda
;
281 if (EQ (readcharfun
, Qget_file_char
))
283 readbyte
= readbyte_from_file
;
287 if (STRINGP (readcharfun
))
289 if (read_from_string_index
>= read_from_string_limit
)
291 else if (STRING_MULTIBYTE (readcharfun
))
295 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
296 read_from_string_index
,
297 read_from_string_index_byte
);
301 c
= SREF (readcharfun
, read_from_string_index_byte
);
302 read_from_string_index
++;
303 read_from_string_index_byte
++;
308 if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
310 /* This is the case that read_vector is reading from a unibyte
311 string that contains a byte sequence previously skipped
312 because of #@NUMBER. The car part of readcharfun is that
313 string, and the cdr part is a value of readcharfun given to
315 readbyte
= readbyte_from_string
;
316 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
317 emacs_mule_encoding
= 1;
321 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
323 readbyte
= readbyte_from_file
;
324 emacs_mule_encoding
= 1;
328 tem
= call0 (readcharfun
);
335 if (unread_char
>= 0)
341 c
= (*readbyte
) (-1, readcharfun
);
346 if (ASCII_CHAR_P (c
))
348 if (emacs_mule_encoding
)
349 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
352 len
= BYTES_BY_CHAR_HEAD (c
);
355 buf
[i
++] = c
= (*readbyte
) (-1, readcharfun
);
356 if (c
< 0 || ! TRAILING_CODE_P (c
))
358 for (i
-= c
< 0; 0 < --i
; )
359 (*readbyte
) (buf
[i
], readcharfun
);
360 return BYTE8_TO_CHAR (buf
[0]);
363 return STRING_CHAR (buf
);
366 #define FROM_FILE_P(readcharfun) \
367 (EQ (readcharfun, Qget_file_char) \
368 || EQ (readcharfun, Qget_emacs_mule_file_char))
371 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
373 if (FROM_FILE_P (readcharfun
))
375 block_input (); /* FIXME: Not sure if it's needed. */
376 fseek (infile
->stream
, n
- infile
->lookahead
, SEEK_CUR
);
378 infile
->lookahead
= 0;
381 { /* We're not reading directly from a file. In that case, it's difficult
382 to reliably count bytes, since these are usually meant for the file's
383 encoding, whereas we're now typically in the internal encoding.
384 But luckily, skip_dyn_bytes is used to skip over a single
385 dynamic-docstring (or dynamic byte-code) which is always quoted such
386 that \037 is the final char. */
390 } while (c
>= 0 && c
!= '\037');
395 skip_dyn_eof (Lisp_Object readcharfun
)
397 if (FROM_FILE_P (readcharfun
))
399 block_input (); /* FIXME: Not sure if it's needed. */
400 fseek (infile
->stream
, 0, SEEK_END
);
402 infile
->lookahead
= 0;
405 while (READCHAR
>= 0);
408 /* Unread the character C in the way appropriate for the stream READCHARFUN.
409 If the stream is a user function, call it with the char as argument. */
412 unreadchar (Lisp_Object readcharfun
, int c
)
416 /* Don't back up the pointer if we're unreading the end-of-input mark,
417 since readchar didn't advance it when we read it. */
419 else if (BUFFERP (readcharfun
))
421 struct buffer
*b
= XBUFFER (readcharfun
);
422 ptrdiff_t charpos
= BUF_PT (b
);
423 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
425 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
426 BUF_DEC_POS (b
, bytepos
);
430 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
432 else if (MARKERP (readcharfun
))
434 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
435 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
437 XMARKER (readcharfun
)->charpos
--;
438 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
439 BUF_DEC_POS (b
, bytepos
);
443 XMARKER (readcharfun
)->bytepos
= bytepos
;
445 else if (STRINGP (readcharfun
))
447 read_from_string_index
--;
448 read_from_string_index_byte
449 = string_char_to_byte (readcharfun
, read_from_string_index
);
451 else if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
455 else if (EQ (readcharfun
, Qlambda
))
459 else if (FROM_FILE_P (readcharfun
))
464 call1 (readcharfun
, make_number (c
));
468 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
470 return read_bytecode_char (c
>= 0);
475 readbyte_from_stdio (void)
477 if (infile
->lookahead
)
478 return infile
->buf
[--infile
->lookahead
];
481 FILE *instream
= infile
->stream
;
485 /* Interrupted reads have been observed while reading over the network. */
486 while ((c
= getc_unlocked (instream
)) == EOF
&& errno
== EINTR
487 && ferror_unlocked (instream
))
492 clearerr_unlocked (instream
);
497 return (c
== EOF
? -1 : c
);
501 readbyte_from_file (int c
, Lisp_Object readcharfun
)
505 eassert (infile
->lookahead
< sizeof infile
->buf
);
506 infile
->buf
[infile
->lookahead
++] = c
;
510 return readbyte_from_stdio ();
514 readbyte_from_string (int c
, Lisp_Object readcharfun
)
516 Lisp_Object string
= XCAR (readcharfun
);
520 read_from_string_index
--;
521 read_from_string_index_byte
522 = string_char_to_byte (string
, read_from_string_index
);
525 if (read_from_string_index
>= read_from_string_limit
)
528 FETCH_STRING_CHAR_ADVANCE (c
, string
,
529 read_from_string_index
,
530 read_from_string_index_byte
);
535 /* Read one non-ASCII character from INFILE. The character is
536 encoded in `emacs-mule' and the first byte is already read in
540 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
542 /* Emacs-mule coding uses at most 4-byte for one character. */
543 unsigned char buf
[4];
544 int len
= emacs_mule_bytes
[c
];
545 struct charset
*charset
;
550 /* C is not a valid leading-code of `emacs-mule'. */
551 return BYTE8_TO_CHAR (c
);
557 buf
[i
++] = c
= (*readbyte
) (-1, readcharfun
);
560 for (i
-= c
< 0; 0 < --i
; )
561 (*readbyte
) (buf
[i
], readcharfun
);
562 return BYTE8_TO_CHAR (buf
[0]);
568 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
569 code
= buf
[1] & 0x7F;
573 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
574 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
576 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
577 code
= buf
[2] & 0x7F;
581 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
582 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
587 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
588 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
590 c
= DECODE_CHAR (charset
, code
);
592 Fsignal (Qinvalid_read_syntax
,
593 list1 (build_string ("invalid multibyte form")));
598 /* An in-progress substitution of OBJECT for PLACEHOLDER. */
602 Lisp_Object placeholder
;
604 /* Hash table of subobjects of OBJECT that might be circular. If
605 Qt, all such objects might be circular. */
606 Lisp_Object completed
;
608 /* List of subobjects of OBJECT that have already been visited. */
612 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
614 static Lisp_Object
read0 (Lisp_Object
);
615 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
617 static Lisp_Object
read_list (bool, Lisp_Object
);
618 static Lisp_Object
read_vector (Lisp_Object
, bool);
620 static Lisp_Object
substitute_object_recurse (struct subst
*, Lisp_Object
);
621 static void substitute_in_interval (INTERVAL
, void *);
624 /* Get a character from the tty. */
626 /* Read input events until we get one that's acceptable for our purposes.
628 If NO_SWITCH_FRAME, switch-frame events are stashed
629 until we get a character we like, and then stuffed into
632 If ASCII_REQUIRED, check function key events to see
633 if the unmodified version of the symbol has a Qascii_character
634 property, and use that character, if present.
636 If ERROR_NONASCII, signal an error if the input we
637 get isn't an ASCII character with modifiers. If it's false but
638 ASCII_REQUIRED is true, just re-read until we get an ASCII
641 If INPUT_METHOD, invoke the current input method
642 if the character warrants that.
644 If SECONDS is a number, wait that many seconds for input, and
645 return Qnil if no input arrives within that time. */
648 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
649 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
651 Lisp_Object val
, delayed_switch_frame
;
652 struct timespec end_time
;
654 #ifdef HAVE_WINDOW_SYSTEM
655 if (display_hourglass_p
)
659 delayed_switch_frame
= Qnil
;
661 /* Compute timeout. */
662 if (NUMBERP (seconds
))
664 double duration
= XFLOATINT (seconds
);
665 struct timespec wait_time
= dtotimespec (duration
);
666 end_time
= timespec_add (current_timespec (), wait_time
);
669 /* Read until we get an acceptable event. */
672 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
673 NUMBERP (seconds
) ? &end_time
: NULL
);
674 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
679 /* `switch-frame' events are put off until after the next ASCII
680 character. This is better than signaling an error just because
681 the last characters were typed to a separate minibuffer frame,
682 for example. Eventually, some code which can deal with
683 switch-frame events will read it and process it. */
685 && EVENT_HAS_PARAMETERS (val
)
686 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
688 delayed_switch_frame
= val
;
692 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
694 /* Convert certain symbols to their ASCII equivalents. */
697 Lisp_Object tem
, tem1
;
698 tem
= Fget (val
, Qevent_symbol_element_mask
);
701 tem1
= Fget (Fcar (tem
), Qascii_character
);
702 /* Merge this symbol's modifier bits
703 with the ASCII equivalent of its basic code. */
705 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
709 /* If we don't have a character now, deal with it appropriately. */
714 Vunread_command_events
= list1 (val
);
715 error ("Non-character input-event");
722 if (! NILP (delayed_switch_frame
))
723 unread_switch_frame
= delayed_switch_frame
;
727 #ifdef HAVE_WINDOW_SYSTEM
728 if (display_hourglass_p
)
737 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
738 doc
: /* Read a character from the command input (keyboard or macro).
739 It is returned as a number.
740 If the character has modifiers, they are resolved and reflected to the
741 character code if possible (e.g. C-SPC -> 0).
743 If the user generates an event which is not a character (i.e. a mouse
744 click or function key event), `read-char' signals an error. As an
745 exception, switch-frame events are put off until non-character events
747 If you want to read non-character events, or ignore them, call
748 `read-event' or `read-char-exclusive' instead.
750 If the optional argument PROMPT is non-nil, display that as a prompt.
751 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
752 input method is turned on in the current buffer, that input method
753 is used for reading a character.
754 If the optional argument SECONDS is non-nil, it should be a number
755 specifying the maximum number of seconds to wait for input. If no
756 input arrives in that time, return nil. SECONDS may be a
757 floating-point value. */)
758 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
763 message_with_string ("%s", prompt
, 0);
764 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
766 return (NILP (val
) ? Qnil
767 : make_number (char_resolve_modifier_mask (XINT (val
))));
770 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
771 doc
: /* Read an event object from the input stream.
772 If the optional argument PROMPT is non-nil, display that as a prompt.
773 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
774 input method is turned on in the current buffer, that input method
775 is used for reading a character.
776 If the optional argument SECONDS is non-nil, it should be a number
777 specifying the maximum number of seconds to wait for input. If no
778 input arrives in that time, return nil. SECONDS may be a
779 floating-point value. */)
780 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
783 message_with_string ("%s", prompt
, 0);
784 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
787 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
788 doc
: /* Read a character from the command input (keyboard or macro).
789 It is returned as a number. Non-character events are ignored.
790 If the character has modifiers, they are resolved and reflected to the
791 character code if possible (e.g. C-SPC -> 0).
793 If the optional argument PROMPT is non-nil, display that as a prompt.
794 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
795 input method is turned on in the current buffer, that input method
796 is used for reading a character.
797 If the optional argument SECONDS is non-nil, it should be a number
798 specifying the maximum number of seconds to wait for input. If no
799 input arrives in that time, return nil. SECONDS may be a
800 floating-point value. */)
801 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
806 message_with_string ("%s", prompt
, 0);
808 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
810 return (NILP (val
) ? Qnil
811 : make_number (char_resolve_modifier_mask (XINT (val
))));
814 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
815 doc
: /* Don't use this yourself. */)
819 error ("get-file-char misused");
820 return make_number (readbyte_from_stdio ());
826 /* Return true if the lisp code read using READCHARFUN defines a non-nil
827 `lexical-binding' file variable. After returning, the stream is
828 positioned following the first line, if it is a comment or #! line,
829 otherwise nothing is read. */
832 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
845 while (ch
!= '\n' && ch
!= EOF
)
847 if (ch
== '\n') ch
= READCHAR
;
848 /* It is OK to leave the position after a #! line, since
849 that is what read1 does. */
853 /* The first line isn't a comment, just give up. */
859 /* Look for an appropriate file-variable in the first line. */
863 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
864 } beg_end_state
= NOMINAL
;
865 bool in_file_vars
= 0;
867 #define UPDATE_BEG_END_STATE(ch) \
868 if (beg_end_state == NOMINAL) \
869 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
870 else if (beg_end_state == AFTER_FIRST_DASH) \
871 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
872 else if (beg_end_state == AFTER_ASTERIX) \
875 in_file_vars = !in_file_vars; \
876 beg_end_state = NOMINAL; \
879 /* Skip until we get to the file vars, if any. */
883 UPDATE_BEG_END_STATE (ch
);
885 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
889 char var
[100], val
[100];
894 /* Read a variable name. */
895 while (ch
== ' ' || ch
== '\t')
899 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
901 if (i
< sizeof var
- 1)
903 UPDATE_BEG_END_STATE (ch
);
907 /* Stop scanning if no colon was found before end marker. */
908 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
911 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
917 /* Read a variable value. */
920 while (ch
== ' ' || ch
== '\t')
924 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
926 if (i
< sizeof val
- 1)
928 UPDATE_BEG_END_STATE (ch
);
932 /* The value was terminated by an end-marker, which remove. */
934 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
938 if (strcmp (var
, "lexical-binding") == 0)
941 rv
= (strcmp (val
, "nil") != 0);
947 while (ch
!= '\n' && ch
!= EOF
)
954 /* Value is a version number of byte compiled code if the file
955 associated with file descriptor FD is a compiled Lisp file that's
956 safe to load. Only files compiled with Emacs are safe to load.
957 Files compiled with XEmacs can lead to a crash in Fbyte_code
958 because of an incompatible change in the byte compiler. */
961 safe_to_load_version (int fd
)
967 /* Read the first few bytes from the file, and look for a line
968 specifying the byte compiler version used. */
969 nbytes
= emacs_read_quit (fd
, buf
, sizeof buf
);
972 /* Skip to the next newline, skipping over the initial `ELC'
973 with NUL bytes following it, but note the version. */
974 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
979 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
980 buf
+ i
, nbytes
- i
) < 0)
984 lseek (fd
, 0, SEEK_SET
);
989 /* Callback for record_unwind_protect. Restore the old load list OLD,
990 after loading a file successfully. */
993 record_load_unwind (Lisp_Object old
)
995 Vloads_in_progress
= old
;
998 /* This handler function is used via internal_condition_case_1. */
1001 load_error_handler (Lisp_Object data
)
1006 static _Noreturn
void
1007 load_error_old_style_backquotes (void)
1009 if (NILP (Vload_file_name
))
1010 xsignal1 (Qerror
, build_string ("Old-style backquotes detected!"));
1013 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
1014 xsignal1 (Qerror
, CALLN (Fformat_message
, format
, Vload_file_name
));
1019 load_warn_unescaped_character_literals (Lisp_Object file
)
1021 if (NILP (Vlread_unescaped_character_literals
)) return;
1022 CHECK_CONS (Vlread_unescaped_character_literals
);
1023 Lisp_Object format
=
1024 build_string ("Loading `%s': unescaped character literals %s detected!");
1025 Lisp_Object separator
= build_string (", ");
1026 Lisp_Object inner_format
= build_string ("`?%c'");
1029 Fmapconcat (list3 (Qlambda
, list1 (Qchar
),
1030 list3 (Qformat
, inner_format
, Qchar
)),
1031 Fsort (Vlread_unescaped_character_literals
, Qlss
),
1035 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
1036 doc
: /* Return the suffixes that `load' should try if a suffix is \
1038 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
1041 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
1042 while (CONSP (suffixes
))
1044 Lisp_Object exts
= Vload_file_rep_suffixes
;
1045 suffix
= XCAR (suffixes
);
1046 suffixes
= XCDR (suffixes
);
1047 while (CONSP (exts
))
1051 lst
= Fcons (concat2 (suffix
, ext
), lst
);
1054 return Fnreverse (lst
);
1057 /* Returns true if STRING ends with SUFFIX */
1059 suffix_p (Lisp_Object string
, const char *suffix
)
1061 ptrdiff_t suffix_len
= strlen (suffix
);
1062 ptrdiff_t string_len
= SBYTES (string
);
1064 return string_len
>= suffix_len
&& !strcmp (SSDATA (string
) + string_len
- suffix_len
, suffix
);
1068 close_infile_unwind (void *arg
)
1071 eassert (infile
== NULL
|| infile
->stream
== stream
);
1076 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1077 doc
: /* Execute a file of Lisp code named FILE.
1078 First try FILE with `.elc' appended, then try with `.el', then try
1079 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
1080 then try FILE unmodified (the exact suffixes in the exact order are
1081 determined by `load-suffixes'). Environment variable references in
1082 FILE are replaced with their values by calling `substitute-in-file-name'.
1083 This function searches the directories in `load-path'.
1085 If optional second arg NOERROR is non-nil,
1086 report no error if FILE doesn't exist.
1087 Print messages at start and end of loading unless
1088 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1090 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1091 suffixes to the specified name FILE.
1092 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1093 the suffix `.elc' or `.el' or the module suffix; don't accept just
1094 FILE unless it ends in one of those suffixes or includes a directory name.
1096 If NOSUFFIX is nil, then if a file could not be found, try looking for
1097 a different representation of the file by adding non-empty suffixes to
1098 its name, before trying another file. Emacs uses this feature to find
1099 compressed versions of files when Auto Compression mode is enabled.
1100 If NOSUFFIX is non-nil, disable this feature.
1102 The suffixes that this function tries out, when NOSUFFIX is nil, are
1103 given by the return value of `get-load-suffixes' and the values listed
1104 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1105 return value of `get-load-suffixes' is used, i.e. the file name is
1106 required to have a non-empty suffix.
1108 When searching suffixes, this function normally stops at the first
1109 one that exists. If the option `load-prefer-newer' is non-nil,
1110 however, it tries all suffixes, and uses whichever file is the newest.
1112 Loading a file records its definitions, and its `provide' and
1113 `require' calls, in an element of `load-history' whose
1114 car is the file name loaded. See `load-history'.
1116 While the file is in the process of being loaded, the variable
1117 `load-in-progress' is non-nil and the variable `load-file-name'
1118 is bound to the file's name.
1120 Return t if the file exists and loads successfully. */)
1121 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1122 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1126 int fd_index UNINIT
;
1127 ptrdiff_t count
= SPECPDL_INDEX ();
1128 Lisp_Object found
, efound
, hist_file_name
;
1129 /* True means we printed the ".el is newer" message. */
1131 /* True means we are loading a compiled file. */
1133 Lisp_Object handler
;
1135 const char *fmode
= "r" FOPEN_TEXT
;
1138 CHECK_STRING (file
);
1140 /* If file name is magic, call the handler. */
1141 /* This shouldn't be necessary any more now that `openp' handles it right.
1142 handler = Ffind_file_name_handler (file, Qload);
1143 if (!NILP (handler))
1144 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1146 /* The presence of this call is the result of a historical accident:
1147 it used to be in every file-operation and when it got removed
1148 everywhere, it accidentally stayed here. Since then, enough people
1149 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1150 that it seemed risky to remove. */
1151 if (! NILP (noerror
))
1153 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1154 Qt
, load_error_handler
);
1159 file
= Fsubstitute_in_file_name (file
);
1161 /* Avoid weird lossage with null string as arg,
1162 since it would try to load a directory as a Lisp file. */
1163 if (SCHARS (file
) == 0)
1170 Lisp_Object suffixes
;
1173 if (! NILP (must_suffix
))
1175 /* Don't insist on adding a suffix if FILE already ends with one. */
1176 if (suffix_p (file
, ".el")
1177 || suffix_p (file
, ".elc")
1179 || suffix_p (file
, MODULES_SUFFIX
)
1183 /* Don't insist on adding a suffix
1184 if the argument includes a directory name. */
1185 else if (! NILP (Ffile_name_directory (file
)))
1189 if (!NILP (nosuffix
))
1193 suffixes
= Fget_load_suffixes ();
1194 if (NILP (must_suffix
))
1195 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1198 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1204 report_file_error ("Cannot open load file", file
);
1208 /* Tell startup.el whether or not we found the user's init file. */
1209 if (EQ (Qt
, Vuser_init_file
))
1210 Vuser_init_file
= found
;
1212 /* If FD is -2, that means openp found a magic file. */
1215 if (NILP (Fequal (found
, file
)))
1216 /* If FOUND is a different file name from FILE,
1217 find its handler even if we have already inhibited
1218 the `load' operation on FILE. */
1219 handler
= Ffind_file_name_handler (found
, Qt
);
1221 handler
= Ffind_file_name_handler (found
, Qload
);
1222 if (! NILP (handler
))
1223 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1225 /* Tramp has to deal with semi-broken packages that prepend
1226 drive letters to remote files. For that reason, Tramp
1227 catches file operations that test for file existence, which
1228 makes openp think X:/foo.elc files are remote. However,
1229 Tramp does not catch `load' operations for such files, so we
1230 end up with a nil as the `load' handler above. If we would
1231 continue with fd = -2, we will behave wrongly, and in
1232 particular try reading a .elc file in the "rt" mode instead
1233 of "rb". See bug #9311 for the results. To work around
1234 this, we try to open the file locally, and go with that if it
1236 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1244 fd_index
= SPECPDL_INDEX ();
1245 record_unwind_protect_int (close_file_unwind
, fd
);
1249 if (suffix_p (found
, MODULES_SUFFIX
))
1250 return unbind_to (count
, Fmodule_load (found
));
1253 /* Check if we're stuck in a recursive load cycle.
1255 2000-09-21: It's not possible to just check for the file loaded
1256 being a member of Vloads_in_progress. This fails because of the
1257 way the byte compiler currently works; `provide's are not
1258 evaluated, see font-lock.el/jit-lock.el as an example. This
1259 leads to a certain amount of ``normal'' recursion.
1261 Also, just loading a file recursively is not always an error in
1262 the general case; the second load may do something different. */
1266 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1267 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1268 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1269 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1270 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1273 /* All loads are by default dynamic, unless the file itself specifies
1274 otherwise using a file-variable in the first line. This is bound here
1275 so that it takes effect whether or not we use
1276 Vload_source_file_function. */
1277 specbind (Qlexical_binding
, Qnil
);
1279 /* Get the name for load-history. */
1280 hist_file_name
= (! NILP (Vpurify_flag
)
1281 ? concat2 (Ffile_name_directory (file
),
1282 Ffile_name_nondirectory (found
))
1287 /* Check for the presence of unescaped character literals and warn
1289 specbind (Qlread_unescaped_character_literals
, Qnil
);
1290 record_unwind_protect (load_warn_unescaped_character_literals
, file
);
1293 if ((is_elc
= suffix_p (found
, ".elc")) != 0
1294 /* version = 1 means the file is empty, in which case we can
1295 treat it as not byte-compiled. */
1296 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 1))
1297 /* Load .elc files directly, but not when they are
1298 remote and have no handler! */
1306 && ! (version
= safe_to_load_version (fd
)))
1309 if (!load_dangerous_libraries
)
1310 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1311 else if (!NILP (nomessage
) && !force_load_messages
)
1312 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1317 efound
= ENCODE_FILE (found
);
1318 fmode
= "r" FOPEN_BINARY
;
1320 /* openp already checked for newness, no point doing it again.
1321 FIXME would be nice to get a message when openp
1322 ignores suffix order due to load_prefer_newer. */
1323 if (!load_prefer_newer
&& is_elc
)
1325 result
= stat (SSDATA (efound
), &s1
);
1328 SSET (efound
, SBYTES (efound
) - 1, 0);
1329 result
= stat (SSDATA (efound
), &s2
);
1330 SSET (efound
, SBYTES (efound
) - 1, 'c');
1334 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1336 /* Make the progress messages mention that source is newer. */
1339 /* If we won't print another message, mention this anyway. */
1340 if (!NILP (nomessage
) && !force_load_messages
)
1342 Lisp_Object msg_file
;
1343 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1344 message_with_string ("Source file `%s' newer than byte-compiled file",
1348 } /* !load_prefer_newer */
1353 /* We are loading a source file (*.el). */
1354 if (!NILP (Vload_source_file_function
))
1361 clear_unwind_protect (fd_index
);
1363 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1364 NILP (noerror
) ? Qnil
: Qt
,
1365 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1366 return unbind_to (count
, val
);
1372 /* We somehow got here with fd == -2, meaning the file is deemed
1373 to be remote. Don't even try to reopen the file locally;
1374 just force a failure. */
1382 clear_unwind_protect (fd_index
);
1383 efound
= ENCODE_FILE (found
);
1384 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1386 stream
= fdopen (fd
, fmode
);
1390 report_file_error ("Opening stdio stream", file
);
1391 set_unwind_protect_ptr (fd_index
, close_infile_unwind
, stream
);
1393 if (! NILP (Vpurify_flag
))
1394 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1396 if (NILP (nomessage
) || force_load_messages
)
1399 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1402 message_with_string ("Loading %s (source)...", file
, 1);
1404 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1406 else /* The typical case; compiled file newer than source file. */
1407 message_with_string ("Loading %s...", file
, 1);
1410 specbind (Qload_file_name
, found
);
1411 specbind (Qinhibit_file_name_operation
, Qnil
);
1412 specbind (Qload_in_progress
, Qt
);
1414 struct infile input
;
1415 input
.stream
= stream
;
1416 input
.lookahead
= 0;
1419 if (lisp_file_lexically_bound_p (Qget_file_char
))
1420 Fset (Qlexical_binding
, Qt
);
1422 if (! version
|| version
>= 22)
1423 readevalloop (Qget_file_char
, &input
, hist_file_name
,
1424 0, Qnil
, Qnil
, Qnil
, Qnil
);
1427 /* We can't handle a file which was compiled with
1428 byte-compile-dynamic by older version of Emacs. */
1429 specbind (Qload_force_doc_strings
, Qt
);
1430 readevalloop (Qget_emacs_mule_file_char
, &input
, hist_file_name
,
1431 0, Qnil
, Qnil
, Qnil
, Qnil
);
1433 unbind_to (count
, Qnil
);
1435 /* Run any eval-after-load forms for this file. */
1436 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1437 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1439 xfree (saved_doc_string
);
1440 saved_doc_string
= 0;
1441 saved_doc_string_size
= 0;
1443 xfree (prev_saved_doc_string
);
1444 prev_saved_doc_string
= 0;
1445 prev_saved_doc_string_size
= 0;
1447 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1450 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1453 message_with_string ("Loading %s (source)...done", file
, 1);
1455 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1457 else /* The typical case; compiled file newer than source file. */
1458 message_with_string ("Loading %s...done", file
, 1);
1465 complete_filename_p (Lisp_Object pathname
)
1467 const unsigned char *s
= SDATA (pathname
);
1468 return (IS_DIRECTORY_SEP (s
[0])
1469 || (SCHARS (pathname
) > 2
1470 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1473 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1474 doc
: /* Search for FILENAME through PATH.
1475 Returns the file's name in absolute form, or nil if not found.
1476 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1477 file name when searching.
1478 If non-nil, PREDICATE is used instead of `file-readable-p'.
1479 PREDICATE can also be an integer to pass to the faccessat(2) function,
1480 in which case file-name-handlers are ignored.
1481 This function will normally skip directories, so if you want it to find
1482 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1483 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1486 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1487 if (NILP (predicate
) && fd
>= 0)
1492 /* Search for a file whose name is STR, looking in directories
1493 in the Lisp list PATH, and trying suffixes from SUFFIX.
1494 On success, return a file descriptor (or 1 or -2 as described below).
1495 On failure, return -1 and set errno.
1497 SUFFIXES is a list of strings containing possible suffixes.
1498 The empty suffix is automatically added if the list is empty.
1500 PREDICATE t means the files are binary.
1501 PREDICATE non-nil and non-t means don't open the files,
1502 just look for one that satisfies the predicate. In this case,
1503 return -2 on success. The predicate can be a lisp function or
1504 an integer to pass to `access' (in which case file-name-handlers
1507 If STOREPTR is nonzero, it points to a slot where the name of
1508 the file actually found should be stored as a Lisp string.
1509 nil is stored there on failure.
1511 If the file we find is remote, return -2
1512 but store the found remote file name in *STOREPTR.
1514 If NEWER is true, try all SUFFIXes and return the result for the
1515 newest file that exists. Does not apply to remote files,
1516 or if a non-nil and non-t PREDICATE is specified. */
1519 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1520 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1522 ptrdiff_t fn_size
= 100;
1526 ptrdiff_t want_length
;
1527 Lisp_Object filename
;
1528 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1529 ptrdiff_t max_suffix_len
= 0;
1530 int last_errno
= ENOENT
;
1534 /* The last-modified time of the newest matching file found.
1535 Initialize it to something less than all valid timestamps. */
1536 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1540 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1542 CHECK_STRING_CAR (tail
);
1543 max_suffix_len
= max (max_suffix_len
,
1544 SBYTES (XCAR (tail
)));
1547 string
= filename
= encoded_fn
= save_string
= Qnil
;
1552 absolute
= complete_filename_p (str
);
1554 for (; CONSP (path
); path
= XCDR (path
))
1556 ptrdiff_t baselen
, prefixlen
;
1558 filename
= Fexpand_file_name (str
, XCAR (path
));
1559 if (!complete_filename_p (filename
))
1560 /* If there are non-absolute elts in PATH (eg "."). */
1561 /* Of course, this could conceivably lose if luser sets
1562 default-directory to be something non-absolute... */
1564 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1565 if (!complete_filename_p (filename
))
1566 /* Give up on this path element! */
1570 /* Calculate maximum length of any filename made from
1571 this path element/specified file name and any possible suffix. */
1572 want_length
= max_suffix_len
+ SBYTES (filename
);
1573 if (fn_size
<= want_length
)
1575 fn_size
= 100 + want_length
;
1576 fn
= SAFE_ALLOCA (fn_size
);
1579 /* Copy FILENAME's data to FN but remove starting /: if any. */
1580 prefixlen
= ((SCHARS (filename
) > 2
1581 && SREF (filename
, 0) == '/'
1582 && SREF (filename
, 1) == ':')
1584 baselen
= SBYTES (filename
) - prefixlen
;
1585 memcpy (fn
, SDATA (filename
) + prefixlen
, baselen
);
1587 /* Loop over suffixes. */
1588 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1589 CONSP (tail
); tail
= XCDR (tail
))
1591 Lisp_Object suffix
= XCAR (tail
);
1592 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1593 Lisp_Object handler
;
1595 /* Make complete filename by appending SUFFIX. */
1596 memcpy (fn
+ baselen
, SDATA (suffix
), lsuffix
+ 1);
1597 fnlen
= baselen
+ lsuffix
;
1599 /* Check that the file exists and is not a directory. */
1600 /* We used to only check for handlers on non-absolute file names:
1604 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1605 It's not clear why that was the case and it breaks things like
1606 (load "/bar.el") where the file is actually "/bar.el.gz". */
1607 /* make_string has its own ideas on when to return a unibyte
1608 string and when a multibyte string, but we know better.
1609 We must have a unibyte string when dumping, since
1610 file-name encoding is shaky at best at that time, and in
1611 particular default-file-name-coding-system is reset
1612 several times during loadup. We therefore don't want to
1613 encode the file before passing it to file I/O library
1615 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1616 string
= make_unibyte_string (fn
, fnlen
);
1618 string
= make_string (fn
, fnlen
);
1619 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1620 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1621 && !NATNUMP (predicate
))
1624 if (NILP (predicate
) || EQ (predicate
, Qt
))
1625 exists
= !NILP (Ffile_readable_p (string
));
1628 Lisp_Object tmp
= call1 (predicate
, string
);
1631 else if (EQ (tmp
, Qdir_ok
)
1632 || NILP (Ffile_directory_p (string
)))
1637 last_errno
= EISDIR
;
1643 /* We succeeded; return this descriptor and filename. */
1656 encoded_fn
= ENCODE_FILE (string
);
1657 pfn
= SSDATA (encoded_fn
);
1659 /* Check that we can access or open it. */
1660 if (NATNUMP (predicate
))
1663 if (INT_MAX
< XFASTINT (predicate
))
1664 last_errno
= EINVAL
;
1665 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1669 if (file_directory_p (pfn
))
1670 last_errno
= EISDIR
;
1677 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1680 if (errno
!= ENOENT
)
1685 int err
= (fstat (fd
, &st
) != 0 ? errno
1686 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1698 if (newer
&& !NATNUMP (predicate
))
1700 struct timespec mtime
= get_stat_mtime (&st
);
1702 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1707 emacs_close (save_fd
);
1710 save_string
= string
;
1715 /* We succeeded; return this descriptor and filename. */
1723 /* No more suffixes. Return the newest. */
1724 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1727 *storeptr
= save_string
;
1743 /* Merge the list we've accumulated of globals from the current input source
1744 into the load_history variable. The details depend on whether
1745 the source has an associated file name or not.
1747 FILENAME is the file name that we are loading from.
1749 ENTIRE is true if loading that entire file, false if evaluating
1753 build_load_history (Lisp_Object filename
, bool entire
)
1755 Lisp_Object tail
, prev
, newelt
;
1756 Lisp_Object tem
, tem2
;
1759 tail
= Vload_history
;
1762 while (CONSP (tail
))
1766 /* Find the feature's previous assoc list... */
1767 if (!NILP (Fequal (filename
, Fcar (tem
))))
1771 /* If we're loading the entire file, remove old data. */
1775 Vload_history
= XCDR (tail
);
1777 Fsetcdr (prev
, XCDR (tail
));
1780 /* Otherwise, cons on new symbols that are not already members. */
1783 tem2
= Vcurrent_load_list
;
1785 while (CONSP (tem2
))
1787 newelt
= XCAR (tem2
);
1789 if (NILP (Fmember (newelt
, tem
)))
1790 Fsetcar (tail
, Fcons (XCAR (tem
),
1791 Fcons (newelt
, XCDR (tem
))));
1804 /* If we're loading an entire file, cons the new assoc onto the
1805 front of load-history, the most-recently-loaded position. Also
1806 do this if we didn't find an existing member for the file. */
1807 if (entire
|| !foundit
)
1808 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1813 readevalloop_1 (int old
)
1815 load_convert_to_unibyte
= old
;
1818 /* Signal an `end-of-file' error, if possible with file name
1821 static _Noreturn
void
1822 end_of_file_error (void)
1824 if (STRINGP (Vload_file_name
))
1825 xsignal1 (Qend_of_file
, Vload_file_name
);
1827 xsignal0 (Qend_of_file
);
1831 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1833 /* If we macroexpand the toplevel form non-recursively and it ends
1834 up being a `progn' (or if it was a progn to start), treat each
1835 form in the progn as a top-level form. This way, if one form in
1836 the progn defines a macro, that macro is in effect when we expand
1837 the remaining forms. See similar code in bytecomp.el. */
1838 val
= call2 (macroexpand
, val
, Qnil
);
1839 if (EQ (CAR_SAFE (val
), Qprogn
))
1841 Lisp_Object subforms
= XCDR (val
);
1843 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1844 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1848 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1852 /* UNIBYTE specifies how to set load_convert_to_unibyte
1853 for this invocation.
1854 READFUN, if non-nil, is used instead of `read'.
1856 START, END specify region to read in current buffer (from eval-region).
1857 If the input is not from a buffer, they must be nil. */
1860 readevalloop (Lisp_Object readcharfun
,
1861 struct infile
*infile0
,
1862 Lisp_Object sourcename
,
1864 Lisp_Object unibyte
, Lisp_Object readfun
,
1865 Lisp_Object start
, Lisp_Object end
)
1869 ptrdiff_t count
= SPECPDL_INDEX ();
1870 struct buffer
*b
= 0;
1871 bool continue_reading_p
;
1872 Lisp_Object lex_bound
;
1873 /* True if reading an entire buffer. */
1874 bool whole_buffer
= 0;
1875 /* True on the first time around. */
1876 bool first_sexp
= 1;
1877 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1879 if (NILP (Ffboundp (macroexpand
))
1880 /* Don't macroexpand in .elc files, since it should have been done
1881 already. We actually don't know whether we're in a .elc file or not,
1882 so we use circumstantial evidence: .el files normally go through
1883 Vload_source_file_function -> load-with-code-conversion
1885 || EQ (readcharfun
, Qget_file_char
)
1886 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1889 if (MARKERP (readcharfun
))
1892 start
= readcharfun
;
1895 if (BUFFERP (readcharfun
))
1896 b
= XBUFFER (readcharfun
);
1897 else if (MARKERP (readcharfun
))
1898 b
= XMARKER (readcharfun
)->buffer
;
1900 /* We assume START is nil when input is not from a buffer. */
1901 if (! NILP (start
) && !b
)
1904 specbind (Qstandard_input
, readcharfun
);
1905 specbind (Qcurrent_load_list
, Qnil
);
1906 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1907 load_convert_to_unibyte
= !NILP (unibyte
);
1909 /* If lexical binding is active (either because it was specified in
1910 the file's header, or via a buffer-local variable), create an empty
1911 lexical environment, otherwise, turn off lexical binding. */
1912 lex_bound
= find_symbol_value (Qlexical_binding
);
1913 specbind (Qinternal_interpreter_environment
,
1914 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1915 ? Qnil
: list1 (Qt
)));
1917 /* Try to ensure sourcename is a truename, except whilst preloading. */
1918 if (NILP (Vpurify_flag
)
1919 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1920 && !NILP (Ffboundp (Qfile_truename
)))
1921 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1923 LOADHIST_ATTACH (sourcename
);
1925 continue_reading_p
= 1;
1926 while (continue_reading_p
)
1928 ptrdiff_t count1
= SPECPDL_INDEX ();
1930 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1931 error ("Reading from killed buffer");
1935 /* Switch to the buffer we are reading from. */
1936 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1937 set_buffer_internal (b
);
1939 /* Save point in it. */
1940 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1941 /* Save ZV in it. */
1942 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1943 /* Those get unbound after we read one expression. */
1945 /* Set point and ZV around stuff to be read. */
1948 Fnarrow_to_region (make_number (BEGV
), end
);
1950 /* Just for cleanliness, convert END to a marker
1951 if it is an integer. */
1953 end
= Fpoint_max_marker ();
1956 /* On the first cycle, we can easily test here
1957 whether we are reading the whole buffer. */
1958 if (b
&& first_sexp
)
1959 whole_buffer
= (BUF_PT (b
) == BUF_BEG (b
) && BUF_ZV (b
) == BUF_Z (b
));
1966 while ((c
= READCHAR
) != '\n' && c
!= -1);
1971 unbind_to (count1
, Qnil
);
1975 /* Ignore whitespace here, so we can detect eof. */
1976 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1977 || c
== NO_BREAK_SPACE
)
1980 if (! HASH_TABLE_P (read_objects_map
)
1981 || XHASH_TABLE (read_objects_map
)->count
)
1983 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
,
1984 DEFAULT_REHASH_SIZE
, DEFAULT_REHASH_THRESHOLD
,
1986 if (! HASH_TABLE_P (read_objects_completed
)
1987 || XHASH_TABLE (read_objects_completed
)->count
)
1988 read_objects_completed
1989 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
,
1990 DEFAULT_REHASH_SIZE
, DEFAULT_REHASH_THRESHOLD
,
1992 if (!NILP (Vpurify_flag
) && c
== '(')
1994 val
= read_list (0, readcharfun
);
1999 if (!NILP (readfun
))
2001 val
= call1 (readfun
, readcharfun
);
2003 /* If READCHARFUN has set point to ZV, we should
2004 stop reading, even if the form read sets point
2005 to a different value when evaluated. */
2006 if (BUFFERP (readcharfun
))
2008 struct buffer
*buf
= XBUFFER (readcharfun
);
2009 if (BUF_PT (buf
) == BUF_ZV (buf
))
2010 continue_reading_p
= 0;
2013 else if (! NILP (Vload_read_function
))
2014 val
= call1 (Vload_read_function
, readcharfun
);
2016 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
2018 /* Empty hashes can be reused; otherwise, reset on next call. */
2019 if (HASH_TABLE_P (read_objects_map
)
2020 && XHASH_TABLE (read_objects_map
)->count
> 0)
2021 read_objects_map
= Qnil
;
2022 if (HASH_TABLE_P (read_objects_completed
)
2023 && XHASH_TABLE (read_objects_completed
)->count
> 0)
2024 read_objects_completed
= Qnil
;
2026 if (!NILP (start
) && continue_reading_p
)
2027 start
= Fpoint_marker ();
2029 /* Restore saved point and BEGV. */
2030 unbind_to (count1
, Qnil
);
2032 /* Now eval what we just read. */
2033 if (!NILP (macroexpand
))
2034 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
2036 val
= eval_sub (val
);
2040 Vvalues
= Fcons (val
, Vvalues
);
2041 if (EQ (Vstandard_output
, Qt
))
2050 build_load_history (sourcename
,
2051 infile0
|| whole_buffer
);
2053 unbind_to (count
, Qnil
);
2056 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
2057 doc
: /* Execute the accessible portion of current buffer as Lisp code.
2058 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
2059 When called from a Lisp program (i.e., not interactively), this
2060 function accepts up to five optional arguments:
2061 BUFFER is the buffer to evaluate (nil means use current buffer),
2062 or a name of a buffer (a string).
2063 PRINTFLAG controls printing of output by any output functions in the
2064 evaluated code, such as `print', `princ', and `prin1':
2065 a value of nil means discard it; anything else is the stream to print to.
2066 See Info node `(elisp)Output Streams' for details on streams.
2067 FILENAME specifies the file name to use for `load-history'.
2068 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
2070 DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
2071 evaluated code should work normally even if PRINTFLAG is nil, in
2072 which case the output is displayed in the echo area.
2074 This function preserves the position of point. */)
2075 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
2077 ptrdiff_t count
= SPECPDL_INDEX ();
2078 Lisp_Object tem
, buf
;
2081 buf
= Fcurrent_buffer ();
2083 buf
= Fget_buffer (buffer
);
2085 error ("No such buffer");
2087 if (NILP (printflag
) && NILP (do_allow_print
))
2092 if (NILP (filename
))
2093 filename
= BVAR (XBUFFER (buf
), filename
);
2095 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
2096 specbind (Qstandard_output
, tem
);
2097 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
2098 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2099 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
2100 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2101 readevalloop (buf
, 0, filename
,
2102 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
2103 unbind_to (count
, Qnil
);
2108 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2109 doc
: /* Execute the region as Lisp code.
2110 When called from programs, expects two arguments,
2111 giving starting and ending indices in the current buffer
2112 of the text to be executed.
2113 Programs can pass third argument PRINTFLAG which controls output:
2114 a value of nil means discard it; anything else is stream for printing it.
2115 See Info node `(elisp)Output Streams' for details on streams.
2116 Also the fourth argument READ-FUNCTION, if non-nil, is used
2117 instead of `read' to read each expression. It gets one argument
2118 which is the input stream for reading characters.
2120 This function does not move point. */)
2121 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2123 /* FIXME: Do the eval-sexp-add-defvars dance! */
2124 ptrdiff_t count
= SPECPDL_INDEX ();
2125 Lisp_Object tem
, cbuf
;
2127 cbuf
= Fcurrent_buffer ();
2129 if (NILP (printflag
))
2133 specbind (Qstandard_output
, tem
);
2134 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2136 /* `readevalloop' calls functions which check the type of start and end. */
2137 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2138 !NILP (printflag
), Qnil
, read_function
,
2141 return unbind_to (count
, Qnil
);
2145 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2146 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2147 If STREAM is nil, use the value of `standard-input' (which see).
2148 STREAM or the value of `standard-input' may be:
2149 a buffer (read from point and advance it)
2150 a marker (read from where it points and advance it)
2151 a function (call it with no arguments for each character,
2152 call it with a char as argument to push a char back)
2153 a string (takes text from string, starting at the beginning)
2154 t (read text line using minibuffer and use it, or read from
2155 standard input in batch mode). */)
2156 (Lisp_Object stream
)
2159 stream
= Vstandard_input
;
2160 if (EQ (stream
, Qt
))
2161 stream
= Qread_char
;
2162 if (EQ (stream
, Qread_char
))
2163 /* FIXME: ?! When is this used !? */
2164 return call1 (intern ("read-minibuffer"),
2165 build_string ("Lisp expression: "));
2167 return read_internal_start (stream
, Qnil
, Qnil
);
2170 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2171 doc
: /* Read one Lisp expression which is represented as text by STRING.
2172 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2173 FINAL-STRING-INDEX is an integer giving the position of the next
2174 remaining character in STRING. START and END optionally delimit
2175 a substring of STRING from which to read; they default to 0 and
2176 \(length STRING) respectively. Negative values are counted from
2177 the end of STRING. */)
2178 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2181 CHECK_STRING (string
);
2182 /* `read_internal_start' sets `read_from_string_index'. */
2183 ret
= read_internal_start (string
, start
, end
);
2184 return Fcons (ret
, make_number (read_from_string_index
));
2187 /* Function to set up the global context we need in toplevel read
2188 calls. START and END only used when STREAM is a string. */
2190 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2195 new_backquote_flag
= force_new_style_backquotes
;
2196 /* We can get called from readevalloop which may have set these
2198 if (! HASH_TABLE_P (read_objects_map
)
2199 || XHASH_TABLE (read_objects_map
)->count
)
2201 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
, DEFAULT_REHASH_SIZE
,
2202 DEFAULT_REHASH_THRESHOLD
, Qnil
, false);
2203 if (! HASH_TABLE_P (read_objects_completed
)
2204 || XHASH_TABLE (read_objects_completed
)->count
)
2205 read_objects_completed
2206 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
, DEFAULT_REHASH_SIZE
,
2207 DEFAULT_REHASH_THRESHOLD
, Qnil
, false);
2208 if (EQ (Vread_with_symbol_positions
, Qt
)
2209 || EQ (Vread_with_symbol_positions
, stream
))
2210 Vread_symbol_positions_list
= Qnil
;
2212 if (STRINGP (stream
)
2213 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2215 ptrdiff_t startval
, endval
;
2218 if (STRINGP (stream
))
2221 string
= XCAR (stream
);
2223 validate_subarray (string
, start
, end
, SCHARS (string
),
2224 &startval
, &endval
);
2226 read_from_string_index
= startval
;
2227 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2228 read_from_string_limit
= endval
;
2231 retval
= read0 (stream
);
2232 if (EQ (Vread_with_symbol_positions
, Qt
)
2233 || EQ (Vread_with_symbol_positions
, stream
))
2234 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2235 /* Empty hashes can be reused; otherwise, reset on next call. */
2236 if (HASH_TABLE_P (read_objects_map
)
2237 && XHASH_TABLE (read_objects_map
)->count
> 0)
2238 read_objects_map
= Qnil
;
2239 if (HASH_TABLE_P (read_objects_completed
)
2240 && XHASH_TABLE (read_objects_completed
)->count
> 0)
2241 read_objects_completed
= Qnil
;
2246 /* Signal Qinvalid_read_syntax error.
2247 S is error string of length N (if > 0) */
2249 static _Noreturn
void
2250 invalid_syntax (const char *s
)
2252 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2256 /* Use this for recursive reads, in contexts where internal tokens
2260 read0 (Lisp_Object readcharfun
)
2262 register Lisp_Object val
;
2265 val
= read1 (readcharfun
, &c
, 0);
2269 xsignal1 (Qinvalid_read_syntax
,
2270 Fmake_string (make_number (1), make_number (c
), Qnil
));
2273 /* Grow a read buffer BUF that contains OFFSET useful bytes of data,
2274 by at least MAX_MULTIBYTE_LENGTH bytes. Update *BUF_ADDR and
2275 *BUF_SIZE accordingly; 0 <= OFFSET <= *BUF_SIZE. If *BUF_ADDR is
2276 initially null, BUF is on the stack: copy its data to the new heap
2277 buffer. Otherwise, BUF must equal *BUF_ADDR and can simply be
2278 reallocated. Either way, remember the heap allocation (which is at
2279 pdl slot COUNT) so that it can be freed when unwinding the stack.*/
2282 grow_read_buffer (char *buf
, ptrdiff_t offset
,
2283 char **buf_addr
, ptrdiff_t *buf_size
, ptrdiff_t count
)
2285 char *p
= xpalloc (*buf_addr
, buf_size
, MAX_MULTIBYTE_LENGTH
, -1, 1);
2288 memcpy (p
, buf
, offset
);
2289 record_unwind_protect_ptr (xfree
, p
);
2292 set_unwind_protect_ptr (count
, xfree
, p
);
2297 /* Return the scalar value that has the Unicode character name NAME.
2298 Raise 'invalid-read-syntax' if there is no such character. */
2300 character_name_to_code (char const *name
, ptrdiff_t name_len
)
2302 /* For "U+XXXX", pass the leading '+' to string_to_number to reject
2303 monstrosities like "U+-0000". */
2305 = (name
[0] == 'U' && name
[1] == '+'
2306 ? string_to_number (name
+ 1, 16, false)
2307 : call2 (Qchar_from_name
, make_unibyte_string (name
, name_len
), Qt
));
2309 if (! RANGED_INTEGERP (0, code
, MAX_UNICODE_CHAR
)
2310 || char_surrogate_p (XINT (code
)))
2312 AUTO_STRING (format
, "\\N{%s}");
2313 AUTO_STRING_WITH_LEN (namestr
, name
, name_len
);
2314 xsignal1 (Qinvalid_read_syntax
, CALLN (Fformat
, format
, namestr
));
2320 /* Bound on the length of a Unicode character name. As of
2321 Unicode 9.0.0 the maximum is 83, so this should be safe. */
2322 enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND
= 200 };
2324 /* Read a \-escape sequence, assuming we already read the `\'.
2325 If the escape sequence forces unibyte, return eight-bit char. */
2328 read_escape (Lisp_Object readcharfun
, bool stringp
)
2331 /* \u allows up to four hex digits, \U up to eight. Default to the
2332 behavior for \u, and change this value in the case that \U is seen. */
2333 int unicode_hex_count
= 4;
2338 end_of_file_error ();
2368 error ("Invalid escape character syntax");
2371 c
= read_escape (readcharfun
, 0);
2372 return c
| meta_modifier
;
2377 error ("Invalid escape character syntax");
2380 c
= read_escape (readcharfun
, 0);
2381 return c
| shift_modifier
;
2386 error ("Invalid escape character syntax");
2389 c
= read_escape (readcharfun
, 0);
2390 return c
| hyper_modifier
;
2395 error ("Invalid escape character syntax");
2398 c
= read_escape (readcharfun
, 0);
2399 return c
| alt_modifier
;
2403 if (stringp
|| c
!= '-')
2410 c
= read_escape (readcharfun
, 0);
2411 return c
| super_modifier
;
2416 error ("Invalid escape character syntax");
2421 c
= read_escape (readcharfun
, 0);
2422 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2423 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2424 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2425 return c
| ctrl_modifier
;
2426 /* ASCII control chars are made from letters (both cases),
2427 as well as the non-letters within 0100...0137. */
2428 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2429 return (c
& (037 | ~0177));
2430 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2431 return (c
& (037 | ~0177));
2433 return c
| ctrl_modifier
;
2443 /* An octal escape, as in ANSI C. */
2445 register int i
= c
- '0';
2446 register int count
= 0;
2449 if ((c
= READCHAR
) >= '0' && c
<= '7')
2461 if (i
>= 0x80 && i
< 0x100)
2462 i
= BYTE8_TO_CHAR (i
);
2467 /* A hex escape, as in ANSI C. */
2474 int digit
= char_hexdigit (c
);
2480 i
= (i
<< 4) + digit
;
2481 /* Allow hex escapes as large as ?\xfffffff, because some
2482 packages use them to denote characters with modifiers. */
2483 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2484 error ("Hex character out of range: \\x%x...", i
);
2488 if (count
< 3 && i
>= 0x80)
2489 return BYTE8_TO_CHAR (i
);
2494 /* Post-Unicode-2.0: Up to eight hex chars. */
2495 unicode_hex_count
= 8;
2499 /* A Unicode escape. We only permit them in strings and characters,
2500 not arbitrarily in the source code, as in some other languages. */
2505 while (++count
<= unicode_hex_count
)
2508 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2510 int digit
= char_hexdigit (c
);
2512 error ("Non-hex digit used for Unicode escape");
2513 i
= (i
<< 4) + digit
;
2516 error ("Non-Unicode character: 0x%x", i
);
2521 /* Named character. */
2525 invalid_syntax ("Expected opening brace after \\N");
2526 char name
[UNICODE_CHARACTER_NAME_LENGTH_BOUND
+ 1];
2527 bool whitespace
= false;
2528 ptrdiff_t length
= 0;
2533 end_of_file_error ();
2536 if (! (0 < c
&& c
< 0x80))
2538 AUTO_STRING (format
,
2539 "Invalid character U+%04X in character name");
2540 xsignal1 (Qinvalid_read_syntax
,
2541 CALLN (Fformat
, format
, make_natnum (c
)));
2543 /* Treat multiple adjacent whitespace characters as a
2544 single space character. This makes it easier to use
2545 character names in e.g. multi-line strings. */
2556 if (length
>= sizeof name
)
2557 invalid_syntax ("Character name too long");
2560 invalid_syntax ("Empty character name");
2561 name
[length
] = '\0';
2563 /* character_name_to_code can invoke read1, recursively.
2564 This is why read1's buffer is not static. */
2565 return character_name_to_code (name
, length
);
2573 /* Return the digit that CHARACTER stands for in the given BASE.
2574 Return -1 if CHARACTER is out of range for BASE,
2575 and -2 if CHARACTER is not valid for any supported BASE. */
2577 digit_to_number (int character
, int base
)
2581 if ('0' <= character
&& character
<= '9')
2582 digit
= character
- '0';
2583 else if ('a' <= character
&& character
<= 'z')
2584 digit
= character
- 'a' + 10;
2585 else if ('A' <= character
&& character
<= 'Z')
2586 digit
= character
- 'A' + 10;
2590 return digit
< base
? digit
: -1;
2593 /* Read an integer in radix RADIX using READCHARFUN to read
2594 characters. RADIX must be in the interval [2..36]; if it isn't, a
2595 read error is signaled . Value is the integer read. Signals an
2596 error if encountering invalid read syntax or if RADIX is out of
2600 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2602 /* Room for sign, leading 0, other digits, trailing null byte.
2603 Also, room for invalid syntax diagnostic. */
2604 char buf
[max (1 + 1 + UINTMAX_WIDTH
+ 1,
2605 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2607 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2609 if (radix
< 2 || radix
> 36)
2617 if (c
== '-' || c
== '+')
2628 /* Ignore redundant leading zeros, so the buffer doesn't
2629 fill up with them. */
2635 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2642 if (p
< buf
+ sizeof buf
- 1)
2656 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2657 invalid_syntax (buf
);
2660 return string_to_number (buf
, radix
, 0);
2664 /* If the next token is ')' or ']' or '.', we store that character
2665 in *PCH and the return value is not interesting. Else, we store
2666 zero in *PCH and we read and return one lisp object.
2668 FIRST_IN_LIST is true if this is the first element of a list. */
2671 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2674 bool uninterned_symbol
= false;
2676 char stackbuf
[MAX_ALLOCA
];
2677 current_thread
->stack_top
= stackbuf
;
2683 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2685 end_of_file_error ();
2690 return read_list (0, readcharfun
);
2693 return read_vector (readcharfun
, 0);
2709 /* Accept extended format for hash tables (extensible to
2711 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2712 Lisp_Object tmp
= read_list (0, readcharfun
);
2713 Lisp_Object head
= CAR_SAFE (tmp
);
2714 Lisp_Object data
= Qnil
;
2715 Lisp_Object val
= Qnil
;
2716 /* The size is 2 * number of allowed keywords to
2718 Lisp_Object params
[12];
2720 Lisp_Object key
= Qnil
;
2721 int param_count
= 0;
2723 if (!EQ (head
, Qhash_table
))
2725 ptrdiff_t size
= XINT (Flength (tmp
));
2726 Lisp_Object record
= Fmake_record (CAR_SAFE (tmp
),
2727 make_number (size
- 1),
2729 for (int i
= 1; i
< size
; i
++)
2732 ASET (record
, i
, Fcar (tmp
));
2737 tmp
= CDR_SAFE (tmp
);
2739 /* This is repetitive but fast and simple. */
2740 params
[param_count
] = QCsize
;
2741 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2742 if (!NILP (params
[param_count
+ 1]))
2745 params
[param_count
] = QCtest
;
2746 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2747 if (!NILP (params
[param_count
+ 1]))
2750 params
[param_count
] = QCweakness
;
2751 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2752 if (!NILP (params
[param_count
+ 1]))
2755 params
[param_count
] = QCrehash_size
;
2756 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2757 if (!NILP (params
[param_count
+ 1]))
2760 params
[param_count
] = QCrehash_threshold
;
2761 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2762 if (!NILP (params
[param_count
+ 1]))
2765 params
[param_count
] = QCpurecopy
;
2766 params
[param_count
+ 1] = Fplist_get (tmp
, Qpurecopy
);
2767 if (!NILP (params
[param_count
+ 1]))
2770 /* This is the hash table data. */
2771 data
= Fplist_get (tmp
, Qdata
);
2773 /* Now use params to make a new hash table and fill it. */
2774 ht
= Fmake_hash_table (param_count
, params
);
2776 while (CONSP (data
))
2781 error ("Odd number of elements in hash table data");
2784 Fputhash (key
, val
, ht
);
2790 invalid_syntax ("#");
2798 tmp
= read_vector (readcharfun
, 0);
2799 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2800 error ("Invalid size char-table");
2801 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2809 /* Sub char-table can't be read as a regular
2810 vector because of a two C integer fields. */
2811 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2812 ptrdiff_t size
= XINT (Flength (tmp
));
2813 int i
, depth
, min_char
;
2814 struct Lisp_Cons
*cell
;
2817 error ("Zero-sized sub char-table");
2819 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2820 error ("Invalid depth in sub char-table");
2821 depth
= XINT (XCAR (tmp
));
2822 if (chartab_size
[depth
] != size
- 2)
2823 error ("Invalid size in sub char-table");
2824 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2827 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2828 error ("Invalid minimum character in sub-char-table");
2829 min_char
= XINT (XCAR (tmp
));
2830 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2833 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2834 for (i
= 0; i
< size
; i
++)
2836 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2837 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2842 invalid_syntax ("#^^");
2844 invalid_syntax ("#^");
2849 length
= read1 (readcharfun
, pch
, first_in_list
);
2853 Lisp_Object tmp
, val
;
2854 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2855 unsigned char *data
;
2858 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2859 if (STRING_MULTIBYTE (tmp
)
2860 || (size_in_chars
!= SCHARS (tmp
)
2861 /* We used to print 1 char too many
2862 when the number of bits was a multiple of 8.
2863 Accept such input in case it came from an old
2865 && ! (XFASTINT (length
)
2866 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2867 invalid_syntax ("#&...");
2869 val
= make_uninit_bool_vector (XFASTINT (length
));
2870 data
= bool_vector_uchar_data (val
);
2871 memcpy (data
, SDATA (tmp
), size_in_chars
);
2872 /* Clear the extraneous bits in the last byte. */
2873 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2874 data
[size_in_chars
- 1]
2875 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2878 invalid_syntax ("#&...");
2882 /* Accept compiled functions at read-time so that we don't have to
2883 build them using function calls. */
2885 struct Lisp_Vector
*vec
;
2886 tmp
= read_vector (readcharfun
, 1);
2887 vec
= XVECTOR (tmp
);
2888 if (vec
->header
.size
== 0)
2889 invalid_syntax ("Empty byte-code object");
2890 make_byte_code (vec
);
2898 /* Read the string itself. */
2899 tmp
= read1 (readcharfun
, &ch
, 0);
2900 if (ch
!= 0 || !STRINGP (tmp
))
2901 invalid_syntax ("#");
2902 /* Read the intervals and their properties. */
2905 Lisp_Object beg
, end
, plist
;
2907 beg
= read1 (readcharfun
, &ch
, 0);
2912 end
= read1 (readcharfun
, &ch
, 0);
2914 plist
= read1 (readcharfun
, &ch
, 0);
2916 invalid_syntax ("Invalid string property list");
2917 Fset_text_properties (beg
, end
, plist
, tmp
);
2923 /* #@NUMBER is used to skip NUMBER following bytes.
2924 That's used in .elc files to skip over doc strings
2925 and function definitions. */
2928 enum { extra
= 100 };
2929 ptrdiff_t i
, nskip
= 0, digits
= 0;
2931 /* Read a decimal integer. */
2932 while ((c
= READCHAR
) >= 0
2933 && c
>= '0' && c
<= '9')
2935 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2940 if (digits
== 2 && nskip
== 0)
2941 { /* We've just seen #@00, which means "skip to end". */
2942 skip_dyn_eof (readcharfun
);
2947 /* We can't use UNREAD here, because in the code below we side-step
2948 READCHAR. Instead, assume the first char after #@NNN occupies
2949 a single byte, which is the case normally since it's just
2955 if (load_force_doc_strings
2956 && (FROM_FILE_P (readcharfun
)))
2958 /* If we are supposed to force doc strings into core right now,
2959 record the last string that we skipped,
2960 and record where in the file it comes from. */
2962 /* But first exchange saved_doc_string
2963 with prev_saved_doc_string, so we save two strings. */
2965 char *temp
= saved_doc_string
;
2966 ptrdiff_t temp_size
= saved_doc_string_size
;
2967 file_offset temp_pos
= saved_doc_string_position
;
2968 ptrdiff_t temp_len
= saved_doc_string_length
;
2970 saved_doc_string
= prev_saved_doc_string
;
2971 saved_doc_string_size
= prev_saved_doc_string_size
;
2972 saved_doc_string_position
= prev_saved_doc_string_position
;
2973 saved_doc_string_length
= prev_saved_doc_string_length
;
2975 prev_saved_doc_string
= temp
;
2976 prev_saved_doc_string_size
= temp_size
;
2977 prev_saved_doc_string_position
= temp_pos
;
2978 prev_saved_doc_string_length
= temp_len
;
2981 if (saved_doc_string_size
== 0)
2983 saved_doc_string
= xmalloc (nskip
+ extra
);
2984 saved_doc_string_size
= nskip
+ extra
;
2986 if (nskip
> saved_doc_string_size
)
2988 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2989 saved_doc_string_size
= nskip
+ extra
;
2992 FILE *instream
= infile
->stream
;
2993 saved_doc_string_position
= (file_tell (instream
)
2994 - infile
->lookahead
);
2996 /* Copy that many bytes into saved_doc_string. */
2998 for (int n
= min (nskip
, infile
->lookahead
); 0 < n
; n
--)
2999 saved_doc_string
[i
++]
3000 = c
= infile
->buf
[--infile
->lookahead
];
3002 for (; i
< nskip
&& 0 <= c
; i
++)
3003 saved_doc_string
[i
] = c
= getc_unlocked (instream
);
3006 saved_doc_string_length
= i
;
3009 /* Skip that many bytes. */
3010 skip_dyn_bytes (readcharfun
, nskip
);
3016 /* #! appears at the beginning of an executable file.
3017 Skip the first line. */
3018 while (c
!= '\n' && c
>= 0)
3023 return Vload_file_name
;
3025 return list2 (Qfunction
, read0 (readcharfun
));
3026 /* #:foo is the uninterned symbol named foo. */
3029 uninterned_symbol
= true;
3032 && c
!= NO_BREAK_SPACE
3034 || strchr ("\"';()[]#`,", c
) == NULL
)))
3036 /* No symbol character follows, this is the empty
3039 return Fmake_symbol (empty_unibyte_string
);
3043 /* ## is the empty symbol. */
3045 return Fintern (empty_unibyte_string
, Qnil
);
3046 /* Reader forms that can reuse previously read objects. */
3047 if (c
>= '0' && c
<= '9')
3051 bool overflow
= false;
3053 /* Read a non-negative integer. */
3054 while (c
>= '0' && c
<= '9')
3056 overflow
|= INT_MULTIPLY_WRAPV (n
, 10, &n
);
3057 overflow
|= INT_ADD_WRAPV (n
, c
- '0', &n
);
3061 if (!overflow
&& n
<= MOST_POSITIVE_FIXNUM
)
3063 if (c
== 'r' || c
== 'R')
3064 return read_integer (readcharfun
, n
);
3066 if (! NILP (Vread_circle
))
3068 /* #n=object returns object, but associates it with
3072 /* Make a placeholder for #n# to use temporarily. */
3073 /* Note: We used to use AUTO_CONS to allocate
3074 placeholder, but that is a bad idea, since it
3075 will place a stack-allocated cons cell into
3076 the list in read_objects_map, which is a
3077 staticpro'd global variable, and thus each of
3078 its elements is marked during each GC. A
3079 stack-allocated object will become garbled
3080 when its stack slot goes out of scope, and
3081 some other function reuses it for entirely
3082 different purposes, which will cause crashes
3084 Lisp_Object placeholder
= Fcons (Qnil
, Qnil
);
3085 struct Lisp_Hash_Table
*h
3086 = XHASH_TABLE (read_objects_map
);
3088 Lisp_Object number
= make_number (n
);
3090 ptrdiff_t i
= hash_lookup (h
, number
, &hash
);
3092 /* Not normal, but input could be malformed. */
3093 set_hash_value_slot (h
, i
, placeholder
);
3095 hash_put (h
, number
, placeholder
, hash
);
3097 /* Read the object itself. */
3098 tem
= read0 (readcharfun
);
3100 /* If it can be recursive, remember it for
3101 future substitutions. */
3104 && ! (STRINGP (tem
) && !string_intervals (tem
)))
3106 struct Lisp_Hash_Table
*h2
3107 = XHASH_TABLE (read_objects_completed
);
3108 i
= hash_lookup (h2
, tem
, &hash
);
3110 hash_put (h2
, tem
, Qnil
, hash
);
3113 /* Now put it everywhere the placeholder was... */
3116 Fsetcar (placeholder
, XCAR (tem
));
3117 Fsetcdr (placeholder
, XCDR (tem
));
3122 Flread__substitute_object_in_subtree
3123 (tem
, placeholder
, read_objects_completed
);
3125 /* ...and #n# will use the real value from now on. */
3126 i
= hash_lookup (h
, number
, &hash
);
3128 set_hash_value_slot (h
, i
, tem
);
3134 /* #n# returns a previously read object. */
3137 struct Lisp_Hash_Table
*h
3138 = XHASH_TABLE (read_objects_map
);
3139 ptrdiff_t i
= hash_lookup (h
, make_number (n
), NULL
);
3141 return HASH_VALUE (h
, i
);
3145 /* Fall through to error message. */
3147 else if (c
== 'x' || c
== 'X')
3148 return read_integer (readcharfun
, 16);
3149 else if (c
== 'o' || c
== 'O')
3150 return read_integer (readcharfun
, 8);
3151 else if (c
== 'b' || c
== 'B')
3152 return read_integer (readcharfun
, 2);
3155 invalid_syntax ("#");
3158 while ((c
= READCHAR
) >= 0 && c
!= '\n');
3162 return list2 (Qquote
, read0 (readcharfun
));
3166 int next_char
= READCHAR
;
3168 /* Transition from old-style to new-style:
3169 If we see "(`" it used to mean old-style, which usually works
3170 fine because ` should almost never appear in such a position
3171 for new-style. But occasionally we need "(`" to mean new
3172 style, so we try to distinguish the two by the fact that we
3173 can either write "( `foo" or "(` foo", where the first
3174 intends to use new-style whereas the second intends to use
3175 old-style. For Emacs-25, we should completely remove this
3176 first_in_list exception (old-style can still be obtained via
3178 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
3179 load_error_old_style_backquotes ();
3183 bool saved_new_backquote_flag
= new_backquote_flag
;
3185 new_backquote_flag
= 1;
3186 value
= read0 (readcharfun
);
3187 new_backquote_flag
= saved_new_backquote_flag
;
3189 return list2 (Qbackquote
, value
);
3194 int next_char
= READCHAR
;
3196 /* Transition from old-style to new-style:
3197 It used to be impossible to have a new-style , other than within
3198 a new-style `. This is sufficient when ` and , are used in the
3199 normal way, but ` and , can also appear in args to macros that
3200 will not interpret them in the usual way, in which case , may be
3201 used without any ` anywhere near.
3202 So we now use the same heuristic as for backquote: old-style
3203 unquotes are only recognized when first on a list, and when
3204 followed by a space.
3205 Because it's more difficult to peek 2 chars ahead, a new-style
3206 ,@ can still not be used outside of a `, unless it's in the middle
3208 if (new_backquote_flag
3210 || (next_char
!= ' ' && next_char
!= '@'))
3212 Lisp_Object comma_type
= Qnil
;
3217 comma_type
= Qcomma_at
;
3219 comma_type
= Qcomma_dot
;
3222 if (ch
>= 0) UNREAD (ch
);
3223 comma_type
= Qcomma
;
3226 value
= read0 (readcharfun
);
3227 return list2 (comma_type
, value
);
3230 load_error_old_style_backquotes ();
3240 end_of_file_error ();
3242 /* Accept `single space' syntax like (list ? x) where the
3243 whitespace character is SPC or TAB.
3244 Other literal whitespace like NL, CR, and FF are not accepted,
3245 as there are well-established escape sequences for these. */
3246 if (c
== ' ' || c
== '\t')
3247 return make_number (c
);
3249 if (c
== '(' || c
== ')' || c
== '[' || c
== ']'
3250 || c
== '"' || c
== ';')
3252 CHECK_LIST (Vlread_unescaped_character_literals
);
3253 Lisp_Object char_obj
= make_natnum (c
);
3254 if (NILP (Fmemq (char_obj
, Vlread_unescaped_character_literals
)))
3255 Vlread_unescaped_character_literals
=
3256 Fcons (char_obj
, Vlread_unescaped_character_literals
);
3260 c
= read_escape (readcharfun
, 0);
3261 modifiers
= c
& CHAR_MODIFIER_MASK
;
3262 c
&= ~CHAR_MODIFIER_MASK
;
3263 if (CHAR_BYTE8_P (c
))
3264 c
= CHAR_TO_BYTE8 (c
);
3267 next_char
= READCHAR
;
3268 ok
= (next_char
<= 040
3269 || (next_char
< 0200
3270 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3273 return make_number (c
);
3275 invalid_syntax ("?");
3280 ptrdiff_t count
= SPECPDL_INDEX ();
3281 char *read_buffer
= stackbuf
;
3282 ptrdiff_t read_buffer_size
= sizeof stackbuf
;
3283 char *heapbuf
= NULL
;
3284 char *p
= read_buffer
;
3285 char *end
= read_buffer
+ read_buffer_size
;
3287 /* True if we saw an escape sequence specifying
3288 a multibyte character. */
3289 bool force_multibyte
= false;
3290 /* True if we saw an escape sequence specifying
3291 a single-byte character. */
3292 bool force_singlebyte
= false;
3293 bool cancel
= false;
3294 ptrdiff_t nchars
= 0;
3296 while ((ch
= READCHAR
) >= 0
3299 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3301 ptrdiff_t offset
= p
- read_buffer
;
3302 read_buffer
= grow_read_buffer (read_buffer
, offset
,
3303 &heapbuf
, &read_buffer_size
,
3305 p
= read_buffer
+ offset
;
3306 end
= read_buffer
+ read_buffer_size
;
3313 ch
= read_escape (readcharfun
, 1);
3315 /* CH is -1 if \ newline or \ space has just been seen. */
3318 if (p
== read_buffer
)
3323 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3324 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3326 if (CHAR_BYTE8_P (ch
))
3327 force_singlebyte
= true;
3328 else if (! ASCII_CHAR_P (ch
))
3329 force_multibyte
= true;
3330 else /* I.e. ASCII_CHAR_P (ch). */
3332 /* Allow `\C- ' and `\C-?'. */
3333 if (modifiers
== CHAR_CTL
)
3336 ch
= 0, modifiers
= 0;
3338 ch
= 127, modifiers
= 0;
3340 if (modifiers
& CHAR_SHIFT
)
3342 /* Shift modifier is valid only with [A-Za-z]. */
3343 if (ch
>= 'A' && ch
<= 'Z')
3344 modifiers
&= ~CHAR_SHIFT
;
3345 else if (ch
>= 'a' && ch
<= 'z')
3346 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3349 if (modifiers
& CHAR_META
)
3351 /* Move the meta bit to the right place for a
3353 modifiers
&= ~CHAR_META
;
3354 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3355 force_singlebyte
= true;
3359 /* Any modifiers remaining are invalid. */
3361 error ("Invalid modifier in string");
3362 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3366 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3367 if (CHAR_BYTE8_P (ch
))
3368 force_singlebyte
= true;
3369 else if (! ASCII_CHAR_P (ch
))
3370 force_multibyte
= true;
3376 end_of_file_error ();
3378 /* If purifying, and string starts with \ newline,
3379 return zero instead. This is for doc strings
3380 that we are really going to find in etc/DOC.nn.nn. */
3381 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3382 return unbind_to (count
, make_number (0));
3384 if (! force_multibyte
&& force_singlebyte
)
3386 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3387 forms. Convert it to unibyte. */
3388 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3390 p
= read_buffer
+ nchars
;
3394 = make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3396 || (p
- read_buffer
!= nchars
)));
3397 return unbind_to (count
, result
);
3402 int next_char
= READCHAR
;
3405 if (next_char
<= 040
3406 || (next_char
< 0200
3407 && strchr ("\"';([#?`,", next_char
) != NULL
))
3413 /* The atom-reading loop below will now loop at least once,
3414 assuring that we will not try to UNREAD two characters in a
3418 if (c
<= 040) goto retry
;
3419 if (c
== NO_BREAK_SPACE
)
3424 ptrdiff_t count
= SPECPDL_INDEX ();
3425 char *read_buffer
= stackbuf
;
3426 ptrdiff_t read_buffer_size
= sizeof stackbuf
;
3427 char *heapbuf
= NULL
;
3428 char *p
= read_buffer
;
3429 char *end
= read_buffer
+ read_buffer_size
;
3430 bool quoted
= false;
3431 EMACS_INT start_position
= readchar_count
- 1;
3435 if (end
- p
< MAX_MULTIBYTE_LENGTH
+ 1)
3437 ptrdiff_t offset
= p
- read_buffer
;
3438 read_buffer
= grow_read_buffer (read_buffer
, offset
,
3439 &heapbuf
, &read_buffer_size
,
3441 p
= read_buffer
+ offset
;
3442 end
= read_buffer
+ read_buffer_size
;
3449 end_of_file_error ();
3454 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3460 && c
!= NO_BREAK_SPACE
3462 || strchr ("\"';()[]#`,", c
) == NULL
));
3467 if (!quoted
&& !uninterned_symbol
)
3469 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3470 if (! NILP (result
))
3471 return unbind_to (count
, result
);
3473 if (!quoted
&& multibyte
)
3475 int ch
= STRING_CHAR ((unsigned char *) read_buffer
);
3476 if (confusable_symbol_character_p (ch
))
3477 xsignal2 (Qinvalid_read_syntax
, build_string ("strange quote"),
3478 CALLN (Fstring
, make_number (ch
)));
3482 ptrdiff_t nbytes
= p
- read_buffer
;
3485 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3489 if (uninterned_symbol
)
3492 = ((! NILP (Vpurify_flag
)
3493 ? make_pure_string
: make_specified_string
)
3494 (read_buffer
, nchars
, nbytes
, multibyte
));
3495 result
= Fmake_symbol (name
);
3499 /* Don't create the string object for the name unless
3500 we're going to retain it in a new symbol.
3502 Like intern_1 but supports multibyte names. */
3503 Lisp_Object obarray
= check_obarray (Vobarray
);
3504 Lisp_Object tem
= oblookup (obarray
, read_buffer
,
3512 = make_specified_string (read_buffer
, nchars
, nbytes
,
3514 result
= intern_driver (name
, obarray
, tem
);
3518 if (EQ (Vread_with_symbol_positions
, Qt
)
3519 || EQ (Vread_with_symbol_positions
, readcharfun
))
3520 Vread_symbol_positions_list
3521 = Fcons (Fcons (result
, make_number (start_position
)),
3522 Vread_symbol_positions_list
);
3523 return unbind_to (count
, result
);
3529 DEFUN ("lread--substitute-object-in-subtree",
3530 Flread__substitute_object_in_subtree
,
3531 Slread__substitute_object_in_subtree
, 3, 3, 0,
3532 doc
: /* In OBJECT, replace every occurrence of PLACEHOLDER with OBJECT.
3533 COMPLETED is a hash table of objects that might be circular, or is t
3534 if any object might be circular. */)
3535 (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object completed
)
3537 struct subst subst
= { object
, placeholder
, completed
, Qnil
};
3538 Lisp_Object check_object
= substitute_object_recurse (&subst
, object
);
3540 /* The returned object here is expected to always eq the
3542 if (!EQ (check_object
, object
))
3543 error ("Unexpected mutation error in reader");
3548 substitute_object_recurse (struct subst
*subst
, Lisp_Object subtree
)
3550 /* If we find the placeholder, return the target object. */
3551 if (EQ (subst
->placeholder
, subtree
))
3552 return subst
->object
;
3554 /* For common object types that can't contain other objects, don't
3555 bother looking them up; we're done. */
3556 if (SYMBOLP (subtree
)
3557 || (STRINGP (subtree
) && !string_intervals (subtree
))
3558 || NUMBERP (subtree
))
3561 /* If we've been to this node before, don't explore it again. */
3562 if (!EQ (Qnil
, Fmemq (subtree
, subst
->seen
)))
3565 /* If this node can be the entry point to a cycle, remember that
3566 we've seen it. It can only be such an entry point if it was made
3567 by #n=, which means that we can find it as a value in
3569 if (EQ (subst
->completed
, Qt
)
3570 || hash_lookup (XHASH_TABLE (subst
->completed
), subtree
, NULL
) >= 0)
3571 subst
->seen
= Fcons (subtree
, subst
->seen
);
3573 /* Recurse according to subtree's type.
3574 Every branch must return a Lisp_Object. */
3575 switch (XTYPE (subtree
))
3577 case Lisp_Vectorlike
:
3579 ptrdiff_t i
= 0, length
= 0;
3580 if (BOOL_VECTOR_P (subtree
))
3581 return subtree
; /* No sub-objects anyway. */
3582 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3583 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
)
3584 || RECORDP (subtree
))
3585 length
= PVSIZE (subtree
);
3586 else if (VECTORP (subtree
))
3587 length
= ASIZE (subtree
);
3589 /* An unknown pseudovector may contain non-Lisp fields, so we
3590 can't just blindly traverse all its fields. We used to call
3591 `Flength' which signaled `sequencep', so I just preserved this
3593 wrong_type_argument (Qsequencep
, subtree
);
3595 if (SUB_CHAR_TABLE_P (subtree
))
3597 for ( ; i
< length
; i
++)
3599 substitute_object_recurse (subst
, AREF (subtree
, i
)));
3604 XSETCAR (subtree
, substitute_object_recurse (subst
, XCAR (subtree
)));
3605 XSETCDR (subtree
, substitute_object_recurse (subst
, XCDR (subtree
)));
3610 /* Check for text properties in each interval.
3611 substitute_in_interval contains part of the logic. */
3613 INTERVAL root_interval
= string_intervals (subtree
);
3614 traverse_intervals_noorder (root_interval
,
3615 substitute_in_interval
, subst
);
3619 /* Other types don't recurse any further. */
3625 /* Helper function for substitute_object_recurse. */
3627 substitute_in_interval (INTERVAL interval
, void *arg
)
3629 set_interval_plist (interval
,
3630 substitute_object_recurse (arg
, interval
->plist
));
3634 /* Convert STRING to a number, assuming base BASE. Return a fixnum if
3635 STRING has integer syntax and fits in a fixnum, else return the
3636 nearest float if STRING has either floating point or integer syntax
3637 and BASE is 10, else return nil. If IGNORE_TRAILING, consider just
3638 the longest prefix of STRING that has valid floating point syntax.
3639 Signal an overflow if BASE is not 10 and the number has integer
3640 syntax but does not fit. */
3643 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3645 char const *cp
= string
;
3646 bool float_syntax
= 0;
3649 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3650 IEEE floating point hosts, and works around a formerly-common bug where
3651 atof ("-0.0") drops the sign. */
3652 bool negative
= *cp
== '-';
3654 bool signedp
= negative
|| *cp
== '+';
3657 enum { INTOVERFLOW
= 1, LEAD_INT
= 2, DOT_CHAR
= 4, TRAIL_INT
= 8,
3660 int leading_digit
= digit_to_number (*cp
, base
);
3661 uintmax_t n
= leading_digit
;
3662 if (leading_digit
>= 0)
3665 for (int digit
; 0 <= (digit
= digit_to_number (*++cp
, base
)); )
3667 if (INT_MULTIPLY_OVERFLOW (n
, base
))
3668 state
|= INTOVERFLOW
;
3670 if (INT_ADD_OVERFLOW (n
, digit
))
3671 state
|= INTOVERFLOW
;
3683 if ('0' <= *cp
&& *cp
<= '9')
3688 while ('0' <= *cp
&& *cp
<= '9');
3690 if (*cp
== 'e' || *cp
== 'E')
3692 char const *ecp
= cp
;
3694 if (*cp
== '+' || *cp
== '-')
3696 if ('0' <= *cp
&& *cp
<= '9')
3701 while ('0' <= *cp
&& *cp
<= '9');
3703 else if (cp
[-1] == '+'
3704 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3710 else if (cp
[-1] == '+'
3711 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3715 /* NAN is a "positive" NaN on all known Emacs hosts. */
3722 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3723 || (state
& ~INTOVERFLOW
) == (LEAD_INT
|E_EXP
));
3726 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3727 any prefix that matches. Otherwise, the entire string must match. */
3728 if (! (ignore_trailing
3729 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3730 : (!*cp
&& ((state
& ~(INTOVERFLOW
| DOT_CHAR
)) == LEAD_INT
3734 /* If the number uses integer and not float syntax, and is in C-language
3735 range, use its value, preferably as a fixnum. */
3736 if (leading_digit
>= 0 && ! float_syntax
)
3738 if (state
& INTOVERFLOW
)
3740 /* Unfortunately there's no simple and accurate way to convert
3741 non-base-10 numbers that are out of C-language range. */
3743 xsignal1 (Qoverflow_error
, build_string (string
));
3745 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3747 EMACS_INT signed_n
= n
;
3748 return make_number (negative
? -signed_n
: signed_n
);
3754 /* Either the number uses float syntax, or it does not fit into a fixnum.
3755 Convert it from string to floating point, unless the value is already
3756 known because it is an infinity, a NAN, or its absolute value fits in
3759 value
= atof (string
+ signedp
);
3761 return make_float (negative
? -value
: value
);
3766 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3770 Lisp_Object tem
, item
, vector
;
3771 struct Lisp_Cons
*otem
;
3774 tem
= read_list (1, readcharfun
);
3775 len
= Flength (tem
);
3776 vector
= Fmake_vector (len
, Qnil
);
3778 size
= ASIZE (vector
);
3779 ptr
= XVECTOR (vector
)->contents
;
3780 for (i
= 0; i
< size
; i
++)
3783 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3784 bytecode object, the docstring containing the bytecode and
3785 constants values must be treated as unibyte and passed to
3786 Fread, to get the actual bytecode string and constants vector. */
3787 if (bytecodeflag
&& load_force_doc_strings
)
3789 if (i
== COMPILED_BYTECODE
)
3791 if (!STRINGP (item
))
3792 error ("Invalid byte code");
3794 /* Delay handling the bytecode slot until we know whether
3795 it is lazily-loaded (we can tell by whether the
3796 constants slot is nil). */
3797 ASET (vector
, COMPILED_CONSTANTS
, item
);
3800 else if (i
== COMPILED_CONSTANTS
)
3802 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3806 /* Coerce string to unibyte (like string-as-unibyte,
3807 but without generating extra garbage and
3808 guaranteeing no change in the contents). */
3809 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3810 STRING_SET_UNIBYTE (bytestr
);
3812 item
= Fread (Fcons (bytestr
, readcharfun
));
3814 error ("Invalid byte code");
3816 otem
= XCONS (item
);
3817 bytestr
= XCAR (item
);
3822 /* Now handle the bytecode slot. */
3823 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3825 else if (i
== COMPILED_DOC_STRING
3827 && ! STRING_MULTIBYTE (item
))
3829 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3830 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3832 item
= Fstring_as_multibyte (item
);
3835 ASET (vector
, i
, item
);
3843 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3846 read_list (bool flag
, Lisp_Object readcharfun
)
3848 Lisp_Object val
, tail
;
3849 Lisp_Object elt
, tem
;
3850 /* 0 is the normal case.
3851 1 means this list is a doc reference; replace it with the number 0.
3852 2 means this list is a doc reference; replace it with the doc string. */
3853 int doc_reference
= 0;
3855 /* Initialize this to 1 if we are reading a list. */
3856 bool first_in_list
= flag
<= 0;
3864 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3868 /* While building, if the list starts with #$, treat it specially. */
3869 if (EQ (elt
, Vload_file_name
)
3871 && !NILP (Vpurify_flag
))
3873 if (NILP (Vdoc_file_name
))
3874 /* We have not yet called Snarf-documentation, so assume
3875 this file is described in the DOC file
3876 and Snarf-documentation will fill in the right value later.
3877 For now, replace the whole list with 0. */
3880 /* We have already called Snarf-documentation, so make a relative
3881 file name for this file, so it can be found properly
3882 in the installed Lisp directory.
3883 We don't use Fexpand_file_name because that would make
3884 the directory absolute now. */
3886 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3887 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3890 else if (EQ (elt
, Vload_file_name
)
3892 && load_force_doc_strings
)
3901 invalid_syntax (") or . in a vector");
3908 XSETCDR (tail
, read0 (readcharfun
));
3910 val
= read0 (readcharfun
);
3911 read1 (readcharfun
, &ch
, 0);
3915 if (doc_reference
== 1)
3916 return make_number (0);
3917 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3920 file_offset saved_position
;
3921 /* Get a doc string from the file we are loading.
3922 If it's in saved_doc_string, get it from there.
3924 Here, we don't know if the string is a
3925 bytecode string or a doc string. As a
3926 bytecode string must be unibyte, we always
3927 return a unibyte string. If it is actually a
3928 doc string, caller must make it
3931 /* Position is negative for user variables. */
3932 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3933 if (pos
>= saved_doc_string_position
3934 && pos
< (saved_doc_string_position
3935 + saved_doc_string_length
))
3937 saved
= saved_doc_string
;
3938 saved_position
= saved_doc_string_position
;
3940 /* Look in prev_saved_doc_string the same way. */
3941 else if (pos
>= prev_saved_doc_string_position
3942 && pos
< (prev_saved_doc_string_position
3943 + prev_saved_doc_string_length
))
3945 saved
= prev_saved_doc_string
;
3946 saved_position
= prev_saved_doc_string_position
;
3950 ptrdiff_t start
= pos
- saved_position
;
3953 /* Process quoting with ^A,
3954 and find the end of the string,
3955 which is marked with ^_ (037). */
3956 for (from
= start
, to
= start
;
3957 saved
[from
] != 037;)
3959 int c
= saved
[from
++];
3963 saved
[to
++] = (c
== 1 ? c
3972 return make_unibyte_string (saved
+ start
,
3976 return get_doc_string (val
, 1, 0);
3981 invalid_syntax (". in wrong context");
3983 invalid_syntax ("] in a list");
3987 XSETCDR (tail
, tem
);
3994 static Lisp_Object initial_obarray
;
3996 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3998 static size_t oblookup_last_bucket_number
;
4000 /* Get an error if OBARRAY is not an obarray.
4001 If it is one, return it. */
4004 check_obarray (Lisp_Object obarray
)
4006 /* We don't want to signal a wrong-type-argument error when we are
4007 shutting down due to a fatal error, and we don't want to hit
4008 assertions in VECTORP and ASIZE if the fatal error was during GC. */
4009 if (!fatal_error_in_progress
4010 && (!VECTORP (obarray
) || ASIZE (obarray
) == 0))
4012 /* If Vobarray is now invalid, force it to be valid. */
4013 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
4014 wrong_type_argument (Qvectorp
, obarray
);
4019 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
4022 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
4026 XSYMBOL (sym
)->u
.s
.interned
= (EQ (obarray
, initial_obarray
)
4027 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
4030 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
4032 make_symbol_constant (sym
);
4033 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_PLAINVAL
;
4034 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
4037 ptr
= aref_addr (obarray
, XINT (index
));
4038 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
4043 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
4046 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
4048 return intern_sym (Fmake_symbol (string
), obarray
, index
);
4051 /* Intern the C string STR: return a symbol with that name,
4052 interned in the current obarray. */
4055 intern_1 (const char *str
, ptrdiff_t len
)
4057 Lisp_Object obarray
= check_obarray (Vobarray
);
4058 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
4060 return (SYMBOLP (tem
) ? tem
4061 /* The above `oblookup' was done on the basis of nchars==nbytes, so
4062 the string has to be unibyte. */
4063 : intern_driver (make_unibyte_string (str
, len
),
4068 intern_c_string_1 (const char *str
, ptrdiff_t len
)
4070 Lisp_Object obarray
= check_obarray (Vobarray
);
4071 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
4075 /* Creating a non-pure string from a string literal not implemented yet.
4076 We could just use make_string here and live with the extra copy. */
4077 eassert (!NILP (Vpurify_flag
));
4078 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
4084 define_symbol (Lisp_Object sym
, char const *str
)
4086 ptrdiff_t len
= strlen (str
);
4087 Lisp_Object string
= make_pure_c_string (str
, len
);
4088 init_symbol (sym
, string
);
4090 /* Qunbound is uninterned, so that it's not confused with any symbol
4091 'unbound' created by a Lisp program. */
4092 if (! EQ (sym
, Qunbound
))
4094 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
4095 eassert (INTEGERP (bucket
));
4096 intern_sym (sym
, initial_obarray
, bucket
);
4100 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
4101 doc
: /* Return the canonical symbol whose name is STRING.
4102 If there is none, one is created by this function and returned.
4103 A second optional argument specifies the obarray to use;
4104 it defaults to the value of `obarray'. */)
4105 (Lisp_Object string
, Lisp_Object obarray
)
4109 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
4110 CHECK_STRING (string
);
4112 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
4114 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
4119 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
4120 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
4121 NAME may be a string or a symbol. If it is a symbol, that exact
4122 symbol is searched for.
4123 A second optional argument specifies the obarray to use;
4124 it defaults to the value of `obarray'. */)
4125 (Lisp_Object name
, Lisp_Object obarray
)
4127 register Lisp_Object tem
, string
;
4129 if (NILP (obarray
)) obarray
= Vobarray
;
4130 obarray
= check_obarray (obarray
);
4132 if (!SYMBOLP (name
))
4134 CHECK_STRING (name
);
4138 string
= SYMBOL_NAME (name
);
4140 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
4141 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
4147 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
4148 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
4149 The value is t if a symbol was found and deleted, nil otherwise.
4150 NAME may be a string or a symbol. If it is a symbol, that symbol
4151 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
4152 OBARRAY, if nil, defaults to the value of the variable `obarray'.
4153 usage: (unintern NAME OBARRAY) */)
4154 (Lisp_Object name
, Lisp_Object obarray
)
4156 register Lisp_Object string
, tem
;
4159 if (NILP (obarray
)) obarray
= Vobarray
;
4160 obarray
= check_obarray (obarray
);
4163 string
= SYMBOL_NAME (name
);
4166 CHECK_STRING (name
);
4170 tem
= oblookup (obarray
, SSDATA (string
),
4175 /* If arg was a symbol, don't delete anything but that symbol itself. */
4176 if (SYMBOLP (name
) && !EQ (name
, tem
))
4179 /* There are plenty of other symbols which will screw up the Emacs
4180 session if we unintern them, as well as even more ways to use
4181 `setq' or `fset' or whatnot to make the Emacs session
4182 unusable. Let's not go down this silly road. --Stef */
4183 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
4184 error ("Attempt to unintern t or nil"); */
4186 XSYMBOL (tem
)->u
.s
.interned
= SYMBOL_UNINTERNED
;
4188 hash
= oblookup_last_bucket_number
;
4190 if (EQ (AREF (obarray
, hash
), tem
))
4192 if (XSYMBOL (tem
)->u
.s
.next
)
4195 XSETSYMBOL (sym
, XSYMBOL (tem
)->u
.s
.next
);
4196 ASET (obarray
, hash
, sym
);
4199 ASET (obarray
, hash
, make_number (0));
4203 Lisp_Object tail
, following
;
4205 for (tail
= AREF (obarray
, hash
);
4206 XSYMBOL (tail
)->u
.s
.next
;
4209 XSETSYMBOL (following
, XSYMBOL (tail
)->u
.s
.next
);
4210 if (EQ (following
, tem
))
4212 set_symbol_next (tail
, XSYMBOL (following
)->u
.s
.next
);
4221 /* Return the symbol in OBARRAY whose names matches the string
4222 of SIZE characters (SIZE_BYTE bytes) at PTR.
4223 If there is no such symbol, return the integer bucket number of
4224 where the symbol would be if it were present.
4226 Also store the bucket number in oblookup_last_bucket_number. */
4229 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
4233 register Lisp_Object tail
;
4234 Lisp_Object bucket
, tem
;
4236 obarray
= check_obarray (obarray
);
4237 /* This is sometimes needed in the middle of GC. */
4238 obsize
= gc_asize (obarray
);
4239 hash
= hash_string (ptr
, size_byte
) % obsize
;
4240 bucket
= AREF (obarray
, hash
);
4241 oblookup_last_bucket_number
= hash
;
4242 if (EQ (bucket
, make_number (0)))
4244 else if (!SYMBOLP (bucket
))
4245 error ("Bad data in guts of obarray"); /* Like CADR error message. */
4247 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->u
.s
.next
))
4249 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
4250 && SCHARS (SYMBOL_NAME (tail
)) == size
4251 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
4253 else if (XSYMBOL (tail
)->u
.s
.next
== 0)
4256 XSETINT (tem
, hash
);
4261 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
4264 register Lisp_Object tail
;
4265 CHECK_VECTOR (obarray
);
4266 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
4268 tail
= AREF (obarray
, i
);
4273 if (XSYMBOL (tail
)->u
.s
.next
== 0)
4275 XSETSYMBOL (tail
, XSYMBOL (tail
)->u
.s
.next
);
4281 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4283 call1 (function
, sym
);
4286 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4287 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4288 OBARRAY defaults to the value of `obarray'. */)
4289 (Lisp_Object function
, Lisp_Object obarray
)
4291 if (NILP (obarray
)) obarray
= Vobarray
;
4292 obarray
= check_obarray (obarray
);
4294 map_obarray (obarray
, mapatoms_1
, function
);
4298 #define OBARRAY_SIZE 15121
4303 Vobarray
= Fmake_vector (make_number (OBARRAY_SIZE
), make_number (0));
4304 initial_obarray
= Vobarray
;
4305 staticpro (&initial_obarray
);
4307 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4308 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4310 DEFSYM (Qunbound
, "unbound");
4312 DEFSYM (Qnil
, "nil");
4313 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4314 make_symbol_constant (Qnil
);
4315 XSYMBOL (Qnil
)->u
.s
.declared_special
= true;
4318 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4319 make_symbol_constant (Qt
);
4320 XSYMBOL (Qt
)->u
.s
.declared_special
= true;
4322 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4325 DEFSYM (Qvariable_documentation
, "variable-documentation");
4329 defsubr (struct Lisp_Subr
*sname
)
4331 Lisp_Object sym
, tem
;
4332 sym
= intern_c_string (sname
->symbol_name
);
4333 XSETPVECTYPE (sname
, PVEC_SUBR
);
4334 XSETSUBR (tem
, sname
);
4335 set_symbol_function (sym
, tem
);
4338 #ifdef NOTDEF /* Use fset in subr.el now! */
4340 defalias (struct Lisp_Subr
*sname
, char *string
)
4343 sym
= intern (string
);
4344 XSETSUBR (XSYMBOL (sym
)->u
.s
.function
, sname
);
4348 /* Define an "integer variable"; a symbol whose value is forwarded to a
4349 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4350 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4352 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4353 const char *namestring
, EMACS_INT
*address
)
4356 sym
= intern_c_string (namestring
);
4357 i_fwd
->type
= Lisp_Fwd_Int
;
4358 i_fwd
->intvar
= address
;
4359 XSYMBOL (sym
)->u
.s
.declared_special
= true;
4360 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_FORWARDED
;
4361 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4364 /* Similar but define a variable whose value is t if address contains 1,
4365 nil if address contains 0. */
4367 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4368 const char *namestring
, bool *address
)
4371 sym
= intern_c_string (namestring
);
4372 b_fwd
->type
= Lisp_Fwd_Bool
;
4373 b_fwd
->boolvar
= address
;
4374 XSYMBOL (sym
)->u
.s
.declared_special
= true;
4375 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_FORWARDED
;
4376 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4377 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4380 /* Similar but define a variable whose value is the Lisp Object stored
4381 at address. Two versions: with and without gc-marking of the C
4382 variable. The nopro version is used when that variable will be
4383 gc-marked for some other reason, since marking the same slot twice
4384 can cause trouble with strings. */
4386 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4387 const char *namestring
, Lisp_Object
*address
)
4390 sym
= intern_c_string (namestring
);
4391 o_fwd
->type
= Lisp_Fwd_Obj
;
4392 o_fwd
->objvar
= address
;
4393 XSYMBOL (sym
)->u
.s
.declared_special
= true;
4394 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_FORWARDED
;
4395 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4399 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4400 const char *namestring
, Lisp_Object
*address
)
4402 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4403 staticpro (address
);
4406 /* Similar but define a variable whose value is the Lisp Object stored
4407 at a particular offset in the current kboard object. */
4410 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4411 const char *namestring
, int offset
)
4414 sym
= intern_c_string (namestring
);
4415 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4416 ko_fwd
->offset
= offset
;
4417 XSYMBOL (sym
)->u
.s
.declared_special
= true;
4418 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_FORWARDED
;
4419 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4422 /* Check that the elements of lpath exist. */
4425 load_path_check (Lisp_Object lpath
)
4427 Lisp_Object path_tail
;
4429 /* The only elements that might not exist are those from
4430 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4432 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4434 Lisp_Object dirfile
;
4435 dirfile
= Fcar (path_tail
);
4436 if (STRINGP (dirfile
))
4438 dirfile
= Fdirectory_file_name (dirfile
);
4439 if (! file_accessible_directory_p (dirfile
))
4440 dir_warning ("Lisp directory", XCAR (path_tail
));
4445 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4446 This does not include the standard site-lisp directories
4447 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4448 but it does (unless no_site_lisp is set) include site-lisp
4449 directories in the source/build directories if those exist and we
4450 are running uninstalled.
4452 Uses the following logic:
4454 If Vinstallation_directory is not nil (ie, running uninstalled),
4455 use PATH_DUMPLOADSEARCH (ie, build path). Else use PATH_LOADSEARCH.
4456 The remainder is what happens when dumping works:
4457 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4458 Otherwise use PATH_LOADSEARCH.
4460 If !initialized, then just return PATH_DUMPLOADSEARCH.
4462 If Vinstallation_directory is not nil (ie, running uninstalled):
4463 If installation-dir/lisp exists and not already a member,
4464 we must be running uninstalled. Reset the load-path
4465 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4466 refers to the eventual installation directories. Since we
4467 are not yet installed, we should not use them, even if they exist.)
4468 If installation-dir/lisp does not exist, just add
4469 PATH_DUMPLOADSEARCH at the end instead.
4470 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4471 and not already a member) at the front.
4472 If installation-dir != source-dir (ie running an uninstalled,
4473 out-of-tree build) AND install-dir/src/Makefile exists BUT
4474 install-dir/src/Makefile.in does NOT exist (this is a sanity
4475 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4478 load_path_default (void)
4480 Lisp_Object lpath
= Qnil
;
4485 const char *loadpath
= ns_load_path ();
4488 normal
= PATH_LOADSEARCH
;
4489 if (!NILP (Vinstallation_directory
)) normal
= PATH_DUMPLOADSEARCH
;
4492 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4494 lpath
= decode_env_path (0, normal
, 0);
4497 #else /* !CANNOT_DUMP */
4499 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4504 const char *loadpath
= ns_load_path ();
4505 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4507 lpath
= decode_env_path (0, normal
, 0);
4509 if (!NILP (Vinstallation_directory
))
4511 Lisp_Object tem
, tem1
;
4513 /* Add to the path the lisp subdir of the installation
4514 dir, if it is accessible. Note: in out-of-tree builds,
4515 this directory is empty save for Makefile. */
4516 tem
= Fexpand_file_name (build_string ("lisp"),
4517 Vinstallation_directory
);
4518 tem1
= Ffile_accessible_directory_p (tem
);
4521 if (NILP (Fmember (tem
, lpath
)))
4523 /* We are running uninstalled. The default load-path
4524 points to the eventual installed lisp directories.
4525 We should not use those now, even if they exist,
4526 so start over from a clean slate. */
4527 lpath
= list1 (tem
);
4531 /* That dir doesn't exist, so add the build-time
4532 Lisp dirs instead. */
4534 Lisp_Object dump_path
=
4535 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4536 lpath
= nconc2 (lpath
, dump_path
);
4539 /* Add site-lisp under the installation dir, if it exists. */
4542 tem
= Fexpand_file_name (build_string ("site-lisp"),
4543 Vinstallation_directory
);
4544 tem1
= Ffile_accessible_directory_p (tem
);
4547 if (NILP (Fmember (tem
, lpath
)))
4548 lpath
= Fcons (tem
, lpath
);
4552 /* If Emacs was not built in the source directory,
4553 and it is run from where it was built, add to load-path
4554 the lisp and site-lisp dirs under that directory. */
4556 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4560 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4561 Vinstallation_directory
);
4562 tem1
= Ffile_exists_p (tem
);
4564 /* Don't be fooled if they moved the entire source tree
4565 AFTER dumping Emacs. If the build directory is indeed
4566 different from the source dir, src/Makefile.in and
4567 src/Makefile will not be found together. */
4568 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4569 Vinstallation_directory
);
4570 tem2
= Ffile_exists_p (tem
);
4571 if (!NILP (tem1
) && NILP (tem2
))
4573 tem
= Fexpand_file_name (build_string ("lisp"),
4576 if (NILP (Fmember (tem
, lpath
)))
4577 lpath
= Fcons (tem
, lpath
);
4581 tem
= Fexpand_file_name (build_string ("site-lisp"),
4583 tem1
= Ffile_accessible_directory_p (tem
);
4586 if (NILP (Fmember (tem
, lpath
)))
4587 lpath
= Fcons (tem
, lpath
);
4591 } /* Vinstallation_directory != Vsource_directory */
4593 } /* if Vinstallation_directory */
4595 else /* !initialized */
4597 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4598 source directory. We used to add ../lisp (ie the lisp dir in
4599 the build directory) at the front here, but that should not
4600 be necessary, since in out of tree builds lisp/ is empty, save
4602 lpath
= decode_env_path (0, normal
, 0);
4604 #endif /* !CANNOT_DUMP */
4612 if (NILP (Vpurify_flag
) && !NILP (Ffboundp (Qfile_truename
)))
4613 Vsource_directory
= call1 (Qfile_truename
, Vsource_directory
);
4615 /* First, set Vload_path. */
4617 /* Ignore EMACSLOADPATH when dumping. */
4619 bool use_loadpath
= true;
4621 bool use_loadpath
= NILP (Vpurify_flag
);
4624 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4626 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4628 /* Check (non-nil) user-supplied elements. */
4629 load_path_check (Vload_path
);
4631 /* If no nils in the environment variable, use as-is.
4632 Otherwise, replace any nils with the default. */
4633 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4635 Lisp_Object elem
, elpath
= Vload_path
;
4636 Lisp_Object default_lpath
= load_path_default ();
4638 /* Check defaults, before adding site-lisp. */
4639 load_path_check (default_lpath
);
4641 /* Add the site-lisp directories to the front of the default. */
4642 if (!no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4644 Lisp_Object sitelisp
;
4645 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4646 if (! NILP (sitelisp
))
4647 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4652 /* Replace nils from EMACSLOADPATH by default. */
4653 while (CONSP (elpath
))
4655 elem
= XCAR (elpath
);
4656 elpath
= XCDR (elpath
);
4657 Vload_path
= CALLN (Fappend
, Vload_path
,
4658 NILP (elem
) ? default_lpath
: list1 (elem
));
4660 } /* Fmemq (Qnil, Vload_path) */
4664 Vload_path
= load_path_default ();
4666 /* Check before adding site-lisp directories.
4667 The install should have created them, but they are not
4668 required, so no need to warn if they are absent.
4669 Or we might be running before installation. */
4670 load_path_check (Vload_path
);
4672 /* Add the site-lisp directories at the front. */
4673 if (initialized
&& !no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4675 Lisp_Object sitelisp
;
4676 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4677 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4683 load_in_progress
= 0;
4684 Vload_file_name
= Qnil
;
4685 Vstandard_input
= Qt
;
4686 Vloads_in_progress
= Qnil
;
4689 /* Print a warning that directory intended for use USE and with name
4690 DIRNAME cannot be accessed. On entry, errno should correspond to
4691 the access failure. Print the warning on stderr and put it in
4695 dir_warning (char const *use
, Lisp_Object dirname
)
4697 static char const format
[] = "Warning: %s '%s': %s\n";
4698 char *diagnostic
= emacs_strerror (errno
);
4699 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)), diagnostic
);
4701 /* Don't log the warning before we've initialized!! */
4704 ptrdiff_t diaglen
= strlen (diagnostic
);
4705 AUTO_STRING_WITH_LEN (diag
, diagnostic
, diaglen
);
4706 if (! NILP (Vlocale_coding_system
))
4709 = code_convert_string_norecord (diag
, Vlocale_coding_system
, false);
4710 diagnostic
= SSDATA (s
);
4711 diaglen
= SBYTES (s
);
4714 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4715 + strlen (use
) + SBYTES (dirname
) + diaglen
);
4716 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4718 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4724 syms_of_lread (void)
4727 defsubr (&Sread_from_string
);
4728 defsubr (&Slread__substitute_object_in_subtree
);
4730 defsubr (&Sintern_soft
);
4731 defsubr (&Sunintern
);
4732 defsubr (&Sget_load_suffixes
);
4734 defsubr (&Seval_buffer
);
4735 defsubr (&Seval_region
);
4736 defsubr (&Sread_char
);
4737 defsubr (&Sread_char_exclusive
);
4738 defsubr (&Sread_event
);
4739 defsubr (&Sget_file_char
);
4740 defsubr (&Smapatoms
);
4741 defsubr (&Slocate_file_internal
);
4743 DEFVAR_LISP ("obarray", Vobarray
,
4744 doc
: /* Symbol table for use by `intern' and `read'.
4745 It is a vector whose length ought to be prime for best results.
4746 The vector's contents don't make sense if examined from Lisp programs;
4747 to find all the symbols in an obarray, use `mapatoms'. */);
4749 DEFVAR_LISP ("values", Vvalues
,
4750 doc
: /* List of values of all expressions which were read, evaluated and printed.
4751 Order is reverse chronological. */);
4752 XSYMBOL (intern ("values"))->u
.s
.declared_special
= false;
4754 DEFVAR_LISP ("standard-input", Vstandard_input
,
4755 doc
: /* Stream for read to get input from.
4756 See documentation of `read' for possible values. */);
4757 Vstandard_input
= Qt
;
4759 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4760 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4762 If this variable is a buffer, then only forms read from that buffer
4763 will be added to `read-symbol-positions-list'.
4764 If this variable is t, then all read forms will be added.
4765 The effect of all other values other than nil are not currently
4766 defined, although they may be in the future.
4768 The positions are relative to the last call to `read' or
4769 `read-from-string'. It is probably a bad idea to set this variable at
4770 the toplevel; bind it instead. */);
4771 Vread_with_symbol_positions
= Qnil
;
4773 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4774 doc
: /* A list mapping read symbols to their positions.
4775 This variable is modified during calls to `read' or
4776 `read-from-string', but only when `read-with-symbol-positions' is
4779 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4780 CHAR-POSITION is an integer giving the offset of that occurrence of the
4781 symbol from the position where `read' or `read-from-string' started.
4783 Note that a symbol will appear multiple times in this list, if it was
4784 read multiple times. The list is in the same order as the symbols
4786 Vread_symbol_positions_list
= Qnil
;
4788 DEFVAR_LISP ("read-circle", Vread_circle
,
4789 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4792 DEFVAR_LISP ("load-path", Vload_path
,
4793 doc
: /* List of directories to search for files to load.
4794 Each element is a string (directory file name) or nil (meaning
4795 `default-directory').
4796 This list is consulted by the `require' function.
4797 Initialized during startup as described in Info node `(elisp)Library Search'.
4798 Use `directory-file-name' when adding items to this path. However, Lisp
4799 programs that process this list should tolerate directories both with
4800 and without trailing slashes. */);
4802 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4803 doc
: /* List of suffixes for Emacs Lisp files and dynamic modules.
4804 This list includes suffixes for both compiled and source Emacs Lisp files.
4805 This list should not include the empty string.
4806 `load' and related functions try to append these suffixes, in order,
4807 to the specified file name if a suffix is allowed or required. */);
4809 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4810 build_pure_c_string (".el"),
4811 build_pure_c_string (MODULES_SUFFIX
));
4813 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4814 build_pure_c_string (".el"));
4816 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix
,
4817 doc
: /* Suffix of loadable module file, or nil if modules are not supported. */);
4819 Vmodule_file_suffix
= build_pure_c_string (MODULES_SUFFIX
);
4821 Vmodule_file_suffix
= Qnil
;
4823 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4824 doc
: /* List of suffixes that indicate representations of \
4826 This list should normally start with the empty string.
4828 Enabling Auto Compression mode appends the suffixes in
4829 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4830 mode removes them again. `load' and related functions use this list to
4831 determine whether they should look for compressed versions of a file
4832 and, if so, which suffixes they should try to append to the file name
4833 in order to do so. However, if you want to customize which suffixes
4834 the loading functions recognize as compression suffixes, you should
4835 customize `jka-compr-load-suffixes' rather than the present variable. */);
4836 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4838 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4839 doc
: /* Non-nil if inside of `load'. */);
4840 DEFSYM (Qload_in_progress
, "load-in-progress");
4842 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4843 doc
: /* An alist of functions to be evalled when particular files are loaded.
4844 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4846 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4847 a symbol (a feature name).
4849 When `load' is run and the file-name argument matches an element's
4850 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4851 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4853 An error in FORMS does not undo the load, but does prevent execution of
4854 the rest of the FORMS. */);
4855 Vafter_load_alist
= Qnil
;
4857 DEFVAR_LISP ("load-history", Vload_history
,
4858 doc
: /* Alist mapping loaded file names to symbols and features.
4859 Each alist element should be a list (FILE-NAME ENTRIES...), where
4860 FILE-NAME is the name of a file that has been loaded into Emacs.
4861 The file name is absolute and true (i.e. it doesn't contain symlinks).
4862 As an exception, one of the alist elements may have FILE-NAME nil,
4863 for symbols and features not associated with any file.
4865 The remaining ENTRIES in the alist element describe the functions and
4866 variables defined in that file, the features provided, and the
4867 features required. Each entry has the form `(provide . FEATURE)',
4868 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4869 `(defface . SYMBOL)', `(define-type . SYMBOL)',
4870 `(cl-defmethod METHOD SPECIALIZERS)', or `(t . SYMBOL)'.
4871 Entries like `(t . SYMBOL)' may precede a `(defun . FUNCTION)' entry,
4872 and means that SYMBOL was an autoload before this file redefined it
4873 as a function. In addition, entries may also be single symbols,
4874 which means that symbol was defined by `defvar' or `defconst'.
4876 During preloading, the file name recorded is relative to the main Lisp
4877 directory. These file names are converted to absolute at startup. */);
4878 Vload_history
= Qnil
;
4880 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4881 doc
: /* Full name of file being loaded by `load'. */);
4882 Vload_file_name
= Qnil
;
4884 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4885 doc
: /* File name, including directory, of user's initialization file.
4886 If the file loaded had extension `.elc', and the corresponding source file
4887 exists, this variable contains the name of source file, suitable for use
4888 by functions like `custom-save-all' which edit the init file.
4889 While Emacs loads and evaluates the init file, value is the real name
4890 of the file, regardless of whether or not it has the `.elc' extension. */);
4891 Vuser_init_file
= Qnil
;
4893 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4894 doc
: /* Used for internal purposes by `load'. */);
4895 Vcurrent_load_list
= Qnil
;
4897 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4898 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4899 Called with a single argument (the stream from which to read).
4900 The default is to use the function `read'. */);
4901 DEFSYM (Qread
, "read");
4902 Vload_read_function
= Qread
;
4904 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4905 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4906 The value should be a function for doing code conversion before
4907 reading a source file. It can also be nil, in which case loading is
4908 done without any code conversion.
4910 If the value is a function, it is called with four arguments,
4911 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4912 the file to load, FILE is the non-absolute name (for messages etc.),
4913 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4914 `load'. The function should return t if the file was loaded. */);
4915 Vload_source_file_function
= Qnil
;
4917 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4918 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4919 This is useful when the file being loaded is a temporary copy. */);
4920 load_force_doc_strings
= 0;
4922 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4923 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4924 This is normally bound by `load' and `eval-buffer' to control `read',
4925 and is not meant for users to change. */);
4926 load_convert_to_unibyte
= 0;
4928 DEFVAR_LISP ("source-directory", Vsource_directory
,
4929 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4930 You cannot count on them to still be there! */);
4932 = Fexpand_file_name (build_string ("../"),
4933 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4935 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4936 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4937 Vpreloaded_file_list
= Qnil
;
4939 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4940 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4941 Vbyte_boolean_vars
= Qnil
;
4943 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4944 doc
: /* Non-nil means load dangerous compiled Lisp files.
4945 Some versions of XEmacs use different byte codes than Emacs. These
4946 incompatible byte codes can make Emacs crash when it tries to execute
4948 load_dangerous_libraries
= 0;
4950 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4951 doc
: /* Non-nil means force printing messages when loading Lisp files.
4952 This overrides the value of the NOMESSAGE argument to `load'. */);
4953 force_load_messages
= 0;
4955 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4956 doc
: /* Regular expression matching safe to load compiled Lisp files.
4957 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4958 from the file, and matches them against this regular expression.
4959 When the regular expression matches, the file is considered to be safe
4960 to load. See also `load-dangerous-libraries'. */);
4961 Vbytecomp_version_regexp
4962 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4964 DEFSYM (Qlexical_binding
, "lexical-binding");
4965 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4966 doc
: /* Whether to use lexical binding when evaluating code.
4967 Non-nil means that the code in the current buffer should be evaluated
4968 with lexical binding.
4969 This variable is automatically set from the file variables of an
4970 interpreted Lisp file read using `load'. Unlike other file local
4971 variables, this must be set in the first line of a file. */);
4972 Vlexical_binding
= Qnil
;
4973 Fmake_variable_buffer_local (Qlexical_binding
);
4975 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4976 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4977 Veval_buffer_list
= Qnil
;
4979 DEFVAR_LISP ("lread--unescaped-character-literals",
4980 Vlread_unescaped_character_literals
,
4981 doc
: /* List of deprecated unescaped character literals encountered by `read'.
4982 For internal use only. */);
4983 Vlread_unescaped_character_literals
= Qnil
;
4984 DEFSYM (Qlread_unescaped_character_literals
,
4985 "lread--unescaped-character-literals");
4988 DEFSYM (Qchar
, "char");
4989 DEFSYM (Qformat
, "format");
4991 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4992 doc
: /* Non-nil means `load' prefers the newest version of a file.
4993 This applies when a filename suffix is not explicitly specified and
4994 `load' is trying various possible suffixes (see `load-suffixes' and
4995 `load-file-rep-suffixes'). Normally, it stops at the first file
4996 that exists unless you explicitly specify one or the other. If this
4997 option is non-nil, it checks all suffixes and uses whichever file is
4999 Note that if you customize this, obviously it will not affect files
5000 that are loaded before your customizations are read! */);
5001 load_prefer_newer
= 0;
5003 DEFVAR_BOOL ("force-new-style-backquotes", force_new_style_backquotes
,
5004 doc
: /* Non-nil means to always use the current syntax for backquotes.
5005 If nil, `load' and `read' raise errors when encountering some
5006 old-style variants of backquote and comma. If non-nil, these
5007 constructs are always interpreted as described in the Info node
5008 `(elisp)Backquotes', even if that interpretation is incompatible with
5009 previous versions of Emacs. Setting this variable to non-nil makes
5010 Emacs compatible with the behavior planned for Emacs 28. In Emacs 28,
5011 this variable will become obsolete. */);
5012 force_new_style_backquotes
= false;
5014 /* Vsource_directory was initialized in init_lread. */
5016 DEFSYM (Qcurrent_load_list
, "current-load-list");
5017 DEFSYM (Qstandard_input
, "standard-input");
5018 DEFSYM (Qread_char
, "read-char");
5019 DEFSYM (Qget_file_char
, "get-file-char");
5021 /* Used instead of Qget_file_char while loading *.elc files compiled
5022 by Emacs 21 or older. */
5023 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
5025 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
5027 DEFSYM (Qbackquote
, "`");
5028 DEFSYM (Qcomma
, ",");
5029 DEFSYM (Qcomma_at
, ",@");
5030 DEFSYM (Qcomma_dot
, ",.");
5032 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
5033 DEFSYM (Qascii_character
, "ascii-character");
5034 DEFSYM (Qfunction
, "function");
5035 DEFSYM (Qload
, "load");
5036 DEFSYM (Qload_file_name
, "load-file-name");
5037 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
5038 DEFSYM (Qfile_truename
, "file-truename");
5039 DEFSYM (Qdir_ok
, "dir-ok");
5040 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
5042 staticpro (&read_objects_map
);
5043 read_objects_map
= Qnil
;
5044 staticpro (&read_objects_completed
);
5045 read_objects_completed
= Qnil
;
5047 Vloads_in_progress
= Qnil
;
5048 staticpro (&Vloads_in_progress
);
5050 DEFSYM (Qhash_table
, "hash-table");
5051 DEFSYM (Qdata
, "data");
5052 DEFSYM (Qtest
, "test");
5053 DEFSYM (Qsize
, "size");
5054 DEFSYM (Qpurecopy
, "purecopy");
5055 DEFSYM (Qweakness
, "weakness");
5056 DEFSYM (Qrehash_size
, "rehash-size");
5057 DEFSYM (Qrehash_threshold
, "rehash-threshold");
5059 DEFSYM (Qchar_from_name
, "char-from-name");