1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2017 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
151 with no surrounding parentheses.
152 Fread initializes this to false, so we need not specbind it
153 or worry about what happens to it when there is an error. */
154 static bool new_backquote_flag
;
156 /* A list of file names for files being loaded in Fload. Used to
157 check for recursive loads. */
159 static Lisp_Object Vloads_in_progress
;
161 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
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 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
1010 xsignal1 (Qerror
, CALLN (Fformat_message
, format
, Vload_file_name
));
1014 load_warn_unescaped_character_literals (Lisp_Object file
)
1016 if (NILP (Vlread_unescaped_character_literals
)) return;
1017 CHECK_CONS (Vlread_unescaped_character_literals
);
1018 Lisp_Object format
=
1019 build_string ("Loading `%s': unescaped character literals %s detected!");
1020 Lisp_Object separator
= build_string (", ");
1021 Lisp_Object inner_format
= build_string ("`?%c'");
1024 Fmapconcat (list3 (Qlambda
, list1 (Qchar
),
1025 list3 (Qformat
, inner_format
, Qchar
)),
1026 Fsort (Vlread_unescaped_character_literals
, Qlss
),
1030 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
1031 doc
: /* Return the suffixes that `load' should try if a suffix is \
1033 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
1036 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
1037 while (CONSP (suffixes
))
1039 Lisp_Object exts
= Vload_file_rep_suffixes
;
1040 suffix
= XCAR (suffixes
);
1041 suffixes
= XCDR (suffixes
);
1042 while (CONSP (exts
))
1046 lst
= Fcons (concat2 (suffix
, ext
), lst
);
1049 return Fnreverse (lst
);
1052 /* Returns true if STRING ends with SUFFIX */
1054 suffix_p (Lisp_Object string
, const char *suffix
)
1056 ptrdiff_t suffix_len
= strlen (suffix
);
1057 ptrdiff_t string_len
= SBYTES (string
);
1059 return string_len
>= suffix_len
&& !strcmp (SSDATA (string
) + string_len
- suffix_len
, suffix
);
1063 close_infile_unwind (void *arg
)
1066 eassert (infile
== NULL
|| infile
->stream
== stream
);
1071 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1072 doc
: /* Execute a file of Lisp code named FILE.
1073 First try FILE with `.elc' appended, then try with `.el', then try
1074 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
1075 then try FILE unmodified (the exact suffixes in the exact order are
1076 determined by `load-suffixes'). Environment variable references in
1077 FILE are replaced with their values by calling `substitute-in-file-name'.
1078 This function searches the directories in `load-path'.
1080 If optional second arg NOERROR is non-nil,
1081 report no error if FILE doesn't exist.
1082 Print messages at start and end of loading unless
1083 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1085 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1086 suffixes to the specified name FILE.
1087 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1088 the suffix `.elc' or `.el' or the module suffix; don't accept just
1089 FILE unless it ends in one of those suffixes or includes a directory name.
1091 If NOSUFFIX is nil, then if a file could not be found, try looking for
1092 a different representation of the file by adding non-empty suffixes to
1093 its name, before trying another file. Emacs uses this feature to find
1094 compressed versions of files when Auto Compression mode is enabled.
1095 If NOSUFFIX is non-nil, disable this feature.
1097 The suffixes that this function tries out, when NOSUFFIX is nil, are
1098 given by the return value of `get-load-suffixes' and the values listed
1099 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1100 return value of `get-load-suffixes' is used, i.e. the file name is
1101 required to have a non-empty suffix.
1103 When searching suffixes, this function normally stops at the first
1104 one that exists. If the option `load-prefer-newer' is non-nil,
1105 however, it tries all suffixes, and uses whichever file is the newest.
1107 Loading a file records its definitions, and its `provide' and
1108 `require' calls, in an element of `load-history' whose
1109 car is the file name loaded. See `load-history'.
1111 While the file is in the process of being loaded, the variable
1112 `load-in-progress' is non-nil and the variable `load-file-name'
1113 is bound to the file's name.
1115 Return t if the file exists and loads successfully. */)
1116 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1117 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1121 int fd_index UNINIT
;
1122 ptrdiff_t count
= SPECPDL_INDEX ();
1123 Lisp_Object found
, efound
, hist_file_name
;
1124 /* True means we printed the ".el is newer" message. */
1126 /* True means we are loading a compiled file. */
1128 Lisp_Object handler
;
1130 const char *fmode
= "r" FOPEN_TEXT
;
1133 CHECK_STRING (file
);
1135 /* If file name is magic, call the handler. */
1136 /* This shouldn't be necessary any more now that `openp' handles it right.
1137 handler = Ffind_file_name_handler (file, Qload);
1138 if (!NILP (handler))
1139 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1141 /* The presence of this call is the result of a historical accident:
1142 it used to be in every file-operation and when it got removed
1143 everywhere, it accidentally stayed here. Since then, enough people
1144 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1145 that it seemed risky to remove. */
1146 if (! NILP (noerror
))
1148 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1149 Qt
, load_error_handler
);
1154 file
= Fsubstitute_in_file_name (file
);
1156 /* Avoid weird lossage with null string as arg,
1157 since it would try to load a directory as a Lisp file. */
1158 if (SCHARS (file
) == 0)
1165 Lisp_Object suffixes
;
1168 if (! NILP (must_suffix
))
1170 /* Don't insist on adding a suffix if FILE already ends with one. */
1171 if (suffix_p (file
, ".el")
1172 || suffix_p (file
, ".elc")
1174 || suffix_p (file
, MODULES_SUFFIX
)
1178 /* Don't insist on adding a suffix
1179 if the argument includes a directory name. */
1180 else if (! NILP (Ffile_name_directory (file
)))
1184 if (!NILP (nosuffix
))
1188 suffixes
= Fget_load_suffixes ();
1189 if (NILP (must_suffix
))
1190 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1193 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1199 report_file_error ("Cannot open load file", file
);
1203 /* Tell startup.el whether or not we found the user's init file. */
1204 if (EQ (Qt
, Vuser_init_file
))
1205 Vuser_init_file
= found
;
1207 /* If FD is -2, that means openp found a magic file. */
1210 if (NILP (Fequal (found
, file
)))
1211 /* If FOUND is a different file name from FILE,
1212 find its handler even if we have already inhibited
1213 the `load' operation on FILE. */
1214 handler
= Ffind_file_name_handler (found
, Qt
);
1216 handler
= Ffind_file_name_handler (found
, Qload
);
1217 if (! NILP (handler
))
1218 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1220 /* Tramp has to deal with semi-broken packages that prepend
1221 drive letters to remote files. For that reason, Tramp
1222 catches file operations that test for file existence, which
1223 makes openp think X:/foo.elc files are remote. However,
1224 Tramp does not catch `load' operations for such files, so we
1225 end up with a nil as the `load' handler above. If we would
1226 continue with fd = -2, we will behave wrongly, and in
1227 particular try reading a .elc file in the "rt" mode instead
1228 of "rb". See bug #9311 for the results. To work around
1229 this, we try to open the file locally, and go with that if it
1231 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1239 fd_index
= SPECPDL_INDEX ();
1240 record_unwind_protect_int (close_file_unwind
, fd
);
1244 if (suffix_p (found
, MODULES_SUFFIX
))
1245 return unbind_to (count
, Fmodule_load (found
));
1248 /* Check if we're stuck in a recursive load cycle.
1250 2000-09-21: It's not possible to just check for the file loaded
1251 being a member of Vloads_in_progress. This fails because of the
1252 way the byte compiler currently works; `provide's are not
1253 evaluated, see font-lock.el/jit-lock.el as an example. This
1254 leads to a certain amount of ``normal'' recursion.
1256 Also, just loading a file recursively is not always an error in
1257 the general case; the second load may do something different. */
1261 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1262 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1263 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1264 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1265 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1268 /* All loads are by default dynamic, unless the file itself specifies
1269 otherwise using a file-variable in the first line. This is bound here
1270 so that it takes effect whether or not we use
1271 Vload_source_file_function. */
1272 specbind (Qlexical_binding
, Qnil
);
1274 /* Get the name for load-history. */
1275 hist_file_name
= (! NILP (Vpurify_flag
)
1276 ? concat2 (Ffile_name_directory (file
),
1277 Ffile_name_nondirectory (found
))
1282 /* Check for the presence of unescaped character literals and warn
1284 specbind (Qlread_unescaped_character_literals
, Qnil
);
1285 record_unwind_protect (load_warn_unescaped_character_literals
, file
);
1288 if ((is_elc
= suffix_p (found
, ".elc")) != 0
1289 /* version = 1 means the file is empty, in which case we can
1290 treat it as not byte-compiled. */
1291 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 1))
1292 /* Load .elc files directly, but not when they are
1293 remote and have no handler! */
1301 && ! (version
= safe_to_load_version (fd
)))
1304 if (!load_dangerous_libraries
)
1305 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1306 else if (!NILP (nomessage
) && !force_load_messages
)
1307 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1312 efound
= ENCODE_FILE (found
);
1313 fmode
= "r" FOPEN_BINARY
;
1315 /* openp already checked for newness, no point doing it again.
1316 FIXME would be nice to get a message when openp
1317 ignores suffix order due to load_prefer_newer. */
1318 if (!load_prefer_newer
&& is_elc
)
1320 result
= stat (SSDATA (efound
), &s1
);
1323 SSET (efound
, SBYTES (efound
) - 1, 0);
1324 result
= stat (SSDATA (efound
), &s2
);
1325 SSET (efound
, SBYTES (efound
) - 1, 'c');
1329 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1331 /* Make the progress messages mention that source is newer. */
1334 /* If we won't print another message, mention this anyway. */
1335 if (!NILP (nomessage
) && !force_load_messages
)
1337 Lisp_Object msg_file
;
1338 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1339 message_with_string ("Source file `%s' newer than byte-compiled file",
1343 } /* !load_prefer_newer */
1348 /* We are loading a source file (*.el). */
1349 if (!NILP (Vload_source_file_function
))
1356 clear_unwind_protect (fd_index
);
1358 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1359 NILP (noerror
) ? Qnil
: Qt
,
1360 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1361 return unbind_to (count
, val
);
1367 /* We somehow got here with fd == -2, meaning the file is deemed
1368 to be remote. Don't even try to reopen the file locally;
1369 just force a failure. */
1377 clear_unwind_protect (fd_index
);
1378 efound
= ENCODE_FILE (found
);
1379 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1381 stream
= fdopen (fd
, fmode
);
1385 report_file_error ("Opening stdio stream", file
);
1386 set_unwind_protect_ptr (fd_index
, close_infile_unwind
, stream
);
1388 if (! NILP (Vpurify_flag
))
1389 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1391 if (NILP (nomessage
) || force_load_messages
)
1394 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1397 message_with_string ("Loading %s (source)...", file
, 1);
1399 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1401 else /* The typical case; compiled file newer than source file. */
1402 message_with_string ("Loading %s...", file
, 1);
1405 specbind (Qload_file_name
, found
);
1406 specbind (Qinhibit_file_name_operation
, Qnil
);
1407 specbind (Qload_in_progress
, Qt
);
1409 struct infile input
;
1410 input
.stream
= stream
;
1411 input
.lookahead
= 0;
1414 if (lisp_file_lexically_bound_p (Qget_file_char
))
1415 Fset (Qlexical_binding
, Qt
);
1417 if (! version
|| version
>= 22)
1418 readevalloop (Qget_file_char
, &input
, hist_file_name
,
1419 0, Qnil
, Qnil
, Qnil
, Qnil
);
1422 /* We can't handle a file which was compiled with
1423 byte-compile-dynamic by older version of Emacs. */
1424 specbind (Qload_force_doc_strings
, Qt
);
1425 readevalloop (Qget_emacs_mule_file_char
, &input
, hist_file_name
,
1426 0, Qnil
, Qnil
, Qnil
, Qnil
);
1428 unbind_to (count
, Qnil
);
1430 /* Run any eval-after-load forms for this file. */
1431 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1432 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1434 xfree (saved_doc_string
);
1435 saved_doc_string
= 0;
1436 saved_doc_string_size
= 0;
1438 xfree (prev_saved_doc_string
);
1439 prev_saved_doc_string
= 0;
1440 prev_saved_doc_string_size
= 0;
1442 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1445 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1448 message_with_string ("Loading %s (source)...done", file
, 1);
1450 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1452 else /* The typical case; compiled file newer than source file. */
1453 message_with_string ("Loading %s...done", file
, 1);
1460 complete_filename_p (Lisp_Object pathname
)
1462 const unsigned char *s
= SDATA (pathname
);
1463 return (IS_DIRECTORY_SEP (s
[0])
1464 || (SCHARS (pathname
) > 2
1465 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1468 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1469 doc
: /* Search for FILENAME through PATH.
1470 Returns the file's name in absolute form, or nil if not found.
1471 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1472 file name when searching.
1473 If non-nil, PREDICATE is used instead of `file-readable-p'.
1474 PREDICATE can also be an integer to pass to the faccessat(2) function,
1475 in which case file-name-handlers are ignored.
1476 This function will normally skip directories, so if you want it to find
1477 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1478 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1481 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1482 if (NILP (predicate
) && fd
>= 0)
1487 /* Search for a file whose name is STR, looking in directories
1488 in the Lisp list PATH, and trying suffixes from SUFFIX.
1489 On success, return a file descriptor (or 1 or -2 as described below).
1490 On failure, return -1 and set errno.
1492 SUFFIXES is a list of strings containing possible suffixes.
1493 The empty suffix is automatically added if the list is empty.
1495 PREDICATE t means the files are binary.
1496 PREDICATE non-nil and non-t means don't open the files,
1497 just look for one that satisfies the predicate. In this case,
1498 return -2 on success. The predicate can be a lisp function or
1499 an integer to pass to `access' (in which case file-name-handlers
1502 If STOREPTR is nonzero, it points to a slot where the name of
1503 the file actually found should be stored as a Lisp string.
1504 nil is stored there on failure.
1506 If the file we find is remote, return -2
1507 but store the found remote file name in *STOREPTR.
1509 If NEWER is true, try all SUFFIXes and return the result for the
1510 newest file that exists. Does not apply to remote files,
1511 or if a non-nil and non-t PREDICATE is specified. */
1514 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1515 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1517 ptrdiff_t fn_size
= 100;
1521 ptrdiff_t want_length
;
1522 Lisp_Object filename
;
1523 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1524 ptrdiff_t max_suffix_len
= 0;
1525 int last_errno
= ENOENT
;
1529 /* The last-modified time of the newest matching file found.
1530 Initialize it to something less than all valid timestamps. */
1531 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1535 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1537 CHECK_STRING_CAR (tail
);
1538 max_suffix_len
= max (max_suffix_len
,
1539 SBYTES (XCAR (tail
)));
1542 string
= filename
= encoded_fn
= save_string
= Qnil
;
1547 absolute
= complete_filename_p (str
);
1549 for (; CONSP (path
); path
= XCDR (path
))
1551 ptrdiff_t baselen
, prefixlen
;
1553 filename
= Fexpand_file_name (str
, XCAR (path
));
1554 if (!complete_filename_p (filename
))
1555 /* If there are non-absolute elts in PATH (eg "."). */
1556 /* Of course, this could conceivably lose if luser sets
1557 default-directory to be something non-absolute... */
1559 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1560 if (!complete_filename_p (filename
))
1561 /* Give up on this path element! */
1565 /* Calculate maximum length of any filename made from
1566 this path element/specified file name and any possible suffix. */
1567 want_length
= max_suffix_len
+ SBYTES (filename
);
1568 if (fn_size
<= want_length
)
1570 fn_size
= 100 + want_length
;
1571 fn
= SAFE_ALLOCA (fn_size
);
1574 /* Copy FILENAME's data to FN but remove starting /: if any. */
1575 prefixlen
= ((SCHARS (filename
) > 2
1576 && SREF (filename
, 0) == '/'
1577 && SREF (filename
, 1) == ':')
1579 baselen
= SBYTES (filename
) - prefixlen
;
1580 memcpy (fn
, SDATA (filename
) + prefixlen
, baselen
);
1582 /* Loop over suffixes. */
1583 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1584 CONSP (tail
); tail
= XCDR (tail
))
1586 Lisp_Object suffix
= XCAR (tail
);
1587 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1588 Lisp_Object handler
;
1590 /* Make complete filename by appending SUFFIX. */
1591 memcpy (fn
+ baselen
, SDATA (suffix
), lsuffix
+ 1);
1592 fnlen
= baselen
+ lsuffix
;
1594 /* Check that the file exists and is not a directory. */
1595 /* We used to only check for handlers on non-absolute file names:
1599 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1600 It's not clear why that was the case and it breaks things like
1601 (load "/bar.el") where the file is actually "/bar.el.gz". */
1602 /* make_string has its own ideas on when to return a unibyte
1603 string and when a multibyte string, but we know better.
1604 We must have a unibyte string when dumping, since
1605 file-name encoding is shaky at best at that time, and in
1606 particular default-file-name-coding-system is reset
1607 several times during loadup. We therefore don't want to
1608 encode the file before passing it to file I/O library
1610 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1611 string
= make_unibyte_string (fn
, fnlen
);
1613 string
= make_string (fn
, fnlen
);
1614 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1615 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1616 && !NATNUMP (predicate
))
1619 if (NILP (predicate
) || EQ (predicate
, Qt
))
1620 exists
= !NILP (Ffile_readable_p (string
));
1623 Lisp_Object tmp
= call1 (predicate
, string
);
1626 else if (EQ (tmp
, Qdir_ok
)
1627 || NILP (Ffile_directory_p (string
)))
1632 last_errno
= EISDIR
;
1638 /* We succeeded; return this descriptor and filename. */
1651 encoded_fn
= ENCODE_FILE (string
);
1652 pfn
= SSDATA (encoded_fn
);
1654 /* Check that we can access or open it. */
1655 if (NATNUMP (predicate
))
1658 if (INT_MAX
< XFASTINT (predicate
))
1659 last_errno
= EINVAL
;
1660 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1664 if (file_directory_p (pfn
))
1665 last_errno
= EISDIR
;
1672 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1675 if (errno
!= ENOENT
)
1680 int err
= (fstat (fd
, &st
) != 0 ? errno
1681 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1693 if (newer
&& !NATNUMP (predicate
))
1695 struct timespec mtime
= get_stat_mtime (&st
);
1697 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1702 emacs_close (save_fd
);
1705 save_string
= string
;
1710 /* We succeeded; return this descriptor and filename. */
1718 /* No more suffixes. Return the newest. */
1719 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1722 *storeptr
= save_string
;
1738 /* Merge the list we've accumulated of globals from the current input source
1739 into the load_history variable. The details depend on whether
1740 the source has an associated file name or not.
1742 FILENAME is the file name that we are loading from.
1744 ENTIRE is true if loading that entire file, false if evaluating
1748 build_load_history (Lisp_Object filename
, bool entire
)
1750 Lisp_Object tail
, prev
, newelt
;
1751 Lisp_Object tem
, tem2
;
1754 tail
= Vload_history
;
1757 while (CONSP (tail
))
1761 /* Find the feature's previous assoc list... */
1762 if (!NILP (Fequal (filename
, Fcar (tem
))))
1766 /* If we're loading the entire file, remove old data. */
1770 Vload_history
= XCDR (tail
);
1772 Fsetcdr (prev
, XCDR (tail
));
1775 /* Otherwise, cons on new symbols that are not already members. */
1778 tem2
= Vcurrent_load_list
;
1780 while (CONSP (tem2
))
1782 newelt
= XCAR (tem2
);
1784 if (NILP (Fmember (newelt
, tem
)))
1785 Fsetcar (tail
, Fcons (XCAR (tem
),
1786 Fcons (newelt
, XCDR (tem
))));
1799 /* If we're loading an entire file, cons the new assoc onto the
1800 front of load-history, the most-recently-loaded position. Also
1801 do this if we didn't find an existing member for the file. */
1802 if (entire
|| !foundit
)
1803 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1808 readevalloop_1 (int old
)
1810 load_convert_to_unibyte
= old
;
1813 /* Signal an `end-of-file' error, if possible with file name
1816 static _Noreturn
void
1817 end_of_file_error (void)
1819 if (STRINGP (Vload_file_name
))
1820 xsignal1 (Qend_of_file
, Vload_file_name
);
1822 xsignal0 (Qend_of_file
);
1826 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1828 /* If we macroexpand the toplevel form non-recursively and it ends
1829 up being a `progn' (or if it was a progn to start), treat each
1830 form in the progn as a top-level form. This way, if one form in
1831 the progn defines a macro, that macro is in effect when we expand
1832 the remaining forms. See similar code in bytecomp.el. */
1833 val
= call2 (macroexpand
, val
, Qnil
);
1834 if (EQ (CAR_SAFE (val
), Qprogn
))
1836 Lisp_Object subforms
= XCDR (val
);
1838 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1839 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1843 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1847 /* UNIBYTE specifies how to set load_convert_to_unibyte
1848 for this invocation.
1849 READFUN, if non-nil, is used instead of `read'.
1851 START, END specify region to read in current buffer (from eval-region).
1852 If the input is not from a buffer, they must be nil. */
1855 readevalloop (Lisp_Object readcharfun
,
1856 struct infile
*infile0
,
1857 Lisp_Object sourcename
,
1859 Lisp_Object unibyte
, Lisp_Object readfun
,
1860 Lisp_Object start
, Lisp_Object end
)
1864 ptrdiff_t count
= SPECPDL_INDEX ();
1865 struct buffer
*b
= 0;
1866 bool continue_reading_p
;
1867 Lisp_Object lex_bound
;
1868 /* True if reading an entire buffer. */
1869 bool whole_buffer
= 0;
1870 /* True on the first time around. */
1871 bool first_sexp
= 1;
1872 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1874 if (NILP (Ffboundp (macroexpand
))
1875 /* Don't macroexpand in .elc files, since it should have been done
1876 already. We actually don't know whether we're in a .elc file or not,
1877 so we use circumstantial evidence: .el files normally go through
1878 Vload_source_file_function -> load-with-code-conversion
1880 || EQ (readcharfun
, Qget_file_char
)
1881 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1884 if (MARKERP (readcharfun
))
1887 start
= readcharfun
;
1890 if (BUFFERP (readcharfun
))
1891 b
= XBUFFER (readcharfun
);
1892 else if (MARKERP (readcharfun
))
1893 b
= XMARKER (readcharfun
)->buffer
;
1895 /* We assume START is nil when input is not from a buffer. */
1896 if (! NILP (start
) && !b
)
1899 specbind (Qstandard_input
, readcharfun
);
1900 specbind (Qcurrent_load_list
, Qnil
);
1901 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1902 load_convert_to_unibyte
= !NILP (unibyte
);
1904 /* If lexical binding is active (either because it was specified in
1905 the file's header, or via a buffer-local variable), create an empty
1906 lexical environment, otherwise, turn off lexical binding. */
1907 lex_bound
= find_symbol_value (Qlexical_binding
);
1908 specbind (Qinternal_interpreter_environment
,
1909 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1910 ? Qnil
: list1 (Qt
)));
1912 /* Try to ensure sourcename is a truename, except whilst preloading. */
1913 if (NILP (Vpurify_flag
)
1914 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1915 && !NILP (Ffboundp (Qfile_truename
)))
1916 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1918 LOADHIST_ATTACH (sourcename
);
1920 continue_reading_p
= 1;
1921 while (continue_reading_p
)
1923 ptrdiff_t count1
= SPECPDL_INDEX ();
1925 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1926 error ("Reading from killed buffer");
1930 /* Switch to the buffer we are reading from. */
1931 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1932 set_buffer_internal (b
);
1934 /* Save point in it. */
1935 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1936 /* Save ZV in it. */
1937 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1938 /* Those get unbound after we read one expression. */
1940 /* Set point and ZV around stuff to be read. */
1943 Fnarrow_to_region (make_number (BEGV
), end
);
1945 /* Just for cleanliness, convert END to a marker
1946 if it is an integer. */
1948 end
= Fpoint_max_marker ();
1951 /* On the first cycle, we can easily test here
1952 whether we are reading the whole buffer. */
1953 if (b
&& first_sexp
)
1954 whole_buffer
= (BUF_PT (b
) == BUF_BEG (b
) && BUF_ZV (b
) == BUF_Z (b
));
1961 while ((c
= READCHAR
) != '\n' && c
!= -1);
1966 unbind_to (count1
, Qnil
);
1970 /* Ignore whitespace here, so we can detect eof. */
1971 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1972 || c
== NO_BREAK_SPACE
)
1975 if (! HASH_TABLE_P (read_objects_map
)
1976 || XHASH_TABLE (read_objects_map
)->count
)
1978 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
,
1979 DEFAULT_REHASH_SIZE
, DEFAULT_REHASH_THRESHOLD
,
1981 if (! HASH_TABLE_P (read_objects_completed
)
1982 || XHASH_TABLE (read_objects_completed
)->count
)
1983 read_objects_completed
1984 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
,
1985 DEFAULT_REHASH_SIZE
, DEFAULT_REHASH_THRESHOLD
,
1987 if (!NILP (Vpurify_flag
) && c
== '(')
1989 val
= read_list (0, readcharfun
);
1994 if (!NILP (readfun
))
1996 val
= call1 (readfun
, readcharfun
);
1998 /* If READCHARFUN has set point to ZV, we should
1999 stop reading, even if the form read sets point
2000 to a different value when evaluated. */
2001 if (BUFFERP (readcharfun
))
2003 struct buffer
*buf
= XBUFFER (readcharfun
);
2004 if (BUF_PT (buf
) == BUF_ZV (buf
))
2005 continue_reading_p
= 0;
2008 else if (! NILP (Vload_read_function
))
2009 val
= call1 (Vload_read_function
, readcharfun
);
2011 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
2013 /* Empty hashes can be reused; otherwise, reset on next call. */
2014 if (HASH_TABLE_P (read_objects_map
)
2015 && XHASH_TABLE (read_objects_map
)->count
> 0)
2016 read_objects_map
= Qnil
;
2017 if (HASH_TABLE_P (read_objects_completed
)
2018 && XHASH_TABLE (read_objects_completed
)->count
> 0)
2019 read_objects_completed
= Qnil
;
2021 if (!NILP (start
) && continue_reading_p
)
2022 start
= Fpoint_marker ();
2024 /* Restore saved point and BEGV. */
2025 unbind_to (count1
, Qnil
);
2027 /* Now eval what we just read. */
2028 if (!NILP (macroexpand
))
2029 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
2031 val
= eval_sub (val
);
2035 Vvalues
= Fcons (val
, Vvalues
);
2036 if (EQ (Vstandard_output
, Qt
))
2045 build_load_history (sourcename
,
2046 infile0
|| whole_buffer
);
2048 unbind_to (count
, Qnil
);
2051 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
2052 doc
: /* Execute the accessible portion of current buffer as Lisp code.
2053 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
2054 When called from a Lisp program (i.e., not interactively), this
2055 function accepts up to five optional arguments:
2056 BUFFER is the buffer to evaluate (nil means use current buffer),
2057 or a name of a buffer (a string).
2058 PRINTFLAG controls printing of output by any output functions in the
2059 evaluated code, such as `print', `princ', and `prin1':
2060 a value of nil means discard it; anything else is the stream to print to.
2061 See Info node `(elisp)Output Streams' for details on streams.
2062 FILENAME specifies the file name to use for `load-history'.
2063 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
2065 DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
2066 evaluated code should work normally even if PRINTFLAG is nil, in
2067 which case the output is displayed in the echo area.
2069 This function preserves the position of point. */)
2070 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
2072 ptrdiff_t count
= SPECPDL_INDEX ();
2073 Lisp_Object tem
, buf
;
2076 buf
= Fcurrent_buffer ();
2078 buf
= Fget_buffer (buffer
);
2080 error ("No such buffer");
2082 if (NILP (printflag
) && NILP (do_allow_print
))
2087 if (NILP (filename
))
2088 filename
= BVAR (XBUFFER (buf
), filename
);
2090 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
2091 specbind (Qstandard_output
, tem
);
2092 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
2093 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2094 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
2095 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2096 readevalloop (buf
, 0, filename
,
2097 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
2098 unbind_to (count
, Qnil
);
2103 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2104 doc
: /* Execute the region as Lisp code.
2105 When called from programs, expects two arguments,
2106 giving starting and ending indices in the current buffer
2107 of the text to be executed.
2108 Programs can pass third argument PRINTFLAG which controls output:
2109 a value of nil means discard it; anything else is stream for printing it.
2110 See Info node `(elisp)Output Streams' for details on streams.
2111 Also the fourth argument READ-FUNCTION, if non-nil, is used
2112 instead of `read' to read each expression. It gets one argument
2113 which is the input stream for reading characters.
2115 This function does not move point. */)
2116 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2118 /* FIXME: Do the eval-sexp-add-defvars dance! */
2119 ptrdiff_t count
= SPECPDL_INDEX ();
2120 Lisp_Object tem
, cbuf
;
2122 cbuf
= Fcurrent_buffer ();
2124 if (NILP (printflag
))
2128 specbind (Qstandard_output
, tem
);
2129 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2131 /* `readevalloop' calls functions which check the type of start and end. */
2132 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2133 !NILP (printflag
), Qnil
, read_function
,
2136 return unbind_to (count
, Qnil
);
2140 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2141 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2142 If STREAM is nil, use the value of `standard-input' (which see).
2143 STREAM or the value of `standard-input' may be:
2144 a buffer (read from point and advance it)
2145 a marker (read from where it points and advance it)
2146 a function (call it with no arguments for each character,
2147 call it with a char as argument to push a char back)
2148 a string (takes text from string, starting at the beginning)
2149 t (read text line using minibuffer and use it, or read from
2150 standard input in batch mode). */)
2151 (Lisp_Object stream
)
2154 stream
= Vstandard_input
;
2155 if (EQ (stream
, Qt
))
2156 stream
= Qread_char
;
2157 if (EQ (stream
, Qread_char
))
2158 /* FIXME: ?! When is this used !? */
2159 return call1 (intern ("read-minibuffer"),
2160 build_string ("Lisp expression: "));
2162 return read_internal_start (stream
, Qnil
, Qnil
);
2165 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2166 doc
: /* Read one Lisp expression which is represented as text by STRING.
2167 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2168 FINAL-STRING-INDEX is an integer giving the position of the next
2169 remaining character in STRING. START and END optionally delimit
2170 a substring of STRING from which to read; they default to 0 and
2171 \(length STRING) respectively. Negative values are counted from
2172 the end of STRING. */)
2173 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2176 CHECK_STRING (string
);
2177 /* `read_internal_start' sets `read_from_string_index'. */
2178 ret
= read_internal_start (string
, start
, end
);
2179 return Fcons (ret
, make_number (read_from_string_index
));
2182 /* Function to set up the global context we need in toplevel read
2183 calls. START and END only used when STREAM is a string. */
2185 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2190 new_backquote_flag
= 0;
2191 /* We can get called from readevalloop which may have set these
2193 if (! HASH_TABLE_P (read_objects_map
)
2194 || XHASH_TABLE (read_objects_map
)->count
)
2196 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
, DEFAULT_REHASH_SIZE
,
2197 DEFAULT_REHASH_THRESHOLD
, Qnil
, false);
2198 if (! HASH_TABLE_P (read_objects_completed
)
2199 || XHASH_TABLE (read_objects_completed
)->count
)
2200 read_objects_completed
2201 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
, DEFAULT_REHASH_SIZE
,
2202 DEFAULT_REHASH_THRESHOLD
, Qnil
, false);
2203 if (EQ (Vread_with_symbol_positions
, Qt
)
2204 || EQ (Vread_with_symbol_positions
, stream
))
2205 Vread_symbol_positions_list
= Qnil
;
2207 if (STRINGP (stream
)
2208 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2210 ptrdiff_t startval
, endval
;
2213 if (STRINGP (stream
))
2216 string
= XCAR (stream
);
2218 validate_subarray (string
, start
, end
, SCHARS (string
),
2219 &startval
, &endval
);
2221 read_from_string_index
= startval
;
2222 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2223 read_from_string_limit
= endval
;
2226 retval
= read0 (stream
);
2227 if (EQ (Vread_with_symbol_positions
, Qt
)
2228 || EQ (Vread_with_symbol_positions
, stream
))
2229 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2230 /* Empty hashes can be reused; otherwise, reset on next call. */
2231 if (HASH_TABLE_P (read_objects_map
)
2232 && XHASH_TABLE (read_objects_map
)->count
> 0)
2233 read_objects_map
= Qnil
;
2234 if (HASH_TABLE_P (read_objects_completed
)
2235 && XHASH_TABLE (read_objects_completed
)->count
> 0)
2236 read_objects_completed
= Qnil
;
2241 /* Signal Qinvalid_read_syntax error.
2242 S is error string of length N (if > 0) */
2244 static _Noreturn
void
2245 invalid_syntax (const char *s
)
2247 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2251 /* Use this for recursive reads, in contexts where internal tokens
2255 read0 (Lisp_Object readcharfun
)
2257 register Lisp_Object val
;
2260 val
= read1 (readcharfun
, &c
, 0);
2264 xsignal1 (Qinvalid_read_syntax
,
2265 Fmake_string (make_number (1), make_number (c
), Qnil
));
2268 /* Grow a read buffer BUF that contains OFFSET useful bytes of data,
2269 by at least MAX_MULTIBYTE_LENGTH bytes. Update *BUF_ADDR and
2270 *BUF_SIZE accordingly; 0 <= OFFSET <= *BUF_SIZE. If *BUF_ADDR is
2271 initially null, BUF is on the stack: copy its data to the new heap
2272 buffer. Otherwise, BUF must equal *BUF_ADDR and can simply be
2273 reallocated. Either way, remember the heap allocation (which is at
2274 pdl slot COUNT) so that it can be freed when unwinding the stack.*/
2277 grow_read_buffer (char *buf
, ptrdiff_t offset
,
2278 char **buf_addr
, ptrdiff_t *buf_size
, ptrdiff_t count
)
2280 char *p
= xpalloc (*buf_addr
, buf_size
, MAX_MULTIBYTE_LENGTH
, -1, 1);
2283 memcpy (p
, buf
, offset
);
2284 record_unwind_protect_ptr (xfree
, p
);
2287 set_unwind_protect_ptr (count
, xfree
, p
);
2292 /* Return the scalar value that has the Unicode character name NAME.
2293 Raise 'invalid-read-syntax' if there is no such character. */
2295 character_name_to_code (char const *name
, ptrdiff_t name_len
)
2297 /* For "U+XXXX", pass the leading '+' to string_to_number to reject
2298 monstrosities like "U+-0000". */
2300 = (name
[0] == 'U' && name
[1] == '+'
2301 ? string_to_number (name
+ 1, 16, false)
2302 : call2 (Qchar_from_name
, make_unibyte_string (name
, name_len
), Qt
));
2304 if (! RANGED_INTEGERP (0, code
, MAX_UNICODE_CHAR
)
2305 || char_surrogate_p (XINT (code
)))
2307 AUTO_STRING (format
, "\\N{%s}");
2308 AUTO_STRING_WITH_LEN (namestr
, name
, name_len
);
2309 xsignal1 (Qinvalid_read_syntax
, CALLN (Fformat
, format
, namestr
));
2315 /* Bound on the length of a Unicode character name. As of
2316 Unicode 9.0.0 the maximum is 83, so this should be safe. */
2317 enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND
= 200 };
2319 /* Read a \-escape sequence, assuming we already read the `\'.
2320 If the escape sequence forces unibyte, return eight-bit char. */
2323 read_escape (Lisp_Object readcharfun
, bool stringp
)
2326 /* \u allows up to four hex digits, \U up to eight. Default to the
2327 behavior for \u, and change this value in the case that \U is seen. */
2328 int unicode_hex_count
= 4;
2333 end_of_file_error ();
2363 error ("Invalid escape character syntax");
2366 c
= read_escape (readcharfun
, 0);
2367 return c
| meta_modifier
;
2372 error ("Invalid escape character syntax");
2375 c
= read_escape (readcharfun
, 0);
2376 return c
| shift_modifier
;
2381 error ("Invalid escape character syntax");
2384 c
= read_escape (readcharfun
, 0);
2385 return c
| hyper_modifier
;
2390 error ("Invalid escape character syntax");
2393 c
= read_escape (readcharfun
, 0);
2394 return c
| alt_modifier
;
2398 if (stringp
|| c
!= '-')
2405 c
= read_escape (readcharfun
, 0);
2406 return c
| super_modifier
;
2411 error ("Invalid escape character syntax");
2416 c
= read_escape (readcharfun
, 0);
2417 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2418 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2419 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2420 return c
| ctrl_modifier
;
2421 /* ASCII control chars are made from letters (both cases),
2422 as well as the non-letters within 0100...0137. */
2423 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2424 return (c
& (037 | ~0177));
2425 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2426 return (c
& (037 | ~0177));
2428 return c
| ctrl_modifier
;
2438 /* An octal escape, as in ANSI C. */
2440 register int i
= c
- '0';
2441 register int count
= 0;
2444 if ((c
= READCHAR
) >= '0' && c
<= '7')
2456 if (i
>= 0x80 && i
< 0x100)
2457 i
= BYTE8_TO_CHAR (i
);
2462 /* A hex escape, as in ANSI C. */
2469 int digit
= char_hexdigit (c
);
2475 i
= (i
<< 4) + digit
;
2476 /* Allow hex escapes as large as ?\xfffffff, because some
2477 packages use them to denote characters with modifiers. */
2478 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2479 error ("Hex character out of range: \\x%x...", i
);
2483 if (count
< 3 && i
>= 0x80)
2484 return BYTE8_TO_CHAR (i
);
2489 /* Post-Unicode-2.0: Up to eight hex chars. */
2490 unicode_hex_count
= 8;
2494 /* A Unicode escape. We only permit them in strings and characters,
2495 not arbitrarily in the source code, as in some other languages. */
2500 while (++count
<= unicode_hex_count
)
2503 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2505 int digit
= char_hexdigit (c
);
2507 error ("Non-hex digit used for Unicode escape");
2508 i
= (i
<< 4) + digit
;
2511 error ("Non-Unicode character: 0x%x", i
);
2516 /* Named character. */
2520 invalid_syntax ("Expected opening brace after \\N");
2521 char name
[UNICODE_CHARACTER_NAME_LENGTH_BOUND
+ 1];
2522 bool whitespace
= false;
2523 ptrdiff_t length
= 0;
2528 end_of_file_error ();
2531 if (! (0 < c
&& c
< 0x80))
2533 AUTO_STRING (format
,
2534 "Invalid character U+%04X in character name");
2535 xsignal1 (Qinvalid_read_syntax
,
2536 CALLN (Fformat
, format
, make_natnum (c
)));
2538 /* Treat multiple adjacent whitespace characters as a
2539 single space character. This makes it easier to use
2540 character names in e.g. multi-line strings. */
2551 if (length
>= sizeof name
)
2552 invalid_syntax ("Character name too long");
2555 invalid_syntax ("Empty character name");
2556 name
[length
] = '\0';
2558 /* character_name_to_code can invoke read1, recursively.
2559 This is why read1's buffer is not static. */
2560 return character_name_to_code (name
, length
);
2568 /* Return the digit that CHARACTER stands for in the given BASE.
2569 Return -1 if CHARACTER is out of range for BASE,
2570 and -2 if CHARACTER is not valid for any supported BASE. */
2572 digit_to_number (int character
, int base
)
2576 if ('0' <= character
&& character
<= '9')
2577 digit
= character
- '0';
2578 else if ('a' <= character
&& character
<= 'z')
2579 digit
= character
- 'a' + 10;
2580 else if ('A' <= character
&& character
<= 'Z')
2581 digit
= character
- 'A' + 10;
2585 return digit
< base
? digit
: -1;
2588 /* Read an integer in radix RADIX using READCHARFUN to read
2589 characters. RADIX must be in the interval [2..36]; if it isn't, a
2590 read error is signaled . Value is the integer read. Signals an
2591 error if encountering invalid read syntax or if RADIX is out of
2595 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2597 /* Room for sign, leading 0, other digits, trailing null byte.
2598 Also, room for invalid syntax diagnostic. */
2599 char buf
[max (1 + 1 + UINTMAX_WIDTH
+ 1,
2600 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2602 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2604 if (radix
< 2 || radix
> 36)
2612 if (c
== '-' || c
== '+')
2623 /* Ignore redundant leading zeros, so the buffer doesn't
2624 fill up with them. */
2630 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2637 if (p
< buf
+ sizeof buf
- 1)
2651 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2652 invalid_syntax (buf
);
2655 return string_to_number (buf
, radix
, 0);
2659 /* If the next token is ')' or ']' or '.', we store that character
2660 in *PCH and the return value is not interesting. Else, we store
2661 zero in *PCH and we read and return one lisp object.
2663 FIRST_IN_LIST is true if this is the first element of a list. */
2666 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2669 bool uninterned_symbol
= false;
2671 char stackbuf
[MAX_ALLOCA
];
2672 current_thread
->stack_top
= stackbuf
;
2678 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2680 end_of_file_error ();
2685 return read_list (0, readcharfun
);
2688 return read_vector (readcharfun
, 0);
2704 /* Accept extended format for hash tables (extensible to
2706 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2707 Lisp_Object tmp
= read_list (0, readcharfun
);
2708 Lisp_Object head
= CAR_SAFE (tmp
);
2709 Lisp_Object data
= Qnil
;
2710 Lisp_Object val
= Qnil
;
2711 /* The size is 2 * number of allowed keywords to
2713 Lisp_Object params
[12];
2715 Lisp_Object key
= Qnil
;
2716 int param_count
= 0;
2718 if (!EQ (head
, Qhash_table
))
2720 ptrdiff_t size
= XINT (Flength (tmp
));
2721 Lisp_Object record
= Fmake_record (CAR_SAFE (tmp
),
2722 make_number (size
- 1),
2724 for (int i
= 1; i
< size
; i
++)
2727 ASET (record
, i
, Fcar (tmp
));
2732 tmp
= CDR_SAFE (tmp
);
2734 /* This is repetitive but fast and simple. */
2735 params
[param_count
] = QCsize
;
2736 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2737 if (!NILP (params
[param_count
+ 1]))
2740 params
[param_count
] = QCtest
;
2741 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2742 if (!NILP (params
[param_count
+ 1]))
2745 params
[param_count
] = QCweakness
;
2746 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2747 if (!NILP (params
[param_count
+ 1]))
2750 params
[param_count
] = QCrehash_size
;
2751 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2752 if (!NILP (params
[param_count
+ 1]))
2755 params
[param_count
] = QCrehash_threshold
;
2756 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2757 if (!NILP (params
[param_count
+ 1]))
2760 params
[param_count
] = QCpurecopy
;
2761 params
[param_count
+ 1] = Fplist_get (tmp
, Qpurecopy
);
2762 if (!NILP (params
[param_count
+ 1]))
2765 /* This is the hash table data. */
2766 data
= Fplist_get (tmp
, Qdata
);
2768 /* Now use params to make a new hash table and fill it. */
2769 ht
= Fmake_hash_table (param_count
, params
);
2771 while (CONSP (data
))
2776 error ("Odd number of elements in hash table data");
2779 Fputhash (key
, val
, ht
);
2785 invalid_syntax ("#");
2793 tmp
= read_vector (readcharfun
, 0);
2794 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2795 error ("Invalid size char-table");
2796 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2804 /* Sub char-table can't be read as a regular
2805 vector because of a two C integer fields. */
2806 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2807 ptrdiff_t size
= XINT (Flength (tmp
));
2808 int i
, depth
, min_char
;
2809 struct Lisp_Cons
*cell
;
2812 error ("Zero-sized sub char-table");
2814 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2815 error ("Invalid depth in sub char-table");
2816 depth
= XINT (XCAR (tmp
));
2817 if (chartab_size
[depth
] != size
- 2)
2818 error ("Invalid size in sub char-table");
2819 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2822 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2823 error ("Invalid minimum character in sub-char-table");
2824 min_char
= XINT (XCAR (tmp
));
2825 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2828 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2829 for (i
= 0; i
< size
; i
++)
2831 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2832 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2837 invalid_syntax ("#^^");
2839 invalid_syntax ("#^");
2844 length
= read1 (readcharfun
, pch
, first_in_list
);
2848 Lisp_Object tmp
, val
;
2849 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2850 unsigned char *data
;
2853 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2854 if (STRING_MULTIBYTE (tmp
)
2855 || (size_in_chars
!= SCHARS (tmp
)
2856 /* We used to print 1 char too many
2857 when the number of bits was a multiple of 8.
2858 Accept such input in case it came from an old
2860 && ! (XFASTINT (length
)
2861 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2862 invalid_syntax ("#&...");
2864 val
= make_uninit_bool_vector (XFASTINT (length
));
2865 data
= bool_vector_uchar_data (val
);
2866 memcpy (data
, SDATA (tmp
), size_in_chars
);
2867 /* Clear the extraneous bits in the last byte. */
2868 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2869 data
[size_in_chars
- 1]
2870 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2873 invalid_syntax ("#&...");
2877 /* Accept compiled functions at read-time so that we don't have to
2878 build them using function calls. */
2880 struct Lisp_Vector
*vec
;
2881 tmp
= read_vector (readcharfun
, 1);
2882 vec
= XVECTOR (tmp
);
2883 if (vec
->header
.size
== 0)
2884 invalid_syntax ("Empty byte-code object");
2885 make_byte_code (vec
);
2893 /* Read the string itself. */
2894 tmp
= read1 (readcharfun
, &ch
, 0);
2895 if (ch
!= 0 || !STRINGP (tmp
))
2896 invalid_syntax ("#");
2897 /* Read the intervals and their properties. */
2900 Lisp_Object beg
, end
, plist
;
2902 beg
= read1 (readcharfun
, &ch
, 0);
2907 end
= read1 (readcharfun
, &ch
, 0);
2909 plist
= read1 (readcharfun
, &ch
, 0);
2911 invalid_syntax ("Invalid string property list");
2912 Fset_text_properties (beg
, end
, plist
, tmp
);
2918 /* #@NUMBER is used to skip NUMBER following bytes.
2919 That's used in .elc files to skip over doc strings
2920 and function definitions. */
2923 enum { extra
= 100 };
2924 ptrdiff_t i
, nskip
= 0, digits
= 0;
2926 /* Read a decimal integer. */
2927 while ((c
= READCHAR
) >= 0
2928 && c
>= '0' && c
<= '9')
2930 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2935 if (digits
== 2 && nskip
== 0)
2936 { /* We've just seen #@00, which means "skip to end". */
2937 skip_dyn_eof (readcharfun
);
2942 /* We can't use UNREAD here, because in the code below we side-step
2943 READCHAR. Instead, assume the first char after #@NNN occupies
2944 a single byte, which is the case normally since it's just
2950 if (load_force_doc_strings
2951 && (FROM_FILE_P (readcharfun
)))
2953 /* If we are supposed to force doc strings into core right now,
2954 record the last string that we skipped,
2955 and record where in the file it comes from. */
2957 /* But first exchange saved_doc_string
2958 with prev_saved_doc_string, so we save two strings. */
2960 char *temp
= saved_doc_string
;
2961 ptrdiff_t temp_size
= saved_doc_string_size
;
2962 file_offset temp_pos
= saved_doc_string_position
;
2963 ptrdiff_t temp_len
= saved_doc_string_length
;
2965 saved_doc_string
= prev_saved_doc_string
;
2966 saved_doc_string_size
= prev_saved_doc_string_size
;
2967 saved_doc_string_position
= prev_saved_doc_string_position
;
2968 saved_doc_string_length
= prev_saved_doc_string_length
;
2970 prev_saved_doc_string
= temp
;
2971 prev_saved_doc_string_size
= temp_size
;
2972 prev_saved_doc_string_position
= temp_pos
;
2973 prev_saved_doc_string_length
= temp_len
;
2976 if (saved_doc_string_size
== 0)
2978 saved_doc_string
= xmalloc (nskip
+ extra
);
2979 saved_doc_string_size
= nskip
+ extra
;
2981 if (nskip
> saved_doc_string_size
)
2983 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2984 saved_doc_string_size
= nskip
+ extra
;
2987 FILE *instream
= infile
->stream
;
2988 saved_doc_string_position
= (file_tell (instream
)
2989 - infile
->lookahead
);
2991 /* Copy that many bytes into saved_doc_string. */
2993 for (int n
= min (nskip
, infile
->lookahead
); 0 < n
; n
--)
2994 saved_doc_string
[i
++]
2995 = c
= infile
->buf
[--infile
->lookahead
];
2997 for (; i
< nskip
&& 0 <= c
; i
++)
2998 saved_doc_string
[i
] = c
= getc_unlocked (instream
);
3001 saved_doc_string_length
= i
;
3004 /* Skip that many bytes. */
3005 skip_dyn_bytes (readcharfun
, nskip
);
3011 /* #! appears at the beginning of an executable file.
3012 Skip the first line. */
3013 while (c
!= '\n' && c
>= 0)
3018 return Vload_file_name
;
3020 return list2 (Qfunction
, read0 (readcharfun
));
3021 /* #:foo is the uninterned symbol named foo. */
3024 uninterned_symbol
= true;
3027 && c
!= NO_BREAK_SPACE
3029 || strchr ("\"';()[]#`,", c
) == NULL
)))
3031 /* No symbol character follows, this is the empty
3034 return Fmake_symbol (empty_unibyte_string
);
3038 /* ## is the empty symbol. */
3040 return Fintern (empty_unibyte_string
, Qnil
);
3041 /* Reader forms that can reuse previously read objects. */
3042 if (c
>= '0' && c
<= '9')
3046 bool overflow
= false;
3048 /* Read a non-negative integer. */
3049 while (c
>= '0' && c
<= '9')
3051 overflow
|= INT_MULTIPLY_WRAPV (n
, 10, &n
);
3052 overflow
|= INT_ADD_WRAPV (n
, c
- '0', &n
);
3056 if (!overflow
&& n
<= MOST_POSITIVE_FIXNUM
)
3058 if (c
== 'r' || c
== 'R')
3059 return read_integer (readcharfun
, n
);
3061 if (! NILP (Vread_circle
))
3063 /* #n=object returns object, but associates it with
3067 /* Make a placeholder for #n# to use temporarily. */
3068 /* Note: We used to use AUTO_CONS to allocate
3069 placeholder, but that is a bad idea, since it
3070 will place a stack-allocated cons cell into
3071 the list in read_objects_map, which is a
3072 staticpro'd global variable, and thus each of
3073 its elements is marked during each GC. A
3074 stack-allocated object will become garbled
3075 when its stack slot goes out of scope, and
3076 some other function reuses it for entirely
3077 different purposes, which will cause crashes
3079 Lisp_Object placeholder
= Fcons (Qnil
, Qnil
);
3080 struct Lisp_Hash_Table
*h
3081 = XHASH_TABLE (read_objects_map
);
3083 Lisp_Object number
= make_number (n
);
3085 ptrdiff_t i
= hash_lookup (h
, number
, &hash
);
3087 /* Not normal, but input could be malformed. */
3088 set_hash_value_slot (h
, i
, placeholder
);
3090 hash_put (h
, number
, placeholder
, hash
);
3092 /* Read the object itself. */
3093 tem
= read0 (readcharfun
);
3095 /* If it can be recursive, remember it for
3096 future substitutions. */
3099 && ! (STRINGP (tem
) && !string_intervals (tem
)))
3101 struct Lisp_Hash_Table
*h2
3102 = XHASH_TABLE (read_objects_completed
);
3103 i
= hash_lookup (h2
, tem
, &hash
);
3105 hash_put (h2
, tem
, Qnil
, hash
);
3108 /* Now put it everywhere the placeholder was... */
3111 Fsetcar (placeholder
, XCAR (tem
));
3112 Fsetcdr (placeholder
, XCDR (tem
));
3117 Flread__substitute_object_in_subtree
3118 (tem
, placeholder
, read_objects_completed
);
3120 /* ...and #n# will use the real value from now on. */
3121 i
= hash_lookup (h
, number
, &hash
);
3123 set_hash_value_slot (h
, i
, tem
);
3129 /* #n# returns a previously read object. */
3132 struct Lisp_Hash_Table
*h
3133 = XHASH_TABLE (read_objects_map
);
3134 ptrdiff_t i
= hash_lookup (h
, make_number (n
), NULL
);
3136 return HASH_VALUE (h
, i
);
3140 /* Fall through to error message. */
3142 else if (c
== 'x' || c
== 'X')
3143 return read_integer (readcharfun
, 16);
3144 else if (c
== 'o' || c
== 'O')
3145 return read_integer (readcharfun
, 8);
3146 else if (c
== 'b' || c
== 'B')
3147 return read_integer (readcharfun
, 2);
3150 invalid_syntax ("#");
3153 while ((c
= READCHAR
) >= 0 && c
!= '\n');
3157 return list2 (Qquote
, read0 (readcharfun
));
3161 int next_char
= READCHAR
;
3163 /* Transition from old-style to new-style:
3164 If we see "(`" it used to mean old-style, which usually works
3165 fine because ` should almost never appear in such a position
3166 for new-style. But occasionally we need "(`" to mean new
3167 style, so we try to distinguish the two by the fact that we
3168 can either write "( `foo" or "(` foo", where the first
3169 intends to use new-style whereas the second intends to use
3170 old-style. For Emacs-25, we should completely remove this
3171 first_in_list exception (old-style can still be obtained via
3173 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
3174 load_error_old_style_backquotes ();
3178 bool saved_new_backquote_flag
= new_backquote_flag
;
3180 new_backquote_flag
= 1;
3181 value
= read0 (readcharfun
);
3182 new_backquote_flag
= saved_new_backquote_flag
;
3184 return list2 (Qbackquote
, value
);
3189 int next_char
= READCHAR
;
3191 /* Transition from old-style to new-style:
3192 It used to be impossible to have a new-style , other than within
3193 a new-style `. This is sufficient when ` and , are used in the
3194 normal way, but ` and , can also appear in args to macros that
3195 will not interpret them in the usual way, in which case , may be
3196 used without any ` anywhere near.
3197 So we now use the same heuristic as for backquote: old-style
3198 unquotes are only recognized when first on a list, and when
3199 followed by a space.
3200 Because it's more difficult to peek 2 chars ahead, a new-style
3201 ,@ can still not be used outside of a `, unless it's in the middle
3203 if (new_backquote_flag
3205 || (next_char
!= ' ' && next_char
!= '@'))
3207 Lisp_Object comma_type
= Qnil
;
3212 comma_type
= Qcomma_at
;
3214 comma_type
= Qcomma_dot
;
3217 if (ch
>= 0) UNREAD (ch
);
3218 comma_type
= Qcomma
;
3221 value
= read0 (readcharfun
);
3222 return list2 (comma_type
, value
);
3225 load_error_old_style_backquotes ();
3235 end_of_file_error ();
3237 /* Accept `single space' syntax like (list ? x) where the
3238 whitespace character is SPC or TAB.
3239 Other literal whitespace like NL, CR, and FF are not accepted,
3240 as there are well-established escape sequences for these. */
3241 if (c
== ' ' || c
== '\t')
3242 return make_number (c
);
3244 if (c
== '(' || c
== ')' || c
== '[' || c
== ']'
3245 || c
== '"' || c
== ';')
3247 CHECK_LIST (Vlread_unescaped_character_literals
);
3248 Lisp_Object char_obj
= make_natnum (c
);
3249 if (NILP (Fmemq (char_obj
, Vlread_unescaped_character_literals
)))
3250 Vlread_unescaped_character_literals
=
3251 Fcons (char_obj
, Vlread_unescaped_character_literals
);
3255 c
= read_escape (readcharfun
, 0);
3256 modifiers
= c
& CHAR_MODIFIER_MASK
;
3257 c
&= ~CHAR_MODIFIER_MASK
;
3258 if (CHAR_BYTE8_P (c
))
3259 c
= CHAR_TO_BYTE8 (c
);
3262 next_char
= READCHAR
;
3263 ok
= (next_char
<= 040
3264 || (next_char
< 0200
3265 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3268 return make_number (c
);
3270 invalid_syntax ("?");
3275 ptrdiff_t count
= SPECPDL_INDEX ();
3276 char *read_buffer
= stackbuf
;
3277 ptrdiff_t read_buffer_size
= sizeof stackbuf
;
3278 char *heapbuf
= NULL
;
3279 char *p
= read_buffer
;
3280 char *end
= read_buffer
+ read_buffer_size
;
3282 /* True if we saw an escape sequence specifying
3283 a multibyte character. */
3284 bool force_multibyte
= false;
3285 /* True if we saw an escape sequence specifying
3286 a single-byte character. */
3287 bool force_singlebyte
= false;
3288 bool cancel
= false;
3289 ptrdiff_t nchars
= 0;
3291 while ((ch
= READCHAR
) >= 0
3294 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3296 ptrdiff_t offset
= p
- read_buffer
;
3297 read_buffer
= grow_read_buffer (read_buffer
, offset
,
3298 &heapbuf
, &read_buffer_size
,
3300 p
= read_buffer
+ offset
;
3301 end
= read_buffer
+ read_buffer_size
;
3308 ch
= read_escape (readcharfun
, 1);
3310 /* CH is -1 if \ newline or \ space has just been seen. */
3313 if (p
== read_buffer
)
3318 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3319 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3321 if (CHAR_BYTE8_P (ch
))
3322 force_singlebyte
= true;
3323 else if (! ASCII_CHAR_P (ch
))
3324 force_multibyte
= true;
3325 else /* I.e. ASCII_CHAR_P (ch). */
3327 /* Allow `\C- ' and `\C-?'. */
3328 if (modifiers
== CHAR_CTL
)
3331 ch
= 0, modifiers
= 0;
3333 ch
= 127, modifiers
= 0;
3335 if (modifiers
& CHAR_SHIFT
)
3337 /* Shift modifier is valid only with [A-Za-z]. */
3338 if (ch
>= 'A' && ch
<= 'Z')
3339 modifiers
&= ~CHAR_SHIFT
;
3340 else if (ch
>= 'a' && ch
<= 'z')
3341 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3344 if (modifiers
& CHAR_META
)
3346 /* Move the meta bit to the right place for a
3348 modifiers
&= ~CHAR_META
;
3349 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3350 force_singlebyte
= true;
3354 /* Any modifiers remaining are invalid. */
3356 error ("Invalid modifier in string");
3357 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3361 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3362 if (CHAR_BYTE8_P (ch
))
3363 force_singlebyte
= true;
3364 else if (! ASCII_CHAR_P (ch
))
3365 force_multibyte
= true;
3371 end_of_file_error ();
3373 /* If purifying, and string starts with \ newline,
3374 return zero instead. This is for doc strings
3375 that we are really going to find in etc/DOC.nn.nn. */
3376 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3377 return unbind_to (count
, make_number (0));
3379 if (! force_multibyte
&& force_singlebyte
)
3381 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3382 forms. Convert it to unibyte. */
3383 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3385 p
= read_buffer
+ nchars
;
3389 = make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3391 || (p
- read_buffer
!= nchars
)));
3392 return unbind_to (count
, result
);
3397 int next_char
= READCHAR
;
3400 if (next_char
<= 040
3401 || (next_char
< 0200
3402 && strchr ("\"';([#?`,", next_char
) != NULL
))
3408 /* The atom-reading loop below will now loop at least once,
3409 assuring that we will not try to UNREAD two characters in a
3413 if (c
<= 040) goto retry
;
3414 if (c
== NO_BREAK_SPACE
)
3419 ptrdiff_t count
= SPECPDL_INDEX ();
3420 char *read_buffer
= stackbuf
;
3421 ptrdiff_t read_buffer_size
= sizeof stackbuf
;
3422 char *heapbuf
= NULL
;
3423 char *p
= read_buffer
;
3424 char *end
= read_buffer
+ read_buffer_size
;
3425 bool quoted
= false;
3426 EMACS_INT start_position
= readchar_count
- 1;
3430 if (end
- p
< MAX_MULTIBYTE_LENGTH
+ 1)
3432 ptrdiff_t offset
= p
- read_buffer
;
3433 read_buffer
= grow_read_buffer (read_buffer
, offset
,
3434 &heapbuf
, &read_buffer_size
,
3436 p
= read_buffer
+ offset
;
3437 end
= read_buffer
+ read_buffer_size
;
3444 end_of_file_error ();
3449 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3455 && c
!= NO_BREAK_SPACE
3457 || strchr ("\"';()[]#`,", c
) == NULL
));
3462 if (!quoted
&& !uninterned_symbol
)
3464 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3465 if (! NILP (result
))
3466 return unbind_to (count
, result
);
3468 if (!quoted
&& multibyte
)
3470 int ch
= STRING_CHAR ((unsigned char *) read_buffer
);
3473 case 0x2018: /* LEFT SINGLE QUOTATION MARK */
3474 case 0x2019: /* RIGHT SINGLE QUOTATION MARK */
3475 case 0x201B: /* SINGLE HIGH-REVERSED-9 QUOTATION MARK */
3476 case 0x201C: /* LEFT DOUBLE QUOTATION MARK */
3477 case 0x201D: /* RIGHT DOUBLE QUOTATION MARK */
3478 case 0x201F: /* DOUBLE HIGH-REVERSED-9 QUOTATION MARK */
3479 case 0x301E: /* DOUBLE PRIME QUOTATION MARK */
3480 case 0xFF02: /* FULLWIDTH QUOTATION MARK */
3481 case 0xFF07: /* FULLWIDTH APOSTROPHE */
3482 xsignal2 (Qinvalid_read_syntax
, build_string ("strange quote"),
3483 CALLN (Fstring
, make_number (ch
)));
3488 ptrdiff_t nbytes
= p
- read_buffer
;
3491 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3495 if (uninterned_symbol
)
3498 = ((! NILP (Vpurify_flag
)
3499 ? make_pure_string
: make_specified_string
)
3500 (read_buffer
, nchars
, nbytes
, multibyte
));
3501 result
= Fmake_symbol (name
);
3505 /* Don't create the string object for the name unless
3506 we're going to retain it in a new symbol.
3508 Like intern_1 but supports multibyte names. */
3509 Lisp_Object obarray
= check_obarray (Vobarray
);
3510 Lisp_Object tem
= oblookup (obarray
, read_buffer
,
3518 = make_specified_string (read_buffer
, nchars
, nbytes
,
3520 result
= intern_driver (name
, obarray
, tem
);
3524 if (EQ (Vread_with_symbol_positions
, Qt
)
3525 || EQ (Vread_with_symbol_positions
, readcharfun
))
3526 Vread_symbol_positions_list
3527 = Fcons (Fcons (result
, make_number (start_position
)),
3528 Vread_symbol_positions_list
);
3529 return unbind_to (count
, result
);
3535 DEFUN ("lread--substitute-object-in-subtree",
3536 Flread__substitute_object_in_subtree
,
3537 Slread__substitute_object_in_subtree
, 3, 3, 0,
3538 doc
: /* In OBJECT, replace every occurrence of PLACEHOLDER with OBJECT.
3539 COMPLETED is a hash table of objects that might be circular, or is t
3540 if any object might be circular. */)
3541 (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object completed
)
3543 struct subst subst
= { object
, placeholder
, completed
, Qnil
};
3544 Lisp_Object check_object
= substitute_object_recurse (&subst
, object
);
3546 /* The returned object here is expected to always eq the
3548 if (!EQ (check_object
, object
))
3549 error ("Unexpected mutation error in reader");
3554 substitute_object_recurse (struct subst
*subst
, Lisp_Object subtree
)
3556 /* If we find the placeholder, return the target object. */
3557 if (EQ (subst
->placeholder
, subtree
))
3558 return subst
->object
;
3560 /* For common object types that can't contain other objects, don't
3561 bother looking them up; we're done. */
3562 if (SYMBOLP (subtree
)
3563 || (STRINGP (subtree
) && !string_intervals (subtree
))
3564 || NUMBERP (subtree
))
3567 /* If we've been to this node before, don't explore it again. */
3568 if (!EQ (Qnil
, Fmemq (subtree
, subst
->seen
)))
3571 /* If this node can be the entry point to a cycle, remember that
3572 we've seen it. It can only be such an entry point if it was made
3573 by #n=, which means that we can find it as a value in
3575 if (EQ (subst
->completed
, Qt
)
3576 || hash_lookup (XHASH_TABLE (subst
->completed
), subtree
, NULL
) >= 0)
3577 subst
->seen
= Fcons (subtree
, subst
->seen
);
3579 /* Recurse according to subtree's type.
3580 Every branch must return a Lisp_Object. */
3581 switch (XTYPE (subtree
))
3583 case Lisp_Vectorlike
:
3585 ptrdiff_t i
= 0, length
= 0;
3586 if (BOOL_VECTOR_P (subtree
))
3587 return subtree
; /* No sub-objects anyway. */
3588 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3589 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
)
3590 || RECORDP (subtree
))
3591 length
= PVSIZE (subtree
);
3592 else if (VECTORP (subtree
))
3593 length
= ASIZE (subtree
);
3595 /* An unknown pseudovector may contain non-Lisp fields, so we
3596 can't just blindly traverse all its fields. We used to call
3597 `Flength' which signaled `sequencep', so I just preserved this
3599 wrong_type_argument (Qsequencep
, subtree
);
3601 if (SUB_CHAR_TABLE_P (subtree
))
3603 for ( ; i
< length
; i
++)
3605 substitute_object_recurse (subst
, AREF (subtree
, i
)));
3610 XSETCAR (subtree
, substitute_object_recurse (subst
, XCAR (subtree
)));
3611 XSETCDR (subtree
, substitute_object_recurse (subst
, XCDR (subtree
)));
3616 /* Check for text properties in each interval.
3617 substitute_in_interval contains part of the logic. */
3619 INTERVAL root_interval
= string_intervals (subtree
);
3620 traverse_intervals_noorder (root_interval
,
3621 substitute_in_interval
, subst
);
3625 /* Other types don't recurse any further. */
3631 /* Helper function for substitute_object_recurse. */
3633 substitute_in_interval (INTERVAL interval
, void *arg
)
3635 set_interval_plist (interval
,
3636 substitute_object_recurse (arg
, interval
->plist
));
3640 /* Convert STRING to a number, assuming base BASE. Return a fixnum if
3641 STRING has integer syntax and fits in a fixnum, else return the
3642 nearest float if STRING has either floating point or integer syntax
3643 and BASE is 10, else return nil. If IGNORE_TRAILING, consider just
3644 the longest prefix of STRING that has valid floating point syntax.
3645 Signal an overflow if BASE is not 10 and the number has integer
3646 syntax but does not fit. */
3649 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3651 char const *cp
= string
;
3652 bool float_syntax
= 0;
3655 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3656 IEEE floating point hosts, and works around a formerly-common bug where
3657 atof ("-0.0") drops the sign. */
3658 bool negative
= *cp
== '-';
3660 bool signedp
= negative
|| *cp
== '+';
3663 enum { INTOVERFLOW
= 1, LEAD_INT
= 2, DOT_CHAR
= 4, TRAIL_INT
= 8,
3666 int leading_digit
= digit_to_number (*cp
, base
);
3667 uintmax_t n
= leading_digit
;
3668 if (leading_digit
>= 0)
3671 for (int digit
; 0 <= (digit
= digit_to_number (*++cp
, base
)); )
3673 if (INT_MULTIPLY_OVERFLOW (n
, base
))
3674 state
|= INTOVERFLOW
;
3676 if (INT_ADD_OVERFLOW (n
, digit
))
3677 state
|= INTOVERFLOW
;
3689 if ('0' <= *cp
&& *cp
<= '9')
3694 while ('0' <= *cp
&& *cp
<= '9');
3696 if (*cp
== 'e' || *cp
== 'E')
3698 char const *ecp
= cp
;
3700 if (*cp
== '+' || *cp
== '-')
3702 if ('0' <= *cp
&& *cp
<= '9')
3707 while ('0' <= *cp
&& *cp
<= '9');
3709 else if (cp
[-1] == '+'
3710 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3716 else if (cp
[-1] == '+'
3717 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3721 /* NAN is a "positive" NaN on all known Emacs hosts. */
3728 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3729 || (state
& ~INTOVERFLOW
) == (LEAD_INT
|E_EXP
));
3732 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3733 any prefix that matches. Otherwise, the entire string must match. */
3734 if (! (ignore_trailing
3735 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3736 : (!*cp
&& ((state
& ~(INTOVERFLOW
| DOT_CHAR
)) == LEAD_INT
3740 /* If the number uses integer and not float syntax, and is in C-language
3741 range, use its value, preferably as a fixnum. */
3742 if (leading_digit
>= 0 && ! float_syntax
)
3744 if (state
& INTOVERFLOW
)
3746 /* Unfortunately there's no simple and accurate way to convert
3747 non-base-10 numbers that are out of C-language range. */
3749 xsignal1 (Qoverflow_error
, build_string (string
));
3751 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3753 EMACS_INT signed_n
= n
;
3754 return make_number (negative
? -signed_n
: signed_n
);
3760 /* Either the number uses float syntax, or it does not fit into a fixnum.
3761 Convert it from string to floating point, unless the value is already
3762 known because it is an infinity, a NAN, or its absolute value fits in
3765 value
= atof (string
+ signedp
);
3767 return make_float (negative
? -value
: value
);
3772 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3776 Lisp_Object tem
, item
, vector
;
3777 struct Lisp_Cons
*otem
;
3780 tem
= read_list (1, readcharfun
);
3781 len
= Flength (tem
);
3782 vector
= Fmake_vector (len
, Qnil
);
3784 size
= ASIZE (vector
);
3785 ptr
= XVECTOR (vector
)->contents
;
3786 for (i
= 0; i
< size
; i
++)
3789 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3790 bytecode object, the docstring containing the bytecode and
3791 constants values must be treated as unibyte and passed to
3792 Fread, to get the actual bytecode string and constants vector. */
3793 if (bytecodeflag
&& load_force_doc_strings
)
3795 if (i
== COMPILED_BYTECODE
)
3797 if (!STRINGP (item
))
3798 error ("Invalid byte code");
3800 /* Delay handling the bytecode slot until we know whether
3801 it is lazily-loaded (we can tell by whether the
3802 constants slot is nil). */
3803 ASET (vector
, COMPILED_CONSTANTS
, item
);
3806 else if (i
== COMPILED_CONSTANTS
)
3808 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3812 /* Coerce string to unibyte (like string-as-unibyte,
3813 but without generating extra garbage and
3814 guaranteeing no change in the contents). */
3815 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3816 STRING_SET_UNIBYTE (bytestr
);
3818 item
= Fread (Fcons (bytestr
, readcharfun
));
3820 error ("Invalid byte code");
3822 otem
= XCONS (item
);
3823 bytestr
= XCAR (item
);
3828 /* Now handle the bytecode slot. */
3829 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3831 else if (i
== COMPILED_DOC_STRING
3833 && ! STRING_MULTIBYTE (item
))
3835 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3836 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3838 item
= Fstring_as_multibyte (item
);
3841 ASET (vector
, i
, item
);
3849 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3852 read_list (bool flag
, Lisp_Object readcharfun
)
3854 Lisp_Object val
, tail
;
3855 Lisp_Object elt
, tem
;
3856 /* 0 is the normal case.
3857 1 means this list is a doc reference; replace it with the number 0.
3858 2 means this list is a doc reference; replace it with the doc string. */
3859 int doc_reference
= 0;
3861 /* Initialize this to 1 if we are reading a list. */
3862 bool first_in_list
= flag
<= 0;
3870 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3874 /* While building, if the list starts with #$, treat it specially. */
3875 if (EQ (elt
, Vload_file_name
)
3877 && !NILP (Vpurify_flag
))
3879 if (NILP (Vdoc_file_name
))
3880 /* We have not yet called Snarf-documentation, so assume
3881 this file is described in the DOC file
3882 and Snarf-documentation will fill in the right value later.
3883 For now, replace the whole list with 0. */
3886 /* We have already called Snarf-documentation, so make a relative
3887 file name for this file, so it can be found properly
3888 in the installed Lisp directory.
3889 We don't use Fexpand_file_name because that would make
3890 the directory absolute now. */
3892 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3893 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3896 else if (EQ (elt
, Vload_file_name
)
3898 && load_force_doc_strings
)
3907 invalid_syntax (") or . in a vector");
3914 XSETCDR (tail
, read0 (readcharfun
));
3916 val
= read0 (readcharfun
);
3917 read1 (readcharfun
, &ch
, 0);
3921 if (doc_reference
== 1)
3922 return make_number (0);
3923 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3926 file_offset saved_position
;
3927 /* Get a doc string from the file we are loading.
3928 If it's in saved_doc_string, get it from there.
3930 Here, we don't know if the string is a
3931 bytecode string or a doc string. As a
3932 bytecode string must be unibyte, we always
3933 return a unibyte string. If it is actually a
3934 doc string, caller must make it
3937 /* Position is negative for user variables. */
3938 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3939 if (pos
>= saved_doc_string_position
3940 && pos
< (saved_doc_string_position
3941 + saved_doc_string_length
))
3943 saved
= saved_doc_string
;
3944 saved_position
= saved_doc_string_position
;
3946 /* Look in prev_saved_doc_string the same way. */
3947 else if (pos
>= prev_saved_doc_string_position
3948 && pos
< (prev_saved_doc_string_position
3949 + prev_saved_doc_string_length
))
3951 saved
= prev_saved_doc_string
;
3952 saved_position
= prev_saved_doc_string_position
;
3956 ptrdiff_t start
= pos
- saved_position
;
3959 /* Process quoting with ^A,
3960 and find the end of the string,
3961 which is marked with ^_ (037). */
3962 for (from
= start
, to
= start
;
3963 saved
[from
] != 037;)
3965 int c
= saved
[from
++];
3969 saved
[to
++] = (c
== 1 ? c
3978 return make_unibyte_string (saved
+ start
,
3982 return get_doc_string (val
, 1, 0);
3987 invalid_syntax (". in wrong context");
3989 invalid_syntax ("] in a list");
3993 XSETCDR (tail
, tem
);
4000 static Lisp_Object initial_obarray
;
4002 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
4004 static size_t oblookup_last_bucket_number
;
4006 /* Get an error if OBARRAY is not an obarray.
4007 If it is one, return it. */
4010 check_obarray (Lisp_Object obarray
)
4012 /* We don't want to signal a wrong-type-argument error when we are
4013 shutting down due to a fatal error, and we don't want to hit
4014 assertions in VECTORP and ASIZE if the fatal error was during GC. */
4015 if (!fatal_error_in_progress
4016 && (!VECTORP (obarray
) || ASIZE (obarray
) == 0))
4018 /* If Vobarray is now invalid, force it to be valid. */
4019 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
4020 wrong_type_argument (Qvectorp
, obarray
);
4025 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
4028 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
4032 XSYMBOL (sym
)->u
.s
.interned
= (EQ (obarray
, initial_obarray
)
4033 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
4036 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
4038 make_symbol_constant (sym
);
4039 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_PLAINVAL
;
4040 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
4043 ptr
= aref_addr (obarray
, XINT (index
));
4044 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
4049 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
4052 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
4054 return intern_sym (Fmake_symbol (string
), obarray
, index
);
4057 /* Intern the C string STR: return a symbol with that name,
4058 interned in the current obarray. */
4061 intern_1 (const char *str
, ptrdiff_t len
)
4063 Lisp_Object obarray
= check_obarray (Vobarray
);
4064 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
4066 return (SYMBOLP (tem
) ? tem
4067 /* The above `oblookup' was done on the basis of nchars==nbytes, so
4068 the string has to be unibyte. */
4069 : intern_driver (make_unibyte_string (str
, len
),
4074 intern_c_string_1 (const char *str
, ptrdiff_t len
)
4076 Lisp_Object obarray
= check_obarray (Vobarray
);
4077 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
4081 /* Creating a non-pure string from a string literal not implemented yet.
4082 We could just use make_string here and live with the extra copy. */
4083 eassert (!NILP (Vpurify_flag
));
4084 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
4090 define_symbol (Lisp_Object sym
, char const *str
)
4092 ptrdiff_t len
= strlen (str
);
4093 Lisp_Object string
= make_pure_c_string (str
, len
);
4094 init_symbol (sym
, string
);
4096 /* Qunbound is uninterned, so that it's not confused with any symbol
4097 'unbound' created by a Lisp program. */
4098 if (! EQ (sym
, Qunbound
))
4100 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
4101 eassert (INTEGERP (bucket
));
4102 intern_sym (sym
, initial_obarray
, bucket
);
4106 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
4107 doc
: /* Return the canonical symbol whose name is STRING.
4108 If there is none, one is created by this function and returned.
4109 A second optional argument specifies the obarray to use;
4110 it defaults to the value of `obarray'. */)
4111 (Lisp_Object string
, Lisp_Object obarray
)
4115 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
4116 CHECK_STRING (string
);
4118 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
4120 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
4125 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
4126 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
4127 NAME may be a string or a symbol. If it is a symbol, that exact
4128 symbol is searched for.
4129 A second optional argument specifies the obarray to use;
4130 it defaults to the value of `obarray'. */)
4131 (Lisp_Object name
, Lisp_Object obarray
)
4133 register Lisp_Object tem
, string
;
4135 if (NILP (obarray
)) obarray
= Vobarray
;
4136 obarray
= check_obarray (obarray
);
4138 if (!SYMBOLP (name
))
4140 CHECK_STRING (name
);
4144 string
= SYMBOL_NAME (name
);
4146 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
4147 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
4153 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
4154 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
4155 The value is t if a symbol was found and deleted, nil otherwise.
4156 NAME may be a string or a symbol. If it is a symbol, that symbol
4157 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
4158 OBARRAY, if nil, defaults to the value of the variable `obarray'.
4159 usage: (unintern NAME OBARRAY) */)
4160 (Lisp_Object name
, Lisp_Object obarray
)
4162 register Lisp_Object string
, tem
;
4165 if (NILP (obarray
)) obarray
= Vobarray
;
4166 obarray
= check_obarray (obarray
);
4169 string
= SYMBOL_NAME (name
);
4172 CHECK_STRING (name
);
4176 tem
= oblookup (obarray
, SSDATA (string
),
4181 /* If arg was a symbol, don't delete anything but that symbol itself. */
4182 if (SYMBOLP (name
) && !EQ (name
, tem
))
4185 /* There are plenty of other symbols which will screw up the Emacs
4186 session if we unintern them, as well as even more ways to use
4187 `setq' or `fset' or whatnot to make the Emacs session
4188 unusable. Let's not go down this silly road. --Stef */
4189 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
4190 error ("Attempt to unintern t or nil"); */
4192 XSYMBOL (tem
)->u
.s
.interned
= SYMBOL_UNINTERNED
;
4194 hash
= oblookup_last_bucket_number
;
4196 if (EQ (AREF (obarray
, hash
), tem
))
4198 if (XSYMBOL (tem
)->u
.s
.next
)
4201 XSETSYMBOL (sym
, XSYMBOL (tem
)->u
.s
.next
);
4202 ASET (obarray
, hash
, sym
);
4205 ASET (obarray
, hash
, make_number (0));
4209 Lisp_Object tail
, following
;
4211 for (tail
= AREF (obarray
, hash
);
4212 XSYMBOL (tail
)->u
.s
.next
;
4215 XSETSYMBOL (following
, XSYMBOL (tail
)->u
.s
.next
);
4216 if (EQ (following
, tem
))
4218 set_symbol_next (tail
, XSYMBOL (following
)->u
.s
.next
);
4227 /* Return the symbol in OBARRAY whose names matches the string
4228 of SIZE characters (SIZE_BYTE bytes) at PTR.
4229 If there is no such symbol, return the integer bucket number of
4230 where the symbol would be if it were present.
4232 Also store the bucket number in oblookup_last_bucket_number. */
4235 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
4239 register Lisp_Object tail
;
4240 Lisp_Object bucket
, tem
;
4242 obarray
= check_obarray (obarray
);
4243 /* This is sometimes needed in the middle of GC. */
4244 obsize
= gc_asize (obarray
);
4245 hash
= hash_string (ptr
, size_byte
) % obsize
;
4246 bucket
= AREF (obarray
, hash
);
4247 oblookup_last_bucket_number
= hash
;
4248 if (EQ (bucket
, make_number (0)))
4250 else if (!SYMBOLP (bucket
))
4251 error ("Bad data in guts of obarray"); /* Like CADR error message. */
4253 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->u
.s
.next
))
4255 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
4256 && SCHARS (SYMBOL_NAME (tail
)) == size
4257 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
4259 else if (XSYMBOL (tail
)->u
.s
.next
== 0)
4262 XSETINT (tem
, hash
);
4267 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
4270 register Lisp_Object tail
;
4271 CHECK_VECTOR (obarray
);
4272 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
4274 tail
= AREF (obarray
, i
);
4279 if (XSYMBOL (tail
)->u
.s
.next
== 0)
4281 XSETSYMBOL (tail
, XSYMBOL (tail
)->u
.s
.next
);
4287 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4289 call1 (function
, sym
);
4292 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4293 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4294 OBARRAY defaults to the value of `obarray'. */)
4295 (Lisp_Object function
, Lisp_Object obarray
)
4297 if (NILP (obarray
)) obarray
= Vobarray
;
4298 obarray
= check_obarray (obarray
);
4300 map_obarray (obarray
, mapatoms_1
, function
);
4304 #define OBARRAY_SIZE 15121
4309 Vobarray
= Fmake_vector (make_number (OBARRAY_SIZE
), make_number (0));
4310 initial_obarray
= Vobarray
;
4311 staticpro (&initial_obarray
);
4313 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4314 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4316 DEFSYM (Qunbound
, "unbound");
4318 DEFSYM (Qnil
, "nil");
4319 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4320 make_symbol_constant (Qnil
);
4321 XSYMBOL (Qnil
)->u
.s
.declared_special
= true;
4324 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4325 make_symbol_constant (Qt
);
4326 XSYMBOL (Qt
)->u
.s
.declared_special
= true;
4328 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4331 DEFSYM (Qvariable_documentation
, "variable-documentation");
4335 defsubr (struct Lisp_Subr
*sname
)
4337 Lisp_Object sym
, tem
;
4338 sym
= intern_c_string (sname
->symbol_name
);
4339 XSETPVECTYPE (sname
, PVEC_SUBR
);
4340 XSETSUBR (tem
, sname
);
4341 set_symbol_function (sym
, tem
);
4344 #ifdef NOTDEF /* Use fset in subr.el now! */
4346 defalias (struct Lisp_Subr
*sname
, char *string
)
4349 sym
= intern (string
);
4350 XSETSUBR (XSYMBOL (sym
)->u
.s
.function
, sname
);
4354 /* Define an "integer variable"; a symbol whose value is forwarded to a
4355 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4356 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4358 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4359 const char *namestring
, EMACS_INT
*address
)
4362 sym
= intern_c_string (namestring
);
4363 i_fwd
->type
= Lisp_Fwd_Int
;
4364 i_fwd
->intvar
= address
;
4365 XSYMBOL (sym
)->u
.s
.declared_special
= true;
4366 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_FORWARDED
;
4367 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4370 /* Similar but define a variable whose value is t if address contains 1,
4371 nil if address contains 0. */
4373 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4374 const char *namestring
, bool *address
)
4377 sym
= intern_c_string (namestring
);
4378 b_fwd
->type
= Lisp_Fwd_Bool
;
4379 b_fwd
->boolvar
= address
;
4380 XSYMBOL (sym
)->u
.s
.declared_special
= true;
4381 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_FORWARDED
;
4382 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4383 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4386 /* Similar but define a variable whose value is the Lisp Object stored
4387 at address. Two versions: with and without gc-marking of the C
4388 variable. The nopro version is used when that variable will be
4389 gc-marked for some other reason, since marking the same slot twice
4390 can cause trouble with strings. */
4392 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4393 const char *namestring
, Lisp_Object
*address
)
4396 sym
= intern_c_string (namestring
);
4397 o_fwd
->type
= Lisp_Fwd_Obj
;
4398 o_fwd
->objvar
= address
;
4399 XSYMBOL (sym
)->u
.s
.declared_special
= true;
4400 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_FORWARDED
;
4401 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4405 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4406 const char *namestring
, Lisp_Object
*address
)
4408 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4409 staticpro (address
);
4412 /* Similar but define a variable whose value is the Lisp Object stored
4413 at a particular offset in the current kboard object. */
4416 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4417 const char *namestring
, int offset
)
4420 sym
= intern_c_string (namestring
);
4421 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4422 ko_fwd
->offset
= offset
;
4423 XSYMBOL (sym
)->u
.s
.declared_special
= true;
4424 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_FORWARDED
;
4425 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4428 /* Check that the elements of lpath exist. */
4431 load_path_check (Lisp_Object lpath
)
4433 Lisp_Object path_tail
;
4435 /* The only elements that might not exist are those from
4436 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4438 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4440 Lisp_Object dirfile
;
4441 dirfile
= Fcar (path_tail
);
4442 if (STRINGP (dirfile
))
4444 dirfile
= Fdirectory_file_name (dirfile
);
4445 if (! file_accessible_directory_p (dirfile
))
4446 dir_warning ("Lisp directory", XCAR (path_tail
));
4451 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4452 This does not include the standard site-lisp directories
4453 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4454 but it does (unless no_site_lisp is set) include site-lisp
4455 directories in the source/build directories if those exist and we
4456 are running uninstalled.
4458 Uses the following logic:
4460 If Vinstallation_directory is not nil (ie, running uninstalled),
4461 use PATH_DUMPLOADSEARCH (ie, build path). Else use PATH_LOADSEARCH.
4462 The remainder is what happens when dumping works:
4463 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4464 Otherwise use PATH_LOADSEARCH.
4466 If !initialized, then just return PATH_DUMPLOADSEARCH.
4468 If Vinstallation_directory is not nil (ie, running uninstalled):
4469 If installation-dir/lisp exists and not already a member,
4470 we must be running uninstalled. Reset the load-path
4471 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4472 refers to the eventual installation directories. Since we
4473 are not yet installed, we should not use them, even if they exist.)
4474 If installation-dir/lisp does not exist, just add
4475 PATH_DUMPLOADSEARCH at the end instead.
4476 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4477 and not already a member) at the front.
4478 If installation-dir != source-dir (ie running an uninstalled,
4479 out-of-tree build) AND install-dir/src/Makefile exists BUT
4480 install-dir/src/Makefile.in does NOT exist (this is a sanity
4481 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4484 load_path_default (void)
4486 Lisp_Object lpath
= Qnil
;
4491 const char *loadpath
= ns_load_path ();
4494 normal
= PATH_LOADSEARCH
;
4495 if (!NILP (Vinstallation_directory
)) normal
= PATH_DUMPLOADSEARCH
;
4498 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4500 lpath
= decode_env_path (0, normal
, 0);
4503 #else /* !CANNOT_DUMP */
4505 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4510 const char *loadpath
= ns_load_path ();
4511 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4513 lpath
= decode_env_path (0, normal
, 0);
4515 if (!NILP (Vinstallation_directory
))
4517 Lisp_Object tem
, tem1
;
4519 /* Add to the path the lisp subdir of the installation
4520 dir, if it is accessible. Note: in out-of-tree builds,
4521 this directory is empty save for Makefile. */
4522 tem
= Fexpand_file_name (build_string ("lisp"),
4523 Vinstallation_directory
);
4524 tem1
= Ffile_accessible_directory_p (tem
);
4527 if (NILP (Fmember (tem
, lpath
)))
4529 /* We are running uninstalled. The default load-path
4530 points to the eventual installed lisp directories.
4531 We should not use those now, even if they exist,
4532 so start over from a clean slate. */
4533 lpath
= list1 (tem
);
4537 /* That dir doesn't exist, so add the build-time
4538 Lisp dirs instead. */
4540 Lisp_Object dump_path
=
4541 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4542 lpath
= nconc2 (lpath
, dump_path
);
4545 /* Add site-lisp under the installation dir, if it exists. */
4548 tem
= Fexpand_file_name (build_string ("site-lisp"),
4549 Vinstallation_directory
);
4550 tem1
= Ffile_accessible_directory_p (tem
);
4553 if (NILP (Fmember (tem
, lpath
)))
4554 lpath
= Fcons (tem
, lpath
);
4558 /* If Emacs was not built in the source directory,
4559 and it is run from where it was built, add to load-path
4560 the lisp and site-lisp dirs under that directory. */
4562 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4566 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4567 Vinstallation_directory
);
4568 tem1
= Ffile_exists_p (tem
);
4570 /* Don't be fooled if they moved the entire source tree
4571 AFTER dumping Emacs. If the build directory is indeed
4572 different from the source dir, src/Makefile.in and
4573 src/Makefile will not be found together. */
4574 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4575 Vinstallation_directory
);
4576 tem2
= Ffile_exists_p (tem
);
4577 if (!NILP (tem1
) && NILP (tem2
))
4579 tem
= Fexpand_file_name (build_string ("lisp"),
4582 if (NILP (Fmember (tem
, lpath
)))
4583 lpath
= Fcons (tem
, lpath
);
4587 tem
= Fexpand_file_name (build_string ("site-lisp"),
4589 tem1
= Ffile_accessible_directory_p (tem
);
4592 if (NILP (Fmember (tem
, lpath
)))
4593 lpath
= Fcons (tem
, lpath
);
4597 } /* Vinstallation_directory != Vsource_directory */
4599 } /* if Vinstallation_directory */
4601 else /* !initialized */
4603 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4604 source directory. We used to add ../lisp (ie the lisp dir in
4605 the build directory) at the front here, but that should not
4606 be necessary, since in out of tree builds lisp/ is empty, save
4608 lpath
= decode_env_path (0, normal
, 0);
4610 #endif /* !CANNOT_DUMP */
4618 if (NILP (Vpurify_flag
) && !NILP (Ffboundp (Qfile_truename
)))
4619 Vsource_directory
= call1 (Qfile_truename
, Vsource_directory
);
4621 /* First, set Vload_path. */
4623 /* Ignore EMACSLOADPATH when dumping. */
4625 bool use_loadpath
= true;
4627 bool use_loadpath
= NILP (Vpurify_flag
);
4630 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4632 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4634 /* Check (non-nil) user-supplied elements. */
4635 load_path_check (Vload_path
);
4637 /* If no nils in the environment variable, use as-is.
4638 Otherwise, replace any nils with the default. */
4639 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4641 Lisp_Object elem
, elpath
= Vload_path
;
4642 Lisp_Object default_lpath
= load_path_default ();
4644 /* Check defaults, before adding site-lisp. */
4645 load_path_check (default_lpath
);
4647 /* Add the site-lisp directories to the front of the default. */
4648 if (!no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4650 Lisp_Object sitelisp
;
4651 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4652 if (! NILP (sitelisp
))
4653 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4658 /* Replace nils from EMACSLOADPATH by default. */
4659 while (CONSP (elpath
))
4661 elem
= XCAR (elpath
);
4662 elpath
= XCDR (elpath
);
4663 Vload_path
= CALLN (Fappend
, Vload_path
,
4664 NILP (elem
) ? default_lpath
: list1 (elem
));
4666 } /* Fmemq (Qnil, Vload_path) */
4670 Vload_path
= load_path_default ();
4672 /* Check before adding site-lisp directories.
4673 The install should have created them, but they are not
4674 required, so no need to warn if they are absent.
4675 Or we might be running before installation. */
4676 load_path_check (Vload_path
);
4678 /* Add the site-lisp directories at the front. */
4679 if (initialized
&& !no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4681 Lisp_Object sitelisp
;
4682 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4683 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4689 load_in_progress
= 0;
4690 Vload_file_name
= Qnil
;
4691 Vstandard_input
= Qt
;
4692 Vloads_in_progress
= Qnil
;
4695 /* Print a warning that directory intended for use USE and with name
4696 DIRNAME cannot be accessed. On entry, errno should correspond to
4697 the access failure. Print the warning on stderr and put it in
4701 dir_warning (char const *use
, Lisp_Object dirname
)
4703 static char const format
[] = "Warning: %s '%s': %s\n";
4704 char *diagnostic
= emacs_strerror (errno
);
4705 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)), diagnostic
);
4707 /* Don't log the warning before we've initialized!! */
4710 ptrdiff_t diaglen
= strlen (diagnostic
);
4711 AUTO_STRING_WITH_LEN (diag
, diagnostic
, diaglen
);
4712 if (! NILP (Vlocale_coding_system
))
4715 = code_convert_string_norecord (diag
, Vlocale_coding_system
, false);
4716 diagnostic
= SSDATA (s
);
4717 diaglen
= SBYTES (s
);
4720 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4721 + strlen (use
) + SBYTES (dirname
) + diaglen
);
4722 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4724 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4730 syms_of_lread (void)
4733 defsubr (&Sread_from_string
);
4734 defsubr (&Slread__substitute_object_in_subtree
);
4736 defsubr (&Sintern_soft
);
4737 defsubr (&Sunintern
);
4738 defsubr (&Sget_load_suffixes
);
4740 defsubr (&Seval_buffer
);
4741 defsubr (&Seval_region
);
4742 defsubr (&Sread_char
);
4743 defsubr (&Sread_char_exclusive
);
4744 defsubr (&Sread_event
);
4745 defsubr (&Sget_file_char
);
4746 defsubr (&Smapatoms
);
4747 defsubr (&Slocate_file_internal
);
4749 DEFVAR_LISP ("obarray", Vobarray
,
4750 doc
: /* Symbol table for use by `intern' and `read'.
4751 It is a vector whose length ought to be prime for best results.
4752 The vector's contents don't make sense if examined from Lisp programs;
4753 to find all the symbols in an obarray, use `mapatoms'. */);
4755 DEFVAR_LISP ("values", Vvalues
,
4756 doc
: /* List of values of all expressions which were read, evaluated and printed.
4757 Order is reverse chronological. */);
4758 XSYMBOL (intern ("values"))->u
.s
.declared_special
= false;
4760 DEFVAR_LISP ("standard-input", Vstandard_input
,
4761 doc
: /* Stream for read to get input from.
4762 See documentation of `read' for possible values. */);
4763 Vstandard_input
= Qt
;
4765 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4766 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4768 If this variable is a buffer, then only forms read from that buffer
4769 will be added to `read-symbol-positions-list'.
4770 If this variable is t, then all read forms will be added.
4771 The effect of all other values other than nil are not currently
4772 defined, although they may be in the future.
4774 The positions are relative to the last call to `read' or
4775 `read-from-string'. It is probably a bad idea to set this variable at
4776 the toplevel; bind it instead. */);
4777 Vread_with_symbol_positions
= Qnil
;
4779 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4780 doc
: /* A list mapping read symbols to their positions.
4781 This variable is modified during calls to `read' or
4782 `read-from-string', but only when `read-with-symbol-positions' is
4785 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4786 CHAR-POSITION is an integer giving the offset of that occurrence of the
4787 symbol from the position where `read' or `read-from-string' started.
4789 Note that a symbol will appear multiple times in this list, if it was
4790 read multiple times. The list is in the same order as the symbols
4792 Vread_symbol_positions_list
= Qnil
;
4794 DEFVAR_LISP ("read-circle", Vread_circle
,
4795 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4798 DEFVAR_LISP ("load-path", Vload_path
,
4799 doc
: /* List of directories to search for files to load.
4800 Each element is a string (directory file name) or nil (meaning
4801 `default-directory').
4802 This list is consulted by the `require' function.
4803 Initialized during startup as described in Info node `(elisp)Library Search'.
4804 Use `directory-file-name' when adding items to this path. However, Lisp
4805 programs that process this list should tolerate directories both with
4806 and without trailing slashes. */);
4808 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4809 doc
: /* List of suffixes for Emacs Lisp files and dynamic modules.
4810 This list includes suffixes for both compiled and source Emacs Lisp files.
4811 This list should not include the empty string.
4812 `load' and related functions try to append these suffixes, in order,
4813 to the specified file name if a suffix is allowed or required. */);
4815 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4816 build_pure_c_string (".el"),
4817 build_pure_c_string (MODULES_SUFFIX
));
4819 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4820 build_pure_c_string (".el"));
4822 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix
,
4823 doc
: /* Suffix of loadable module file, or nil if modules are not supported. */);
4825 Vmodule_file_suffix
= build_pure_c_string (MODULES_SUFFIX
);
4827 Vmodule_file_suffix
= Qnil
;
4829 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4830 doc
: /* List of suffixes that indicate representations of \
4832 This list should normally start with the empty string.
4834 Enabling Auto Compression mode appends the suffixes in
4835 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4836 mode removes them again. `load' and related functions use this list to
4837 determine whether they should look for compressed versions of a file
4838 and, if so, which suffixes they should try to append to the file name
4839 in order to do so. However, if you want to customize which suffixes
4840 the loading functions recognize as compression suffixes, you should
4841 customize `jka-compr-load-suffixes' rather than the present variable. */);
4842 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4844 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4845 doc
: /* Non-nil if inside of `load'. */);
4846 DEFSYM (Qload_in_progress
, "load-in-progress");
4848 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4849 doc
: /* An alist of functions to be evalled when particular files are loaded.
4850 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4852 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4853 a symbol (a feature name).
4855 When `load' is run and the file-name argument matches an element's
4856 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4857 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4859 An error in FORMS does not undo the load, but does prevent execution of
4860 the rest of the FORMS. */);
4861 Vafter_load_alist
= Qnil
;
4863 DEFVAR_LISP ("load-history", Vload_history
,
4864 doc
: /* Alist mapping loaded file names to symbols and features.
4865 Each alist element should be a list (FILE-NAME ENTRIES...), where
4866 FILE-NAME is the name of a file that has been loaded into Emacs.
4867 The file name is absolute and true (i.e. it doesn't contain symlinks).
4868 As an exception, one of the alist elements may have FILE-NAME nil,
4869 for symbols and features not associated with any file.
4871 The remaining ENTRIES in the alist element describe the functions and
4872 variables defined in that file, the features provided, and the
4873 features required. Each entry has the form `(provide . FEATURE)',
4874 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4875 `(defface . SYMBOL)', `(define-type . SYMBOL)',
4876 `(cl-defmethod METHOD SPECIALIZERS)', or `(t . SYMBOL)'.
4877 Entries like `(t . SYMBOL)' may precede a `(defun . FUNCTION)' entry,
4878 and means that SYMBOL was an autoload before this file redefined it
4879 as a function. In addition, entries may also be single symbols,
4880 which means that symbol was defined by `defvar' or `defconst'.
4882 During preloading, the file name recorded is relative to the main Lisp
4883 directory. These file names are converted to absolute at startup. */);
4884 Vload_history
= Qnil
;
4886 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4887 doc
: /* Full name of file being loaded by `load'. */);
4888 Vload_file_name
= Qnil
;
4890 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4891 doc
: /* File name, including directory, of user's initialization file.
4892 If the file loaded had extension `.elc', and the corresponding source file
4893 exists, this variable contains the name of source file, suitable for use
4894 by functions like `custom-save-all' which edit the init file.
4895 While Emacs loads and evaluates the init file, value is the real name
4896 of the file, regardless of whether or not it has the `.elc' extension. */);
4897 Vuser_init_file
= Qnil
;
4899 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4900 doc
: /* Used for internal purposes by `load'. */);
4901 Vcurrent_load_list
= Qnil
;
4903 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4904 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4905 Called with a single argument (the stream from which to read).
4906 The default is to use the function `read'. */);
4907 DEFSYM (Qread
, "read");
4908 Vload_read_function
= Qread
;
4910 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4911 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4912 The value should be a function for doing code conversion before
4913 reading a source file. It can also be nil, in which case loading is
4914 done without any code conversion.
4916 If the value is a function, it is called with four arguments,
4917 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4918 the file to load, FILE is the non-absolute name (for messages etc.),
4919 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4920 `load'. The function should return t if the file was loaded. */);
4921 Vload_source_file_function
= Qnil
;
4923 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4924 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4925 This is useful when the file being loaded is a temporary copy. */);
4926 load_force_doc_strings
= 0;
4928 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4929 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4930 This is normally bound by `load' and `eval-buffer' to control `read',
4931 and is not meant for users to change. */);
4932 load_convert_to_unibyte
= 0;
4934 DEFVAR_LISP ("source-directory", Vsource_directory
,
4935 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4936 You cannot count on them to still be there! */);
4938 = Fexpand_file_name (build_string ("../"),
4939 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4941 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4942 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4943 Vpreloaded_file_list
= Qnil
;
4945 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4946 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4947 Vbyte_boolean_vars
= Qnil
;
4949 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4950 doc
: /* Non-nil means load dangerous compiled Lisp files.
4951 Some versions of XEmacs use different byte codes than Emacs. These
4952 incompatible byte codes can make Emacs crash when it tries to execute
4954 load_dangerous_libraries
= 0;
4956 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4957 doc
: /* Non-nil means force printing messages when loading Lisp files.
4958 This overrides the value of the NOMESSAGE argument to `load'. */);
4959 force_load_messages
= 0;
4961 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4962 doc
: /* Regular expression matching safe to load compiled Lisp files.
4963 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4964 from the file, and matches them against this regular expression.
4965 When the regular expression matches, the file is considered to be safe
4966 to load. See also `load-dangerous-libraries'. */);
4967 Vbytecomp_version_regexp
4968 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4970 DEFSYM (Qlexical_binding
, "lexical-binding");
4971 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4972 doc
: /* Whether to use lexical binding when evaluating code.
4973 Non-nil means that the code in the current buffer should be evaluated
4974 with lexical binding.
4975 This variable is automatically set from the file variables of an
4976 interpreted Lisp file read using `load'. Unlike other file local
4977 variables, this must be set in the first line of a file. */);
4978 Vlexical_binding
= Qnil
;
4979 Fmake_variable_buffer_local (Qlexical_binding
);
4981 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4982 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4983 Veval_buffer_list
= Qnil
;
4985 DEFVAR_LISP ("lread--unescaped-character-literals",
4986 Vlread_unescaped_character_literals
,
4987 doc
: /* List of deprecated unescaped character literals encountered by `read'.
4988 For internal use only. */);
4989 Vlread_unescaped_character_literals
= Qnil
;
4990 DEFSYM (Qlread_unescaped_character_literals
,
4991 "lread--unescaped-character-literals");
4994 DEFSYM (Qchar
, "char");
4995 DEFSYM (Qformat
, "format");
4997 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4998 doc
: /* Non-nil means `load' prefers the newest version of a file.
4999 This applies when a filename suffix is not explicitly specified and
5000 `load' is trying various possible suffixes (see `load-suffixes' and
5001 `load-file-rep-suffixes'). Normally, it stops at the first file
5002 that exists unless you explicitly specify one or the other. If this
5003 option is non-nil, it checks all suffixes and uses whichever file is
5005 Note that if you customize this, obviously it will not affect files
5006 that are loaded before your customizations are read! */);
5007 load_prefer_newer
= 0;
5009 /* Vsource_directory was initialized in init_lread. */
5011 DEFSYM (Qcurrent_load_list
, "current-load-list");
5012 DEFSYM (Qstandard_input
, "standard-input");
5013 DEFSYM (Qread_char
, "read-char");
5014 DEFSYM (Qget_file_char
, "get-file-char");
5016 /* Used instead of Qget_file_char while loading *.elc files compiled
5017 by Emacs 21 or older. */
5018 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
5020 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
5022 DEFSYM (Qbackquote
, "`");
5023 DEFSYM (Qcomma
, ",");
5024 DEFSYM (Qcomma_at
, ",@");
5025 DEFSYM (Qcomma_dot
, ",.");
5027 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
5028 DEFSYM (Qascii_character
, "ascii-character");
5029 DEFSYM (Qfunction
, "function");
5030 DEFSYM (Qload
, "load");
5031 DEFSYM (Qload_file_name
, "load-file-name");
5032 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
5033 DEFSYM (Qfile_truename
, "file-truename");
5034 DEFSYM (Qdir_ok
, "dir-ok");
5035 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
5037 staticpro (&read_objects_map
);
5038 read_objects_map
= Qnil
;
5039 staticpro (&read_objects_completed
);
5040 read_objects_completed
= Qnil
;
5042 Vloads_in_progress
= Qnil
;
5043 staticpro (&Vloads_in_progress
);
5045 DEFSYM (Qhash_table
, "hash-table");
5046 DEFSYM (Qdata
, "data");
5047 DEFSYM (Qtest
, "test");
5048 DEFSYM (Qsize
, "size");
5049 DEFSYM (Qpurecopy
, "purecopy");
5050 DEFSYM (Qweakness
, "weakness");
5051 DEFSYM (Qrehash_size
, "rehash-size");
5052 DEFSYM (Qrehash_threshold
, "rehash-threshold");
5054 DEFSYM (Qchar_from_name
, "char-from-name");