1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2017 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://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 for get_file_char to read from. Use by load. */
107 static FILE *instream
;
109 /* For use within read-from-string (this reader is non-reentrant!!) */
110 static ptrdiff_t read_from_string_index
;
111 static ptrdiff_t read_from_string_index_byte
;
112 static ptrdiff_t read_from_string_limit
;
114 /* Number of characters read in the current call to Fread or
115 Fread_from_string. */
116 static EMACS_INT readchar_count
;
118 /* This contains the last string skipped with #@. */
119 static char *saved_doc_string
;
120 /* Length of buffer allocated in saved_doc_string. */
121 static ptrdiff_t saved_doc_string_size
;
122 /* Length of actual data in saved_doc_string. */
123 static ptrdiff_t saved_doc_string_length
;
124 /* This is the file position that string came from. */
125 static file_offset saved_doc_string_position
;
127 /* This contains the previous string skipped with #@.
128 We copy it from saved_doc_string when a new string
129 is put in saved_doc_string. */
130 static char *prev_saved_doc_string
;
131 /* Length of buffer allocated in prev_saved_doc_string. */
132 static ptrdiff_t prev_saved_doc_string_size
;
133 /* Length of actual data in prev_saved_doc_string. */
134 static ptrdiff_t prev_saved_doc_string_length
;
135 /* This is the file position that string came from. */
136 static file_offset prev_saved_doc_string_position
;
138 /* True means inside a new-style backquote
139 with no surrounding parentheses.
140 Fread initializes this to false, so we need not specbind it
141 or worry about what happens to it when there is an error. */
142 static bool new_backquote_flag
;
144 /* A list of file names for files being loaded in Fload. Used to
145 check for recursive loads. */
147 static Lisp_Object Vloads_in_progress
;
149 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
152 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
153 Lisp_Object
, Lisp_Object
,
154 Lisp_Object
, Lisp_Object
);
156 /* Functions that read one byte from the current source READCHARFUN
157 or unreads one byte. If the integer argument C is -1, it returns
158 one read byte, or -1 when there's no more byte in the source. If C
159 is 0 or positive, it unreads C, and the return value is not
162 static int readbyte_for_lambda (int, Lisp_Object
);
163 static int readbyte_from_file (int, Lisp_Object
);
164 static int readbyte_from_string (int, Lisp_Object
);
166 /* Handle unreading and rereading of characters.
167 Write READCHAR to read a character,
168 UNREAD(c) to unread c to be read again.
170 These macros correctly read/unread multibyte characters. */
172 #define READCHAR readchar (readcharfun, NULL)
173 #define UNREAD(c) unreadchar (readcharfun, c)
175 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
176 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
178 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
179 Qlambda, or a cons, we use this to keep an unread character because
180 a file stream can't handle multibyte-char unreading. The value -1
181 means that there's no unread character. */
182 static int unread_char
;
185 readchar (Lisp_Object readcharfun
, bool *multibyte
)
189 int (*readbyte
) (int, Lisp_Object
);
190 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
192 bool emacs_mule_encoding
= 0;
199 if (BUFFERP (readcharfun
))
201 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
203 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
205 if (! BUFFER_LIVE_P (inbuffer
))
208 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
211 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
213 /* Fetch the character code from the buffer. */
214 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
215 BUF_INC_POS (inbuffer
, pt_byte
);
222 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
223 if (! ASCII_CHAR_P (c
))
224 c
= BYTE8_TO_CHAR (c
);
227 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
231 if (MARKERP (readcharfun
))
233 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
235 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
237 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
240 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
242 /* Fetch the character code from the buffer. */
243 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
244 BUF_INC_POS (inbuffer
, bytepos
);
251 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
252 if (! ASCII_CHAR_P (c
))
253 c
= BYTE8_TO_CHAR (c
);
257 XMARKER (readcharfun
)->bytepos
= bytepos
;
258 XMARKER (readcharfun
)->charpos
++;
263 if (EQ (readcharfun
, Qlambda
))
265 readbyte
= readbyte_for_lambda
;
269 if (EQ (readcharfun
, Qget_file_char
))
271 readbyte
= readbyte_from_file
;
275 if (STRINGP (readcharfun
))
277 if (read_from_string_index
>= read_from_string_limit
)
279 else if (STRING_MULTIBYTE (readcharfun
))
283 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
284 read_from_string_index
,
285 read_from_string_index_byte
);
289 c
= SREF (readcharfun
, read_from_string_index_byte
);
290 read_from_string_index
++;
291 read_from_string_index_byte
++;
296 if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
298 /* This is the case that read_vector is reading from a unibyte
299 string that contains a byte sequence previously skipped
300 because of #@NUMBER. The car part of readcharfun is that
301 string, and the cdr part is a value of readcharfun given to
303 readbyte
= readbyte_from_string
;
304 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
305 emacs_mule_encoding
= 1;
309 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
311 readbyte
= readbyte_from_file
;
312 emacs_mule_encoding
= 1;
316 tem
= call0 (readcharfun
);
323 if (unread_char
>= 0)
329 c
= (*readbyte
) (-1, readcharfun
);
334 if (ASCII_CHAR_P (c
))
336 if (emacs_mule_encoding
)
337 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
340 len
= BYTES_BY_CHAR_HEAD (c
);
343 c
= (*readbyte
) (-1, readcharfun
);
344 if (c
< 0 || ! TRAILING_CODE_P (c
))
347 (*readbyte
) (buf
[i
], readcharfun
);
348 return BYTE8_TO_CHAR (buf
[0]);
352 return STRING_CHAR (buf
);
355 #define FROM_FILE_P(readcharfun) \
356 (EQ (readcharfun, Qget_file_char) \
357 || EQ (readcharfun, Qget_emacs_mule_file_char))
360 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
362 if (FROM_FILE_P (readcharfun
))
364 block_input (); /* FIXME: Not sure if it's needed. */
365 fseek (instream
, n
, SEEK_CUR
);
369 { /* We're not reading directly from a file. In that case, it's difficult
370 to reliably count bytes, since these are usually meant for the file's
371 encoding, whereas we're now typically in the internal encoding.
372 But luckily, skip_dyn_bytes is used to skip over a single
373 dynamic-docstring (or dynamic byte-code) which is always quoted such
374 that \037 is the final char. */
378 } while (c
>= 0 && c
!= '\037');
383 skip_dyn_eof (Lisp_Object readcharfun
)
385 if (FROM_FILE_P (readcharfun
))
387 block_input (); /* FIXME: Not sure if it's needed. */
388 fseek (instream
, 0, SEEK_END
);
392 while (READCHAR
>= 0);
395 /* Unread the character C in the way appropriate for the stream READCHARFUN.
396 If the stream is a user function, call it with the char as argument. */
399 unreadchar (Lisp_Object readcharfun
, int c
)
403 /* Don't back up the pointer if we're unreading the end-of-input mark,
404 since readchar didn't advance it when we read it. */
406 else if (BUFFERP (readcharfun
))
408 struct buffer
*b
= XBUFFER (readcharfun
);
409 ptrdiff_t charpos
= BUF_PT (b
);
410 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
412 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
413 BUF_DEC_POS (b
, bytepos
);
417 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
419 else if (MARKERP (readcharfun
))
421 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
422 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
424 XMARKER (readcharfun
)->charpos
--;
425 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
426 BUF_DEC_POS (b
, bytepos
);
430 XMARKER (readcharfun
)->bytepos
= bytepos
;
432 else if (STRINGP (readcharfun
))
434 read_from_string_index
--;
435 read_from_string_index_byte
436 = string_char_to_byte (readcharfun
, read_from_string_index
);
438 else if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
442 else if (EQ (readcharfun
, Qlambda
))
446 else if (FROM_FILE_P (readcharfun
))
451 call1 (readcharfun
, make_number (c
));
455 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
457 return read_bytecode_char (c
>= 0);
462 readbyte_from_file (int c
, Lisp_Object readcharfun
)
467 ungetc (c
, instream
);
474 /* Interrupted reads have been observed while reading over the network. */
475 while ((c
= getc_unlocked (instream
)) == EOF
&& errno
== EINTR
476 && ferror_unlocked (instream
))
481 clearerr_unlocked (instream
);
486 return (c
== EOF
? -1 : c
);
490 readbyte_from_string (int c
, Lisp_Object readcharfun
)
492 Lisp_Object string
= XCAR (readcharfun
);
496 read_from_string_index
--;
497 read_from_string_index_byte
498 = string_char_to_byte (string
, read_from_string_index
);
501 if (read_from_string_index
>= read_from_string_limit
)
504 FETCH_STRING_CHAR_ADVANCE (c
, string
,
505 read_from_string_index
,
506 read_from_string_index_byte
);
511 /* Read one non-ASCII character from INSTREAM. The character is
512 encoded in `emacs-mule' and the first byte is already read in
516 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
518 /* Emacs-mule coding uses at most 4-byte for one character. */
519 unsigned char buf
[4];
520 int len
= emacs_mule_bytes
[c
];
521 struct charset
*charset
;
526 /* C is not a valid leading-code of `emacs-mule'. */
527 return BYTE8_TO_CHAR (c
);
533 c
= (*readbyte
) (-1, readcharfun
);
537 (*readbyte
) (buf
[i
], readcharfun
);
538 return BYTE8_TO_CHAR (buf
[0]);
545 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
546 code
= buf
[1] & 0x7F;
550 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
551 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
553 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
554 code
= buf
[2] & 0x7F;
558 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
559 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
564 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
565 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
567 c
= DECODE_CHAR (charset
, code
);
569 Fsignal (Qinvalid_read_syntax
,
570 list1 (build_string ("invalid multibyte form")));
575 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
577 static Lisp_Object
read0 (Lisp_Object
);
578 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
580 static Lisp_Object
read_list (bool, Lisp_Object
);
581 static Lisp_Object
read_vector (Lisp_Object
, bool);
583 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
585 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
588 /* Get a character from the tty. */
590 /* Read input events until we get one that's acceptable for our purposes.
592 If NO_SWITCH_FRAME, switch-frame events are stashed
593 until we get a character we like, and then stuffed into
596 If ASCII_REQUIRED, check function key events to see
597 if the unmodified version of the symbol has a Qascii_character
598 property, and use that character, if present.
600 If ERROR_NONASCII, signal an error if the input we
601 get isn't an ASCII character with modifiers. If it's false but
602 ASCII_REQUIRED is true, just re-read until we get an ASCII
605 If INPUT_METHOD, invoke the current input method
606 if the character warrants that.
608 If SECONDS is a number, wait that many seconds for input, and
609 return Qnil if no input arrives within that time. */
612 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
613 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
615 Lisp_Object val
, delayed_switch_frame
;
616 struct timespec end_time
;
618 #ifdef HAVE_WINDOW_SYSTEM
619 if (display_hourglass_p
)
623 delayed_switch_frame
= Qnil
;
625 /* Compute timeout. */
626 if (NUMBERP (seconds
))
628 double duration
= XFLOATINT (seconds
);
629 struct timespec wait_time
= dtotimespec (duration
);
630 end_time
= timespec_add (current_timespec (), wait_time
);
633 /* Read until we get an acceptable event. */
636 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
637 NUMBERP (seconds
) ? &end_time
: NULL
);
638 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
643 /* `switch-frame' events are put off until after the next ASCII
644 character. This is better than signaling an error just because
645 the last characters were typed to a separate minibuffer frame,
646 for example. Eventually, some code which can deal with
647 switch-frame events will read it and process it. */
649 && EVENT_HAS_PARAMETERS (val
)
650 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
652 delayed_switch_frame
= val
;
656 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
658 /* Convert certain symbols to their ASCII equivalents. */
661 Lisp_Object tem
, tem1
;
662 tem
= Fget (val
, Qevent_symbol_element_mask
);
665 tem1
= Fget (Fcar (tem
), Qascii_character
);
666 /* Merge this symbol's modifier bits
667 with the ASCII equivalent of its basic code. */
669 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
673 /* If we don't have a character now, deal with it appropriately. */
678 Vunread_command_events
= list1 (val
);
679 error ("Non-character input-event");
686 if (! NILP (delayed_switch_frame
))
687 unread_switch_frame
= delayed_switch_frame
;
691 #ifdef HAVE_WINDOW_SYSTEM
692 if (display_hourglass_p
)
701 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
702 doc
: /* Read a character from the command input (keyboard or macro).
703 It is returned as a number.
704 If the character has modifiers, they are resolved and reflected to the
705 character code if possible (e.g. C-SPC -> 0).
707 If the user generates an event which is not a character (i.e. a mouse
708 click or function key event), `read-char' signals an error. As an
709 exception, switch-frame events are put off until non-character events
711 If you want to read non-character events, or ignore them, call
712 `read-event' or `read-char-exclusive' instead.
714 If the optional argument PROMPT is non-nil, display that as a prompt.
715 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
716 input method is turned on in the current buffer, that input method
717 is used for reading a character.
718 If the optional argument SECONDS is non-nil, it should be a number
719 specifying the maximum number of seconds to wait for input. If no
720 input arrives in that time, return nil. SECONDS may be a
721 floating-point value. */)
722 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
727 message_with_string ("%s", prompt
, 0);
728 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
730 return (NILP (val
) ? Qnil
731 : make_number (char_resolve_modifier_mask (XINT (val
))));
734 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
735 doc
: /* Read an event object from the input stream.
736 If the optional argument PROMPT is non-nil, display that as a prompt.
737 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
738 input method is turned on in the current buffer, that input method
739 is used for reading a character.
740 If the optional argument SECONDS is non-nil, it should be a number
741 specifying the maximum number of seconds to wait for input. If no
742 input arrives in that time, return nil. SECONDS may be a
743 floating-point value. */)
744 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
747 message_with_string ("%s", prompt
, 0);
748 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
751 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
752 doc
: /* Read a character from the command input (keyboard or macro).
753 It is returned as a number. Non-character events are ignored.
754 If the character has modifiers, they are resolved and reflected to the
755 character code if possible (e.g. C-SPC -> 0).
757 If the optional argument PROMPT is non-nil, display that as a prompt.
758 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
759 input method is turned on in the current buffer, that input method
760 is used for reading a character.
761 If the optional argument SECONDS is non-nil, it should be a number
762 specifying the maximum number of seconds to wait for input. If no
763 input arrives in that time, return nil. SECONDS may be a
764 floating-point value. */)
765 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
770 message_with_string ("%s", prompt
, 0);
772 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
774 return (NILP (val
) ? Qnil
775 : make_number (char_resolve_modifier_mask (XINT (val
))));
778 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
779 doc
: /* Don't use this yourself. */)
782 register Lisp_Object val
;
784 XSETINT (val
, getc_unlocked (instream
));
792 /* Return true if the lisp code read using READCHARFUN defines a non-nil
793 `lexical-binding' file variable. After returning, the stream is
794 positioned following the first line, if it is a comment or #! line,
795 otherwise nothing is read. */
798 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
811 while (ch
!= '\n' && ch
!= EOF
)
813 if (ch
== '\n') ch
= READCHAR
;
814 /* It is OK to leave the position after a #! line, since
815 that is what read1 does. */
819 /* The first line isn't a comment, just give up. */
825 /* Look for an appropriate file-variable in the first line. */
829 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
830 } beg_end_state
= NOMINAL
;
831 bool in_file_vars
= 0;
833 #define UPDATE_BEG_END_STATE(ch) \
834 if (beg_end_state == NOMINAL) \
835 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
836 else if (beg_end_state == AFTER_FIRST_DASH) \
837 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
838 else if (beg_end_state == AFTER_ASTERIX) \
841 in_file_vars = !in_file_vars; \
842 beg_end_state = NOMINAL; \
845 /* Skip until we get to the file vars, if any. */
849 UPDATE_BEG_END_STATE (ch
);
851 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
855 char var
[100], val
[100];
860 /* Read a variable name. */
861 while (ch
== ' ' || ch
== '\t')
865 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
867 if (i
< sizeof var
- 1)
869 UPDATE_BEG_END_STATE (ch
);
873 /* Stop scanning if no colon was found before end marker. */
874 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
877 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
883 /* Read a variable value. */
886 while (ch
== ' ' || ch
== '\t')
890 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
892 if (i
< sizeof val
- 1)
894 UPDATE_BEG_END_STATE (ch
);
898 /* The value was terminated by an end-marker, which remove. */
900 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
904 if (strcmp (var
, "lexical-binding") == 0)
907 rv
= (strcmp (val
, "nil") != 0);
913 while (ch
!= '\n' && ch
!= EOF
)
920 /* Value is a version number of byte compiled code if the file
921 associated with file descriptor FD is a compiled Lisp file that's
922 safe to load. Only files compiled with Emacs are safe to load.
923 Files compiled with XEmacs can lead to a crash in Fbyte_code
924 because of an incompatible change in the byte compiler. */
927 safe_to_load_version (int fd
)
933 /* Read the first few bytes from the file, and look for a line
934 specifying the byte compiler version used. */
935 nbytes
= emacs_read_quit (fd
, buf
, sizeof buf
);
938 /* Skip to the next newline, skipping over the initial `ELC'
939 with NUL bytes following it, but note the version. */
940 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
945 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
946 buf
+ i
, nbytes
- i
) < 0)
950 lseek (fd
, 0, SEEK_SET
);
955 /* Callback for record_unwind_protect. Restore the old load list OLD,
956 after loading a file successfully. */
959 record_load_unwind (Lisp_Object old
)
961 Vloads_in_progress
= old
;
964 /* This handler function is used via internal_condition_case_1. */
967 load_error_handler (Lisp_Object data
)
973 load_warn_old_style_backquotes (Lisp_Object file
)
975 if (!NILP (Vlread_old_style_backquotes
))
977 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
978 CALLN (Fmessage
, format
, file
);
983 load_warn_unescaped_character_literals (Lisp_Object file
)
985 if (NILP (Vlread_unescaped_character_literals
)) return;
986 CHECK_CONS (Vlread_unescaped_character_literals
);
988 build_string ("Loading `%s': unescaped character literals %s detected!");
989 Lisp_Object separator
= build_string (", ");
990 Lisp_Object inner_format
= build_string ("`?%c'");
993 Fmapconcat (list3 (Qlambda
, list1 (Qchar
),
994 list3 (Qformat
, inner_format
, Qchar
)),
995 Fsort (Vlread_unescaped_character_literals
, Qlss
),
999 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
1000 doc
: /* Return the suffixes that `load' should try if a suffix is \
1002 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
1005 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
1006 while (CONSP (suffixes
))
1008 Lisp_Object exts
= Vload_file_rep_suffixes
;
1009 suffix
= XCAR (suffixes
);
1010 suffixes
= XCDR (suffixes
);
1011 while (CONSP (exts
))
1015 lst
= Fcons (concat2 (suffix
, ext
), lst
);
1018 return Fnreverse (lst
);
1021 /* Returns true if STRING ends with SUFFIX */
1023 suffix_p (Lisp_Object string
, const char *suffix
)
1025 ptrdiff_t suffix_len
= strlen (suffix
);
1026 ptrdiff_t string_len
= SBYTES (string
);
1028 return string_len
>= suffix_len
&& !strcmp (SSDATA (string
) + string_len
- suffix_len
, suffix
);
1031 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1032 doc
: /* Execute a file of Lisp code named FILE.
1033 First try FILE with `.elc' appended, then try with `.el', then try
1034 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
1035 then try FILE unmodified (the exact suffixes in the exact order are
1036 determined by `load-suffixes'). Environment variable references in
1037 FILE are replaced with their values by calling `substitute-in-file-name'.
1038 This function searches the directories in `load-path'.
1040 If optional second arg NOERROR is non-nil,
1041 report no error if FILE doesn't exist.
1042 Print messages at start and end of loading unless
1043 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1045 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1046 suffixes to the specified name FILE.
1047 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1048 the suffix `.elc' or `.el' or the module suffix; don't accept just
1049 FILE unless it ends in one of those suffixes or includes a directory name.
1051 If NOSUFFIX is nil, then if a file could not be found, try looking for
1052 a different representation of the file by adding non-empty suffixes to
1053 its name, before trying another file. Emacs uses this feature to find
1054 compressed versions of files when Auto Compression mode is enabled.
1055 If NOSUFFIX is non-nil, disable this feature.
1057 The suffixes that this function tries out, when NOSUFFIX is nil, are
1058 given by the return value of `get-load-suffixes' and the values listed
1059 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1060 return value of `get-load-suffixes' is used, i.e. the file name is
1061 required to have a non-empty suffix.
1063 When searching suffixes, this function normally stops at the first
1064 one that exists. If the option `load-prefer-newer' is non-nil,
1065 however, it tries all suffixes, and uses whichever file is the newest.
1067 Loading a file records its definitions, and its `provide' and
1068 `require' calls, in an element of `load-history' whose
1069 car is the file name loaded. See `load-history'.
1071 While the file is in the process of being loaded, the variable
1072 `load-in-progress' is non-nil and the variable `load-file-name'
1073 is bound to the file's name.
1075 Return t if the file exists and loads successfully. */)
1076 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1077 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1081 int fd_index UNINIT
;
1082 ptrdiff_t count
= SPECPDL_INDEX ();
1083 Lisp_Object found
, efound
, hist_file_name
;
1084 /* True means we printed the ".el is newer" message. */
1086 /* True means we are loading a compiled file. */
1088 Lisp_Object handler
;
1090 const char *fmode
= "r" FOPEN_TEXT
;
1093 CHECK_STRING (file
);
1095 /* If file name is magic, call the handler. */
1096 /* This shouldn't be necessary any more now that `openp' handles it right.
1097 handler = Ffind_file_name_handler (file, Qload);
1098 if (!NILP (handler))
1099 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1101 /* The presence of this call is the result of a historical accident:
1102 it used to be in every file-operation and when it got removed
1103 everywhere, it accidentally stayed here. Since then, enough people
1104 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1105 that it seemed risky to remove. */
1106 if (! NILP (noerror
))
1108 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1109 Qt
, load_error_handler
);
1114 file
= Fsubstitute_in_file_name (file
);
1116 /* Avoid weird lossage with null string as arg,
1117 since it would try to load a directory as a Lisp file. */
1118 if (SCHARS (file
) == 0)
1125 Lisp_Object suffixes
;
1128 if (! NILP (must_suffix
))
1130 /* Don't insist on adding a suffix if FILE already ends with one. */
1131 if (suffix_p (file
, ".el")
1132 || suffix_p (file
, ".elc")
1134 || suffix_p (file
, MODULES_SUFFIX
)
1138 /* Don't insist on adding a suffix
1139 if the argument includes a directory name. */
1140 else if (! NILP (Ffile_name_directory (file
)))
1144 if (!NILP (nosuffix
))
1148 suffixes
= Fget_load_suffixes ();
1149 if (NILP (must_suffix
))
1150 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1153 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1159 report_file_error ("Cannot open load file", file
);
1163 /* Tell startup.el whether or not we found the user's init file. */
1164 if (EQ (Qt
, Vuser_init_file
))
1165 Vuser_init_file
= found
;
1167 /* If FD is -2, that means openp found a magic file. */
1170 if (NILP (Fequal (found
, file
)))
1171 /* If FOUND is a different file name from FILE,
1172 find its handler even if we have already inhibited
1173 the `load' operation on FILE. */
1174 handler
= Ffind_file_name_handler (found
, Qt
);
1176 handler
= Ffind_file_name_handler (found
, Qload
);
1177 if (! NILP (handler
))
1178 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1180 /* Tramp has to deal with semi-broken packages that prepend
1181 drive letters to remote files. For that reason, Tramp
1182 catches file operations that test for file existence, which
1183 makes openp think X:/foo.elc files are remote. However,
1184 Tramp does not catch `load' operations for such files, so we
1185 end up with a nil as the `load' handler above. If we would
1186 continue with fd = -2, we will behave wrongly, and in
1187 particular try reading a .elc file in the "rt" mode instead
1188 of "rb". See bug #9311 for the results. To work around
1189 this, we try to open the file locally, and go with that if it
1191 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1199 fd_index
= SPECPDL_INDEX ();
1200 record_unwind_protect_int (close_file_unwind
, fd
);
1204 if (suffix_p (found
, MODULES_SUFFIX
))
1205 return unbind_to (count
, Fmodule_load (found
));
1208 /* Check if we're stuck in a recursive load cycle.
1210 2000-09-21: It's not possible to just check for the file loaded
1211 being a member of Vloads_in_progress. This fails because of the
1212 way the byte compiler currently works; `provide's are not
1213 evaluated, see font-lock.el/jit-lock.el as an example. This
1214 leads to a certain amount of ``normal'' recursion.
1216 Also, just loading a file recursively is not always an error in
1217 the general case; the second load may do something different. */
1221 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1222 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1223 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1224 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1225 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1228 /* All loads are by default dynamic, unless the file itself specifies
1229 otherwise using a file-variable in the first line. This is bound here
1230 so that it takes effect whether or not we use
1231 Vload_source_file_function. */
1232 specbind (Qlexical_binding
, Qnil
);
1234 /* Get the name for load-history. */
1235 hist_file_name
= (! NILP (Vpurify_flag
)
1236 ? concat2 (Ffile_name_directory (file
),
1237 Ffile_name_nondirectory (found
))
1242 /* Check for the presence of old-style quotes and warn about them. */
1243 specbind (Qlread_old_style_backquotes
, Qnil
);
1244 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1246 /* Check for the presence of unescaped character literals and warn
1248 specbind (Qlread_unescaped_character_literals
, Qnil
);
1249 record_unwind_protect (load_warn_unescaped_character_literals
, file
);
1252 if ((is_elc
= suffix_p (found
, ".elc")) != 0
1253 /* version = 1 means the file is empty, in which case we can
1254 treat it as not byte-compiled. */
1255 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 1))
1256 /* Load .elc files directly, but not when they are
1257 remote and have no handler! */
1265 && ! (version
= safe_to_load_version (fd
)))
1268 if (!load_dangerous_libraries
)
1269 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1270 else if (!NILP (nomessage
) && !force_load_messages
)
1271 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1276 efound
= ENCODE_FILE (found
);
1277 fmode
= "r" FOPEN_BINARY
;
1279 /* openp already checked for newness, no point doing it again.
1280 FIXME would be nice to get a message when openp
1281 ignores suffix order due to load_prefer_newer. */
1282 if (!load_prefer_newer
&& is_elc
)
1284 result
= stat (SSDATA (efound
), &s1
);
1287 SSET (efound
, SBYTES (efound
) - 1, 0);
1288 result
= stat (SSDATA (efound
), &s2
);
1289 SSET (efound
, SBYTES (efound
) - 1, 'c');
1293 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1295 /* Make the progress messages mention that source is newer. */
1298 /* If we won't print another message, mention this anyway. */
1299 if (!NILP (nomessage
) && !force_load_messages
)
1301 Lisp_Object msg_file
;
1302 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1303 message_with_string ("Source file `%s' newer than byte-compiled file",
1307 } /* !load_prefer_newer */
1312 /* We are loading a source file (*.el). */
1313 if (!NILP (Vload_source_file_function
))
1320 clear_unwind_protect (fd_index
);
1322 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1323 NILP (noerror
) ? Qnil
: Qt
,
1324 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1325 return unbind_to (count
, val
);
1331 /* We somehow got here with fd == -2, meaning the file is deemed
1332 to be remote. Don't even try to reopen the file locally;
1333 just force a failure. */
1341 clear_unwind_protect (fd_index
);
1342 efound
= ENCODE_FILE (found
);
1343 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1345 stream
= fdopen (fd
, fmode
);
1349 report_file_error ("Opening stdio stream", file
);
1350 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1352 if (! NILP (Vpurify_flag
))
1353 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1355 if (NILP (nomessage
) || force_load_messages
)
1358 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1361 message_with_string ("Loading %s (source)...", file
, 1);
1363 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1365 else /* The typical case; compiled file newer than source file. */
1366 message_with_string ("Loading %s...", file
, 1);
1369 specbind (Qload_file_name
, found
);
1370 specbind (Qinhibit_file_name_operation
, Qnil
);
1371 specbind (Qload_in_progress
, Qt
);
1374 if (lisp_file_lexically_bound_p (Qget_file_char
))
1375 Fset (Qlexical_binding
, Qt
);
1377 if (! version
|| version
>= 22)
1378 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1379 0, Qnil
, Qnil
, Qnil
, Qnil
);
1382 /* We can't handle a file which was compiled with
1383 byte-compile-dynamic by older version of Emacs. */
1384 specbind (Qload_force_doc_strings
, Qt
);
1385 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1386 0, Qnil
, Qnil
, Qnil
, Qnil
);
1388 unbind_to (count
, Qnil
);
1390 /* Run any eval-after-load forms for this file. */
1391 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1392 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1394 xfree (saved_doc_string
);
1395 saved_doc_string
= 0;
1396 saved_doc_string_size
= 0;
1398 xfree (prev_saved_doc_string
);
1399 prev_saved_doc_string
= 0;
1400 prev_saved_doc_string_size
= 0;
1402 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1405 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1408 message_with_string ("Loading %s (source)...done", file
, 1);
1410 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1412 else /* The typical case; compiled file newer than source file. */
1413 message_with_string ("Loading %s...done", file
, 1);
1420 complete_filename_p (Lisp_Object pathname
)
1422 const unsigned char *s
= SDATA (pathname
);
1423 return (IS_DIRECTORY_SEP (s
[0])
1424 || (SCHARS (pathname
) > 2
1425 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1428 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1429 doc
: /* Search for FILENAME through PATH.
1430 Returns the file's name in absolute form, or nil if not found.
1431 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1432 file name when searching.
1433 If non-nil, PREDICATE is used instead of `file-readable-p'.
1434 PREDICATE can also be an integer to pass to the faccessat(2) function,
1435 in which case file-name-handlers are ignored.
1436 This function will normally skip directories, so if you want it to find
1437 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1438 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1441 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1442 if (NILP (predicate
) && fd
>= 0)
1447 /* Search for a file whose name is STR, looking in directories
1448 in the Lisp list PATH, and trying suffixes from SUFFIX.
1449 On success, return a file descriptor (or 1 or -2 as described below).
1450 On failure, return -1 and set errno.
1452 SUFFIXES is a list of strings containing possible suffixes.
1453 The empty suffix is automatically added if the list is empty.
1455 PREDICATE t means the files are binary.
1456 PREDICATE non-nil and non-t means don't open the files,
1457 just look for one that satisfies the predicate. In this case,
1458 return -2 on success. The predicate can be a lisp function or
1459 an integer to pass to `access' (in which case file-name-handlers
1462 If STOREPTR is nonzero, it points to a slot where the name of
1463 the file actually found should be stored as a Lisp string.
1464 nil is stored there on failure.
1466 If the file we find is remote, return -2
1467 but store the found remote file name in *STOREPTR.
1469 If NEWER is true, try all SUFFIXes and return the result for the
1470 newest file that exists. Does not apply to remote files,
1471 or if a non-nil and non-t PREDICATE is specified. */
1474 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1475 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1477 ptrdiff_t fn_size
= 100;
1481 ptrdiff_t want_length
;
1482 Lisp_Object filename
;
1483 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1484 ptrdiff_t max_suffix_len
= 0;
1485 int last_errno
= ENOENT
;
1489 /* The last-modified time of the newest matching file found.
1490 Initialize it to something less than all valid timestamps. */
1491 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1495 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1497 CHECK_STRING_CAR (tail
);
1498 max_suffix_len
= max (max_suffix_len
,
1499 SBYTES (XCAR (tail
)));
1502 string
= filename
= encoded_fn
= save_string
= Qnil
;
1507 absolute
= complete_filename_p (str
);
1509 for (; CONSP (path
); path
= XCDR (path
))
1511 ptrdiff_t baselen
, prefixlen
;
1513 filename
= Fexpand_file_name (str
, XCAR (path
));
1514 if (!complete_filename_p (filename
))
1515 /* If there are non-absolute elts in PATH (eg "."). */
1516 /* Of course, this could conceivably lose if luser sets
1517 default-directory to be something non-absolute... */
1519 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1520 if (!complete_filename_p (filename
))
1521 /* Give up on this path element! */
1525 /* Calculate maximum length of any filename made from
1526 this path element/specified file name and any possible suffix. */
1527 want_length
= max_suffix_len
+ SBYTES (filename
);
1528 if (fn_size
<= want_length
)
1530 fn_size
= 100 + want_length
;
1531 fn
= SAFE_ALLOCA (fn_size
);
1534 /* Copy FILENAME's data to FN but remove starting /: if any. */
1535 prefixlen
= ((SCHARS (filename
) > 2
1536 && SREF (filename
, 0) == '/'
1537 && SREF (filename
, 1) == ':')
1539 baselen
= SBYTES (filename
) - prefixlen
;
1540 memcpy (fn
, SDATA (filename
) + prefixlen
, baselen
);
1542 /* Loop over suffixes. */
1543 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1544 CONSP (tail
); tail
= XCDR (tail
))
1546 Lisp_Object suffix
= XCAR (tail
);
1547 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1548 Lisp_Object handler
;
1550 /* Make complete filename by appending SUFFIX. */
1551 memcpy (fn
+ baselen
, SDATA (suffix
), lsuffix
+ 1);
1552 fnlen
= baselen
+ lsuffix
;
1554 /* Check that the file exists and is not a directory. */
1555 /* We used to only check for handlers on non-absolute file names:
1559 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1560 It's not clear why that was the case and it breaks things like
1561 (load "/bar.el") where the file is actually "/bar.el.gz". */
1562 /* make_string has its own ideas on when to return a unibyte
1563 string and when a multibyte string, but we know better.
1564 We must have a unibyte string when dumping, since
1565 file-name encoding is shaky at best at that time, and in
1566 particular default-file-name-coding-system is reset
1567 several times during loadup. We therefore don't want to
1568 encode the file before passing it to file I/O library
1570 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1571 string
= make_unibyte_string (fn
, fnlen
);
1573 string
= make_string (fn
, fnlen
);
1574 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1575 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1576 && !NATNUMP (predicate
))
1579 if (NILP (predicate
) || EQ (predicate
, Qt
))
1580 exists
= !NILP (Ffile_readable_p (string
));
1583 Lisp_Object tmp
= call1 (predicate
, string
);
1586 else if (EQ (tmp
, Qdir_ok
)
1587 || NILP (Ffile_directory_p (string
)))
1592 last_errno
= EISDIR
;
1598 /* We succeeded; return this descriptor and filename. */
1611 encoded_fn
= ENCODE_FILE (string
);
1612 pfn
= SSDATA (encoded_fn
);
1614 /* Check that we can access or open it. */
1615 if (NATNUMP (predicate
))
1618 if (INT_MAX
< XFASTINT (predicate
))
1619 last_errno
= EINVAL
;
1620 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1624 if (file_directory_p (pfn
))
1625 last_errno
= EISDIR
;
1632 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1635 if (errno
!= ENOENT
)
1640 int err
= (fstat (fd
, &st
) != 0 ? errno
1641 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1653 if (newer
&& !NATNUMP (predicate
))
1655 struct timespec mtime
= get_stat_mtime (&st
);
1657 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1662 emacs_close (save_fd
);
1665 save_string
= string
;
1670 /* We succeeded; return this descriptor and filename. */
1678 /* No more suffixes. Return the newest. */
1679 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1682 *storeptr
= save_string
;
1698 /* Merge the list we've accumulated of globals from the current input source
1699 into the load_history variable. The details depend on whether
1700 the source has an associated file name or not.
1702 FILENAME is the file name that we are loading from.
1704 ENTIRE is true if loading that entire file, false if evaluating
1708 build_load_history (Lisp_Object filename
, bool entire
)
1710 Lisp_Object tail
, prev
, newelt
;
1711 Lisp_Object tem
, tem2
;
1714 tail
= Vload_history
;
1717 while (CONSP (tail
))
1721 /* Find the feature's previous assoc list... */
1722 if (!NILP (Fequal (filename
, Fcar (tem
))))
1726 /* If we're loading the entire file, remove old data. */
1730 Vload_history
= XCDR (tail
);
1732 Fsetcdr (prev
, XCDR (tail
));
1735 /* Otherwise, cons on new symbols that are not already members. */
1738 tem2
= Vcurrent_load_list
;
1740 while (CONSP (tem2
))
1742 newelt
= XCAR (tem2
);
1744 if (NILP (Fmember (newelt
, tem
)))
1745 Fsetcar (tail
, Fcons (XCAR (tem
),
1746 Fcons (newelt
, XCDR (tem
))));
1759 /* If we're loading an entire file, cons the new assoc onto the
1760 front of load-history, the most-recently-loaded position. Also
1761 do this if we didn't find an existing member for the file. */
1762 if (entire
|| !foundit
)
1763 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1768 readevalloop_1 (int old
)
1770 load_convert_to_unibyte
= old
;
1773 /* Signal an `end-of-file' error, if possible with file name
1776 static _Noreturn
void
1777 end_of_file_error (void)
1779 if (STRINGP (Vload_file_name
))
1780 xsignal1 (Qend_of_file
, Vload_file_name
);
1782 xsignal0 (Qend_of_file
);
1786 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1788 /* If we macroexpand the toplevel form non-recursively and it ends
1789 up being a `progn' (or if it was a progn to start), treat each
1790 form in the progn as a top-level form. This way, if one form in
1791 the progn defines a macro, that macro is in effect when we expand
1792 the remaining forms. See similar code in bytecomp.el. */
1793 val
= call2 (macroexpand
, val
, Qnil
);
1794 if (EQ (CAR_SAFE (val
), Qprogn
))
1796 Lisp_Object subforms
= XCDR (val
);
1798 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1799 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1803 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1807 /* UNIBYTE specifies how to set load_convert_to_unibyte
1808 for this invocation.
1809 READFUN, if non-nil, is used instead of `read'.
1811 START, END specify region to read in current buffer (from eval-region).
1812 If the input is not from a buffer, they must be nil. */
1815 readevalloop (Lisp_Object readcharfun
,
1817 Lisp_Object sourcename
,
1819 Lisp_Object unibyte
, Lisp_Object readfun
,
1820 Lisp_Object start
, Lisp_Object end
)
1824 ptrdiff_t count
= SPECPDL_INDEX ();
1825 struct buffer
*b
= 0;
1826 bool continue_reading_p
;
1827 Lisp_Object lex_bound
;
1828 /* True if reading an entire buffer. */
1829 bool whole_buffer
= 0;
1830 /* True on the first time around. */
1831 bool first_sexp
= 1;
1832 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1834 if (NILP (Ffboundp (macroexpand
))
1835 /* Don't macroexpand in .elc files, since it should have been done
1836 already. We actually don't know whether we're in a .elc file or not,
1837 so we use circumstantial evidence: .el files normally go through
1838 Vload_source_file_function -> load-with-code-conversion
1840 || EQ (readcharfun
, Qget_file_char
)
1841 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1844 if (MARKERP (readcharfun
))
1847 start
= readcharfun
;
1850 if (BUFFERP (readcharfun
))
1851 b
= XBUFFER (readcharfun
);
1852 else if (MARKERP (readcharfun
))
1853 b
= XMARKER (readcharfun
)->buffer
;
1855 /* We assume START is nil when input is not from a buffer. */
1856 if (! NILP (start
) && !b
)
1859 specbind (Qstandard_input
, readcharfun
);
1860 specbind (Qcurrent_load_list
, Qnil
);
1861 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1862 load_convert_to_unibyte
= !NILP (unibyte
);
1864 /* If lexical binding is active (either because it was specified in
1865 the file's header, or via a buffer-local variable), create an empty
1866 lexical environment, otherwise, turn off lexical binding. */
1867 lex_bound
= find_symbol_value (Qlexical_binding
);
1868 specbind (Qinternal_interpreter_environment
,
1869 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1870 ? Qnil
: list1 (Qt
)));
1872 /* Try to ensure sourcename is a truename, except whilst preloading. */
1873 if (NILP (Vpurify_flag
)
1874 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1875 && !NILP (Ffboundp (Qfile_truename
)))
1876 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1878 LOADHIST_ATTACH (sourcename
);
1880 continue_reading_p
= 1;
1881 while (continue_reading_p
)
1883 ptrdiff_t count1
= SPECPDL_INDEX ();
1885 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1886 error ("Reading from killed buffer");
1890 /* Switch to the buffer we are reading from. */
1891 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1892 set_buffer_internal (b
);
1894 /* Save point in it. */
1895 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1896 /* Save ZV in it. */
1897 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1898 /* Those get unbound after we read one expression. */
1900 /* Set point and ZV around stuff to be read. */
1903 Fnarrow_to_region (make_number (BEGV
), end
);
1905 /* Just for cleanliness, convert END to a marker
1906 if it is an integer. */
1908 end
= Fpoint_max_marker ();
1911 /* On the first cycle, we can easily test here
1912 whether we are reading the whole buffer. */
1913 if (b
&& first_sexp
)
1914 whole_buffer
= (BUF_PT (b
) == BUF_BEG (b
) && BUF_ZV (b
) == BUF_Z (b
));
1921 while ((c
= READCHAR
) != '\n' && c
!= -1);
1926 unbind_to (count1
, Qnil
);
1930 /* Ignore whitespace here, so we can detect eof. */
1931 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1932 || c
== NO_BREAK_SPACE
)
1935 if (! HASH_TABLE_P (read_objects_map
)
1936 || XHASH_TABLE (read_objects_map
)->count
)
1938 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
,
1939 DEFAULT_REHASH_SIZE
, DEFAULT_REHASH_THRESHOLD
,
1941 if (! HASH_TABLE_P (read_objects_completed
)
1942 || XHASH_TABLE (read_objects_completed
)->count
)
1943 read_objects_completed
1944 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
,
1945 DEFAULT_REHASH_SIZE
, DEFAULT_REHASH_THRESHOLD
,
1947 if (!NILP (Vpurify_flag
) && c
== '(')
1949 val
= read_list (0, readcharfun
);
1954 if (!NILP (readfun
))
1956 val
= call1 (readfun
, readcharfun
);
1958 /* If READCHARFUN has set point to ZV, we should
1959 stop reading, even if the form read sets point
1960 to a different value when evaluated. */
1961 if (BUFFERP (readcharfun
))
1963 struct buffer
*buf
= XBUFFER (readcharfun
);
1964 if (BUF_PT (buf
) == BUF_ZV (buf
))
1965 continue_reading_p
= 0;
1968 else if (! NILP (Vload_read_function
))
1969 val
= call1 (Vload_read_function
, readcharfun
);
1971 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1973 /* Empty hashes can be reused; otherwise, reset on next call. */
1974 if (HASH_TABLE_P (read_objects_map
)
1975 && XHASH_TABLE (read_objects_map
)->count
> 0)
1976 read_objects_map
= Qnil
;
1977 if (HASH_TABLE_P (read_objects_completed
)
1978 && XHASH_TABLE (read_objects_completed
)->count
> 0)
1979 read_objects_completed
= Qnil
;
1981 if (!NILP (start
) && continue_reading_p
)
1982 start
= Fpoint_marker ();
1984 /* Restore saved point and BEGV. */
1985 unbind_to (count1
, Qnil
);
1987 /* Now eval what we just read. */
1988 if (!NILP (macroexpand
))
1989 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1991 val
= eval_sub (val
);
1995 Vvalues
= Fcons (val
, Vvalues
);
1996 if (EQ (Vstandard_output
, Qt
))
2005 build_load_history (sourcename
,
2006 stream
|| whole_buffer
);
2008 unbind_to (count
, Qnil
);
2011 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
2012 doc
: /* Execute the accessible portion of current buffer as Lisp code.
2013 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
2014 When called from a Lisp program (i.e., not interactively), this
2015 function accepts up to five optional arguments:
2016 BUFFER is the buffer to evaluate (nil means use current buffer),
2017 or a name of a buffer (a string).
2018 PRINTFLAG controls printing of output by any output functions in the
2019 evaluated code, such as `print', `princ', and `prin1':
2020 a value of nil means discard it; anything else is the stream to print to.
2021 See Info node `(elisp)Output Streams' for details on streams.
2022 FILENAME specifies the file name to use for `load-history'.
2023 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
2025 DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
2026 evaluated code should work normally even if PRINTFLAG is nil, in
2027 which case the output is displayed in the echo area.
2029 This function preserves the position of point. */)
2030 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
2032 ptrdiff_t count
= SPECPDL_INDEX ();
2033 Lisp_Object tem
, buf
;
2036 buf
= Fcurrent_buffer ();
2038 buf
= Fget_buffer (buffer
);
2040 error ("No such buffer");
2042 if (NILP (printflag
) && NILP (do_allow_print
))
2047 if (NILP (filename
))
2048 filename
= BVAR (XBUFFER (buf
), filename
);
2050 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
2051 specbind (Qstandard_output
, tem
);
2052 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
2053 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2054 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
2055 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2056 readevalloop (buf
, 0, filename
,
2057 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
2058 unbind_to (count
, Qnil
);
2063 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2064 doc
: /* Execute the region as Lisp code.
2065 When called from programs, expects two arguments,
2066 giving starting and ending indices in the current buffer
2067 of the text to be executed.
2068 Programs can pass third argument PRINTFLAG which controls output:
2069 a value of nil means discard it; anything else is stream for printing it.
2070 See Info node `(elisp)Output Streams' for details on streams.
2071 Also the fourth argument READ-FUNCTION, if non-nil, is used
2072 instead of `read' to read each expression. It gets one argument
2073 which is the input stream for reading characters.
2075 This function does not move point. */)
2076 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2078 /* FIXME: Do the eval-sexp-add-defvars dance! */
2079 ptrdiff_t count
= SPECPDL_INDEX ();
2080 Lisp_Object tem
, cbuf
;
2082 cbuf
= Fcurrent_buffer ();
2084 if (NILP (printflag
))
2088 specbind (Qstandard_output
, tem
);
2089 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2091 /* `readevalloop' calls functions which check the type of start and end. */
2092 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2093 !NILP (printflag
), Qnil
, read_function
,
2096 return unbind_to (count
, Qnil
);
2100 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2101 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2102 If STREAM is nil, use the value of `standard-input' (which see).
2103 STREAM or the value of `standard-input' may be:
2104 a buffer (read from point and advance it)
2105 a marker (read from where it points and advance it)
2106 a function (call it with no arguments for each character,
2107 call it with a char as argument to push a char back)
2108 a string (takes text from string, starting at the beginning)
2109 t (read text line using minibuffer and use it, or read from
2110 standard input in batch mode). */)
2111 (Lisp_Object stream
)
2114 stream
= Vstandard_input
;
2115 if (EQ (stream
, Qt
))
2116 stream
= Qread_char
;
2117 if (EQ (stream
, Qread_char
))
2118 /* FIXME: ?! When is this used !? */
2119 return call1 (intern ("read-minibuffer"),
2120 build_string ("Lisp expression: "));
2122 return read_internal_start (stream
, Qnil
, Qnil
);
2125 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2126 doc
: /* Read one Lisp expression which is represented as text by STRING.
2127 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2128 FINAL-STRING-INDEX is an integer giving the position of the next
2129 remaining character in STRING. START and END optionally delimit
2130 a substring of STRING from which to read; they default to 0 and
2131 \(length STRING) respectively. Negative values are counted from
2132 the end of STRING. */)
2133 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2136 CHECK_STRING (string
);
2137 /* `read_internal_start' sets `read_from_string_index'. */
2138 ret
= read_internal_start (string
, start
, end
);
2139 return Fcons (ret
, make_number (read_from_string_index
));
2142 /* Function to set up the global context we need in toplevel read
2143 calls. START and END only used when STREAM is a string. */
2145 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2150 new_backquote_flag
= 0;
2151 /* We can get called from readevalloop which may have set these
2153 if (! HASH_TABLE_P (read_objects_map
)
2154 || XHASH_TABLE (read_objects_map
)->count
)
2156 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
, DEFAULT_REHASH_SIZE
,
2157 DEFAULT_REHASH_THRESHOLD
, Qnil
, false);
2158 if (! HASH_TABLE_P (read_objects_completed
)
2159 || XHASH_TABLE (read_objects_completed
)->count
)
2160 read_objects_completed
2161 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
, DEFAULT_REHASH_SIZE
,
2162 DEFAULT_REHASH_THRESHOLD
, Qnil
, false);
2163 if (EQ (Vread_with_symbol_positions
, Qt
)
2164 || EQ (Vread_with_symbol_positions
, stream
))
2165 Vread_symbol_positions_list
= Qnil
;
2167 if (STRINGP (stream
)
2168 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2170 ptrdiff_t startval
, endval
;
2173 if (STRINGP (stream
))
2176 string
= XCAR (stream
);
2178 validate_subarray (string
, start
, end
, SCHARS (string
),
2179 &startval
, &endval
);
2181 read_from_string_index
= startval
;
2182 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2183 read_from_string_limit
= endval
;
2186 retval
= read0 (stream
);
2187 if (EQ (Vread_with_symbol_positions
, Qt
)
2188 || EQ (Vread_with_symbol_positions
, stream
))
2189 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2190 /* Empty hashes can be reused; otherwise, reset on next call. */
2191 if (HASH_TABLE_P (read_objects_map
)
2192 && XHASH_TABLE (read_objects_map
)->count
> 0)
2193 read_objects_map
= Qnil
;
2194 if (HASH_TABLE_P (read_objects_completed
)
2195 && XHASH_TABLE (read_objects_completed
)->count
> 0)
2196 read_objects_completed
= Qnil
;
2201 /* Signal Qinvalid_read_syntax error.
2202 S is error string of length N (if > 0) */
2204 static _Noreturn
void
2205 invalid_syntax (const char *s
)
2207 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2211 /* Use this for recursive reads, in contexts where internal tokens
2215 read0 (Lisp_Object readcharfun
)
2217 register Lisp_Object val
;
2220 val
= read1 (readcharfun
, &c
, 0);
2224 xsignal1 (Qinvalid_read_syntax
,
2225 Fmake_string (make_number (1), make_number (c
)));
2228 /* Grow a read buffer BUF that contains OFFSET useful bytes of data,
2229 by at least MAX_MULTIBYTE_LENGTH bytes. Update *BUF_ADDR and
2230 *BUF_SIZE accordingly; 0 <= OFFSET <= *BUF_SIZE. If *BUF_ADDR is
2231 initially null, BUF is on the stack: copy its data to the new heap
2232 buffer. Otherwise, BUF must equal *BUF_ADDR and can simply be
2233 reallocated. Either way, remember the heap allocation (which is at
2234 pdl slot COUNT) so that it can be freed when unwinding the stack.*/
2237 grow_read_buffer (char *buf
, ptrdiff_t offset
,
2238 char **buf_addr
, ptrdiff_t *buf_size
, ptrdiff_t count
)
2240 char *p
= xpalloc (*buf_addr
, buf_size
, MAX_MULTIBYTE_LENGTH
, -1, 1);
2243 memcpy (p
, buf
, offset
);
2244 record_unwind_protect_ptr (xfree
, p
);
2247 set_unwind_protect_ptr (count
, xfree
, p
);
2252 /* Return the scalar value that has the Unicode character name NAME.
2253 Raise 'invalid-read-syntax' if there is no such character. */
2255 character_name_to_code (char const *name
, ptrdiff_t name_len
)
2257 /* For "U+XXXX", pass the leading '+' to string_to_number to reject
2258 monstrosities like "U+-0000". */
2260 = (name
[0] == 'U' && name
[1] == '+'
2261 ? string_to_number (name
+ 1, 16, false)
2262 : call2 (Qchar_from_name
, make_unibyte_string (name
, name_len
), Qt
));
2264 if (! RANGED_INTEGERP (0, code
, MAX_UNICODE_CHAR
)
2265 || char_surrogate_p (XINT (code
)))
2267 AUTO_STRING (format
, "\\N{%s}");
2268 AUTO_STRING_WITH_LEN (namestr
, name
, name_len
);
2269 xsignal1 (Qinvalid_read_syntax
, CALLN (Fformat
, format
, namestr
));
2275 /* Bound on the length of a Unicode character name. As of
2276 Unicode 9.0.0 the maximum is 83, so this should be safe. */
2277 enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND
= 200 };
2279 /* Read a \-escape sequence, assuming we already read the `\'.
2280 If the escape sequence forces unibyte, return eight-bit char. */
2283 read_escape (Lisp_Object readcharfun
, bool stringp
)
2286 /* \u allows up to four hex digits, \U up to eight. Default to the
2287 behavior for \u, and change this value in the case that \U is seen. */
2288 int unicode_hex_count
= 4;
2293 end_of_file_error ();
2323 error ("Invalid escape character syntax");
2326 c
= read_escape (readcharfun
, 0);
2327 return c
| meta_modifier
;
2332 error ("Invalid escape character syntax");
2335 c
= read_escape (readcharfun
, 0);
2336 return c
| shift_modifier
;
2341 error ("Invalid escape character syntax");
2344 c
= read_escape (readcharfun
, 0);
2345 return c
| hyper_modifier
;
2350 error ("Invalid escape character syntax");
2353 c
= read_escape (readcharfun
, 0);
2354 return c
| alt_modifier
;
2358 if (stringp
|| c
!= '-')
2365 c
= read_escape (readcharfun
, 0);
2366 return c
| super_modifier
;
2371 error ("Invalid escape character syntax");
2376 c
= read_escape (readcharfun
, 0);
2377 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2378 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2379 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2380 return c
| ctrl_modifier
;
2381 /* ASCII control chars are made from letters (both cases),
2382 as well as the non-letters within 0100...0137. */
2383 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2384 return (c
& (037 | ~0177));
2385 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2386 return (c
& (037 | ~0177));
2388 return c
| ctrl_modifier
;
2398 /* An octal escape, as in ANSI C. */
2400 register int i
= c
- '0';
2401 register int count
= 0;
2404 if ((c
= READCHAR
) >= '0' && c
<= '7')
2416 if (i
>= 0x80 && i
< 0x100)
2417 i
= BYTE8_TO_CHAR (i
);
2422 /* A hex escape, as in ANSI C. */
2429 if (c
>= '0' && c
<= '9')
2434 else if ((c
>= 'a' && c
<= 'f')
2435 || (c
>= 'A' && c
<= 'F'))
2438 if (c
>= 'a' && c
<= 'f')
2448 /* Allow hex escapes as large as ?\xfffffff, because some
2449 packages use them to denote characters with modifiers. */
2450 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2451 error ("Hex character out of range: \\x%x...", i
);
2455 if (count
< 3 && i
>= 0x80)
2456 return BYTE8_TO_CHAR (i
);
2461 /* Post-Unicode-2.0: Up to eight hex chars. */
2462 unicode_hex_count
= 8;
2466 /* A Unicode escape. We only permit them in strings and characters,
2467 not arbitrarily in the source code, as in some other languages. */
2472 while (++count
<= unicode_hex_count
)
2475 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2477 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2478 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2479 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2481 error ("Non-hex digit used for Unicode escape");
2484 error ("Non-Unicode character: 0x%x", i
);
2489 /* Named character. */
2493 invalid_syntax ("Expected opening brace after \\N");
2494 char name
[UNICODE_CHARACTER_NAME_LENGTH_BOUND
+ 1];
2495 bool whitespace
= false;
2496 ptrdiff_t length
= 0;
2501 end_of_file_error ();
2504 if (! (0 < c
&& c
< 0x80))
2506 AUTO_STRING (format
,
2507 "Invalid character U+%04X in character name");
2508 xsignal1 (Qinvalid_read_syntax
,
2509 CALLN (Fformat
, format
, make_natnum (c
)));
2511 /* Treat multiple adjacent whitespace characters as a
2512 single space character. This makes it easier to use
2513 character names in e.g. multi-line strings. */
2524 if (length
>= sizeof name
)
2525 invalid_syntax ("Character name too long");
2528 invalid_syntax ("Empty character name");
2529 name
[length
] = '\0';
2531 /* character_name_to_code can invoke read1, recursively.
2532 This is why read1's buffer is not static. */
2533 return character_name_to_code (name
, length
);
2541 /* Return the digit that CHARACTER stands for in the given BASE.
2542 Return -1 if CHARACTER is out of range for BASE,
2543 and -2 if CHARACTER is not valid for any supported BASE. */
2545 digit_to_number (int character
, int base
)
2549 if ('0' <= character
&& character
<= '9')
2550 digit
= character
- '0';
2551 else if ('a' <= character
&& character
<= 'z')
2552 digit
= character
- 'a' + 10;
2553 else if ('A' <= character
&& character
<= 'Z')
2554 digit
= character
- 'A' + 10;
2558 return digit
< base
? digit
: -1;
2561 /* Read an integer in radix RADIX using READCHARFUN to read
2562 characters. RADIX must be in the interval [2..36]; if it isn't, a
2563 read error is signaled . Value is the integer read. Signals an
2564 error if encountering invalid read syntax or if RADIX is out of
2568 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2570 /* Room for sign, leading 0, other digits, trailing null byte.
2571 Also, room for invalid syntax diagnostic. */
2572 char buf
[max (1 + 1 + UINTMAX_WIDTH
+ 1,
2573 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2575 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2577 if (radix
< 2 || radix
> 36)
2585 if (c
== '-' || c
== '+')
2596 /* Ignore redundant leading zeros, so the buffer doesn't
2597 fill up with them. */
2603 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2610 if (p
< buf
+ sizeof buf
- 1)
2624 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2625 invalid_syntax (buf
);
2628 return string_to_number (buf
, radix
, 0);
2632 /* If the next token is ')' or ']' or '.', we store that character
2633 in *PCH and the return value is not interesting. Else, we store
2634 zero in *PCH and we read and return one lisp object.
2636 FIRST_IN_LIST is true if this is the first element of a list. */
2639 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2642 bool uninterned_symbol
= false;
2644 char stackbuf
[MAX_ALLOCA
];
2650 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2652 end_of_file_error ();
2657 return read_list (0, readcharfun
);
2660 return read_vector (readcharfun
, 0);
2676 /* Accept extended format for hash tables (extensible to
2678 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2679 Lisp_Object tmp
= read_list (0, readcharfun
);
2680 Lisp_Object head
= CAR_SAFE (tmp
);
2681 Lisp_Object data
= Qnil
;
2682 Lisp_Object val
= Qnil
;
2683 /* The size is 2 * number of allowed keywords to
2685 Lisp_Object params
[12];
2687 Lisp_Object key
= Qnil
;
2688 int param_count
= 0;
2690 if (!EQ (head
, Qhash_table
))
2692 ptrdiff_t size
= XINT (Flength (tmp
));
2693 Lisp_Object record
= Fmake_record (CAR_SAFE (tmp
),
2694 make_number (size
- 1),
2696 for (int i
= 1; i
< size
; i
++)
2699 ASET (record
, i
, Fcar (tmp
));
2704 tmp
= CDR_SAFE (tmp
);
2706 /* This is repetitive but fast and simple. */
2707 params
[param_count
] = QCsize
;
2708 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2709 if (!NILP (params
[param_count
+ 1]))
2712 params
[param_count
] = QCtest
;
2713 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2714 if (!NILP (params
[param_count
+ 1]))
2717 params
[param_count
] = QCweakness
;
2718 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2719 if (!NILP (params
[param_count
+ 1]))
2722 params
[param_count
] = QCrehash_size
;
2723 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2724 if (!NILP (params
[param_count
+ 1]))
2727 params
[param_count
] = QCrehash_threshold
;
2728 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2729 if (!NILP (params
[param_count
+ 1]))
2732 params
[param_count
] = QCpurecopy
;
2733 params
[param_count
+ 1] = Fplist_get (tmp
, Qpurecopy
);
2734 if (!NILP (params
[param_count
+ 1]))
2737 /* This is the hash table data. */
2738 data
= Fplist_get (tmp
, Qdata
);
2740 /* Now use params to make a new hash table and fill it. */
2741 ht
= Fmake_hash_table (param_count
, params
);
2743 while (CONSP (data
))
2748 error ("Odd number of elements in hash table data");
2751 Fputhash (key
, val
, ht
);
2757 invalid_syntax ("#");
2765 tmp
= read_vector (readcharfun
, 0);
2766 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2767 error ("Invalid size char-table");
2768 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2776 /* Sub char-table can't be read as a regular
2777 vector because of a two C integer fields. */
2778 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2779 ptrdiff_t size
= XINT (Flength (tmp
));
2780 int i
, depth
, min_char
;
2781 struct Lisp_Cons
*cell
;
2784 error ("Zero-sized sub char-table");
2786 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2787 error ("Invalid depth in sub char-table");
2788 depth
= XINT (XCAR (tmp
));
2789 if (chartab_size
[depth
] != size
- 2)
2790 error ("Invalid size in sub char-table");
2791 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2794 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2795 error ("Invalid minimum character in sub-char-table");
2796 min_char
= XINT (XCAR (tmp
));
2797 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2800 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2801 for (i
= 0; i
< size
; i
++)
2803 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2804 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2809 invalid_syntax ("#^^");
2811 invalid_syntax ("#^");
2816 length
= read1 (readcharfun
, pch
, first_in_list
);
2820 Lisp_Object tmp
, val
;
2821 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2822 unsigned char *data
;
2825 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2826 if (STRING_MULTIBYTE (tmp
)
2827 || (size_in_chars
!= SCHARS (tmp
)
2828 /* We used to print 1 char too many
2829 when the number of bits was a multiple of 8.
2830 Accept such input in case it came from an old
2832 && ! (XFASTINT (length
)
2833 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2834 invalid_syntax ("#&...");
2836 val
= make_uninit_bool_vector (XFASTINT (length
));
2837 data
= bool_vector_uchar_data (val
);
2838 memcpy (data
, SDATA (tmp
), size_in_chars
);
2839 /* Clear the extraneous bits in the last byte. */
2840 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2841 data
[size_in_chars
- 1]
2842 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2845 invalid_syntax ("#&...");
2849 /* Accept compiled functions at read-time so that we don't have to
2850 build them using function calls. */
2852 struct Lisp_Vector
*vec
;
2853 tmp
= read_vector (readcharfun
, 1);
2854 vec
= XVECTOR (tmp
);
2855 if (vec
->header
.size
== 0)
2856 invalid_syntax ("Empty byte-code object");
2857 make_byte_code (vec
);
2865 /* Read the string itself. */
2866 tmp
= read1 (readcharfun
, &ch
, 0);
2867 if (ch
!= 0 || !STRINGP (tmp
))
2868 invalid_syntax ("#");
2869 /* Read the intervals and their properties. */
2872 Lisp_Object beg
, end
, plist
;
2874 beg
= read1 (readcharfun
, &ch
, 0);
2879 end
= read1 (readcharfun
, &ch
, 0);
2881 plist
= read1 (readcharfun
, &ch
, 0);
2883 invalid_syntax ("Invalid string property list");
2884 Fset_text_properties (beg
, end
, plist
, tmp
);
2890 /* #@NUMBER is used to skip NUMBER following bytes.
2891 That's used in .elc files to skip over doc strings
2892 and function definitions. */
2895 enum { extra
= 100 };
2896 ptrdiff_t i
, nskip
= 0, digits
= 0;
2898 /* Read a decimal integer. */
2899 while ((c
= READCHAR
) >= 0
2900 && c
>= '0' && c
<= '9')
2902 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2907 if (digits
== 2 && nskip
== 0)
2908 { /* We've just seen #@00, which means "skip to end". */
2909 skip_dyn_eof (readcharfun
);
2914 /* We can't use UNREAD here, because in the code below we side-step
2915 READCHAR. Instead, assume the first char after #@NNN occupies
2916 a single byte, which is the case normally since it's just
2922 if (load_force_doc_strings
2923 && (FROM_FILE_P (readcharfun
)))
2925 /* If we are supposed to force doc strings into core right now,
2926 record the last string that we skipped,
2927 and record where in the file it comes from. */
2929 /* But first exchange saved_doc_string
2930 with prev_saved_doc_string, so we save two strings. */
2932 char *temp
= saved_doc_string
;
2933 ptrdiff_t temp_size
= saved_doc_string_size
;
2934 file_offset temp_pos
= saved_doc_string_position
;
2935 ptrdiff_t temp_len
= saved_doc_string_length
;
2937 saved_doc_string
= prev_saved_doc_string
;
2938 saved_doc_string_size
= prev_saved_doc_string_size
;
2939 saved_doc_string_position
= prev_saved_doc_string_position
;
2940 saved_doc_string_length
= prev_saved_doc_string_length
;
2942 prev_saved_doc_string
= temp
;
2943 prev_saved_doc_string_size
= temp_size
;
2944 prev_saved_doc_string_position
= temp_pos
;
2945 prev_saved_doc_string_length
= temp_len
;
2948 if (saved_doc_string_size
== 0)
2950 saved_doc_string
= xmalloc (nskip
+ extra
);
2951 saved_doc_string_size
= nskip
+ extra
;
2953 if (nskip
> saved_doc_string_size
)
2955 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2956 saved_doc_string_size
= nskip
+ extra
;
2959 saved_doc_string_position
= file_tell (instream
);
2961 /* Copy that many characters into saved_doc_string. */
2963 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2964 saved_doc_string
[i
] = c
= getc_unlocked (instream
);
2967 saved_doc_string_length
= i
;
2970 /* Skip that many bytes. */
2971 skip_dyn_bytes (readcharfun
, nskip
);
2977 /* #! appears at the beginning of an executable file.
2978 Skip the first line. */
2979 while (c
!= '\n' && c
>= 0)
2984 return Vload_file_name
;
2986 return list2 (Qfunction
, read0 (readcharfun
));
2987 /* #:foo is the uninterned symbol named foo. */
2990 uninterned_symbol
= true;
2993 && c
!= NO_BREAK_SPACE
2995 || strchr ("\"';()[]#`,", c
) == NULL
)))
2997 /* No symbol character follows, this is the empty
3000 return Fmake_symbol (empty_unibyte_string
);
3004 /* ## is the empty symbol. */
3006 return Fintern (empty_unibyte_string
, Qnil
);
3007 /* Reader forms that can reuse previously read objects. */
3008 if (c
>= '0' && c
<= '9')
3012 bool overflow
= false;
3014 /* Read a non-negative integer. */
3015 while (c
>= '0' && c
<= '9')
3017 overflow
|= INT_MULTIPLY_WRAPV (n
, 10, &n
);
3018 overflow
|= INT_ADD_WRAPV (n
, c
- '0', &n
);
3022 if (!overflow
&& n
<= MOST_POSITIVE_FIXNUM
)
3024 if (c
== 'r' || c
== 'R')
3025 return read_integer (readcharfun
, n
);
3027 if (! NILP (Vread_circle
))
3029 /* #n=object returns object, but associates it with
3033 /* Make a placeholder for #n# to use temporarily. */
3034 /* Note: We used to use AUTO_CONS to allocate
3035 placeholder, but that is a bad idea, since it
3036 will place a stack-allocated cons cell into
3037 the list in read_objects_map, which is a
3038 staticpro'd global variable, and thus each of
3039 its elements is marked during each GC. A
3040 stack-allocated object will become garbled
3041 when its stack slot goes out of scope, and
3042 some other function reuses it for entirely
3043 different purposes, which will cause crashes
3045 Lisp_Object placeholder
= Fcons (Qnil
, Qnil
);
3046 struct Lisp_Hash_Table
*h
3047 = XHASH_TABLE (read_objects_map
);
3049 Lisp_Object number
= make_number (n
);
3051 ptrdiff_t i
= hash_lookup (h
, number
, &hash
);
3053 /* Not normal, but input could be malformed. */
3054 set_hash_value_slot (h
, i
, placeholder
);
3056 hash_put (h
, number
, placeholder
, hash
);
3058 /* Read the object itself. */
3059 tem
= read0 (readcharfun
);
3061 /* If it can be recursive, remember it for
3062 future substitutions. */
3065 && ! (STRINGP (tem
) && !string_intervals (tem
)))
3067 struct Lisp_Hash_Table
*h2
3068 = XHASH_TABLE (read_objects_completed
);
3069 i
= hash_lookup (h2
, tem
, &hash
);
3071 hash_put (h2
, tem
, Qnil
, hash
);
3074 /* Now put it everywhere the placeholder was... */
3077 Fsetcar (placeholder
, XCAR (tem
));
3078 Fsetcdr (placeholder
, XCDR (tem
));
3083 Fsubstitute_object_in_subtree (tem
, placeholder
);
3085 /* ...and #n# will use the real value from now on. */
3086 i
= hash_lookup (h
, number
, &hash
);
3088 set_hash_value_slot (h
, i
, tem
);
3094 /* #n# returns a previously read object. */
3097 struct Lisp_Hash_Table
*h
3098 = XHASH_TABLE (read_objects_map
);
3099 ptrdiff_t i
= hash_lookup (h
, make_number (n
), NULL
);
3101 return HASH_VALUE (h
, i
);
3105 /* Fall through to error message. */
3107 else if (c
== 'x' || c
== 'X')
3108 return read_integer (readcharfun
, 16);
3109 else if (c
== 'o' || c
== 'O')
3110 return read_integer (readcharfun
, 8);
3111 else if (c
== 'b' || c
== 'B')
3112 return read_integer (readcharfun
, 2);
3115 invalid_syntax ("#");
3118 while ((c
= READCHAR
) >= 0 && c
!= '\n');
3122 return list2 (Qquote
, read0 (readcharfun
));
3126 int next_char
= READCHAR
;
3128 /* Transition from old-style to new-style:
3129 If we see "(`" it used to mean old-style, which usually works
3130 fine because ` should almost never appear in such a position
3131 for new-style. But occasionally we need "(`" to mean new
3132 style, so we try to distinguish the two by the fact that we
3133 can either write "( `foo" or "(` foo", where the first
3134 intends to use new-style whereas the second intends to use
3135 old-style. For Emacs-25, we should completely remove this
3136 first_in_list exception (old-style can still be obtained via
3138 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
3140 Vlread_old_style_backquotes
= Qt
;
3146 bool saved_new_backquote_flag
= new_backquote_flag
;
3148 new_backquote_flag
= 1;
3149 value
= read0 (readcharfun
);
3150 new_backquote_flag
= saved_new_backquote_flag
;
3152 return list2 (Qbackquote
, value
);
3157 int next_char
= READCHAR
;
3159 /* Transition from old-style to new-style:
3160 It used to be impossible to have a new-style , other than within
3161 a new-style `. This is sufficient when ` and , are used in the
3162 normal way, but ` and , can also appear in args to macros that
3163 will not interpret them in the usual way, in which case , may be
3164 used without any ` anywhere near.
3165 So we now use the same heuristic as for backquote: old-style
3166 unquotes are only recognized when first on a list, and when
3167 followed by a space.
3168 Because it's more difficult to peek 2 chars ahead, a new-style
3169 ,@ can still not be used outside of a `, unless it's in the middle
3171 if (new_backquote_flag
3173 || (next_char
!= ' ' && next_char
!= '@'))
3175 Lisp_Object comma_type
= Qnil
;
3180 comma_type
= Qcomma_at
;
3182 comma_type
= Qcomma_dot
;
3185 if (ch
>= 0) UNREAD (ch
);
3186 comma_type
= Qcomma
;
3189 value
= read0 (readcharfun
);
3190 return list2 (comma_type
, value
);
3194 Vlread_old_style_backquotes
= Qt
;
3206 end_of_file_error ();
3208 /* Accept `single space' syntax like (list ? x) where the
3209 whitespace character is SPC or TAB.
3210 Other literal whitespace like NL, CR, and FF are not accepted,
3211 as there are well-established escape sequences for these. */
3212 if (c
== ' ' || c
== '\t')
3213 return make_number (c
);
3215 if (c
== '(' || c
== ')' || c
== '[' || c
== ']'
3216 || c
== '"' || c
== ';')
3218 CHECK_LIST (Vlread_unescaped_character_literals
);
3219 Lisp_Object char_obj
= make_natnum (c
);
3220 if (NILP (Fmemq (char_obj
, Vlread_unescaped_character_literals
)))
3221 Vlread_unescaped_character_literals
=
3222 Fcons (char_obj
, Vlread_unescaped_character_literals
);
3226 c
= read_escape (readcharfun
, 0);
3227 modifiers
= c
& CHAR_MODIFIER_MASK
;
3228 c
&= ~CHAR_MODIFIER_MASK
;
3229 if (CHAR_BYTE8_P (c
))
3230 c
= CHAR_TO_BYTE8 (c
);
3233 next_char
= READCHAR
;
3234 ok
= (next_char
<= 040
3235 || (next_char
< 0200
3236 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3239 return make_number (c
);
3241 invalid_syntax ("?");
3246 ptrdiff_t count
= SPECPDL_INDEX ();
3247 char *read_buffer
= stackbuf
;
3248 ptrdiff_t read_buffer_size
= sizeof stackbuf
;
3249 char *heapbuf
= NULL
;
3250 char *p
= read_buffer
;
3251 char *end
= read_buffer
+ read_buffer_size
;
3253 /* True if we saw an escape sequence specifying
3254 a multibyte character. */
3255 bool force_multibyte
= false;
3256 /* True if we saw an escape sequence specifying
3257 a single-byte character. */
3258 bool force_singlebyte
= false;
3259 bool cancel
= false;
3260 ptrdiff_t nchars
= 0;
3262 while ((ch
= READCHAR
) >= 0
3265 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3267 ptrdiff_t offset
= p
- read_buffer
;
3268 read_buffer
= grow_read_buffer (read_buffer
, offset
,
3269 &heapbuf
, &read_buffer_size
,
3271 p
= read_buffer
+ offset
;
3272 end
= read_buffer
+ read_buffer_size
;
3279 ch
= read_escape (readcharfun
, 1);
3281 /* CH is -1 if \ newline or \ space has just been seen. */
3284 if (p
== read_buffer
)
3289 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3290 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3292 if (CHAR_BYTE8_P (ch
))
3293 force_singlebyte
= true;
3294 else if (! ASCII_CHAR_P (ch
))
3295 force_multibyte
= true;
3296 else /* I.e. ASCII_CHAR_P (ch). */
3298 /* Allow `\C- ' and `\C-?'. */
3299 if (modifiers
== CHAR_CTL
)
3302 ch
= 0, modifiers
= 0;
3304 ch
= 127, modifiers
= 0;
3306 if (modifiers
& CHAR_SHIFT
)
3308 /* Shift modifier is valid only with [A-Za-z]. */
3309 if (ch
>= 'A' && ch
<= 'Z')
3310 modifiers
&= ~CHAR_SHIFT
;
3311 else if (ch
>= 'a' && ch
<= 'z')
3312 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3315 if (modifiers
& CHAR_META
)
3317 /* Move the meta bit to the right place for a
3319 modifiers
&= ~CHAR_META
;
3320 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3321 force_singlebyte
= true;
3325 /* Any modifiers remaining are invalid. */
3327 error ("Invalid modifier in string");
3328 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3332 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3333 if (CHAR_BYTE8_P (ch
))
3334 force_singlebyte
= true;
3335 else if (! ASCII_CHAR_P (ch
))
3336 force_multibyte
= true;
3342 end_of_file_error ();
3344 /* If purifying, and string starts with \ newline,
3345 return zero instead. This is for doc strings
3346 that we are really going to find in etc/DOC.nn.nn. */
3347 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3348 return unbind_to (count
, make_number (0));
3350 if (! force_multibyte
&& force_singlebyte
)
3352 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3353 forms. Convert it to unibyte. */
3354 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3356 p
= read_buffer
+ nchars
;
3360 = make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3362 || (p
- read_buffer
!= nchars
)));
3363 return unbind_to (count
, result
);
3368 int next_char
= READCHAR
;
3371 if (next_char
<= 040
3372 || (next_char
< 0200
3373 && strchr ("\"';([#?`,", next_char
) != NULL
))
3379 /* The atom-reading loop below will now loop at least once,
3380 assuring that we will not try to UNREAD two characters in a
3385 if (c
<= 040) goto retry
;
3386 if (c
== NO_BREAK_SPACE
)
3391 ptrdiff_t count
= SPECPDL_INDEX ();
3392 char *read_buffer
= stackbuf
;
3393 ptrdiff_t read_buffer_size
= sizeof stackbuf
;
3394 char *heapbuf
= NULL
;
3395 char *p
= read_buffer
;
3396 char *end
= read_buffer
+ read_buffer_size
;
3397 bool quoted
= false;
3398 EMACS_INT start_position
= readchar_count
- 1;
3402 if (end
- p
< MAX_MULTIBYTE_LENGTH
+ 1)
3404 ptrdiff_t offset
= p
- read_buffer
;
3405 read_buffer
= grow_read_buffer (read_buffer
, offset
,
3406 &heapbuf
, &read_buffer_size
,
3408 p
= read_buffer
+ offset
;
3409 end
= read_buffer
+ read_buffer_size
;
3416 end_of_file_error ();
3421 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3427 && c
!= NO_BREAK_SPACE
3429 || strchr ("\"';()[]#`,", c
) == NULL
));
3434 if (!quoted
&& !uninterned_symbol
)
3436 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3437 if (! NILP (result
))
3438 return unbind_to (count
, result
);
3442 ptrdiff_t nbytes
= p
- read_buffer
;
3445 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3449 if (uninterned_symbol
)
3452 = ((! NILP (Vpurify_flag
)
3453 ? make_pure_string
: make_specified_string
)
3454 (read_buffer
, nchars
, nbytes
, multibyte
));
3455 result
= Fmake_symbol (name
);
3459 /* Don't create the string object for the name unless
3460 we're going to retain it in a new symbol.
3462 Like intern_1 but supports multibyte names. */
3463 Lisp_Object obarray
= check_obarray (Vobarray
);
3464 Lisp_Object tem
= oblookup (obarray
, read_buffer
,
3472 = make_specified_string (read_buffer
, nchars
, nbytes
,
3474 result
= intern_driver (name
, obarray
, tem
);
3478 if (EQ (Vread_with_symbol_positions
, Qt
)
3479 || EQ (Vread_with_symbol_positions
, readcharfun
))
3480 Vread_symbol_positions_list
3481 = Fcons (Fcons (result
, make_number (start_position
)),
3482 Vread_symbol_positions_list
);
3483 return unbind_to (count
, result
);
3490 /* List of nodes we've seen during substitute_object_in_subtree. */
3491 static Lisp_Object seen_list
;
3493 DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree
,
3494 Ssubstitute_object_in_subtree
, 2, 2, 0,
3495 doc
: /* Replace every reference to PLACEHOLDER in OBJECT with OBJECT. */)
3496 (Lisp_Object object
, Lisp_Object placeholder
)
3498 Lisp_Object check_object
;
3500 /* We haven't seen any objects when we start. */
3503 /* Make all the substitutions. */
3505 = substitute_object_recurse (object
, placeholder
, object
);
3507 /* Clear seen_list because we're done with it. */
3510 /* The returned object here is expected to always eq the
3512 if (!EQ (check_object
, object
))
3513 error ("Unexpected mutation error in reader");
3517 /* Feval doesn't get called from here, so no gc protection is needed. */
3518 #define SUBSTITUTE(get_val, set_val) \
3520 Lisp_Object old_value = get_val; \
3521 Lisp_Object true_value \
3522 = substitute_object_recurse (object, placeholder, \
3525 if (!EQ (old_value, true_value)) \
3532 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3534 /* If we find the placeholder, return the target object. */
3535 if (EQ (placeholder
, subtree
))
3538 /* For common object types that can't contain other objects, don't
3539 bother looking them up; we're done. */
3540 if (SYMBOLP (subtree
)
3541 || (STRINGP (subtree
) && !string_intervals (subtree
))
3542 || NUMBERP (subtree
))
3545 /* If we've been to this node before, don't explore it again. */
3546 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3549 /* If this node can be the entry point to a cycle, remember that
3550 we've seen it. It can only be such an entry point if it was made
3551 by #n=, which means that we can find it as a value in
3552 read_objects_completed. */
3553 if (hash_lookup (XHASH_TABLE (read_objects_completed
), subtree
, NULL
) >= 0)
3554 seen_list
= Fcons (subtree
, seen_list
);
3556 /* Recurse according to subtree's type.
3557 Every branch must return a Lisp_Object. */
3558 switch (XTYPE (subtree
))
3560 case Lisp_Vectorlike
:
3562 ptrdiff_t i
= 0, length
= 0;
3563 if (BOOL_VECTOR_P (subtree
))
3564 return subtree
; /* No sub-objects anyway. */
3565 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3566 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
)
3567 || RECORDP (subtree
))
3568 length
= PVSIZE (subtree
);
3569 else if (VECTORP (subtree
))
3570 length
= ASIZE (subtree
);
3572 /* An unknown pseudovector may contain non-Lisp fields, so we
3573 can't just blindly traverse all its fields. We used to call
3574 `Flength' which signaled `sequencep', so I just preserved this
3576 wrong_type_argument (Qsequencep
, subtree
);
3578 if (SUB_CHAR_TABLE_P (subtree
))
3580 for ( ; i
< length
; i
++)
3581 SUBSTITUTE (AREF (subtree
, i
),
3582 ASET (subtree
, i
, true_value
));
3588 SUBSTITUTE (XCAR (subtree
),
3589 XSETCAR (subtree
, true_value
));
3590 SUBSTITUTE (XCDR (subtree
),
3591 XSETCDR (subtree
, true_value
));
3597 /* Check for text properties in each interval.
3598 substitute_in_interval contains part of the logic. */
3600 INTERVAL root_interval
= string_intervals (subtree
);
3601 AUTO_CONS (arg
, object
, placeholder
);
3603 traverse_intervals_noorder (root_interval
,
3604 &substitute_in_interval
, arg
);
3609 /* Other types don't recurse any further. */
3615 /* Helper function for substitute_object_recurse. */
3617 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3619 Lisp_Object object
= Fcar (arg
);
3620 Lisp_Object placeholder
= Fcdr (arg
);
3622 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3626 /* Convert STRING to a number, assuming base BASE. Return a fixnum if
3627 STRING has integer syntax and fits in a fixnum, else return the
3628 nearest float if STRING has either floating point or integer syntax
3629 and BASE is 10, else return nil. If IGNORE_TRAILING, consider just
3630 the longest prefix of STRING that has valid floating point syntax.
3631 Signal an overflow if BASE is not 10 and the number has integer
3632 syntax but does not fit. */
3635 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3637 char const *cp
= string
;
3638 bool float_syntax
= 0;
3641 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3642 IEEE floating point hosts, and works around a formerly-common bug where
3643 atof ("-0.0") drops the sign. */
3644 bool negative
= *cp
== '-';
3646 bool signedp
= negative
|| *cp
== '+';
3649 enum { INTOVERFLOW
= 1, LEAD_INT
= 2, DOT_CHAR
= 4, TRAIL_INT
= 8,
3652 int leading_digit
= digit_to_number (*cp
, base
);
3653 uintmax_t n
= leading_digit
;
3654 if (leading_digit
>= 0)
3657 for (int digit
; 0 <= (digit
= digit_to_number (*++cp
, base
)); )
3659 if (INT_MULTIPLY_OVERFLOW (n
, base
))
3660 state
|= INTOVERFLOW
;
3662 if (INT_ADD_OVERFLOW (n
, digit
))
3663 state
|= INTOVERFLOW
;
3675 if ('0' <= *cp
&& *cp
<= '9')
3680 while ('0' <= *cp
&& *cp
<= '9');
3682 if (*cp
== 'e' || *cp
== 'E')
3684 char const *ecp
= cp
;
3686 if (*cp
== '+' || *cp
== '-')
3688 if ('0' <= *cp
&& *cp
<= '9')
3693 while ('0' <= *cp
&& *cp
<= '9');
3695 else if (cp
[-1] == '+'
3696 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3702 else if (cp
[-1] == '+'
3703 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3707 /* NAN is a "positive" NaN on all known Emacs hosts. */
3714 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3715 || (state
& ~INTOVERFLOW
) == (LEAD_INT
|E_EXP
));
3718 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3719 any prefix that matches. Otherwise, the entire string must match. */
3720 if (! (ignore_trailing
3721 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3722 : (!*cp
&& ((state
& ~(INTOVERFLOW
| DOT_CHAR
)) == LEAD_INT
3726 /* If the number uses integer and not float syntax, and is in C-language
3727 range, use its value, preferably as a fixnum. */
3728 if (leading_digit
>= 0 && ! float_syntax
)
3730 if (state
& INTOVERFLOW
)
3732 /* Unfortunately there's no simple and accurate way to convert
3733 non-base-10 numbers that are out of C-language range. */
3735 xsignal1 (Qoverflow_error
, build_string (string
));
3737 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3739 EMACS_INT signed_n
= n
;
3740 return make_number (negative
? -signed_n
: signed_n
);
3746 /* Either the number uses float syntax, or it does not fit into a fixnum.
3747 Convert it from string to floating point, unless the value is already
3748 known because it is an infinity, a NAN, or its absolute value fits in
3751 value
= atof (string
+ signedp
);
3753 return make_float (negative
? -value
: value
);
3758 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3762 Lisp_Object tem
, item
, vector
;
3763 struct Lisp_Cons
*otem
;
3766 tem
= read_list (1, readcharfun
);
3767 len
= Flength (tem
);
3768 vector
= Fmake_vector (len
, Qnil
);
3770 size
= ASIZE (vector
);
3771 ptr
= XVECTOR (vector
)->contents
;
3772 for (i
= 0; i
< size
; i
++)
3775 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3776 bytecode object, the docstring containing the bytecode and
3777 constants values must be treated as unibyte and passed to
3778 Fread, to get the actual bytecode string and constants vector. */
3779 if (bytecodeflag
&& load_force_doc_strings
)
3781 if (i
== COMPILED_BYTECODE
)
3783 if (!STRINGP (item
))
3784 error ("Invalid byte code");
3786 /* Delay handling the bytecode slot until we know whether
3787 it is lazily-loaded (we can tell by whether the
3788 constants slot is nil). */
3789 ASET (vector
, COMPILED_CONSTANTS
, item
);
3792 else if (i
== COMPILED_CONSTANTS
)
3794 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3798 /* Coerce string to unibyte (like string-as-unibyte,
3799 but without generating extra garbage and
3800 guaranteeing no change in the contents). */
3801 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3802 STRING_SET_UNIBYTE (bytestr
);
3804 item
= Fread (Fcons (bytestr
, readcharfun
));
3806 error ("Invalid byte code");
3808 otem
= XCONS (item
);
3809 bytestr
= XCAR (item
);
3814 /* Now handle the bytecode slot. */
3815 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3817 else if (i
== COMPILED_DOC_STRING
3819 && ! STRING_MULTIBYTE (item
))
3821 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3822 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3824 item
= Fstring_as_multibyte (item
);
3827 ASET (vector
, i
, item
);
3835 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3838 read_list (bool flag
, Lisp_Object readcharfun
)
3840 Lisp_Object val
, tail
;
3841 Lisp_Object elt
, tem
;
3842 /* 0 is the normal case.
3843 1 means this list is a doc reference; replace it with the number 0.
3844 2 means this list is a doc reference; replace it with the doc string. */
3845 int doc_reference
= 0;
3847 /* Initialize this to 1 if we are reading a list. */
3848 bool first_in_list
= flag
<= 0;
3856 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3860 /* While building, if the list starts with #$, treat it specially. */
3861 if (EQ (elt
, Vload_file_name
)
3863 && !NILP (Vpurify_flag
))
3865 if (NILP (Vdoc_file_name
))
3866 /* We have not yet called Snarf-documentation, so assume
3867 this file is described in the DOC file
3868 and Snarf-documentation will fill in the right value later.
3869 For now, replace the whole list with 0. */
3872 /* We have already called Snarf-documentation, so make a relative
3873 file name for this file, so it can be found properly
3874 in the installed Lisp directory.
3875 We don't use Fexpand_file_name because that would make
3876 the directory absolute now. */
3878 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3879 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3882 else if (EQ (elt
, Vload_file_name
)
3884 && load_force_doc_strings
)
3893 invalid_syntax (") or . in a vector");
3900 XSETCDR (tail
, read0 (readcharfun
));
3902 val
= read0 (readcharfun
);
3903 read1 (readcharfun
, &ch
, 0);
3907 if (doc_reference
== 1)
3908 return make_number (0);
3909 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3912 file_offset saved_position
;
3913 /* Get a doc string from the file we are loading.
3914 If it's in saved_doc_string, get it from there.
3916 Here, we don't know if the string is a
3917 bytecode string or a doc string. As a
3918 bytecode string must be unibyte, we always
3919 return a unibyte string. If it is actually a
3920 doc string, caller must make it
3923 /* Position is negative for user variables. */
3924 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3925 if (pos
>= saved_doc_string_position
3926 && pos
< (saved_doc_string_position
3927 + saved_doc_string_length
))
3929 saved
= saved_doc_string
;
3930 saved_position
= saved_doc_string_position
;
3932 /* Look in prev_saved_doc_string the same way. */
3933 else if (pos
>= prev_saved_doc_string_position
3934 && pos
< (prev_saved_doc_string_position
3935 + prev_saved_doc_string_length
))
3937 saved
= prev_saved_doc_string
;
3938 saved_position
= prev_saved_doc_string_position
;
3942 ptrdiff_t start
= pos
- saved_position
;
3945 /* Process quoting with ^A,
3946 and find the end of the string,
3947 which is marked with ^_ (037). */
3948 for (from
= start
, to
= start
;
3949 saved
[from
] != 037;)
3951 int c
= saved
[from
++];
3955 saved
[to
++] = (c
== 1 ? c
3964 return make_unibyte_string (saved
+ start
,
3968 return get_doc_string (val
, 1, 0);
3973 invalid_syntax (". in wrong context");
3975 invalid_syntax ("] in a list");
3979 XSETCDR (tail
, tem
);
3986 static Lisp_Object initial_obarray
;
3988 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3990 static size_t oblookup_last_bucket_number
;
3992 /* Get an error if OBARRAY is not an obarray.
3993 If it is one, return it. */
3996 check_obarray (Lisp_Object obarray
)
3998 /* We don't want to signal a wrong-type-argument error when we are
3999 shutting down due to a fatal error, and we don't want to hit
4000 assertions in VECTORP and ASIZE if the fatal error was during GC. */
4001 if (!fatal_error_in_progress
4002 && (!VECTORP (obarray
) || ASIZE (obarray
) == 0))
4004 /* If Vobarray is now invalid, force it to be valid. */
4005 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
4006 wrong_type_argument (Qvectorp
, obarray
);
4011 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
4014 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
4018 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
4019 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
4022 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
4024 make_symbol_constant (sym
);
4025 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
4026 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
4029 ptr
= aref_addr (obarray
, XINT (index
));
4030 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
4035 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
4038 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
4040 return intern_sym (Fmake_symbol (string
), obarray
, index
);
4043 /* Intern the C string STR: return a symbol with that name,
4044 interned in the current obarray. */
4047 intern_1 (const char *str
, ptrdiff_t len
)
4049 Lisp_Object obarray
= check_obarray (Vobarray
);
4050 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
4052 return (SYMBOLP (tem
) ? tem
4053 /* The above `oblookup' was done on the basis of nchars==nbytes, so
4054 the string has to be unibyte. */
4055 : intern_driver (make_unibyte_string (str
, len
),
4060 intern_c_string_1 (const char *str
, ptrdiff_t len
)
4062 Lisp_Object obarray
= check_obarray (Vobarray
);
4063 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
4067 /* Creating a non-pure string from a string literal not implemented yet.
4068 We could just use make_string here and live with the extra copy. */
4069 eassert (!NILP (Vpurify_flag
));
4070 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
4076 define_symbol (Lisp_Object sym
, char const *str
)
4078 ptrdiff_t len
= strlen (str
);
4079 Lisp_Object string
= make_pure_c_string (str
, len
);
4080 init_symbol (sym
, string
);
4082 /* Qunbound is uninterned, so that it's not confused with any symbol
4083 'unbound' created by a Lisp program. */
4084 if (! EQ (sym
, Qunbound
))
4086 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
4087 eassert (INTEGERP (bucket
));
4088 intern_sym (sym
, initial_obarray
, bucket
);
4092 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
4093 doc
: /* Return the canonical symbol whose name is STRING.
4094 If there is none, one is created by this function and returned.
4095 A second optional argument specifies the obarray to use;
4096 it defaults to the value of `obarray'. */)
4097 (Lisp_Object string
, Lisp_Object obarray
)
4101 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
4102 CHECK_STRING (string
);
4104 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
4106 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
4111 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
4112 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
4113 NAME may be a string or a symbol. If it is a symbol, that exact
4114 symbol is searched for.
4115 A second optional argument specifies the obarray to use;
4116 it defaults to the value of `obarray'. */)
4117 (Lisp_Object name
, Lisp_Object obarray
)
4119 register Lisp_Object tem
, string
;
4121 if (NILP (obarray
)) obarray
= Vobarray
;
4122 obarray
= check_obarray (obarray
);
4124 if (!SYMBOLP (name
))
4126 CHECK_STRING (name
);
4130 string
= SYMBOL_NAME (name
);
4132 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
4133 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
4139 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
4140 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
4141 The value is t if a symbol was found and deleted, nil otherwise.
4142 NAME may be a string or a symbol. If it is a symbol, that symbol
4143 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
4144 OBARRAY, if nil, defaults to the value of the variable `obarray'.
4145 usage: (unintern NAME OBARRAY) */)
4146 (Lisp_Object name
, Lisp_Object obarray
)
4148 register Lisp_Object string
, tem
;
4151 if (NILP (obarray
)) obarray
= Vobarray
;
4152 obarray
= check_obarray (obarray
);
4155 string
= SYMBOL_NAME (name
);
4158 CHECK_STRING (name
);
4162 tem
= oblookup (obarray
, SSDATA (string
),
4167 /* If arg was a symbol, don't delete anything but that symbol itself. */
4168 if (SYMBOLP (name
) && !EQ (name
, tem
))
4171 /* There are plenty of other symbols which will screw up the Emacs
4172 session if we unintern them, as well as even more ways to use
4173 `setq' or `fset' or whatnot to make the Emacs session
4174 unusable. Let's not go down this silly road. --Stef */
4175 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
4176 error ("Attempt to unintern t or nil"); */
4178 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
4180 hash
= oblookup_last_bucket_number
;
4182 if (EQ (AREF (obarray
, hash
), tem
))
4184 if (XSYMBOL (tem
)->next
)
4187 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
4188 ASET (obarray
, hash
, sym
);
4191 ASET (obarray
, hash
, make_number (0));
4195 Lisp_Object tail
, following
;
4197 for (tail
= AREF (obarray
, hash
);
4198 XSYMBOL (tail
)->next
;
4201 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
4202 if (EQ (following
, tem
))
4204 set_symbol_next (tail
, XSYMBOL (following
)->next
);
4213 /* Return the symbol in OBARRAY whose names matches the string
4214 of SIZE characters (SIZE_BYTE bytes) at PTR.
4215 If there is no such symbol, return the integer bucket number of
4216 where the symbol would be if it were present.
4218 Also store the bucket number in oblookup_last_bucket_number. */
4221 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
4225 register Lisp_Object tail
;
4226 Lisp_Object bucket
, tem
;
4228 obarray
= check_obarray (obarray
);
4229 /* This is sometimes needed in the middle of GC. */
4230 obsize
= gc_asize (obarray
);
4231 hash
= hash_string (ptr
, size_byte
) % obsize
;
4232 bucket
= AREF (obarray
, hash
);
4233 oblookup_last_bucket_number
= hash
;
4234 if (EQ (bucket
, make_number (0)))
4236 else if (!SYMBOLP (bucket
))
4237 error ("Bad data in guts of obarray"); /* Like CADR error message. */
4239 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
4241 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
4242 && SCHARS (SYMBOL_NAME (tail
)) == size
4243 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
4245 else if (XSYMBOL (tail
)->next
== 0)
4248 XSETINT (tem
, hash
);
4253 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
4256 register Lisp_Object tail
;
4257 CHECK_VECTOR (obarray
);
4258 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
4260 tail
= AREF (obarray
, i
);
4265 if (XSYMBOL (tail
)->next
== 0)
4267 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4273 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4275 call1 (function
, sym
);
4278 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4279 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4280 OBARRAY defaults to the value of `obarray'. */)
4281 (Lisp_Object function
, Lisp_Object obarray
)
4283 if (NILP (obarray
)) obarray
= Vobarray
;
4284 obarray
= check_obarray (obarray
);
4286 map_obarray (obarray
, mapatoms_1
, function
);
4290 #define OBARRAY_SIZE 15121
4295 Vobarray
= Fmake_vector (make_number (OBARRAY_SIZE
), make_number (0));
4296 initial_obarray
= Vobarray
;
4297 staticpro (&initial_obarray
);
4299 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4300 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4302 DEFSYM (Qunbound
, "unbound");
4304 DEFSYM (Qnil
, "nil");
4305 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4306 make_symbol_constant (Qnil
);
4307 XSYMBOL (Qnil
)->declared_special
= true;
4310 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4311 make_symbol_constant (Qt
);
4312 XSYMBOL (Qt
)->declared_special
= true;
4314 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4317 DEFSYM (Qvariable_documentation
, "variable-documentation");
4321 defsubr (struct Lisp_Subr
*sname
)
4323 Lisp_Object sym
, tem
;
4324 sym
= intern_c_string (sname
->symbol_name
);
4325 XSETPVECTYPE (sname
, PVEC_SUBR
);
4326 XSETSUBR (tem
, sname
);
4327 set_symbol_function (sym
, tem
);
4330 #ifdef NOTDEF /* Use fset in subr.el now! */
4332 defalias (struct Lisp_Subr
*sname
, char *string
)
4335 sym
= intern (string
);
4336 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4340 /* Define an "integer variable"; a symbol whose value is forwarded to a
4341 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4342 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4344 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4345 const char *namestring
, EMACS_INT
*address
)
4348 sym
= intern_c_string (namestring
);
4349 i_fwd
->type
= Lisp_Fwd_Int
;
4350 i_fwd
->intvar
= address
;
4351 XSYMBOL (sym
)->declared_special
= 1;
4352 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4353 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4356 /* Similar but define a variable whose value is t if address contains 1,
4357 nil if address contains 0. */
4359 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4360 const char *namestring
, bool *address
)
4363 sym
= intern_c_string (namestring
);
4364 b_fwd
->type
= Lisp_Fwd_Bool
;
4365 b_fwd
->boolvar
= address
;
4366 XSYMBOL (sym
)->declared_special
= 1;
4367 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4368 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4369 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4372 /* Similar but define a variable whose value is the Lisp Object stored
4373 at address. Two versions: with and without gc-marking of the C
4374 variable. The nopro version is used when that variable will be
4375 gc-marked for some other reason, since marking the same slot twice
4376 can cause trouble with strings. */
4378 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4379 const char *namestring
, Lisp_Object
*address
)
4382 sym
= intern_c_string (namestring
);
4383 o_fwd
->type
= Lisp_Fwd_Obj
;
4384 o_fwd
->objvar
= address
;
4385 XSYMBOL (sym
)->declared_special
= 1;
4386 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4387 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4391 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4392 const char *namestring
, Lisp_Object
*address
)
4394 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4395 staticpro (address
);
4398 /* Similar but define a variable whose value is the Lisp Object stored
4399 at a particular offset in the current kboard object. */
4402 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4403 const char *namestring
, int offset
)
4406 sym
= intern_c_string (namestring
);
4407 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4408 ko_fwd
->offset
= offset
;
4409 XSYMBOL (sym
)->declared_special
= 1;
4410 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4411 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4414 /* Check that the elements of lpath exist. */
4417 load_path_check (Lisp_Object lpath
)
4419 Lisp_Object path_tail
;
4421 /* The only elements that might not exist are those from
4422 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4424 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4426 Lisp_Object dirfile
;
4427 dirfile
= Fcar (path_tail
);
4428 if (STRINGP (dirfile
))
4430 dirfile
= Fdirectory_file_name (dirfile
);
4431 if (! file_accessible_directory_p (dirfile
))
4432 dir_warning ("Lisp directory", XCAR (path_tail
));
4437 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4438 This does not include the standard site-lisp directories
4439 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4440 but it does (unless no_site_lisp is set) include site-lisp
4441 directories in the source/build directories if those exist and we
4442 are running uninstalled.
4444 Uses the following logic:
4446 If Vinstallation_directory is not nil (ie, running uninstalled),
4447 use PATH_DUMPLOADSEARCH (ie, build path). Else use PATH_LOADSEARCH.
4448 The remainder is what happens when dumping works:
4449 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4450 Otherwise use PATH_LOADSEARCH.
4452 If !initialized, then just return PATH_DUMPLOADSEARCH.
4454 If Vinstallation_directory is not nil (ie, running uninstalled):
4455 If installation-dir/lisp exists and not already a member,
4456 we must be running uninstalled. Reset the load-path
4457 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4458 refers to the eventual installation directories. Since we
4459 are not yet installed, we should not use them, even if they exist.)
4460 If installation-dir/lisp does not exist, just add
4461 PATH_DUMPLOADSEARCH at the end instead.
4462 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4463 and not already a member) at the front.
4464 If installation-dir != source-dir (ie running an uninstalled,
4465 out-of-tree build) AND install-dir/src/Makefile exists BUT
4466 install-dir/src/Makefile.in does NOT exist (this is a sanity
4467 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4470 load_path_default (void)
4472 Lisp_Object lpath
= Qnil
;
4477 const char *loadpath
= ns_load_path ();
4480 normal
= PATH_LOADSEARCH
;
4481 if (!NILP (Vinstallation_directory
)) normal
= PATH_DUMPLOADSEARCH
;
4484 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4486 lpath
= decode_env_path (0, normal
, 0);
4489 #else /* !CANNOT_DUMP */
4491 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4496 const char *loadpath
= ns_load_path ();
4497 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4499 lpath
= decode_env_path (0, normal
, 0);
4501 if (!NILP (Vinstallation_directory
))
4503 Lisp_Object tem
, tem1
;
4505 /* Add to the path the lisp subdir of the installation
4506 dir, if it is accessible. Note: in out-of-tree builds,
4507 this directory is empty save for Makefile. */
4508 tem
= Fexpand_file_name (build_string ("lisp"),
4509 Vinstallation_directory
);
4510 tem1
= Ffile_accessible_directory_p (tem
);
4513 if (NILP (Fmember (tem
, lpath
)))
4515 /* We are running uninstalled. The default load-path
4516 points to the eventual installed lisp directories.
4517 We should not use those now, even if they exist,
4518 so start over from a clean slate. */
4519 lpath
= list1 (tem
);
4523 /* That dir doesn't exist, so add the build-time
4524 Lisp dirs instead. */
4526 Lisp_Object dump_path
=
4527 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4528 lpath
= nconc2 (lpath
, dump_path
);
4531 /* Add site-lisp under the installation dir, if it exists. */
4534 tem
= Fexpand_file_name (build_string ("site-lisp"),
4535 Vinstallation_directory
);
4536 tem1
= Ffile_accessible_directory_p (tem
);
4539 if (NILP (Fmember (tem
, lpath
)))
4540 lpath
= Fcons (tem
, lpath
);
4544 /* If Emacs was not built in the source directory,
4545 and it is run from where it was built, add to load-path
4546 the lisp and site-lisp dirs under that directory. */
4548 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4552 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4553 Vinstallation_directory
);
4554 tem1
= Ffile_exists_p (tem
);
4556 /* Don't be fooled if they moved the entire source tree
4557 AFTER dumping Emacs. If the build directory is indeed
4558 different from the source dir, src/Makefile.in and
4559 src/Makefile will not be found together. */
4560 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4561 Vinstallation_directory
);
4562 tem2
= Ffile_exists_p (tem
);
4563 if (!NILP (tem1
) && NILP (tem2
))
4565 tem
= Fexpand_file_name (build_string ("lisp"),
4568 if (NILP (Fmember (tem
, lpath
)))
4569 lpath
= Fcons (tem
, lpath
);
4573 tem
= Fexpand_file_name (build_string ("site-lisp"),
4575 tem1
= Ffile_accessible_directory_p (tem
);
4578 if (NILP (Fmember (tem
, lpath
)))
4579 lpath
= Fcons (tem
, lpath
);
4583 } /* Vinstallation_directory != Vsource_directory */
4585 } /* if Vinstallation_directory */
4587 else /* !initialized */
4589 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4590 source directory. We used to add ../lisp (ie the lisp dir in
4591 the build directory) at the front here, but that should not
4592 be necessary, since in out of tree builds lisp/ is empty, save
4594 lpath
= decode_env_path (0, normal
, 0);
4596 #endif /* !CANNOT_DUMP */
4604 if (NILP (Vpurify_flag
) && !NILP (Ffboundp (Qfile_truename
)))
4605 Vsource_directory
= call1 (Qfile_truename
, Vsource_directory
);
4607 /* First, set Vload_path. */
4609 /* Ignore EMACSLOADPATH when dumping. */
4611 bool use_loadpath
= true;
4613 bool use_loadpath
= NILP (Vpurify_flag
);
4616 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4618 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4620 /* Check (non-nil) user-supplied elements. */
4621 load_path_check (Vload_path
);
4623 /* If no nils in the environment variable, use as-is.
4624 Otherwise, replace any nils with the default. */
4625 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4627 Lisp_Object elem
, elpath
= Vload_path
;
4628 Lisp_Object default_lpath
= load_path_default ();
4630 /* Check defaults, before adding site-lisp. */
4631 load_path_check (default_lpath
);
4633 /* Add the site-lisp directories to the front of the default. */
4634 if (!no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4636 Lisp_Object sitelisp
;
4637 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4638 if (! NILP (sitelisp
))
4639 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4644 /* Replace nils from EMACSLOADPATH by default. */
4645 while (CONSP (elpath
))
4647 elem
= XCAR (elpath
);
4648 elpath
= XCDR (elpath
);
4649 Vload_path
= CALLN (Fappend
, Vload_path
,
4650 NILP (elem
) ? default_lpath
: list1 (elem
));
4652 } /* Fmemq (Qnil, Vload_path) */
4656 Vload_path
= load_path_default ();
4658 /* Check before adding site-lisp directories.
4659 The install should have created them, but they are not
4660 required, so no need to warn if they are absent.
4661 Or we might be running before installation. */
4662 load_path_check (Vload_path
);
4664 /* Add the site-lisp directories at the front. */
4665 if (initialized
&& !no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4667 Lisp_Object sitelisp
;
4668 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4669 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4675 load_in_progress
= 0;
4676 Vload_file_name
= Qnil
;
4677 Vstandard_input
= Qt
;
4678 Vloads_in_progress
= Qnil
;
4681 /* Print a warning that directory intended for use USE and with name
4682 DIRNAME cannot be accessed. On entry, errno should correspond to
4683 the access failure. Print the warning on stderr and put it in
4687 dir_warning (char const *use
, Lisp_Object dirname
)
4689 static char const format
[] = "Warning: %s '%s': %s\n";
4690 char *diagnostic
= emacs_strerror (errno
);
4691 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)), diagnostic
);
4693 /* Don't log the warning before we've initialized!! */
4696 ptrdiff_t diaglen
= strlen (diagnostic
);
4697 AUTO_STRING_WITH_LEN (diag
, diagnostic
, diaglen
);
4698 if (! NILP (Vlocale_coding_system
))
4701 = code_convert_string_norecord (diag
, Vlocale_coding_system
, false);
4702 diagnostic
= SSDATA (s
);
4703 diaglen
= SBYTES (s
);
4706 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4707 + strlen (use
) + SBYTES (dirname
) + diaglen
);
4708 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4710 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4716 syms_of_lread (void)
4719 defsubr (&Sread_from_string
);
4720 defsubr (&Ssubstitute_object_in_subtree
);
4722 defsubr (&Sintern_soft
);
4723 defsubr (&Sunintern
);
4724 defsubr (&Sget_load_suffixes
);
4726 defsubr (&Seval_buffer
);
4727 defsubr (&Seval_region
);
4728 defsubr (&Sread_char
);
4729 defsubr (&Sread_char_exclusive
);
4730 defsubr (&Sread_event
);
4731 defsubr (&Sget_file_char
);
4732 defsubr (&Smapatoms
);
4733 defsubr (&Slocate_file_internal
);
4735 DEFVAR_LISP ("obarray", Vobarray
,
4736 doc
: /* Symbol table for use by `intern' and `read'.
4737 It is a vector whose length ought to be prime for best results.
4738 The vector's contents don't make sense if examined from Lisp programs;
4739 to find all the symbols in an obarray, use `mapatoms'. */);
4741 DEFVAR_LISP ("values", Vvalues
,
4742 doc
: /* List of values of all expressions which were read, evaluated and printed.
4743 Order is reverse chronological. */);
4744 XSYMBOL (intern ("values"))->declared_special
= 0;
4746 DEFVAR_LISP ("standard-input", Vstandard_input
,
4747 doc
: /* Stream for read to get input from.
4748 See documentation of `read' for possible values. */);
4749 Vstandard_input
= Qt
;
4751 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4752 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4754 If this variable is a buffer, then only forms read from that buffer
4755 will be added to `read-symbol-positions-list'.
4756 If this variable is t, then all read forms will be added.
4757 The effect of all other values other than nil are not currently
4758 defined, although they may be in the future.
4760 The positions are relative to the last call to `read' or
4761 `read-from-string'. It is probably a bad idea to set this variable at
4762 the toplevel; bind it instead. */);
4763 Vread_with_symbol_positions
= Qnil
;
4765 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4766 doc
: /* A list mapping read symbols to their positions.
4767 This variable is modified during calls to `read' or
4768 `read-from-string', but only when `read-with-symbol-positions' is
4771 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4772 CHAR-POSITION is an integer giving the offset of that occurrence of the
4773 symbol from the position where `read' or `read-from-string' started.
4775 Note that a symbol will appear multiple times in this list, if it was
4776 read multiple times. The list is in the same order as the symbols
4778 Vread_symbol_positions_list
= Qnil
;
4780 DEFVAR_LISP ("read-circle", Vread_circle
,
4781 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4784 DEFVAR_LISP ("load-path", Vload_path
,
4785 doc
: /* List of directories to search for files to load.
4786 Each element is a string (directory file name) or nil (meaning
4787 `default-directory').
4788 This list is consulted by the `require' function.
4789 Initialized during startup as described in Info node `(elisp)Library Search'.
4790 Use `directory-file-name' when adding items to this path. However, Lisp
4791 programs that process this list should tolerate directories both with
4792 and without trailing slashes. */);
4794 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4795 doc
: /* List of suffixes for Emacs Lisp files and dynamic modules.
4796 This list includes suffixes for both compiled and source Emacs Lisp files.
4797 This list should not include the empty string.
4798 `load' and related functions try to append these suffixes, in order,
4799 to the specified file name if a suffix is allowed or required. */);
4801 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4802 build_pure_c_string (".el"),
4803 build_pure_c_string (MODULES_SUFFIX
));
4805 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4806 build_pure_c_string (".el"));
4808 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix
,
4809 doc
: /* Suffix of loadable module file, or nil of modules are not supported. */);
4811 Vmodule_file_suffix
= build_pure_c_string (MODULES_SUFFIX
);
4813 Vmodule_file_suffix
= Qnil
;
4815 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4816 doc
: /* List of suffixes that indicate representations of \
4818 This list should normally start with the empty string.
4820 Enabling Auto Compression mode appends the suffixes in
4821 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4822 mode removes them again. `load' and related functions use this list to
4823 determine whether they should look for compressed versions of a file
4824 and, if so, which suffixes they should try to append to the file name
4825 in order to do so. However, if you want to customize which suffixes
4826 the loading functions recognize as compression suffixes, you should
4827 customize `jka-compr-load-suffixes' rather than the present variable. */);
4828 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4830 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4831 doc
: /* Non-nil if inside of `load'. */);
4832 DEFSYM (Qload_in_progress
, "load-in-progress");
4834 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4835 doc
: /* An alist of functions to be evalled when particular files are loaded.
4836 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4838 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4839 a symbol (a feature name).
4841 When `load' is run and the file-name argument matches an element's
4842 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4843 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4845 An error in FORMS does not undo the load, but does prevent execution of
4846 the rest of the FORMS. */);
4847 Vafter_load_alist
= Qnil
;
4849 DEFVAR_LISP ("load-history", Vload_history
,
4850 doc
: /* Alist mapping loaded file names to symbols and features.
4851 Each alist element should be a list (FILE-NAME ENTRIES...), where
4852 FILE-NAME is the name of a file that has been loaded into Emacs.
4853 The file name is absolute and true (i.e. it doesn't contain symlinks).
4854 As an exception, one of the alist elements may have FILE-NAME nil,
4855 for symbols and features not associated with any file.
4857 The remaining ENTRIES in the alist element describe the functions and
4858 variables defined in that file, the features provided, and the
4859 features required. Each entry has the form `(provide . FEATURE)',
4860 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4861 `(defface . SYMBOL)', `(define-type . SYMBOL)',
4862 `(cl-defmethod METHOD SPECIALIZERS)', or `(t . SYMBOL)'.
4863 Entries like `(t . SYMBOL)' may precede a `(defun . FUNCTION)' entry,
4864 and means that SYMBOL was an autoload before this file redefined it
4865 as a function. In addition, entries may also be single symbols,
4866 which means that symbol was defined by `defvar' or `defconst'.
4868 During preloading, the file name recorded is relative to the main Lisp
4869 directory. These file names are converted to absolute at startup. */);
4870 Vload_history
= Qnil
;
4872 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4873 doc
: /* Full name of file being loaded by `load'. */);
4874 Vload_file_name
= Qnil
;
4876 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4877 doc
: /* File name, including directory, of user's initialization file.
4878 If the file loaded had extension `.elc', and the corresponding source file
4879 exists, this variable contains the name of source file, suitable for use
4880 by functions like `custom-save-all' which edit the init file.
4881 While Emacs loads and evaluates the init file, value is the real name
4882 of the file, regardless of whether or not it has the `.elc' extension. */);
4883 Vuser_init_file
= Qnil
;
4885 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4886 doc
: /* Used for internal purposes by `load'. */);
4887 Vcurrent_load_list
= Qnil
;
4889 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4890 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4891 Called with a single argument (the stream from which to read).
4892 The default is to use the function `read'. */);
4893 DEFSYM (Qread
, "read");
4894 Vload_read_function
= Qread
;
4896 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4897 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4898 The value should be a function for doing code conversion before
4899 reading a source file. It can also be nil, in which case loading is
4900 done without any code conversion.
4902 If the value is a function, it is called with four arguments,
4903 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4904 the file to load, FILE is the non-absolute name (for messages etc.),
4905 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4906 `load'. The function should return t if the file was loaded. */);
4907 Vload_source_file_function
= Qnil
;
4909 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4910 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4911 This is useful when the file being loaded is a temporary copy. */);
4912 load_force_doc_strings
= 0;
4914 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4915 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4916 This is normally bound by `load' and `eval-buffer' to control `read',
4917 and is not meant for users to change. */);
4918 load_convert_to_unibyte
= 0;
4920 DEFVAR_LISP ("source-directory", Vsource_directory
,
4921 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4922 You cannot count on them to still be there! */);
4924 = Fexpand_file_name (build_string ("../"),
4925 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4927 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4928 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4929 Vpreloaded_file_list
= Qnil
;
4931 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4932 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4933 Vbyte_boolean_vars
= Qnil
;
4935 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4936 doc
: /* Non-nil means load dangerous compiled Lisp files.
4937 Some versions of XEmacs use different byte codes than Emacs. These
4938 incompatible byte codes can make Emacs crash when it tries to execute
4940 load_dangerous_libraries
= 0;
4942 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4943 doc
: /* Non-nil means force printing messages when loading Lisp files.
4944 This overrides the value of the NOMESSAGE argument to `load'. */);
4945 force_load_messages
= 0;
4947 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4948 doc
: /* Regular expression matching safe to load compiled Lisp files.
4949 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4950 from the file, and matches them against this regular expression.
4951 When the regular expression matches, the file is considered to be safe
4952 to load. See also `load-dangerous-libraries'. */);
4953 Vbytecomp_version_regexp
4954 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4956 DEFSYM (Qlexical_binding
, "lexical-binding");
4957 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4958 doc
: /* Whether to use lexical binding when evaluating code.
4959 Non-nil means that the code in the current buffer should be evaluated
4960 with lexical binding.
4961 This variable is automatically set from the file variables of an
4962 interpreted Lisp file read using `load'. Unlike other file local
4963 variables, this must be set in the first line of a file. */);
4964 Vlexical_binding
= Qnil
;
4965 Fmake_variable_buffer_local (Qlexical_binding
);
4967 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4968 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4969 Veval_buffer_list
= Qnil
;
4971 DEFVAR_LISP ("lread--old-style-backquotes", Vlread_old_style_backquotes
,
4972 doc
: /* Set to non-nil when `read' encounters an old-style backquote.
4973 For internal use only. */);
4974 Vlread_old_style_backquotes
= Qnil
;
4975 DEFSYM (Qlread_old_style_backquotes
, "lread--old-style-backquotes");
4977 DEFVAR_LISP ("lread--unescaped-character-literals",
4978 Vlread_unescaped_character_literals
,
4979 doc
: /* List of deprecated unescaped character literals encountered by `read'.
4980 For internal use only. */);
4981 Vlread_unescaped_character_literals
= Qnil
;
4982 DEFSYM (Qlread_unescaped_character_literals
,
4983 "lread--unescaped-character-literals");
4986 DEFSYM (Qchar
, "char");
4987 DEFSYM (Qformat
, "format");
4989 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4990 doc
: /* Non-nil means `load' prefers the newest version of a file.
4991 This applies when a filename suffix is not explicitly specified and
4992 `load' is trying various possible suffixes (see `load-suffixes' and
4993 `load-file-rep-suffixes'). Normally, it stops at the first file
4994 that exists unless you explicitly specify one or the other. If this
4995 option is non-nil, it checks all suffixes and uses whichever file is
4997 Note that if you customize this, obviously it will not affect files
4998 that are loaded before your customizations are read! */);
4999 load_prefer_newer
= 0;
5001 /* Vsource_directory was initialized in init_lread. */
5003 DEFSYM (Qcurrent_load_list
, "current-load-list");
5004 DEFSYM (Qstandard_input
, "standard-input");
5005 DEFSYM (Qread_char
, "read-char");
5006 DEFSYM (Qget_file_char
, "get-file-char");
5008 /* Used instead of Qget_file_char while loading *.elc files compiled
5009 by Emacs 21 or older. */
5010 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
5012 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
5014 DEFSYM (Qbackquote
, "`");
5015 DEFSYM (Qcomma
, ",");
5016 DEFSYM (Qcomma_at
, ",@");
5017 DEFSYM (Qcomma_dot
, ",.");
5019 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
5020 DEFSYM (Qascii_character
, "ascii-character");
5021 DEFSYM (Qfunction
, "function");
5022 DEFSYM (Qload
, "load");
5023 DEFSYM (Qload_file_name
, "load-file-name");
5024 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
5025 DEFSYM (Qfile_truename
, "file-truename");
5026 DEFSYM (Qdir_ok
, "dir-ok");
5027 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
5029 staticpro (&read_objects_map
);
5030 read_objects_map
= Qnil
;
5031 staticpro (&read_objects_completed
);
5032 read_objects_completed
= Qnil
;
5033 staticpro (&seen_list
);
5036 Vloads_in_progress
= Qnil
;
5037 staticpro (&Vloads_in_progress
);
5039 DEFSYM (Qhash_table
, "hash-table");
5040 DEFSYM (Qdata
, "data");
5041 DEFSYM (Qtest
, "test");
5042 DEFSYM (Qsize
, "size");
5043 DEFSYM (Qpurecopy
, "purecopy");
5044 DEFSYM (Qweakness
, "weakness");
5045 DEFSYM (Qrehash_size
, "rehash-size");
5046 DEFSYM (Qrehash_threshold
, "rehash-threshold");
5048 DEFSYM (Qchar_from_name
, "char-from-name");