1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2019 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 event from the command input (keyboard or macro).
739 It is returned as a number.
740 If the event has modifiers, they are resolved and reflected in the
741 returned character code if possible (e.g. C-SPC yields 0 and C-a yields 97).
742 If some of the modifiers cannot be reflected in the character code, the
743 returned value will include those modifiers, and will not be a valid
744 character code: it will fail the `characterp' test. Use `event-basic-type'
745 to recover the character code with the modifiers removed.
747 If the user generates an event which is not a character (i.e. a mouse
748 click or function key event), `read-char' signals an error. As an
749 exception, switch-frame events are put off until non-character events
751 If you want to read non-character events, or ignore them, call
752 `read-event' or `read-char-exclusive' instead.
754 If the optional argument PROMPT is non-nil, display that as a prompt.
755 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
756 input method is turned on in the current buffer, that input method
757 is used for reading a character.
758 If the optional argument SECONDS is non-nil, it should be a number
759 specifying the maximum number of seconds to wait for input. If no
760 input arrives in that time, return nil. SECONDS may be a
761 floating-point value. */)
762 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
767 message_with_string ("%s", prompt
, 0);
768 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
770 return (NILP (val
) ? Qnil
771 : make_number (char_resolve_modifier_mask (XINT (val
))));
774 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
775 doc
: /* Read an event object from the input stream.
776 If the optional argument PROMPT is non-nil, display that as a prompt.
777 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
778 input method is turned on in the current buffer, that input method
779 is used for reading a character.
780 If the optional argument SECONDS is non-nil, it should be a number
781 specifying the maximum number of seconds to wait for input. If no
782 input arrives in that time, return nil. SECONDS may be a
783 floating-point value. */)
784 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
787 message_with_string ("%s", prompt
, 0);
788 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
791 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
792 doc
: /* Read a character event from the command input (keyboard or macro).
793 It is returned as a number. Non-character events are ignored.
794 If the event has modifiers, they are resolved and reflected in the
795 returned character code if possible (e.g. C-SPC yields 0 and C-a yields 97).
796 If some of the modifiers cannot be reflected in the character code, the
797 returned value will include those modifiers, and will not be a valid
798 character code: it will fail the `characterp' test. Use `event-basic-type'
799 to recover the character code with the modifiers removed.
801 If the optional argument PROMPT is non-nil, display that as a prompt.
802 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
803 input method is turned on in the current buffer, that input method
804 is used for reading a character.
805 If the optional argument SECONDS is non-nil, it should be a number
806 specifying the maximum number of seconds to wait for input. If no
807 input arrives in that time, return nil. SECONDS may be a
808 floating-point value. */)
809 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
814 message_with_string ("%s", prompt
, 0);
816 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
818 return (NILP (val
) ? Qnil
819 : make_number (char_resolve_modifier_mask (XINT (val
))));
822 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
823 doc
: /* Don't use this yourself. */)
827 error ("get-file-char misused");
828 return make_number (readbyte_from_stdio ());
834 /* Return true if the lisp code read using READCHARFUN defines a non-nil
835 `lexical-binding' file variable. After returning, the stream is
836 positioned following the first line, if it is a comment or #! line,
837 otherwise nothing is read. */
840 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
853 while (ch
!= '\n' && ch
!= EOF
)
855 if (ch
== '\n') ch
= READCHAR
;
856 /* It is OK to leave the position after a #! line, since
857 that is what read1 does. */
861 /* The first line isn't a comment, just give up. */
867 /* Look for an appropriate file-variable in the first line. */
871 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
872 } beg_end_state
= NOMINAL
;
873 bool in_file_vars
= 0;
875 #define UPDATE_BEG_END_STATE(ch) \
876 if (beg_end_state == NOMINAL) \
877 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
878 else if (beg_end_state == AFTER_FIRST_DASH) \
879 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
880 else if (beg_end_state == AFTER_ASTERIX) \
883 in_file_vars = !in_file_vars; \
884 beg_end_state = NOMINAL; \
887 /* Skip until we get to the file vars, if any. */
891 UPDATE_BEG_END_STATE (ch
);
893 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
897 char var
[100], val
[100];
902 /* Read a variable name. */
903 while (ch
== ' ' || ch
== '\t')
907 beg_end_state
= NOMINAL
;
908 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
910 if (i
< sizeof var
- 1)
912 UPDATE_BEG_END_STATE (ch
);
916 /* Stop scanning if no colon was found before end marker. */
917 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
920 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
926 /* Read a variable value. */
929 while (ch
== ' ' || ch
== '\t')
933 beg_end_state
= NOMINAL
;
934 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
936 if (i
< sizeof val
- 1)
938 UPDATE_BEG_END_STATE (ch
);
942 /* The value was terminated by an end-marker, which remove. */
944 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
948 if (strcmp (var
, "lexical-binding") == 0)
951 rv
= (strcmp (val
, "nil") != 0);
957 while (ch
!= '\n' && ch
!= EOF
)
964 /* Value is a version number of byte compiled code if the file
965 associated with file descriptor FD is a compiled Lisp file that's
966 safe to load. Only files compiled with Emacs are safe to load.
967 Files compiled with XEmacs can lead to a crash in Fbyte_code
968 because of an incompatible change in the byte compiler. */
971 safe_to_load_version (int fd
)
977 /* Read the first few bytes from the file, and look for a line
978 specifying the byte compiler version used. */
979 nbytes
= emacs_read_quit (fd
, buf
, sizeof buf
);
982 /* Skip to the next newline, skipping over the initial `ELC'
983 with NUL bytes following it, but note the version. */
984 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
989 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
990 buf
+ i
, nbytes
- i
) < 0)
994 lseek (fd
, 0, SEEK_SET
);
999 /* Callback for record_unwind_protect. Restore the old load list OLD,
1000 after loading a file successfully. */
1003 record_load_unwind (Lisp_Object old
)
1005 Vloads_in_progress
= old
;
1008 /* This handler function is used via internal_condition_case_1. */
1011 load_error_handler (Lisp_Object data
)
1017 load_warn_old_style_backquotes (Lisp_Object file
)
1019 if (!NILP (Vlread_old_style_backquotes
))
1021 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
1022 CALLN (Fmessage
, format
, file
);
1027 load_warn_unescaped_character_literals (Lisp_Object file
)
1029 if (NILP (Vlread_unescaped_character_literals
)) return;
1030 CHECK_CONS (Vlread_unescaped_character_literals
);
1031 Lisp_Object format
=
1032 build_string ("Loading `%s': unescaped character literals %s detected!");
1033 Lisp_Object separator
= build_string (", ");
1034 Lisp_Object inner_format
= build_string ("`?%c'");
1037 Fmapconcat (list3 (Qlambda
, list1 (Qchar
),
1038 list3 (Qformat
, inner_format
, Qchar
)),
1039 Fsort (Vlread_unescaped_character_literals
, Qlss
),
1043 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
1044 doc
: /* Return the suffixes that `load' should try if a suffix is \
1046 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
1049 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
1050 while (CONSP (suffixes
))
1052 Lisp_Object exts
= Vload_file_rep_suffixes
;
1053 suffix
= XCAR (suffixes
);
1054 suffixes
= XCDR (suffixes
);
1055 while (CONSP (exts
))
1059 lst
= Fcons (concat2 (suffix
, ext
), lst
);
1062 return Fnreverse (lst
);
1065 /* Returns true if STRING ends with SUFFIX */
1067 suffix_p (Lisp_Object string
, const char *suffix
)
1069 ptrdiff_t suffix_len
= strlen (suffix
);
1070 ptrdiff_t string_len
= SBYTES (string
);
1072 return string_len
>= suffix_len
&& !strcmp (SSDATA (string
) + string_len
- suffix_len
, suffix
);
1076 close_infile_unwind (void *arg
)
1079 eassert (infile
== NULL
|| infile
->stream
== stream
);
1084 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1085 doc
: /* Execute a file of Lisp code named FILE.
1086 First try FILE with `.elc' appended, then try with `.el', then try
1087 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
1088 then try FILE unmodified (the exact suffixes in the exact order are
1089 determined by `load-suffixes'). Environment variable references in
1090 FILE are replaced with their values by calling `substitute-in-file-name'.
1091 This function searches the directories in `load-path'.
1093 If optional second arg NOERROR is non-nil,
1094 report no error if FILE doesn't exist.
1095 Print messages at start and end of loading unless
1096 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1098 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1099 suffixes to the specified name FILE.
1100 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1101 the suffix `.elc' or `.el' or the module suffix; don't accept just
1102 FILE unless it ends in one of those suffixes or includes a directory name.
1104 If NOSUFFIX is nil, then if a file could not be found, try looking for
1105 a different representation of the file by adding non-empty suffixes to
1106 its name, before trying another file. Emacs uses this feature to find
1107 compressed versions of files when Auto Compression mode is enabled.
1108 If NOSUFFIX is non-nil, disable this feature.
1110 The suffixes that this function tries out, when NOSUFFIX is nil, are
1111 given by the return value of `get-load-suffixes' and the values listed
1112 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1113 return value of `get-load-suffixes' is used, i.e. the file name is
1114 required to have a non-empty suffix.
1116 When searching suffixes, this function normally stops at the first
1117 one that exists. If the option `load-prefer-newer' is non-nil,
1118 however, it tries all suffixes, and uses whichever file is the newest.
1120 Loading a file records its definitions, and its `provide' and
1121 `require' calls, in an element of `load-history' whose
1122 car is the file name loaded. See `load-history'.
1124 While the file is in the process of being loaded, the variable
1125 `load-in-progress' is non-nil and the variable `load-file-name'
1126 is bound to the file's name.
1128 Return t if the file exists and loads successfully. */)
1129 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1130 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1134 int fd_index UNINIT
;
1135 ptrdiff_t count
= SPECPDL_INDEX ();
1136 Lisp_Object found
, efound
, hist_file_name
;
1137 /* True means we printed the ".el is newer" message. */
1139 /* True means we are loading a compiled file. */
1141 Lisp_Object handler
;
1143 const char *fmode
= "r" FOPEN_TEXT
;
1146 CHECK_STRING (file
);
1148 /* If file name is magic, call the handler. */
1149 /* This shouldn't be necessary any more now that `openp' handles it right.
1150 handler = Ffind_file_name_handler (file, Qload);
1151 if (!NILP (handler))
1152 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1154 /* The presence of this call is the result of a historical accident:
1155 it used to be in every file-operation and when it got removed
1156 everywhere, it accidentally stayed here. Since then, enough people
1157 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1158 that it seemed risky to remove. */
1159 if (! NILP (noerror
))
1161 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1162 Qt
, load_error_handler
);
1167 file
= Fsubstitute_in_file_name (file
);
1169 /* Avoid weird lossage with null string as arg,
1170 since it would try to load a directory as a Lisp file. */
1171 if (SCHARS (file
) == 0)
1178 Lisp_Object suffixes
;
1181 if (! NILP (must_suffix
))
1183 /* Don't insist on adding a suffix if FILE already ends with one. */
1184 if (suffix_p (file
, ".el")
1185 || suffix_p (file
, ".elc")
1187 || suffix_p (file
, MODULES_SUFFIX
)
1191 /* Don't insist on adding a suffix
1192 if the argument includes a directory name. */
1193 else if (! NILP (Ffile_name_directory (file
)))
1197 if (!NILP (nosuffix
))
1201 suffixes
= Fget_load_suffixes ();
1202 if (NILP (must_suffix
))
1203 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1206 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1212 report_file_error ("Cannot open load file", file
);
1216 /* Tell startup.el whether or not we found the user's init file. */
1217 if (EQ (Qt
, Vuser_init_file
))
1218 Vuser_init_file
= found
;
1220 /* If FD is -2, that means openp found a magic file. */
1223 if (NILP (Fequal (found
, file
)))
1224 /* If FOUND is a different file name from FILE,
1225 find its handler even if we have already inhibited
1226 the `load' operation on FILE. */
1227 handler
= Ffind_file_name_handler (found
, Qt
);
1229 handler
= Ffind_file_name_handler (found
, Qload
);
1230 if (! NILP (handler
))
1231 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1233 /* Tramp has to deal with semi-broken packages that prepend
1234 drive letters to remote files. For that reason, Tramp
1235 catches file operations that test for file existence, which
1236 makes openp think X:/foo.elc files are remote. However,
1237 Tramp does not catch `load' operations for such files, so we
1238 end up with a nil as the `load' handler above. If we would
1239 continue with fd = -2, we will behave wrongly, and in
1240 particular try reading a .elc file in the "rt" mode instead
1241 of "rb". See bug #9311 for the results. To work around
1242 this, we try to open the file locally, and go with that if it
1244 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1252 fd_index
= SPECPDL_INDEX ();
1253 record_unwind_protect_int (close_file_unwind
, fd
);
1257 if (suffix_p (found
, MODULES_SUFFIX
))
1258 return unbind_to (count
, Fmodule_load (found
));
1261 /* Check if we're stuck in a recursive load cycle.
1263 2000-09-21: It's not possible to just check for the file loaded
1264 being a member of Vloads_in_progress. This fails because of the
1265 way the byte compiler currently works; `provide's are not
1266 evaluated, see font-lock.el/jit-lock.el as an example. This
1267 leads to a certain amount of ``normal'' recursion.
1269 Also, just loading a file recursively is not always an error in
1270 the general case; the second load may do something different. */
1274 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1275 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1276 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1277 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1278 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1281 /* All loads are by default dynamic, unless the file itself specifies
1282 otherwise using a file-variable in the first line. This is bound here
1283 so that it takes effect whether or not we use
1284 Vload_source_file_function. */
1285 specbind (Qlexical_binding
, Qnil
);
1287 /* Get the name for load-history. */
1288 hist_file_name
= (! NILP (Vpurify_flag
)
1289 ? concat2 (Ffile_name_directory (file
),
1290 Ffile_name_nondirectory (found
))
1295 /* Check for the presence of old-style quotes and warn about them. */
1296 specbind (Qlread_old_style_backquotes
, Qnil
);
1297 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1299 /* Check for the presence of unescaped character literals and warn
1301 specbind (Qlread_unescaped_character_literals
, Qnil
);
1302 record_unwind_protect (load_warn_unescaped_character_literals
, file
);
1305 if ((is_elc
= suffix_p (found
, ".elc")) != 0
1306 /* version = 1 means the file is empty, in which case we can
1307 treat it as not byte-compiled. */
1308 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 1))
1309 /* Load .elc files directly, but not when they are
1310 remote and have no handler! */
1318 && ! (version
= safe_to_load_version (fd
)))
1321 if (!load_dangerous_libraries
)
1322 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1323 else if (!NILP (nomessage
) && !force_load_messages
)
1324 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1329 efound
= ENCODE_FILE (found
);
1330 fmode
= "r" FOPEN_BINARY
;
1332 /* openp already checked for newness, no point doing it again.
1333 FIXME would be nice to get a message when openp
1334 ignores suffix order due to load_prefer_newer. */
1335 if (!load_prefer_newer
&& is_elc
)
1337 result
= stat (SSDATA (efound
), &s1
);
1340 SSET (efound
, SBYTES (efound
) - 1, 0);
1341 result
= stat (SSDATA (efound
), &s2
);
1342 SSET (efound
, SBYTES (efound
) - 1, 'c');
1346 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1348 /* Make the progress messages mention that source is newer. */
1351 /* If we won't print another message, mention this anyway. */
1352 if (!NILP (nomessage
) && !force_load_messages
)
1354 Lisp_Object msg_file
;
1355 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1356 message_with_string ("Source file `%s' newer than byte-compiled file",
1360 } /* !load_prefer_newer */
1365 /* We are loading a source file (*.el). */
1366 if (!NILP (Vload_source_file_function
))
1373 clear_unwind_protect (fd_index
);
1375 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1376 NILP (noerror
) ? Qnil
: Qt
,
1377 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1378 return unbind_to (count
, val
);
1384 /* We somehow got here with fd == -2, meaning the file is deemed
1385 to be remote. Don't even try to reopen the file locally;
1386 just force a failure. */
1394 clear_unwind_protect (fd_index
);
1395 efound
= ENCODE_FILE (found
);
1396 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1398 stream
= fdopen (fd
, fmode
);
1402 report_file_error ("Opening stdio stream", file
);
1403 set_unwind_protect_ptr (fd_index
, close_infile_unwind
, stream
);
1405 if (! NILP (Vpurify_flag
))
1406 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1408 if (NILP (nomessage
) || force_load_messages
)
1411 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1414 message_with_string ("Loading %s (source)...", file
, 1);
1416 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1418 else /* The typical case; compiled file newer than source file. */
1419 message_with_string ("Loading %s...", file
, 1);
1422 specbind (Qload_file_name
, found
);
1423 specbind (Qinhibit_file_name_operation
, Qnil
);
1424 specbind (Qload_in_progress
, Qt
);
1426 struct infile input
;
1427 input
.stream
= stream
;
1428 input
.lookahead
= 0;
1431 if (lisp_file_lexically_bound_p (Qget_file_char
))
1432 Fset (Qlexical_binding
, Qt
);
1434 if (! version
|| version
>= 22)
1435 readevalloop (Qget_file_char
, &input
, hist_file_name
,
1436 0, Qnil
, Qnil
, Qnil
, Qnil
);
1439 /* We can't handle a file which was compiled with
1440 byte-compile-dynamic by older version of Emacs. */
1441 specbind (Qload_force_doc_strings
, Qt
);
1442 readevalloop (Qget_emacs_mule_file_char
, &input
, hist_file_name
,
1443 0, Qnil
, Qnil
, Qnil
, Qnil
);
1445 unbind_to (count
, Qnil
);
1447 /* Run any eval-after-load forms for this file. */
1448 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1449 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1451 xfree (saved_doc_string
);
1452 saved_doc_string
= 0;
1453 saved_doc_string_size
= 0;
1455 xfree (prev_saved_doc_string
);
1456 prev_saved_doc_string
= 0;
1457 prev_saved_doc_string_size
= 0;
1459 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1462 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1465 message_with_string ("Loading %s (source)...done", file
, 1);
1467 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1469 else /* The typical case; compiled file newer than source file. */
1470 message_with_string ("Loading %s...done", file
, 1);
1477 complete_filename_p (Lisp_Object pathname
)
1479 const unsigned char *s
= SDATA (pathname
);
1480 return (IS_DIRECTORY_SEP (s
[0])
1481 || (SCHARS (pathname
) > 2
1482 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1485 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1486 doc
: /* Search for FILENAME through PATH.
1487 Returns the file's name in absolute form, or nil if not found.
1488 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1489 file name when searching.
1490 If non-nil, PREDICATE is used instead of `file-readable-p'.
1491 PREDICATE can also be an integer to pass to the faccessat(2) function,
1492 in which case file-name-handlers are ignored.
1493 This function will normally skip directories, so if you want it to find
1494 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1495 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1498 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1499 if (NILP (predicate
) && fd
>= 0)
1504 /* Search for a file whose name is STR, looking in directories
1505 in the Lisp list PATH, and trying suffixes from SUFFIX.
1506 On success, return a file descriptor (or 1 or -2 as described below).
1507 On failure, return -1 and set errno.
1509 SUFFIXES is a list of strings containing possible suffixes.
1510 The empty suffix is automatically added if the list is empty.
1512 PREDICATE t means the files are binary.
1513 PREDICATE non-nil and non-t means don't open the files,
1514 just look for one that satisfies the predicate. In this case,
1515 return -2 on success. The predicate can be a lisp function or
1516 an integer to pass to `access' (in which case file-name-handlers
1519 If STOREPTR is nonzero, it points to a slot where the name of
1520 the file actually found should be stored as a Lisp string.
1521 nil is stored there on failure.
1523 If the file we find is remote, return -2
1524 but store the found remote file name in *STOREPTR.
1526 If NEWER is true, try all SUFFIXes and return the result for the
1527 newest file that exists. Does not apply to remote files,
1528 or if a non-nil and non-t PREDICATE is specified. */
1531 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1532 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1534 ptrdiff_t fn_size
= 100;
1538 ptrdiff_t want_length
;
1539 Lisp_Object filename
;
1540 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1541 ptrdiff_t max_suffix_len
= 0;
1542 int last_errno
= ENOENT
;
1546 /* The last-modified time of the newest matching file found.
1547 Initialize it to something less than all valid timestamps. */
1548 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1552 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1554 CHECK_STRING_CAR (tail
);
1555 max_suffix_len
= max (max_suffix_len
,
1556 SBYTES (XCAR (tail
)));
1559 string
= filename
= encoded_fn
= save_string
= Qnil
;
1564 absolute
= complete_filename_p (str
);
1566 for (; CONSP (path
); path
= XCDR (path
))
1568 ptrdiff_t baselen
, prefixlen
;
1570 filename
= Fexpand_file_name (str
, XCAR (path
));
1571 if (!complete_filename_p (filename
))
1572 /* If there are non-absolute elts in PATH (eg "."). */
1573 /* Of course, this could conceivably lose if luser sets
1574 default-directory to be something non-absolute... */
1576 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1577 if (!complete_filename_p (filename
))
1578 /* Give up on this path element! */
1582 /* Calculate maximum length of any filename made from
1583 this path element/specified file name and any possible suffix. */
1584 want_length
= max_suffix_len
+ SBYTES (filename
);
1585 if (fn_size
<= want_length
)
1587 fn_size
= 100 + want_length
;
1588 fn
= SAFE_ALLOCA (fn_size
);
1591 /* Copy FILENAME's data to FN but remove starting /: if any. */
1592 prefixlen
= ((SCHARS (filename
) > 2
1593 && SREF (filename
, 0) == '/'
1594 && SREF (filename
, 1) == ':')
1596 baselen
= SBYTES (filename
) - prefixlen
;
1597 memcpy (fn
, SDATA (filename
) + prefixlen
, baselen
);
1599 /* Loop over suffixes. */
1600 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1601 CONSP (tail
); tail
= XCDR (tail
))
1603 Lisp_Object suffix
= XCAR (tail
);
1604 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1605 Lisp_Object handler
;
1607 /* Make complete filename by appending SUFFIX. */
1608 memcpy (fn
+ baselen
, SDATA (suffix
), lsuffix
+ 1);
1609 fnlen
= baselen
+ lsuffix
;
1611 /* Check that the file exists and is not a directory. */
1612 /* We used to only check for handlers on non-absolute file names:
1616 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1617 It's not clear why that was the case and it breaks things like
1618 (load "/bar.el") where the file is actually "/bar.el.gz". */
1619 /* make_string has its own ideas on when to return a unibyte
1620 string and when a multibyte string, but we know better.
1621 We must have a unibyte string when dumping, since
1622 file-name encoding is shaky at best at that time, and in
1623 particular default-file-name-coding-system is reset
1624 several times during loadup. We therefore don't want to
1625 encode the file before passing it to file I/O library
1627 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1628 string
= make_unibyte_string (fn
, fnlen
);
1630 string
= make_string (fn
, fnlen
);
1631 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1632 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1633 && !NATNUMP (predicate
))
1636 if (NILP (predicate
) || EQ (predicate
, Qt
))
1637 exists
= !NILP (Ffile_readable_p (string
));
1640 Lisp_Object tmp
= call1 (predicate
, string
);
1643 else if (EQ (tmp
, Qdir_ok
)
1644 || NILP (Ffile_directory_p (string
)))
1649 last_errno
= EISDIR
;
1655 /* We succeeded; return this descriptor and filename. */
1668 encoded_fn
= ENCODE_FILE (string
);
1669 pfn
= SSDATA (encoded_fn
);
1671 /* Check that we can access or open it. */
1672 if (NATNUMP (predicate
))
1675 if (INT_MAX
< XFASTINT (predicate
))
1676 last_errno
= EINVAL
;
1677 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1681 if (file_directory_p (pfn
))
1682 last_errno
= EISDIR
;
1689 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1692 if (errno
!= ENOENT
)
1697 int err
= (fstat (fd
, &st
) != 0 ? errno
1698 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1710 if (newer
&& !NATNUMP (predicate
))
1712 struct timespec mtime
= get_stat_mtime (&st
);
1714 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1719 emacs_close (save_fd
);
1722 save_string
= string
;
1727 /* We succeeded; return this descriptor and filename. */
1735 /* No more suffixes. Return the newest. */
1736 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1739 *storeptr
= save_string
;
1755 /* Merge the list we've accumulated of globals from the current input source
1756 into the load_history variable. The details depend on whether
1757 the source has an associated file name or not.
1759 FILENAME is the file name that we are loading from.
1761 ENTIRE is true if loading that entire file, false if evaluating
1765 build_load_history (Lisp_Object filename
, bool entire
)
1767 Lisp_Object tail
, prev
, newelt
;
1768 Lisp_Object tem
, tem2
;
1771 tail
= Vload_history
;
1774 while (CONSP (tail
))
1778 /* Find the feature's previous assoc list... */
1779 if (!NILP (Fequal (filename
, Fcar (tem
))))
1783 /* If we're loading the entire file, remove old data. */
1787 Vload_history
= XCDR (tail
);
1789 Fsetcdr (prev
, XCDR (tail
));
1792 /* Otherwise, cons on new symbols that are not already members. */
1795 tem2
= Vcurrent_load_list
;
1797 while (CONSP (tem2
))
1799 newelt
= XCAR (tem2
);
1801 if (NILP (Fmember (newelt
, tem
)))
1802 Fsetcar (tail
, Fcons (XCAR (tem
),
1803 Fcons (newelt
, XCDR (tem
))));
1816 /* If we're loading an entire file, cons the new assoc onto the
1817 front of load-history, the most-recently-loaded position. Also
1818 do this if we didn't find an existing member for the file. */
1819 if (entire
|| !foundit
)
1820 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1825 readevalloop_1 (int old
)
1827 load_convert_to_unibyte
= old
;
1830 /* Signal an `end-of-file' error, if possible with file name
1833 static _Noreturn
void
1834 end_of_file_error (void)
1836 if (STRINGP (Vload_file_name
))
1837 xsignal1 (Qend_of_file
, Vload_file_name
);
1839 xsignal0 (Qend_of_file
);
1843 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1845 /* If we macroexpand the toplevel form non-recursively and it ends
1846 up being a `progn' (or if it was a progn to start), treat each
1847 form in the progn as a top-level form. This way, if one form in
1848 the progn defines a macro, that macro is in effect when we expand
1849 the remaining forms. See similar code in bytecomp.el. */
1850 val
= call2 (macroexpand
, val
, Qnil
);
1851 if (EQ (CAR_SAFE (val
), Qprogn
))
1853 Lisp_Object subforms
= XCDR (val
);
1855 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1856 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1860 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1864 /* UNIBYTE specifies how to set load_convert_to_unibyte
1865 for this invocation.
1866 READFUN, if non-nil, is used instead of `read'.
1868 START, END specify region to read in current buffer (from eval-region).
1869 If the input is not from a buffer, they must be nil. */
1872 readevalloop (Lisp_Object readcharfun
,
1873 struct infile
*infile0
,
1874 Lisp_Object sourcename
,
1876 Lisp_Object unibyte
, Lisp_Object readfun
,
1877 Lisp_Object start
, Lisp_Object end
)
1881 ptrdiff_t count
= SPECPDL_INDEX ();
1882 struct buffer
*b
= 0;
1883 bool continue_reading_p
;
1884 Lisp_Object lex_bound
;
1885 /* True if reading an entire buffer. */
1886 bool whole_buffer
= 0;
1887 /* True on the first time around. */
1888 bool first_sexp
= 1;
1889 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1891 if (NILP (Ffboundp (macroexpand
))
1892 /* Don't macroexpand in .elc files, since it should have been done
1893 already. We actually don't know whether we're in a .elc file or not,
1894 so we use circumstantial evidence: .el files normally go through
1895 Vload_source_file_function -> load-with-code-conversion
1897 || EQ (readcharfun
, Qget_file_char
)
1898 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1901 if (MARKERP (readcharfun
))
1904 start
= readcharfun
;
1907 if (BUFFERP (readcharfun
))
1908 b
= XBUFFER (readcharfun
);
1909 else if (MARKERP (readcharfun
))
1910 b
= XMARKER (readcharfun
)->buffer
;
1912 /* We assume START is nil when input is not from a buffer. */
1913 if (! NILP (start
) && !b
)
1916 specbind (Qstandard_input
, readcharfun
);
1917 specbind (Qcurrent_load_list
, Qnil
);
1918 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1919 load_convert_to_unibyte
= !NILP (unibyte
);
1921 /* If lexical binding is active (either because it was specified in
1922 the file's header, or via a buffer-local variable), create an empty
1923 lexical environment, otherwise, turn off lexical binding. */
1924 lex_bound
= find_symbol_value (Qlexical_binding
);
1925 specbind (Qinternal_interpreter_environment
,
1926 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1927 ? Qnil
: list1 (Qt
)));
1929 /* Try to ensure sourcename is a truename, except whilst preloading. */
1930 if (NILP (Vpurify_flag
)
1931 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1932 && !NILP (Ffboundp (Qfile_truename
)))
1933 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1935 LOADHIST_ATTACH (sourcename
);
1937 continue_reading_p
= 1;
1938 while (continue_reading_p
)
1940 ptrdiff_t count1
= SPECPDL_INDEX ();
1942 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1943 error ("Reading from killed buffer");
1947 /* Switch to the buffer we are reading from. */
1948 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1949 set_buffer_internal (b
);
1951 /* Save point in it. */
1952 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1953 /* Save ZV in it. */
1954 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1955 /* Those get unbound after we read one expression. */
1957 /* Set point and ZV around stuff to be read. */
1960 Fnarrow_to_region (make_number (BEGV
), end
);
1962 /* Just for cleanliness, convert END to a marker
1963 if it is an integer. */
1965 end
= Fpoint_max_marker ();
1968 /* On the first cycle, we can easily test here
1969 whether we are reading the whole buffer. */
1970 if (b
&& first_sexp
)
1971 whole_buffer
= (BUF_PT (b
) == BUF_BEG (b
) && BUF_ZV (b
) == BUF_Z (b
));
1978 while ((c
= READCHAR
) != '\n' && c
!= -1);
1983 unbind_to (count1
, Qnil
);
1987 /* Ignore whitespace here, so we can detect eof. */
1988 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1989 || c
== NO_BREAK_SPACE
)
1992 if (! HASH_TABLE_P (read_objects_map
)
1993 || XHASH_TABLE (read_objects_map
)->count
)
1995 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
,
1996 DEFAULT_REHASH_SIZE
, DEFAULT_REHASH_THRESHOLD
,
1998 if (! HASH_TABLE_P (read_objects_completed
)
1999 || XHASH_TABLE (read_objects_completed
)->count
)
2000 read_objects_completed
2001 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
,
2002 DEFAULT_REHASH_SIZE
, DEFAULT_REHASH_THRESHOLD
,
2004 if (!NILP (Vpurify_flag
) && c
== '(')
2006 val
= read_list (0, readcharfun
);
2011 if (!NILP (readfun
))
2013 val
= call1 (readfun
, readcharfun
);
2015 /* If READCHARFUN has set point to ZV, we should
2016 stop reading, even if the form read sets point
2017 to a different value when evaluated. */
2018 if (BUFFERP (readcharfun
))
2020 struct buffer
*buf
= XBUFFER (readcharfun
);
2021 if (BUF_PT (buf
) == BUF_ZV (buf
))
2022 continue_reading_p
= 0;
2025 else if (! NILP (Vload_read_function
))
2026 val
= call1 (Vload_read_function
, readcharfun
);
2028 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
2030 /* Empty hashes can be reused; otherwise, reset on next call. */
2031 if (HASH_TABLE_P (read_objects_map
)
2032 && XHASH_TABLE (read_objects_map
)->count
> 0)
2033 read_objects_map
= Qnil
;
2034 if (HASH_TABLE_P (read_objects_completed
)
2035 && XHASH_TABLE (read_objects_completed
)->count
> 0)
2036 read_objects_completed
= Qnil
;
2038 if (!NILP (start
) && continue_reading_p
)
2039 start
= Fpoint_marker ();
2041 /* Restore saved point and BEGV. */
2042 unbind_to (count1
, Qnil
);
2044 /* Now eval what we just read. */
2045 if (!NILP (macroexpand
))
2046 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
2048 val
= eval_sub (val
);
2052 Vvalues
= Fcons (val
, Vvalues
);
2053 if (EQ (Vstandard_output
, Qt
))
2062 build_load_history (sourcename
,
2063 infile0
|| whole_buffer
);
2065 unbind_to (count
, Qnil
);
2068 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
2069 doc
: /* Execute the accessible portion of current buffer as Lisp code.
2070 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
2071 When called from a Lisp program (i.e., not interactively), this
2072 function accepts up to five optional arguments:
2073 BUFFER is the buffer to evaluate (nil means use current buffer),
2074 or a name of a buffer (a string).
2075 PRINTFLAG controls printing of output by any output functions in the
2076 evaluated code, such as `print', `princ', and `prin1':
2077 a value of nil means discard it; anything else is the stream to print to.
2078 See Info node `(elisp)Output Streams' for details on streams.
2079 FILENAME specifies the file name to use for `load-history'.
2080 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
2082 DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
2083 evaluated code should work normally even if PRINTFLAG is nil, in
2084 which case the output is displayed in the echo area.
2086 This function preserves the position of point. */)
2087 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
2089 ptrdiff_t count
= SPECPDL_INDEX ();
2090 Lisp_Object tem
, buf
;
2093 buf
= Fcurrent_buffer ();
2095 buf
= Fget_buffer (buffer
);
2097 error ("No such buffer");
2099 if (NILP (printflag
) && NILP (do_allow_print
))
2104 if (NILP (filename
))
2105 filename
= BVAR (XBUFFER (buf
), filename
);
2107 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
2108 specbind (Qstandard_output
, tem
);
2109 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
2110 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2111 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
2112 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2113 readevalloop (buf
, 0, filename
,
2114 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
2115 unbind_to (count
, Qnil
);
2120 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2121 doc
: /* Execute the region as Lisp code.
2122 When called from programs, expects two arguments,
2123 giving starting and ending indices in the current buffer
2124 of the text to be executed.
2125 Programs can pass third argument PRINTFLAG which controls output:
2126 a value of nil means discard it; anything else is stream for printing it.
2127 See Info node `(elisp)Output Streams' for details on streams.
2128 Also the fourth argument READ-FUNCTION, if non-nil, is used
2129 instead of `read' to read each expression. It gets one argument
2130 which is the input stream for reading characters.
2132 This function does not move point. */)
2133 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2135 /* FIXME: Do the eval-sexp-add-defvars dance! */
2136 ptrdiff_t count
= SPECPDL_INDEX ();
2137 Lisp_Object tem
, cbuf
;
2139 cbuf
= Fcurrent_buffer ();
2141 if (NILP (printflag
))
2145 specbind (Qstandard_output
, tem
);
2146 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2148 /* `readevalloop' calls functions which check the type of start and end. */
2149 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2150 !NILP (printflag
), Qnil
, read_function
,
2153 return unbind_to (count
, Qnil
);
2157 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2158 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2159 If STREAM is nil, use the value of `standard-input' (which see).
2160 STREAM or the value of `standard-input' may be:
2161 a buffer (read from point and advance it)
2162 a marker (read from where it points and advance it)
2163 a function (call it with no arguments for each character,
2164 call it with a char as argument to push a char back)
2165 a string (takes text from string, starting at the beginning)
2166 t (read text line using minibuffer and use it, or read from
2167 standard input in batch mode). */)
2168 (Lisp_Object stream
)
2171 stream
= Vstandard_input
;
2172 if (EQ (stream
, Qt
))
2173 stream
= Qread_char
;
2174 if (EQ (stream
, Qread_char
))
2175 /* FIXME: ?! When is this used !? */
2176 return call1 (intern ("read-minibuffer"),
2177 build_string ("Lisp expression: "));
2179 return read_internal_start (stream
, Qnil
, Qnil
);
2182 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2183 doc
: /* Read one Lisp expression which is represented as text by STRING.
2184 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2185 FINAL-STRING-INDEX is an integer giving the position of the next
2186 remaining character in STRING. START and END optionally delimit
2187 a substring of STRING from which to read; they default to 0 and
2188 \(length STRING) respectively. Negative values are counted from
2189 the end of STRING. */)
2190 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2193 CHECK_STRING (string
);
2194 /* `read_internal_start' sets `read_from_string_index'. */
2195 ret
= read_internal_start (string
, start
, end
);
2196 return Fcons (ret
, make_number (read_from_string_index
));
2199 /* Function to set up the global context we need in toplevel read
2200 calls. START and END only used when STREAM is a string. */
2202 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2207 new_backquote_flag
= 0;
2208 /* We can get called from readevalloop which may have set these
2210 if (! HASH_TABLE_P (read_objects_map
)
2211 || XHASH_TABLE (read_objects_map
)->count
)
2213 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
, DEFAULT_REHASH_SIZE
,
2214 DEFAULT_REHASH_THRESHOLD
, Qnil
, false);
2215 if (! HASH_TABLE_P (read_objects_completed
)
2216 || XHASH_TABLE (read_objects_completed
)->count
)
2217 read_objects_completed
2218 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
, DEFAULT_REHASH_SIZE
,
2219 DEFAULT_REHASH_THRESHOLD
, Qnil
, false);
2220 if (EQ (Vread_with_symbol_positions
, Qt
)
2221 || EQ (Vread_with_symbol_positions
, stream
))
2222 Vread_symbol_positions_list
= Qnil
;
2224 if (STRINGP (stream
)
2225 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2227 ptrdiff_t startval
, endval
;
2230 if (STRINGP (stream
))
2233 string
= XCAR (stream
);
2235 validate_subarray (string
, start
, end
, SCHARS (string
),
2236 &startval
, &endval
);
2238 read_from_string_index
= startval
;
2239 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2240 read_from_string_limit
= endval
;
2243 retval
= read0 (stream
);
2244 if (EQ (Vread_with_symbol_positions
, Qt
)
2245 || EQ (Vread_with_symbol_positions
, stream
))
2246 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2247 /* Empty hashes can be reused; otherwise, reset on next call. */
2248 if (HASH_TABLE_P (read_objects_map
)
2249 && XHASH_TABLE (read_objects_map
)->count
> 0)
2250 read_objects_map
= Qnil
;
2251 if (HASH_TABLE_P (read_objects_completed
)
2252 && XHASH_TABLE (read_objects_completed
)->count
> 0)
2253 read_objects_completed
= Qnil
;
2258 /* Signal Qinvalid_read_syntax error.
2259 S is error string of length N (if > 0) */
2261 static _Noreturn
void
2262 invalid_syntax (const char *s
)
2264 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2268 /* Use this for recursive reads, in contexts where internal tokens
2272 read0 (Lisp_Object readcharfun
)
2274 register Lisp_Object val
;
2277 val
= read1 (readcharfun
, &c
, 0);
2281 xsignal1 (Qinvalid_read_syntax
,
2282 Fmake_string (make_number (1), make_number (c
)));
2285 /* Grow a read buffer BUF that contains OFFSET useful bytes of data,
2286 by at least MAX_MULTIBYTE_LENGTH bytes. Update *BUF_ADDR and
2287 *BUF_SIZE accordingly; 0 <= OFFSET <= *BUF_SIZE. If *BUF_ADDR is
2288 initially null, BUF is on the stack: copy its data to the new heap
2289 buffer. Otherwise, BUF must equal *BUF_ADDR and can simply be
2290 reallocated. Either way, remember the heap allocation (which is at
2291 pdl slot COUNT) so that it can be freed when unwinding the stack.*/
2294 grow_read_buffer (char *buf
, ptrdiff_t offset
,
2295 char **buf_addr
, ptrdiff_t *buf_size
, ptrdiff_t count
)
2297 char *p
= xpalloc (*buf_addr
, buf_size
, MAX_MULTIBYTE_LENGTH
, -1, 1);
2300 memcpy (p
, buf
, offset
);
2301 record_unwind_protect_ptr (xfree
, p
);
2304 set_unwind_protect_ptr (count
, xfree
, p
);
2309 /* Return the scalar value that has the Unicode character name NAME.
2310 Raise 'invalid-read-syntax' if there is no such character. */
2312 character_name_to_code (char const *name
, ptrdiff_t name_len
)
2314 /* For "U+XXXX", pass the leading '+' to string_to_number to reject
2315 monstrosities like "U+-0000". */
2317 = (name
[0] == 'U' && name
[1] == '+'
2318 ? string_to_number (name
+ 1, 16, false)
2319 : call2 (Qchar_from_name
, make_unibyte_string (name
, name_len
), Qt
));
2321 if (! RANGED_INTEGERP (0, code
, MAX_UNICODE_CHAR
)
2322 || char_surrogate_p (XINT (code
)))
2324 AUTO_STRING (format
, "\\N{%s}");
2325 AUTO_STRING_WITH_LEN (namestr
, name
, name_len
);
2326 xsignal1 (Qinvalid_read_syntax
, CALLN (Fformat
, format
, namestr
));
2332 /* Bound on the length of a Unicode character name. As of
2333 Unicode 9.0.0 the maximum is 83, so this should be safe. */
2334 enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND
= 200 };
2336 /* Read a \-escape sequence, assuming we already read the `\'.
2337 If the escape sequence forces unibyte, return eight-bit char. */
2340 read_escape (Lisp_Object readcharfun
, bool stringp
)
2343 /* \u allows up to four hex digits, \U up to eight. Default to the
2344 behavior for \u, and change this value in the case that \U is seen. */
2345 int unicode_hex_count
= 4;
2350 end_of_file_error ();
2380 error ("Invalid escape character syntax");
2383 c
= read_escape (readcharfun
, 0);
2384 return c
| meta_modifier
;
2389 error ("Invalid escape character syntax");
2392 c
= read_escape (readcharfun
, 0);
2393 return c
| shift_modifier
;
2398 error ("Invalid escape character syntax");
2401 c
= read_escape (readcharfun
, 0);
2402 return c
| hyper_modifier
;
2407 error ("Invalid escape character syntax");
2410 c
= read_escape (readcharfun
, 0);
2411 return c
| alt_modifier
;
2415 if (stringp
|| c
!= '-')
2422 c
= read_escape (readcharfun
, 0);
2423 return c
| super_modifier
;
2428 error ("Invalid escape character syntax");
2433 c
= read_escape (readcharfun
, 0);
2434 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2435 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2436 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2437 return c
| ctrl_modifier
;
2438 /* ASCII control chars are made from letters (both cases),
2439 as well as the non-letters within 0100...0137. */
2440 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2441 return (c
& (037 | ~0177));
2442 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2443 return (c
& (037 | ~0177));
2445 return c
| ctrl_modifier
;
2455 /* An octal escape, as in ANSI C. */
2457 register int i
= c
- '0';
2458 register int count
= 0;
2461 if ((c
= READCHAR
) >= '0' && c
<= '7')
2473 if (i
>= 0x80 && i
< 0x100)
2474 i
= BYTE8_TO_CHAR (i
);
2479 /* A hex escape, as in ANSI C. */
2486 int digit
= char_hexdigit (c
);
2492 i
= (i
<< 4) + digit
;
2493 /* Allow hex escapes as large as ?\xfffffff, because some
2494 packages use them to denote characters with modifiers. */
2495 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2496 error ("Hex character out of range: \\x%x...", i
);
2500 if (count
< 3 && i
>= 0x80)
2501 return BYTE8_TO_CHAR (i
);
2506 /* Post-Unicode-2.0: Up to eight hex chars. */
2507 unicode_hex_count
= 8;
2511 /* A Unicode escape. We only permit them in strings and characters,
2512 not arbitrarily in the source code, as in some other languages. */
2517 while (++count
<= unicode_hex_count
)
2520 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2522 int digit
= char_hexdigit (c
);
2524 error ("Non-hex digit used for Unicode escape");
2525 i
= (i
<< 4) + digit
;
2528 error ("Non-Unicode character: 0x%x", i
);
2533 /* Named character. */
2537 invalid_syntax ("Expected opening brace after \\N");
2538 char name
[UNICODE_CHARACTER_NAME_LENGTH_BOUND
+ 1];
2539 bool whitespace
= false;
2540 ptrdiff_t length
= 0;
2545 end_of_file_error ();
2548 if (! (0 < c
&& c
< 0x80))
2550 AUTO_STRING (format
,
2551 "Invalid character U+%04X in character name");
2552 xsignal1 (Qinvalid_read_syntax
,
2553 CALLN (Fformat
, format
, make_natnum (c
)));
2555 /* Treat multiple adjacent whitespace characters as a
2556 single space character. This makes it easier to use
2557 character names in e.g. multi-line strings. */
2568 if (length
>= sizeof name
)
2569 invalid_syntax ("Character name too long");
2572 invalid_syntax ("Empty character name");
2573 name
[length
] = '\0';
2575 /* character_name_to_code can invoke read1, recursively.
2576 This is why read1's buffer is not static. */
2577 return character_name_to_code (name
, length
);
2585 /* Return the digit that CHARACTER stands for in the given BASE.
2586 Return -1 if CHARACTER is out of range for BASE,
2587 and -2 if CHARACTER is not valid for any supported BASE. */
2589 digit_to_number (int character
, int base
)
2593 if ('0' <= character
&& character
<= '9')
2594 digit
= character
- '0';
2595 else if ('a' <= character
&& character
<= 'z')
2596 digit
= character
- 'a' + 10;
2597 else if ('A' <= character
&& character
<= 'Z')
2598 digit
= character
- 'A' + 10;
2602 return digit
< base
? digit
: -1;
2605 /* Read an integer in radix RADIX using READCHARFUN to read
2606 characters. RADIX must be in the interval [2..36]; if it isn't, a
2607 read error is signaled . Value is the integer read. Signals an
2608 error if encountering invalid read syntax or if RADIX is out of
2612 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2614 /* Room for sign, leading 0, other digits, trailing null byte.
2615 Also, room for invalid syntax diagnostic. */
2616 char buf
[max (1 + 1 + UINTMAX_WIDTH
+ 1,
2617 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2619 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2621 if (radix
< 2 || radix
> 36)
2629 if (c
== '-' || c
== '+')
2640 /* Ignore redundant leading zeros, so the buffer doesn't
2641 fill up with them. */
2647 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2654 if (p
< buf
+ sizeof buf
- 1)
2668 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2669 invalid_syntax (buf
);
2672 return string_to_number (buf
, radix
, 0);
2676 /* If the next token is ')' or ']' or '.', we store that character
2677 in *PCH and the return value is not interesting. Else, we store
2678 zero in *PCH and we read and return one lisp object.
2680 FIRST_IN_LIST is true if this is the first element of a list. */
2683 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2686 bool uninterned_symbol
= false;
2688 char stackbuf
[128]; /* Small, as read1 is recursive (Bug#31995). */
2689 current_thread
->stack_top
= stackbuf
;
2695 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2697 end_of_file_error ();
2702 return read_list (0, readcharfun
);
2705 return read_vector (readcharfun
, 0);
2721 /* Accept extended format for hash tables (extensible to
2723 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2724 Lisp_Object tmp
= read_list (0, readcharfun
);
2725 Lisp_Object head
= CAR_SAFE (tmp
);
2726 Lisp_Object data
= Qnil
;
2727 Lisp_Object val
= Qnil
;
2728 /* The size is 2 * number of allowed keywords to
2730 Lisp_Object params
[12];
2732 Lisp_Object key
= Qnil
;
2733 int param_count
= 0;
2735 if (!EQ (head
, Qhash_table
))
2737 ptrdiff_t size
= XINT (Flength (tmp
));
2738 Lisp_Object record
= Fmake_record (CAR_SAFE (tmp
),
2739 make_number (size
- 1),
2741 for (int i
= 1; i
< size
; i
++)
2744 ASET (record
, i
, Fcar (tmp
));
2749 tmp
= CDR_SAFE (tmp
);
2751 /* This is repetitive but fast and simple. */
2752 params
[param_count
] = QCsize
;
2753 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2754 if (!NILP (params
[param_count
+ 1]))
2757 params
[param_count
] = QCtest
;
2758 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2759 if (!NILP (params
[param_count
+ 1]))
2762 params
[param_count
] = QCweakness
;
2763 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2764 if (!NILP (params
[param_count
+ 1]))
2767 params
[param_count
] = QCrehash_size
;
2768 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2769 if (!NILP (params
[param_count
+ 1]))
2772 params
[param_count
] = QCrehash_threshold
;
2773 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2774 if (!NILP (params
[param_count
+ 1]))
2777 params
[param_count
] = QCpurecopy
;
2778 params
[param_count
+ 1] = Fplist_get (tmp
, Qpurecopy
);
2779 if (!NILP (params
[param_count
+ 1]))
2782 /* This is the hash table data. */
2783 data
= Fplist_get (tmp
, Qdata
);
2785 /* Now use params to make a new hash table and fill it. */
2786 ht
= Fmake_hash_table (param_count
, params
);
2788 while (CONSP (data
))
2793 error ("Odd number of elements in hash table data");
2796 Fputhash (key
, val
, ht
);
2802 invalid_syntax ("#");
2810 tmp
= read_vector (readcharfun
, 0);
2811 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2812 error ("Invalid size char-table");
2813 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2821 /* Sub char-table can't be read as a regular
2822 vector because of a two C integer fields. */
2823 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2824 ptrdiff_t size
= XINT (Flength (tmp
));
2825 int i
, depth
, min_char
;
2826 struct Lisp_Cons
*cell
;
2829 error ("Zero-sized sub char-table");
2831 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2832 error ("Invalid depth in sub char-table");
2833 depth
= XINT (XCAR (tmp
));
2834 if (chartab_size
[depth
] != size
- 2)
2835 error ("Invalid size in sub char-table");
2836 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2839 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2840 error ("Invalid minimum character in sub-char-table");
2841 min_char
= XINT (XCAR (tmp
));
2842 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2845 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2846 for (i
= 0; i
< size
; i
++)
2848 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2849 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2854 invalid_syntax ("#^^");
2856 invalid_syntax ("#^");
2861 length
= read1 (readcharfun
, pch
, first_in_list
);
2865 Lisp_Object tmp
, val
;
2866 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2867 unsigned char *data
;
2870 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2871 if (STRING_MULTIBYTE (tmp
)
2872 || (size_in_chars
!= SCHARS (tmp
)
2873 /* We used to print 1 char too many
2874 when the number of bits was a multiple of 8.
2875 Accept such input in case it came from an old
2877 && ! (XFASTINT (length
)
2878 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2879 invalid_syntax ("#&...");
2881 val
= make_uninit_bool_vector (XFASTINT (length
));
2882 data
= bool_vector_uchar_data (val
);
2883 memcpy (data
, SDATA (tmp
), size_in_chars
);
2884 /* Clear the extraneous bits in the last byte. */
2885 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2886 data
[size_in_chars
- 1]
2887 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2890 invalid_syntax ("#&...");
2894 /* Accept compiled functions at read-time so that we don't have to
2895 build them using function calls. */
2897 struct Lisp_Vector
*vec
;
2898 tmp
= read_vector (readcharfun
, 1);
2899 vec
= XVECTOR (tmp
);
2900 if (vec
->header
.size
== 0)
2901 invalid_syntax ("Empty byte-code object");
2902 make_byte_code (vec
);
2910 /* Read the string itself. */
2911 tmp
= read1 (readcharfun
, &ch
, 0);
2912 if (ch
!= 0 || !STRINGP (tmp
))
2913 invalid_syntax ("#");
2914 /* Read the intervals and their properties. */
2917 Lisp_Object beg
, end
, plist
;
2919 beg
= read1 (readcharfun
, &ch
, 0);
2924 end
= read1 (readcharfun
, &ch
, 0);
2926 plist
= read1 (readcharfun
, &ch
, 0);
2928 invalid_syntax ("Invalid string property list");
2929 Fset_text_properties (beg
, end
, plist
, tmp
);
2935 /* #@NUMBER is used to skip NUMBER following bytes.
2936 That's used in .elc files to skip over doc strings
2937 and function definitions. */
2940 enum { extra
= 100 };
2941 ptrdiff_t i
, nskip
= 0, digits
= 0;
2943 /* Read a decimal integer. */
2944 while ((c
= READCHAR
) >= 0
2945 && c
>= '0' && c
<= '9')
2947 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2952 if (digits
== 2 && nskip
== 0)
2953 { /* We've just seen #@00, which means "skip to end". */
2954 skip_dyn_eof (readcharfun
);
2959 /* We can't use UNREAD here, because in the code below we side-step
2960 READCHAR. Instead, assume the first char after #@NNN occupies
2961 a single byte, which is the case normally since it's just
2967 if (load_force_doc_strings
2968 && (FROM_FILE_P (readcharfun
)))
2970 /* If we are supposed to force doc strings into core right now,
2971 record the last string that we skipped,
2972 and record where in the file it comes from. */
2974 /* But first exchange saved_doc_string
2975 with prev_saved_doc_string, so we save two strings. */
2977 char *temp
= saved_doc_string
;
2978 ptrdiff_t temp_size
= saved_doc_string_size
;
2979 file_offset temp_pos
= saved_doc_string_position
;
2980 ptrdiff_t temp_len
= saved_doc_string_length
;
2982 saved_doc_string
= prev_saved_doc_string
;
2983 saved_doc_string_size
= prev_saved_doc_string_size
;
2984 saved_doc_string_position
= prev_saved_doc_string_position
;
2985 saved_doc_string_length
= prev_saved_doc_string_length
;
2987 prev_saved_doc_string
= temp
;
2988 prev_saved_doc_string_size
= temp_size
;
2989 prev_saved_doc_string_position
= temp_pos
;
2990 prev_saved_doc_string_length
= temp_len
;
2993 if (saved_doc_string_size
== 0)
2995 saved_doc_string
= xmalloc (nskip
+ extra
);
2996 saved_doc_string_size
= nskip
+ extra
;
2998 if (nskip
> saved_doc_string_size
)
3000 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
3001 saved_doc_string_size
= nskip
+ extra
;
3004 FILE *instream
= infile
->stream
;
3005 saved_doc_string_position
= (file_tell (instream
)
3006 - infile
->lookahead
);
3008 /* Copy that many bytes into saved_doc_string. */
3010 for (int n
= min (nskip
, infile
->lookahead
); 0 < n
; n
--)
3011 saved_doc_string
[i
++]
3012 = c
= infile
->buf
[--infile
->lookahead
];
3014 for (; i
< nskip
&& 0 <= c
; i
++)
3015 saved_doc_string
[i
] = c
= getc_unlocked (instream
);
3018 saved_doc_string_length
= i
;
3021 /* Skip that many bytes. */
3022 skip_dyn_bytes (readcharfun
, nskip
);
3028 /* #! appears at the beginning of an executable file.
3029 Skip the first line. */
3030 while (c
!= '\n' && c
>= 0)
3035 return Vload_file_name
;
3037 return list2 (Qfunction
, read0 (readcharfun
));
3038 /* #:foo is the uninterned symbol named foo. */
3041 uninterned_symbol
= true;
3044 && c
!= NO_BREAK_SPACE
3046 || strchr ("\"';()[]#`,", c
) == NULL
)))
3048 /* No symbol character follows, this is the empty
3051 return Fmake_symbol (empty_unibyte_string
);
3055 /* ## is the empty symbol. */
3057 return Fintern (empty_unibyte_string
, Qnil
);
3058 /* Reader forms that can reuse previously read objects. */
3059 if (c
>= '0' && c
<= '9')
3063 bool overflow
= false;
3065 /* Read a non-negative integer. */
3066 while (c
>= '0' && c
<= '9')
3068 overflow
|= INT_MULTIPLY_WRAPV (n
, 10, &n
);
3069 overflow
|= INT_ADD_WRAPV (n
, c
- '0', &n
);
3073 if (!overflow
&& n
<= MOST_POSITIVE_FIXNUM
)
3075 if (c
== 'r' || c
== 'R')
3076 return read_integer (readcharfun
, n
);
3078 if (! NILP (Vread_circle
))
3080 /* #n=object returns object, but associates it with
3084 /* Make a placeholder for #n# to use temporarily. */
3085 /* Note: We used to use AUTO_CONS to allocate
3086 placeholder, but that is a bad idea, since it
3087 will place a stack-allocated cons cell into
3088 the list in read_objects_map, which is a
3089 staticpro'd global variable, and thus each of
3090 its elements is marked during each GC. A
3091 stack-allocated object will become garbled
3092 when its stack slot goes out of scope, and
3093 some other function reuses it for entirely
3094 different purposes, which will cause crashes
3096 Lisp_Object placeholder
= Fcons (Qnil
, Qnil
);
3097 struct Lisp_Hash_Table
*h
3098 = XHASH_TABLE (read_objects_map
);
3100 Lisp_Object number
= make_number (n
);
3102 ptrdiff_t i
= hash_lookup (h
, number
, &hash
);
3104 /* Not normal, but input could be malformed. */
3105 set_hash_value_slot (h
, i
, placeholder
);
3107 hash_put (h
, number
, placeholder
, hash
);
3109 /* Read the object itself. */
3110 tem
= read0 (readcharfun
);
3112 /* If it can be recursive, remember it for
3113 future substitutions. */
3116 && ! (STRINGP (tem
) && !string_intervals (tem
)))
3118 struct Lisp_Hash_Table
*h2
3119 = XHASH_TABLE (read_objects_completed
);
3120 i
= hash_lookup (h2
, tem
, &hash
);
3122 hash_put (h2
, tem
, Qnil
, hash
);
3125 /* Now put it everywhere the placeholder was... */
3128 Fsetcar (placeholder
, XCAR (tem
));
3129 Fsetcdr (placeholder
, XCDR (tem
));
3134 Flread__substitute_object_in_subtree
3135 (tem
, placeholder
, read_objects_completed
);
3137 /* ...and #n# will use the real value from now on. */
3138 i
= hash_lookup (h
, number
, &hash
);
3140 set_hash_value_slot (h
, i
, tem
);
3146 /* #n# returns a previously read object. */
3149 struct Lisp_Hash_Table
*h
3150 = XHASH_TABLE (read_objects_map
);
3151 ptrdiff_t i
= hash_lookup (h
, make_number (n
), NULL
);
3153 return HASH_VALUE (h
, i
);
3157 /* Fall through to error message. */
3159 else if (c
== 'x' || c
== 'X')
3160 return read_integer (readcharfun
, 16);
3161 else if (c
== 'o' || c
== 'O')
3162 return read_integer (readcharfun
, 8);
3163 else if (c
== 'b' || c
== 'B')
3164 return read_integer (readcharfun
, 2);
3167 invalid_syntax ("#");
3170 while ((c
= READCHAR
) >= 0 && c
!= '\n');
3174 return list2 (Qquote
, read0 (readcharfun
));
3178 int next_char
= READCHAR
;
3180 /* Transition from old-style to new-style:
3181 If we see "(`" it used to mean old-style, which usually works
3182 fine because ` should almost never appear in such a position
3183 for new-style. But occasionally we need "(`" to mean new
3184 style, so we try to distinguish the two by the fact that we
3185 can either write "( `foo" or "(` foo", where the first
3186 intends to use new-style whereas the second intends to use
3187 old-style. For Emacs-25, we should completely remove this
3188 first_in_list exception (old-style can still be obtained via
3190 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
3192 Vlread_old_style_backquotes
= Qt
;
3198 bool saved_new_backquote_flag
= new_backquote_flag
;
3200 new_backquote_flag
= 1;
3201 value
= read0 (readcharfun
);
3202 new_backquote_flag
= saved_new_backquote_flag
;
3204 return list2 (Qbackquote
, value
);
3209 int next_char
= READCHAR
;
3211 /* Transition from old-style to new-style:
3212 It used to be impossible to have a new-style , other than within
3213 a new-style `. This is sufficient when ` and , are used in the
3214 normal way, but ` and , can also appear in args to macros that
3215 will not interpret them in the usual way, in which case , may be
3216 used without any ` anywhere near.
3217 So we now use the same heuristic as for backquote: old-style
3218 unquotes are only recognized when first on a list, and when
3219 followed by a space.
3220 Because it's more difficult to peek 2 chars ahead, a new-style
3221 ,@ can still not be used outside of a `, unless it's in the middle
3223 if (new_backquote_flag
3225 || (next_char
!= ' ' && next_char
!= '@'))
3227 Lisp_Object comma_type
= Qnil
;
3232 comma_type
= Qcomma_at
;
3234 comma_type
= Qcomma_dot
;
3237 if (ch
>= 0) UNREAD (ch
);
3238 comma_type
= Qcomma
;
3241 value
= read0 (readcharfun
);
3242 return list2 (comma_type
, value
);
3246 Vlread_old_style_backquotes
= Qt
;
3258 end_of_file_error ();
3260 /* Accept `single space' syntax like (list ? x) where the
3261 whitespace character is SPC or TAB.
3262 Other literal whitespace like NL, CR, and FF are not accepted,
3263 as there are well-established escape sequences for these. */
3264 if (c
== ' ' || c
== '\t')
3265 return make_number (c
);
3267 if (c
== '(' || c
== ')' || c
== '[' || c
== ']'
3268 || c
== '"' || c
== ';')
3270 CHECK_LIST (Vlread_unescaped_character_literals
);
3271 Lisp_Object char_obj
= make_natnum (c
);
3272 if (NILP (Fmemq (char_obj
, Vlread_unescaped_character_literals
)))
3273 Vlread_unescaped_character_literals
=
3274 Fcons (char_obj
, Vlread_unescaped_character_literals
);
3278 c
= read_escape (readcharfun
, 0);
3279 modifiers
= c
& CHAR_MODIFIER_MASK
;
3280 c
&= ~CHAR_MODIFIER_MASK
;
3281 if (CHAR_BYTE8_P (c
))
3282 c
= CHAR_TO_BYTE8 (c
);
3285 next_char
= READCHAR
;
3286 ok
= (next_char
<= 040
3287 || (next_char
< 0200
3288 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3291 return make_number (c
);
3293 invalid_syntax ("?");
3298 ptrdiff_t count
= SPECPDL_INDEX ();
3299 char *read_buffer
= stackbuf
;
3300 ptrdiff_t read_buffer_size
= sizeof stackbuf
;
3301 char *heapbuf
= NULL
;
3302 char *p
= read_buffer
;
3303 char *end
= read_buffer
+ read_buffer_size
;
3305 /* True if we saw an escape sequence specifying
3306 a multibyte character. */
3307 bool force_multibyte
= false;
3308 /* True if we saw an escape sequence specifying
3309 a single-byte character. */
3310 bool force_singlebyte
= false;
3311 bool cancel
= false;
3312 ptrdiff_t nchars
= 0;
3314 while ((ch
= READCHAR
) >= 0
3317 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3319 ptrdiff_t offset
= p
- read_buffer
;
3320 read_buffer
= grow_read_buffer (read_buffer
, offset
,
3321 &heapbuf
, &read_buffer_size
,
3323 p
= read_buffer
+ offset
;
3324 end
= read_buffer
+ read_buffer_size
;
3331 ch
= read_escape (readcharfun
, 1);
3333 /* CH is -1 if \ newline or \ space has just been seen. */
3336 if (p
== read_buffer
)
3341 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3342 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3344 if (CHAR_BYTE8_P (ch
))
3345 force_singlebyte
= true;
3346 else if (! ASCII_CHAR_P (ch
))
3347 force_multibyte
= true;
3348 else /* I.e. ASCII_CHAR_P (ch). */
3350 /* Allow `\C- ' and `\C-?'. */
3351 if (modifiers
== CHAR_CTL
)
3354 ch
= 0, modifiers
= 0;
3356 ch
= 127, modifiers
= 0;
3358 if (modifiers
& CHAR_SHIFT
)
3360 /* Shift modifier is valid only with [A-Za-z]. */
3361 if (ch
>= 'A' && ch
<= 'Z')
3362 modifiers
&= ~CHAR_SHIFT
;
3363 else if (ch
>= 'a' && ch
<= 'z')
3364 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3367 if (modifiers
& CHAR_META
)
3369 /* Move the meta bit to the right place for a
3371 modifiers
&= ~CHAR_META
;
3372 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3373 force_singlebyte
= true;
3377 /* Any modifiers remaining are invalid. */
3379 error ("Invalid modifier in string");
3380 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3384 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3385 if (CHAR_BYTE8_P (ch
))
3386 force_singlebyte
= true;
3387 else if (! ASCII_CHAR_P (ch
))
3388 force_multibyte
= true;
3394 end_of_file_error ();
3396 /* If purifying, and string starts with \ newline,
3397 return zero instead. This is for doc strings
3398 that we are really going to find in etc/DOC.nn.nn. */
3399 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3400 return unbind_to (count
, make_number (0));
3402 if (! force_multibyte
&& force_singlebyte
)
3404 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3405 forms. Convert it to unibyte. */
3406 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3408 p
= read_buffer
+ nchars
;
3412 = make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3414 || (p
- read_buffer
!= nchars
)));
3415 return unbind_to (count
, result
);
3420 int next_char
= READCHAR
;
3423 if (next_char
<= 040
3424 || (next_char
< 0200
3425 && strchr ("\"';([#?`,", next_char
) != NULL
))
3431 /* The atom-reading loop below will now loop at least once,
3432 assuring that we will not try to UNREAD two characters in a
3437 if (c
<= 040) goto retry
;
3438 if (c
== NO_BREAK_SPACE
)
3443 ptrdiff_t count
= SPECPDL_INDEX ();
3444 char *read_buffer
= stackbuf
;
3445 ptrdiff_t read_buffer_size
= sizeof stackbuf
;
3446 char *heapbuf
= NULL
;
3447 char *p
= read_buffer
;
3448 char *end
= read_buffer
+ read_buffer_size
;
3449 bool quoted
= false;
3450 EMACS_INT start_position
= readchar_count
- 1;
3454 if (end
- p
< MAX_MULTIBYTE_LENGTH
+ 1)
3456 ptrdiff_t offset
= p
- read_buffer
;
3457 read_buffer
= grow_read_buffer (read_buffer
, offset
,
3458 &heapbuf
, &read_buffer_size
,
3460 p
= read_buffer
+ offset
;
3461 end
= read_buffer
+ read_buffer_size
;
3468 end_of_file_error ();
3473 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3479 && c
!= NO_BREAK_SPACE
3481 || strchr ("\"';()[]#`,", c
) == NULL
));
3486 if (!quoted
&& !uninterned_symbol
)
3488 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3489 if (! NILP (result
))
3490 return unbind_to (count
, result
);
3494 ptrdiff_t nbytes
= p
- read_buffer
;
3497 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3501 if (uninterned_symbol
)
3504 = ((! NILP (Vpurify_flag
)
3505 ? make_pure_string
: make_specified_string
)
3506 (read_buffer
, nchars
, nbytes
, multibyte
));
3507 result
= Fmake_symbol (name
);
3511 /* Don't create the string object for the name unless
3512 we're going to retain it in a new symbol.
3514 Like intern_1 but supports multibyte names. */
3515 Lisp_Object obarray
= check_obarray (Vobarray
);
3516 Lisp_Object tem
= oblookup (obarray
, read_buffer
,
3524 = make_specified_string (read_buffer
, nchars
, nbytes
,
3526 result
= intern_driver (name
, obarray
, tem
);
3530 if (EQ (Vread_with_symbol_positions
, Qt
)
3531 || EQ (Vread_with_symbol_positions
, readcharfun
))
3532 Vread_symbol_positions_list
3533 = Fcons (Fcons (result
, make_number (start_position
)),
3534 Vread_symbol_positions_list
);
3535 return unbind_to (count
, result
);
3541 DEFUN ("lread--substitute-object-in-subtree",
3542 Flread__substitute_object_in_subtree
,
3543 Slread__substitute_object_in_subtree
, 3, 3, 0,
3544 doc
: /* In OBJECT, replace every occurrence of PLACEHOLDER with OBJECT.
3545 COMPLETED is a hash table of objects that might be circular, or is t
3546 if any object might be circular. */)
3547 (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object completed
)
3549 struct subst subst
= { object
, placeholder
, completed
, Qnil
};
3550 Lisp_Object check_object
= substitute_object_recurse (&subst
, object
);
3552 /* The returned object here is expected to always eq the
3554 if (!EQ (check_object
, object
))
3555 error ("Unexpected mutation error in reader");
3560 substitute_object_recurse (struct subst
*subst
, Lisp_Object subtree
)
3562 /* If we find the placeholder, return the target object. */
3563 if (EQ (subst
->placeholder
, subtree
))
3564 return subst
->object
;
3566 /* For common object types that can't contain other objects, don't
3567 bother looking them up; we're done. */
3568 if (SYMBOLP (subtree
)
3569 || (STRINGP (subtree
) && !string_intervals (subtree
))
3570 || NUMBERP (subtree
))
3573 /* If we've been to this node before, don't explore it again. */
3574 if (!EQ (Qnil
, Fmemq (subtree
, subst
->seen
)))
3577 /* If this node can be the entry point to a cycle, remember that
3578 we've seen it. It can only be such an entry point if it was made
3579 by #n=, which means that we can find it as a value in
3581 if (EQ (subst
->completed
, Qt
)
3582 || hash_lookup (XHASH_TABLE (subst
->completed
), subtree
, NULL
) >= 0)
3583 subst
->seen
= Fcons (subtree
, subst
->seen
);
3585 /* Recurse according to subtree's type.
3586 Every branch must return a Lisp_Object. */
3587 switch (XTYPE (subtree
))
3589 case Lisp_Vectorlike
:
3591 ptrdiff_t i
= 0, length
= 0;
3592 if (BOOL_VECTOR_P (subtree
))
3593 return subtree
; /* No sub-objects anyway. */
3594 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3595 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
)
3596 || RECORDP (subtree
))
3597 length
= PVSIZE (subtree
);
3598 else if (VECTORP (subtree
))
3599 length
= ASIZE (subtree
);
3601 /* An unknown pseudovector may contain non-Lisp fields, so we
3602 can't just blindly traverse all its fields. We used to call
3603 `Flength' which signaled `sequencep', so I just preserved this
3605 wrong_type_argument (Qsequencep
, subtree
);
3607 if (SUB_CHAR_TABLE_P (subtree
))
3609 for ( ; i
< length
; i
++)
3611 substitute_object_recurse (subst
, AREF (subtree
, i
)));
3616 XSETCAR (subtree
, substitute_object_recurse (subst
, XCAR (subtree
)));
3617 XSETCDR (subtree
, substitute_object_recurse (subst
, XCDR (subtree
)));
3622 /* Check for text properties in each interval.
3623 substitute_in_interval contains part of the logic. */
3625 INTERVAL root_interval
= string_intervals (subtree
);
3626 traverse_intervals_noorder (root_interval
,
3627 substitute_in_interval
, subst
);
3631 /* Other types don't recurse any further. */
3637 /* Helper function for substitute_object_recurse. */
3639 substitute_in_interval (INTERVAL interval
, void *arg
)
3641 set_interval_plist (interval
,
3642 substitute_object_recurse (arg
, interval
->plist
));
3646 /* Convert STRING to a number, assuming base BASE. Return a fixnum if
3647 STRING has integer syntax and fits in a fixnum, else return the
3648 nearest float if STRING has either floating point or integer syntax
3649 and BASE is 10, else return nil. If IGNORE_TRAILING, consider just
3650 the longest prefix of STRING that has valid floating point syntax.
3651 Signal an overflow if BASE is not 10 and the number has integer
3652 syntax but does not fit. */
3655 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3657 char const *cp
= string
;
3658 bool float_syntax
= 0;
3661 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3662 IEEE floating point hosts, and works around a formerly-common bug where
3663 atof ("-0.0") drops the sign. */
3664 bool negative
= *cp
== '-';
3666 bool signedp
= negative
|| *cp
== '+';
3669 enum { INTOVERFLOW
= 1, LEAD_INT
= 2, DOT_CHAR
= 4, TRAIL_INT
= 8,
3672 int leading_digit
= digit_to_number (*cp
, base
);
3673 uintmax_t n
= leading_digit
;
3674 if (leading_digit
>= 0)
3677 for (int digit
; 0 <= (digit
= digit_to_number (*++cp
, base
)); )
3679 if (INT_MULTIPLY_OVERFLOW (n
, base
))
3680 state
|= INTOVERFLOW
;
3682 if (INT_ADD_OVERFLOW (n
, digit
))
3683 state
|= INTOVERFLOW
;
3695 if ('0' <= *cp
&& *cp
<= '9')
3700 while ('0' <= *cp
&& *cp
<= '9');
3702 if (*cp
== 'e' || *cp
== 'E')
3704 char const *ecp
= cp
;
3706 if (*cp
== '+' || *cp
== '-')
3708 if ('0' <= *cp
&& *cp
<= '9')
3713 while ('0' <= *cp
&& *cp
<= '9');
3715 else if (cp
[-1] == '+'
3716 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3722 else if (cp
[-1] == '+'
3723 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3727 /* NAN is a "positive" NaN on all known Emacs hosts. */
3734 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3735 || (state
& ~INTOVERFLOW
) == (LEAD_INT
|E_EXP
));
3738 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3739 any prefix that matches. Otherwise, the entire string must match. */
3740 if (! (ignore_trailing
3741 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3742 : (!*cp
&& ((state
& ~(INTOVERFLOW
| DOT_CHAR
)) == LEAD_INT
3746 /* If the number uses integer and not float syntax, and is in C-language
3747 range, use its value, preferably as a fixnum. */
3748 if (leading_digit
>= 0 && ! float_syntax
)
3750 if (state
& INTOVERFLOW
)
3752 /* Unfortunately there's no simple and accurate way to convert
3753 non-base-10 numbers that are out of C-language range. */
3755 xsignal1 (Qoverflow_error
, build_string (string
));
3757 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3759 EMACS_INT signed_n
= n
;
3760 return make_number (negative
? -signed_n
: signed_n
);
3766 /* Either the number uses float syntax, or it does not fit into a fixnum.
3767 Convert it from string to floating point, unless the value is already
3768 known because it is an infinity, a NAN, or its absolute value fits in
3771 value
= atof (string
+ signedp
);
3773 return make_float (negative
? -value
: value
);
3778 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3782 Lisp_Object tem
, item
, vector
;
3783 struct Lisp_Cons
*otem
;
3786 tem
= read_list (1, readcharfun
);
3787 len
= Flength (tem
);
3788 vector
= Fmake_vector (len
, Qnil
);
3790 size
= ASIZE (vector
);
3791 ptr
= XVECTOR (vector
)->contents
;
3792 for (i
= 0; i
< size
; i
++)
3795 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3796 bytecode object, the docstring containing the bytecode and
3797 constants values must be treated as unibyte and passed to
3798 Fread, to get the actual bytecode string and constants vector. */
3799 if (bytecodeflag
&& load_force_doc_strings
)
3801 if (i
== COMPILED_BYTECODE
)
3803 if (!STRINGP (item
))
3804 error ("Invalid byte code");
3806 /* Delay handling the bytecode slot until we know whether
3807 it is lazily-loaded (we can tell by whether the
3808 constants slot is nil). */
3809 ASET (vector
, COMPILED_CONSTANTS
, item
);
3812 else if (i
== COMPILED_CONSTANTS
)
3814 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3818 /* Coerce string to unibyte (like string-as-unibyte,
3819 but without generating extra garbage and
3820 guaranteeing no change in the contents). */
3821 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3822 STRING_SET_UNIBYTE (bytestr
);
3824 item
= Fread (Fcons (bytestr
, readcharfun
));
3826 error ("Invalid byte code");
3828 otem
= XCONS (item
);
3829 bytestr
= XCAR (item
);
3834 /* Now handle the bytecode slot. */
3835 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3837 else if (i
== COMPILED_DOC_STRING
3839 && ! STRING_MULTIBYTE (item
))
3841 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3842 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3844 item
= Fstring_as_multibyte (item
);
3847 ASET (vector
, i
, item
);
3855 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3858 read_list (bool flag
, Lisp_Object readcharfun
)
3860 Lisp_Object val
, tail
;
3861 Lisp_Object elt
, tem
;
3862 /* 0 is the normal case.
3863 1 means this list is a doc reference; replace it with the number 0.
3864 2 means this list is a doc reference; replace it with the doc string. */
3865 int doc_reference
= 0;
3867 /* Initialize this to 1 if we are reading a list. */
3868 bool first_in_list
= flag
<= 0;
3876 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3880 /* While building, if the list starts with #$, treat it specially. */
3881 if (EQ (elt
, Vload_file_name
)
3883 && !NILP (Vpurify_flag
))
3885 if (NILP (Vdoc_file_name
))
3886 /* We have not yet called Snarf-documentation, so assume
3887 this file is described in the DOC file
3888 and Snarf-documentation will fill in the right value later.
3889 For now, replace the whole list with 0. */
3892 /* We have already called Snarf-documentation, so make a relative
3893 file name for this file, so it can be found properly
3894 in the installed Lisp directory.
3895 We don't use Fexpand_file_name because that would make
3896 the directory absolute now. */
3898 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3899 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3902 else if (EQ (elt
, Vload_file_name
)
3904 && load_force_doc_strings
)
3913 invalid_syntax (") or . in a vector");
3920 XSETCDR (tail
, read0 (readcharfun
));
3922 val
= read0 (readcharfun
);
3923 read1 (readcharfun
, &ch
, 0);
3927 if (doc_reference
== 1)
3928 return make_number (0);
3929 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3932 file_offset saved_position
;
3933 /* Get a doc string from the file we are loading.
3934 If it's in saved_doc_string, get it from there.
3936 Here, we don't know if the string is a
3937 bytecode string or a doc string. As a
3938 bytecode string must be unibyte, we always
3939 return a unibyte string. If it is actually a
3940 doc string, caller must make it
3943 /* Position is negative for user variables. */
3944 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3945 if (pos
>= saved_doc_string_position
3946 && pos
< (saved_doc_string_position
3947 + saved_doc_string_length
))
3949 saved
= saved_doc_string
;
3950 saved_position
= saved_doc_string_position
;
3952 /* Look in prev_saved_doc_string the same way. */
3953 else if (pos
>= prev_saved_doc_string_position
3954 && pos
< (prev_saved_doc_string_position
3955 + prev_saved_doc_string_length
))
3957 saved
= prev_saved_doc_string
;
3958 saved_position
= prev_saved_doc_string_position
;
3962 ptrdiff_t start
= pos
- saved_position
;
3965 /* Process quoting with ^A,
3966 and find the end of the string,
3967 which is marked with ^_ (037). */
3968 for (from
= start
, to
= start
;
3969 saved
[from
] != 037;)
3971 int c
= saved
[from
++];
3975 saved
[to
++] = (c
== 1 ? c
3984 return make_unibyte_string (saved
+ start
,
3988 return get_doc_string (val
, 1, 0);
3993 invalid_syntax (". in wrong context");
3995 invalid_syntax ("] in a list");
3999 XSETCDR (tail
, tem
);
4006 static Lisp_Object initial_obarray
;
4008 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
4010 static size_t oblookup_last_bucket_number
;
4012 /* Get an error if OBARRAY is not an obarray.
4013 If it is one, return it. */
4016 check_obarray (Lisp_Object obarray
)
4018 /* We don't want to signal a wrong-type-argument error when we are
4019 shutting down due to a fatal error, and we don't want to hit
4020 assertions in VECTORP and ASIZE if the fatal error was during GC. */
4021 if (!fatal_error_in_progress
4022 && (!VECTORP (obarray
) || ASIZE (obarray
) == 0))
4024 /* If Vobarray is now invalid, force it to be valid. */
4025 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
4026 wrong_type_argument (Qvectorp
, obarray
);
4031 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
4034 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
4038 XSYMBOL (sym
)->u
.s
.interned
= (EQ (obarray
, initial_obarray
)
4039 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
4042 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
4044 make_symbol_constant (sym
);
4045 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_PLAINVAL
;
4046 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
4049 ptr
= aref_addr (obarray
, XINT (index
));
4050 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
4055 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
4058 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
4060 return intern_sym (Fmake_symbol (string
), obarray
, index
);
4063 /* Intern the C string STR: return a symbol with that name,
4064 interned in the current obarray. */
4067 intern_1 (const char *str
, ptrdiff_t len
)
4069 Lisp_Object obarray
= check_obarray (Vobarray
);
4070 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
4072 return (SYMBOLP (tem
) ? tem
4073 /* The above `oblookup' was done on the basis of nchars==nbytes, so
4074 the string has to be unibyte. */
4075 : intern_driver (make_unibyte_string (str
, len
),
4080 intern_c_string_1 (const char *str
, ptrdiff_t len
)
4082 Lisp_Object obarray
= check_obarray (Vobarray
);
4083 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
4087 /* Creating a non-pure string from a string literal not implemented yet.
4088 We could just use make_string here and live with the extra copy. */
4089 eassert (!NILP (Vpurify_flag
));
4090 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
4096 define_symbol (Lisp_Object sym
, char const *str
)
4098 ptrdiff_t len
= strlen (str
);
4099 Lisp_Object string
= make_pure_c_string (str
, len
);
4100 init_symbol (sym
, string
);
4102 /* Qunbound is uninterned, so that it's not confused with any symbol
4103 'unbound' created by a Lisp program. */
4104 if (! EQ (sym
, Qunbound
))
4106 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
4107 eassert (INTEGERP (bucket
));
4108 intern_sym (sym
, initial_obarray
, bucket
);
4112 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
4113 doc
: /* Return the canonical symbol whose name is STRING.
4114 If there is none, one is created by this function and returned.
4115 A second optional argument specifies the obarray to use;
4116 it defaults to the value of `obarray'. */)
4117 (Lisp_Object string
, Lisp_Object obarray
)
4121 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
4122 CHECK_STRING (string
);
4124 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
4126 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
4131 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
4132 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
4133 NAME may be a string or a symbol. If it is a symbol, that exact
4134 symbol is searched for.
4135 A second optional argument specifies the obarray to use;
4136 it defaults to the value of `obarray'. */)
4137 (Lisp_Object name
, Lisp_Object obarray
)
4139 register Lisp_Object tem
, string
;
4141 if (NILP (obarray
)) obarray
= Vobarray
;
4142 obarray
= check_obarray (obarray
);
4144 if (!SYMBOLP (name
))
4146 CHECK_STRING (name
);
4150 string
= SYMBOL_NAME (name
);
4152 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
4153 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
4159 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
4160 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
4161 The value is t if a symbol was found and deleted, nil otherwise.
4162 NAME may be a string or a symbol. If it is a symbol, that symbol
4163 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
4164 OBARRAY, if nil, defaults to the value of the variable `obarray'.
4165 usage: (unintern NAME OBARRAY) */)
4166 (Lisp_Object name
, Lisp_Object obarray
)
4168 register Lisp_Object string
, tem
;
4171 if (NILP (obarray
)) obarray
= Vobarray
;
4172 obarray
= check_obarray (obarray
);
4175 string
= SYMBOL_NAME (name
);
4178 CHECK_STRING (name
);
4182 tem
= oblookup (obarray
, SSDATA (string
),
4187 /* If arg was a symbol, don't delete anything but that symbol itself. */
4188 if (SYMBOLP (name
) && !EQ (name
, tem
))
4191 /* There are plenty of other symbols which will screw up the Emacs
4192 session if we unintern them, as well as even more ways to use
4193 `setq' or `fset' or whatnot to make the Emacs session
4194 unusable. Let's not go down this silly road. --Stef */
4195 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
4196 error ("Attempt to unintern t or nil"); */
4198 XSYMBOL (tem
)->u
.s
.interned
= SYMBOL_UNINTERNED
;
4200 hash
= oblookup_last_bucket_number
;
4202 if (EQ (AREF (obarray
, hash
), tem
))
4204 if (XSYMBOL (tem
)->u
.s
.next
)
4207 XSETSYMBOL (sym
, XSYMBOL (tem
)->u
.s
.next
);
4208 ASET (obarray
, hash
, sym
);
4211 ASET (obarray
, hash
, make_number (0));
4215 Lisp_Object tail
, following
;
4217 for (tail
= AREF (obarray
, hash
);
4218 XSYMBOL (tail
)->u
.s
.next
;
4221 XSETSYMBOL (following
, XSYMBOL (tail
)->u
.s
.next
);
4222 if (EQ (following
, tem
))
4224 set_symbol_next (tail
, XSYMBOL (following
)->u
.s
.next
);
4233 /* Return the symbol in OBARRAY whose names matches the string
4234 of SIZE characters (SIZE_BYTE bytes) at PTR.
4235 If there is no such symbol, return the integer bucket number of
4236 where the symbol would be if it were present.
4238 Also store the bucket number in oblookup_last_bucket_number. */
4241 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
4245 register Lisp_Object tail
;
4246 Lisp_Object bucket
, tem
;
4248 obarray
= check_obarray (obarray
);
4249 /* This is sometimes needed in the middle of GC. */
4250 obsize
= gc_asize (obarray
);
4251 hash
= hash_string (ptr
, size_byte
) % obsize
;
4252 bucket
= AREF (obarray
, hash
);
4253 oblookup_last_bucket_number
= hash
;
4254 if (EQ (bucket
, make_number (0)))
4256 else if (!SYMBOLP (bucket
))
4257 error ("Bad data in guts of obarray"); /* Like CADR error message. */
4259 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->u
.s
.next
))
4261 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
4262 && SCHARS (SYMBOL_NAME (tail
)) == size
4263 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
4265 else if (XSYMBOL (tail
)->u
.s
.next
== 0)
4268 XSETINT (tem
, hash
);
4273 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
4276 register Lisp_Object tail
;
4277 CHECK_VECTOR (obarray
);
4278 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
4280 tail
= AREF (obarray
, i
);
4285 if (XSYMBOL (tail
)->u
.s
.next
== 0)
4287 XSETSYMBOL (tail
, XSYMBOL (tail
)->u
.s
.next
);
4293 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4295 call1 (function
, sym
);
4298 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4299 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4300 OBARRAY defaults to the value of `obarray'. */)
4301 (Lisp_Object function
, Lisp_Object obarray
)
4303 if (NILP (obarray
)) obarray
= Vobarray
;
4304 obarray
= check_obarray (obarray
);
4306 map_obarray (obarray
, mapatoms_1
, function
);
4310 #define OBARRAY_SIZE 15121
4315 Vobarray
= Fmake_vector (make_number (OBARRAY_SIZE
), make_number (0));
4316 initial_obarray
= Vobarray
;
4317 staticpro (&initial_obarray
);
4319 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4320 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4322 DEFSYM (Qunbound
, "unbound");
4324 DEFSYM (Qnil
, "nil");
4325 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4326 make_symbol_constant (Qnil
);
4327 XSYMBOL (Qnil
)->u
.s
.declared_special
= true;
4330 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4331 make_symbol_constant (Qt
);
4332 XSYMBOL (Qt
)->u
.s
.declared_special
= true;
4334 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4337 DEFSYM (Qvariable_documentation
, "variable-documentation");
4341 defsubr (struct Lisp_Subr
*sname
)
4343 Lisp_Object sym
, tem
;
4344 sym
= intern_c_string (sname
->symbol_name
);
4345 XSETPVECTYPE (sname
, PVEC_SUBR
);
4346 XSETSUBR (tem
, sname
);
4347 set_symbol_function (sym
, tem
);
4350 #ifdef NOTDEF /* Use fset in subr.el now! */
4352 defalias (struct Lisp_Subr
*sname
, char *string
)
4355 sym
= intern (string
);
4356 XSETSUBR (XSYMBOL (sym
)->u
.s
.function
, sname
);
4360 /* Define an "integer variable"; a symbol whose value is forwarded to a
4361 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4362 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4364 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4365 const char *namestring
, EMACS_INT
*address
)
4368 sym
= intern_c_string (namestring
);
4369 i_fwd
->type
= Lisp_Fwd_Int
;
4370 i_fwd
->intvar
= address
;
4371 XSYMBOL (sym
)->u
.s
.declared_special
= true;
4372 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_FORWARDED
;
4373 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4376 /* Similar but define a variable whose value is t if address contains 1,
4377 nil if address contains 0. */
4379 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4380 const char *namestring
, bool *address
)
4383 sym
= intern_c_string (namestring
);
4384 b_fwd
->type
= Lisp_Fwd_Bool
;
4385 b_fwd
->boolvar
= address
;
4386 XSYMBOL (sym
)->u
.s
.declared_special
= true;
4387 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_FORWARDED
;
4388 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4389 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4392 /* Similar but define a variable whose value is the Lisp Object stored
4393 at address. Two versions: with and without gc-marking of the C
4394 variable. The nopro version is used when that variable will be
4395 gc-marked for some other reason, since marking the same slot twice
4396 can cause trouble with strings. */
4398 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4399 const char *namestring
, Lisp_Object
*address
)
4402 sym
= intern_c_string (namestring
);
4403 o_fwd
->type
= Lisp_Fwd_Obj
;
4404 o_fwd
->objvar
= address
;
4405 XSYMBOL (sym
)->u
.s
.declared_special
= true;
4406 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_FORWARDED
;
4407 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4411 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4412 const char *namestring
, Lisp_Object
*address
)
4414 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4415 staticpro (address
);
4418 /* Similar but define a variable whose value is the Lisp Object stored
4419 at a particular offset in the current kboard object. */
4422 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4423 const char *namestring
, int offset
)
4426 sym
= intern_c_string (namestring
);
4427 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4428 ko_fwd
->offset
= offset
;
4429 XSYMBOL (sym
)->u
.s
.declared_special
= true;
4430 XSYMBOL (sym
)->u
.s
.redirect
= SYMBOL_FORWARDED
;
4431 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4434 /* Check that the elements of lpath exist. */
4437 load_path_check (Lisp_Object lpath
)
4439 Lisp_Object path_tail
;
4441 /* The only elements that might not exist are those from
4442 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4444 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4446 Lisp_Object dirfile
;
4447 dirfile
= Fcar (path_tail
);
4448 if (STRINGP (dirfile
))
4450 dirfile
= Fdirectory_file_name (dirfile
);
4451 if (! file_accessible_directory_p (dirfile
))
4452 dir_warning ("Lisp directory", XCAR (path_tail
));
4457 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4458 This does not include the standard site-lisp directories
4459 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4460 but it does (unless no_site_lisp is set) include site-lisp
4461 directories in the source/build directories if those exist and we
4462 are running uninstalled.
4464 Uses the following logic:
4466 If Vinstallation_directory is not nil (ie, running uninstalled),
4467 use PATH_DUMPLOADSEARCH (ie, build path). Else use PATH_LOADSEARCH.
4468 The remainder is what happens when dumping works:
4469 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4470 Otherwise use PATH_LOADSEARCH.
4472 If !initialized, then just return PATH_DUMPLOADSEARCH.
4474 If Vinstallation_directory is not nil (ie, running uninstalled):
4475 If installation-dir/lisp exists and not already a member,
4476 we must be running uninstalled. Reset the load-path
4477 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4478 refers to the eventual installation directories. Since we
4479 are not yet installed, we should not use them, even if they exist.)
4480 If installation-dir/lisp does not exist, just add
4481 PATH_DUMPLOADSEARCH at the end instead.
4482 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4483 and not already a member) at the front.
4484 If installation-dir != source-dir (ie running an uninstalled,
4485 out-of-tree build) AND install-dir/src/Makefile exists BUT
4486 install-dir/src/Makefile.in does NOT exist (this is a sanity
4487 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4490 load_path_default (void)
4492 Lisp_Object lpath
= Qnil
;
4497 const char *loadpath
= ns_load_path ();
4500 normal
= PATH_LOADSEARCH
;
4501 if (!NILP (Vinstallation_directory
)) normal
= PATH_DUMPLOADSEARCH
;
4504 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4506 lpath
= decode_env_path (0, normal
, 0);
4509 #else /* !CANNOT_DUMP */
4511 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4516 const char *loadpath
= ns_load_path ();
4517 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4519 lpath
= decode_env_path (0, normal
, 0);
4521 if (!NILP (Vinstallation_directory
))
4523 Lisp_Object tem
, tem1
;
4525 /* Add to the path the lisp subdir of the installation
4526 dir, if it is accessible. Note: in out-of-tree builds,
4527 this directory is empty save for Makefile. */
4528 tem
= Fexpand_file_name (build_string ("lisp"),
4529 Vinstallation_directory
);
4530 tem1
= Ffile_accessible_directory_p (tem
);
4533 if (NILP (Fmember (tem
, lpath
)))
4535 /* We are running uninstalled. The default load-path
4536 points to the eventual installed lisp directories.
4537 We should not use those now, even if they exist,
4538 so start over from a clean slate. */
4539 lpath
= list1 (tem
);
4543 /* That dir doesn't exist, so add the build-time
4544 Lisp dirs instead. */
4546 Lisp_Object dump_path
=
4547 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4548 lpath
= nconc2 (lpath
, dump_path
);
4551 /* Add site-lisp under the installation dir, if it exists. */
4554 tem
= Fexpand_file_name (build_string ("site-lisp"),
4555 Vinstallation_directory
);
4556 tem1
= Ffile_accessible_directory_p (tem
);
4559 if (NILP (Fmember (tem
, lpath
)))
4560 lpath
= Fcons (tem
, lpath
);
4564 /* If Emacs was not built in the source directory,
4565 and it is run from where it was built, add to load-path
4566 the lisp and site-lisp dirs under that directory. */
4568 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4572 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4573 Vinstallation_directory
);
4574 tem1
= Ffile_exists_p (tem
);
4576 /* Don't be fooled if they moved the entire source tree
4577 AFTER dumping Emacs. If the build directory is indeed
4578 different from the source dir, src/Makefile.in and
4579 src/Makefile will not be found together. */
4580 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4581 Vinstallation_directory
);
4582 tem2
= Ffile_exists_p (tem
);
4583 if (!NILP (tem1
) && NILP (tem2
))
4585 tem
= Fexpand_file_name (build_string ("lisp"),
4588 if (NILP (Fmember (tem
, lpath
)))
4589 lpath
= Fcons (tem
, lpath
);
4593 tem
= Fexpand_file_name (build_string ("site-lisp"),
4595 tem1
= Ffile_accessible_directory_p (tem
);
4598 if (NILP (Fmember (tem
, lpath
)))
4599 lpath
= Fcons (tem
, lpath
);
4603 } /* Vinstallation_directory != Vsource_directory */
4605 } /* if Vinstallation_directory */
4607 else /* !initialized */
4609 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4610 source directory. We used to add ../lisp (ie the lisp dir in
4611 the build directory) at the front here, but that should not
4612 be necessary, since in out of tree builds lisp/ is empty, save
4614 lpath
= decode_env_path (0, normal
, 0);
4616 #endif /* !CANNOT_DUMP */
4624 if (NILP (Vpurify_flag
) && !NILP (Ffboundp (Qfile_truename
)))
4625 Vsource_directory
= call1 (Qfile_truename
, Vsource_directory
);
4627 /* First, set Vload_path. */
4629 /* Ignore EMACSLOADPATH when dumping. */
4631 bool use_loadpath
= true;
4633 bool use_loadpath
= NILP (Vpurify_flag
);
4636 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4638 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4640 /* Check (non-nil) user-supplied elements. */
4641 load_path_check (Vload_path
);
4643 /* If no nils in the environment variable, use as-is.
4644 Otherwise, replace any nils with the default. */
4645 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4647 Lisp_Object elem
, elpath
= Vload_path
;
4648 Lisp_Object default_lpath
= load_path_default ();
4650 /* Check defaults, before adding site-lisp. */
4651 load_path_check (default_lpath
);
4653 /* Add the site-lisp directories to the front of the default. */
4654 if (!no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4656 Lisp_Object sitelisp
;
4657 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4658 if (! NILP (sitelisp
))
4659 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4664 /* Replace nils from EMACSLOADPATH by default. */
4665 while (CONSP (elpath
))
4667 elem
= XCAR (elpath
);
4668 elpath
= XCDR (elpath
);
4669 Vload_path
= CALLN (Fappend
, Vload_path
,
4670 NILP (elem
) ? default_lpath
: list1 (elem
));
4672 } /* Fmemq (Qnil, Vload_path) */
4676 Vload_path
= load_path_default ();
4678 /* Check before adding site-lisp directories.
4679 The install should have created them, but they are not
4680 required, so no need to warn if they are absent.
4681 Or we might be running before installation. */
4682 load_path_check (Vload_path
);
4684 /* Add the site-lisp directories at the front. */
4685 if (initialized
&& !no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4687 Lisp_Object sitelisp
;
4688 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4689 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4695 load_in_progress
= 0;
4696 Vload_file_name
= Qnil
;
4697 Vstandard_input
= Qt
;
4698 Vloads_in_progress
= Qnil
;
4701 /* Print a warning that directory intended for use USE and with name
4702 DIRNAME cannot be accessed. On entry, errno should correspond to
4703 the access failure. Print the warning on stderr and put it in
4707 dir_warning (char const *use
, Lisp_Object dirname
)
4709 static char const format
[] = "Warning: %s '%s': %s\n";
4710 char *diagnostic
= emacs_strerror (errno
);
4711 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)), diagnostic
);
4713 /* Don't log the warning before we've initialized!! */
4716 ptrdiff_t diaglen
= strlen (diagnostic
);
4717 AUTO_STRING_WITH_LEN (diag
, diagnostic
, diaglen
);
4718 if (! NILP (Vlocale_coding_system
))
4721 = code_convert_string_norecord (diag
, Vlocale_coding_system
, false);
4722 diagnostic
= SSDATA (s
);
4723 diaglen
= SBYTES (s
);
4726 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4727 + strlen (use
) + SBYTES (dirname
) + diaglen
);
4728 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4730 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4736 syms_of_lread (void)
4739 defsubr (&Sread_from_string
);
4740 defsubr (&Slread__substitute_object_in_subtree
);
4742 defsubr (&Sintern_soft
);
4743 defsubr (&Sunintern
);
4744 defsubr (&Sget_load_suffixes
);
4746 defsubr (&Seval_buffer
);
4747 defsubr (&Seval_region
);
4748 defsubr (&Sread_char
);
4749 defsubr (&Sread_char_exclusive
);
4750 defsubr (&Sread_event
);
4751 defsubr (&Sget_file_char
);
4752 defsubr (&Smapatoms
);
4753 defsubr (&Slocate_file_internal
);
4755 DEFVAR_LISP ("obarray", Vobarray
,
4756 doc
: /* Symbol table for use by `intern' and `read'.
4757 It is a vector whose length ought to be prime for best results.
4758 The vector's contents don't make sense if examined from Lisp programs;
4759 to find all the symbols in an obarray, use `mapatoms'. */);
4761 DEFVAR_LISP ("values", Vvalues
,
4762 doc
: /* List of values of all expressions which were read, evaluated and printed.
4763 Order is reverse chronological. */);
4764 XSYMBOL (intern ("values"))->u
.s
.declared_special
= false;
4766 DEFVAR_LISP ("standard-input", Vstandard_input
,
4767 doc
: /* Stream for read to get input from.
4768 See documentation of `read' for possible values. */);
4769 Vstandard_input
= Qt
;
4771 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4772 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4774 If this variable is a buffer, then only forms read from that buffer
4775 will be added to `read-symbol-positions-list'.
4776 If this variable is t, then all read forms will be added.
4777 The effect of all other values other than nil are not currently
4778 defined, although they may be in the future.
4780 The positions are relative to the last call to `read' or
4781 `read-from-string'. It is probably a bad idea to set this variable at
4782 the toplevel; bind it instead. */);
4783 Vread_with_symbol_positions
= Qnil
;
4785 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4786 doc
: /* A list mapping read symbols to their positions.
4787 This variable is modified during calls to `read' or
4788 `read-from-string', but only when `read-with-symbol-positions' is
4791 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4792 CHAR-POSITION is an integer giving the offset of that occurrence of the
4793 symbol from the position where `read' or `read-from-string' started.
4795 Note that a symbol will appear multiple times in this list, if it was
4796 read multiple times. The list is in the same order as the symbols
4798 Vread_symbol_positions_list
= Qnil
;
4800 DEFVAR_LISP ("read-circle", Vread_circle
,
4801 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4804 DEFVAR_LISP ("load-path", Vload_path
,
4805 doc
: /* List of directories to search for files to load.
4806 Each element is a string (directory file name) or nil (meaning
4807 `default-directory').
4808 This list is consulted by the `require' function.
4809 Initialized during startup as described in Info node `(elisp)Library Search'.
4810 Use `directory-file-name' when adding items to this path. However, Lisp
4811 programs that process this list should tolerate directories both with
4812 and without trailing slashes. */);
4814 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4815 doc
: /* List of suffixes for Emacs Lisp files and dynamic modules.
4816 This list includes suffixes for both compiled and source Emacs Lisp files.
4817 This list should not include the empty string.
4818 `load' and related functions try to append these suffixes, in order,
4819 to the specified file name if a suffix is allowed or required. */);
4821 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4822 build_pure_c_string (".el"),
4823 build_pure_c_string (MODULES_SUFFIX
));
4825 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4826 build_pure_c_string (".el"));
4828 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix
,
4829 doc
: /* Suffix of loadable module file, or nil if modules are not supported. */);
4831 Vmodule_file_suffix
= build_pure_c_string (MODULES_SUFFIX
);
4833 Vmodule_file_suffix
= Qnil
;
4835 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4836 doc
: /* List of suffixes that indicate representations of \
4838 This list should normally start with the empty string.
4840 Enabling Auto Compression mode appends the suffixes in
4841 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4842 mode removes them again. `load' and related functions use this list to
4843 determine whether they should look for compressed versions of a file
4844 and, if so, which suffixes they should try to append to the file name
4845 in order to do so. However, if you want to customize which suffixes
4846 the loading functions recognize as compression suffixes, you should
4847 customize `jka-compr-load-suffixes' rather than the present variable. */);
4848 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4850 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4851 doc
: /* Non-nil if inside of `load'. */);
4852 DEFSYM (Qload_in_progress
, "load-in-progress");
4854 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4855 doc
: /* An alist of functions to be evalled when particular files are loaded.
4856 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4858 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4859 a symbol (a feature name).
4861 When `load' is run and the file-name argument matches an element's
4862 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4863 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4865 An error in FORMS does not undo the load, but does prevent execution of
4866 the rest of the FORMS. */);
4867 Vafter_load_alist
= Qnil
;
4869 DEFVAR_LISP ("load-history", Vload_history
,
4870 doc
: /* Alist mapping loaded file names to symbols and features.
4871 Each alist element should be a list (FILE-NAME ENTRIES...), where
4872 FILE-NAME is the name of a file that has been loaded into Emacs.
4873 The file name is absolute and true (i.e. it doesn't contain symlinks).
4874 As an exception, one of the alist elements may have FILE-NAME nil,
4875 for symbols and features not associated with any file.
4877 The remaining ENTRIES in the alist element describe the functions and
4878 variables defined in that file, the features provided, and the
4879 features required. Each entry has the form `(provide . FEATURE)',
4880 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4881 `(defface . SYMBOL)', `(define-type . SYMBOL)',
4882 `(cl-defmethod METHOD SPECIALIZERS)', or `(t . SYMBOL)'.
4883 Entries like `(t . SYMBOL)' may precede a `(defun . FUNCTION)' entry,
4884 and means that SYMBOL was an autoload before this file redefined it
4885 as a function. In addition, entries may also be single symbols,
4886 which means that symbol was defined by `defvar' or `defconst'.
4888 During preloading, the file name recorded is relative to the main Lisp
4889 directory. These file names are converted to absolute at startup. */);
4890 Vload_history
= Qnil
;
4892 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4893 doc
: /* Full name of file being loaded by `load'. */);
4894 Vload_file_name
= Qnil
;
4896 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4897 doc
: /* File name, including directory, of user's initialization file.
4898 If the file loaded had extension `.elc', and the corresponding source file
4899 exists, this variable contains the name of source file, suitable for use
4900 by functions like `custom-save-all' which edit the init file.
4901 While Emacs loads and evaluates the init file, value is the real name
4902 of the file, regardless of whether or not it has the `.elc' extension. */);
4903 Vuser_init_file
= Qnil
;
4905 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4906 doc
: /* Used for internal purposes by `load'. */);
4907 Vcurrent_load_list
= Qnil
;
4909 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4910 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4911 Called with a single argument (the stream from which to read).
4912 The default is to use the function `read'. */);
4913 DEFSYM (Qread
, "read");
4914 Vload_read_function
= Qread
;
4916 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4917 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4918 The value should be a function for doing code conversion before
4919 reading a source file. It can also be nil, in which case loading is
4920 done without any code conversion.
4922 If the value is a function, it is called with four arguments,
4923 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4924 the file to load, FILE is the non-absolute name (for messages etc.),
4925 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4926 `load'. The function should return t if the file was loaded. */);
4927 Vload_source_file_function
= Qnil
;
4929 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4930 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4931 This is useful when the file being loaded is a temporary copy. */);
4932 load_force_doc_strings
= 0;
4934 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4935 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4936 This is normally bound by `load' and `eval-buffer' to control `read',
4937 and is not meant for users to change. */);
4938 load_convert_to_unibyte
= 0;
4940 DEFVAR_LISP ("source-directory", Vsource_directory
,
4941 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4942 You cannot count on them to still be there! */);
4944 = Fexpand_file_name (build_string ("../"),
4945 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4947 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4948 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4949 Vpreloaded_file_list
= Qnil
;
4951 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4952 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4953 Vbyte_boolean_vars
= Qnil
;
4955 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4956 doc
: /* Non-nil means load dangerous compiled Lisp files.
4957 Some versions of XEmacs use different byte codes than Emacs. These
4958 incompatible byte codes can make Emacs crash when it tries to execute
4960 load_dangerous_libraries
= 0;
4962 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4963 doc
: /* Non-nil means force printing messages when loading Lisp files.
4964 This overrides the value of the NOMESSAGE argument to `load'. */);
4965 force_load_messages
= 0;
4967 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4968 doc
: /* Regular expression matching safe to load compiled Lisp files.
4969 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4970 from the file, and matches them against this regular expression.
4971 When the regular expression matches, the file is considered to be safe
4972 to load. See also `load-dangerous-libraries'. */);
4973 Vbytecomp_version_regexp
4974 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4976 DEFSYM (Qlexical_binding
, "lexical-binding");
4977 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4978 doc
: /* Whether to use lexical binding when evaluating code.
4979 Non-nil means that the code in the current buffer should be evaluated
4980 with lexical binding.
4981 This variable is automatically set from the file variables of an
4982 interpreted Lisp file read using `load'. Unlike other file local
4983 variables, this must be set in the first line of a file. */);
4984 Vlexical_binding
= Qnil
;
4985 Fmake_variable_buffer_local (Qlexical_binding
);
4987 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4988 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4989 Veval_buffer_list
= Qnil
;
4991 DEFVAR_LISP ("lread--old-style-backquotes", Vlread_old_style_backquotes
,
4992 doc
: /* Set to non-nil when `read' encounters an old-style backquote.
4993 For internal use only. */);
4994 Vlread_old_style_backquotes
= Qnil
;
4995 DEFSYM (Qlread_old_style_backquotes
, "lread--old-style-backquotes");
4997 DEFVAR_LISP ("lread--unescaped-character-literals",
4998 Vlread_unescaped_character_literals
,
4999 doc
: /* List of deprecated unescaped character literals encountered by `read'.
5000 For internal use only. */);
5001 Vlread_unescaped_character_literals
= Qnil
;
5002 DEFSYM (Qlread_unescaped_character_literals
,
5003 "lread--unescaped-character-literals");
5006 DEFSYM (Qchar
, "char");
5007 DEFSYM (Qformat
, "format");
5009 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
5010 doc
: /* Non-nil means `load' prefers the newest version of a file.
5011 This applies when a filename suffix is not explicitly specified and
5012 `load' is trying various possible suffixes (see `load-suffixes' and
5013 `load-file-rep-suffixes'). Normally, it stops at the first file
5014 that exists unless you explicitly specify one or the other. If this
5015 option is non-nil, it checks all suffixes and uses whichever file is
5017 Note that if you customize this, obviously it will not affect files
5018 that are loaded before your customizations are read! */);
5019 load_prefer_newer
= 0;
5021 /* Vsource_directory was initialized in init_lread. */
5023 DEFSYM (Qcurrent_load_list
, "current-load-list");
5024 DEFSYM (Qstandard_input
, "standard-input");
5025 DEFSYM (Qread_char
, "read-char");
5026 DEFSYM (Qget_file_char
, "get-file-char");
5028 /* Used instead of Qget_file_char while loading *.elc files compiled
5029 by Emacs 21 or older. */
5030 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
5032 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
5034 DEFSYM (Qbackquote
, "`");
5035 DEFSYM (Qcomma
, ",");
5036 DEFSYM (Qcomma_at
, ",@");
5037 DEFSYM (Qcomma_dot
, ",.");
5039 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
5040 DEFSYM (Qascii_character
, "ascii-character");
5041 DEFSYM (Qfunction
, "function");
5042 DEFSYM (Qload
, "load");
5043 DEFSYM (Qload_file_name
, "load-file-name");
5044 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
5045 DEFSYM (Qfile_truename
, "file-truename");
5046 DEFSYM (Qdir_ok
, "dir-ok");
5047 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
5049 staticpro (&read_objects_map
);
5050 read_objects_map
= Qnil
;
5051 staticpro (&read_objects_completed
);
5052 read_objects_completed
= Qnil
;
5054 Vloads_in_progress
= Qnil
;
5055 staticpro (&Vloads_in_progress
);
5057 DEFSYM (Qhash_table
, "hash-table");
5058 DEFSYM (Qdata
, "data");
5059 DEFSYM (Qtest
, "test");
5060 DEFSYM (Qsize
, "size");
5061 DEFSYM (Qpurecopy
, "purecopy");
5062 DEFSYM (Qweakness
, "weakness");
5063 DEFSYM (Qrehash_size
, "rehash-size");
5064 DEFSYM (Qrehash_threshold
, "rehash-threshold");
5066 DEFSYM (Qchar_from_name
, "char-from-name");