1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2016 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
26 #include <sys/types.h>
30 #include <limits.h> /* For CHAR_BIT. */
32 #include <stat-time.h>
34 #include "dispextern.h"
35 #include "intervals.h"
36 #include "character.h"
44 #include "termhooks.h"
45 #include "blockinput.h"
50 #if __DJGPP__ == 2 && __DJGPP_MINOR__ < 5
51 # define INFINITY __builtin_inf()
52 # define NAN __builtin_nan("")
64 #endif /* HAVE_SETLOCALE */
69 #define file_offset off_t
70 #define file_tell ftello
72 #define file_offset long
73 #define file_tell ftell
76 /* The association list of objects read with the #n=object form.
77 Each member of the list has the form (n . object), and is used to
78 look up the object for the corresponding #n# construct.
79 It must be set to nil before all top-level calls to read0. */
80 static Lisp_Object read_objects
;
82 /* File for get_file_char to read from. Use by load. */
83 static FILE *instream
;
85 /* For use within read-from-string (this reader is non-reentrant!!) */
86 static ptrdiff_t read_from_string_index
;
87 static ptrdiff_t read_from_string_index_byte
;
88 static ptrdiff_t read_from_string_limit
;
90 /* Number of characters read in the current call to Fread or
92 static EMACS_INT readchar_count
;
94 /* This contains the last string skipped with #@. */
95 static char *saved_doc_string
;
96 /* Length of buffer allocated in saved_doc_string. */
97 static ptrdiff_t saved_doc_string_size
;
98 /* Length of actual data in saved_doc_string. */
99 static ptrdiff_t saved_doc_string_length
;
100 /* This is the file position that string came from. */
101 static file_offset saved_doc_string_position
;
103 /* This contains the previous string skipped with #@.
104 We copy it from saved_doc_string when a new string
105 is put in saved_doc_string. */
106 static char *prev_saved_doc_string
;
107 /* Length of buffer allocated in prev_saved_doc_string. */
108 static ptrdiff_t prev_saved_doc_string_size
;
109 /* Length of actual data in prev_saved_doc_string. */
110 static ptrdiff_t prev_saved_doc_string_length
;
111 /* This is the file position that string came from. */
112 static file_offset prev_saved_doc_string_position
;
114 /* True means inside a new-style backquote
115 with no surrounding parentheses.
116 Fread initializes this to false, so we need not specbind it
117 or worry about what happens to it when there is an error. */
118 static bool new_backquote_flag
;
120 /* A list of file names for files being loaded in Fload. Used to
121 check for recursive loads. */
123 static Lisp_Object Vloads_in_progress
;
125 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
128 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
129 Lisp_Object
, Lisp_Object
,
130 Lisp_Object
, Lisp_Object
);
132 /* Functions that read one byte from the current source READCHARFUN
133 or unreads one byte. If the integer argument C is -1, it returns
134 one read byte, or -1 when there's no more byte in the source. If C
135 is 0 or positive, it unreads C, and the return value is not
138 static int readbyte_for_lambda (int, Lisp_Object
);
139 static int readbyte_from_file (int, Lisp_Object
);
140 static int readbyte_from_string (int, Lisp_Object
);
142 /* Handle unreading and rereading of characters.
143 Write READCHAR to read a character,
144 UNREAD(c) to unread c to be read again.
146 These macros correctly read/unread multibyte characters. */
148 #define READCHAR readchar (readcharfun, NULL)
149 #define UNREAD(c) unreadchar (readcharfun, c)
151 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
152 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
154 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
155 Qlambda, or a cons, we use this to keep an unread character because
156 a file stream can't handle multibyte-char unreading. The value -1
157 means that there's no unread character. */
158 static int unread_char
;
161 readchar (Lisp_Object readcharfun
, bool *multibyte
)
165 int (*readbyte
) (int, Lisp_Object
);
166 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
168 bool emacs_mule_encoding
= 0;
175 if (BUFFERP (readcharfun
))
177 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
179 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
181 if (! BUFFER_LIVE_P (inbuffer
))
184 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
187 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
189 /* Fetch the character code from the buffer. */
190 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
191 BUF_INC_POS (inbuffer
, pt_byte
);
198 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
199 if (! ASCII_CHAR_P (c
))
200 c
= BYTE8_TO_CHAR (c
);
203 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
207 if (MARKERP (readcharfun
))
209 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
211 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
213 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
216 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
218 /* Fetch the character code from the buffer. */
219 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
220 BUF_INC_POS (inbuffer
, bytepos
);
227 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
228 if (! ASCII_CHAR_P (c
))
229 c
= BYTE8_TO_CHAR (c
);
233 XMARKER (readcharfun
)->bytepos
= bytepos
;
234 XMARKER (readcharfun
)->charpos
++;
239 if (EQ (readcharfun
, Qlambda
))
241 readbyte
= readbyte_for_lambda
;
245 if (EQ (readcharfun
, Qget_file_char
))
247 readbyte
= readbyte_from_file
;
251 if (STRINGP (readcharfun
))
253 if (read_from_string_index
>= read_from_string_limit
)
255 else if (STRING_MULTIBYTE (readcharfun
))
259 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
260 read_from_string_index
,
261 read_from_string_index_byte
);
265 c
= SREF (readcharfun
, read_from_string_index_byte
);
266 read_from_string_index
++;
267 read_from_string_index_byte
++;
272 if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
274 /* This is the case that read_vector is reading from a unibyte
275 string that contains a byte sequence previously skipped
276 because of #@NUMBER. The car part of readcharfun is that
277 string, and the cdr part is a value of readcharfun given to
279 readbyte
= readbyte_from_string
;
280 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
281 emacs_mule_encoding
= 1;
285 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
287 readbyte
= readbyte_from_file
;
288 emacs_mule_encoding
= 1;
292 tem
= call0 (readcharfun
);
299 if (unread_char
>= 0)
305 c
= (*readbyte
) (-1, readcharfun
);
310 if (ASCII_CHAR_P (c
))
312 if (emacs_mule_encoding
)
313 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
316 len
= BYTES_BY_CHAR_HEAD (c
);
319 c
= (*readbyte
) (-1, readcharfun
);
320 if (c
< 0 || ! TRAILING_CODE_P (c
))
323 (*readbyte
) (buf
[i
], readcharfun
);
324 return BYTE8_TO_CHAR (buf
[0]);
328 return STRING_CHAR (buf
);
331 #define FROM_FILE_P(readcharfun) \
332 (EQ (readcharfun, Qget_file_char) \
333 || EQ (readcharfun, Qget_emacs_mule_file_char))
336 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
338 if (FROM_FILE_P (readcharfun
))
340 block_input (); /* FIXME: Not sure if it's needed. */
341 fseek (instream
, n
, SEEK_CUR
);
345 { /* We're not reading directly from a file. In that case, it's difficult
346 to reliably count bytes, since these are usually meant for the file's
347 encoding, whereas we're now typically in the internal encoding.
348 But luckily, skip_dyn_bytes is used to skip over a single
349 dynamic-docstring (or dynamic byte-code) which is always quoted such
350 that \037 is the final char. */
354 } while (c
>= 0 && c
!= '\037');
359 skip_dyn_eof (Lisp_Object readcharfun
)
361 if (FROM_FILE_P (readcharfun
))
363 block_input (); /* FIXME: Not sure if it's needed. */
364 fseek (instream
, 0, SEEK_END
);
368 while (READCHAR
>= 0);
371 /* Unread the character C in the way appropriate for the stream READCHARFUN.
372 If the stream is a user function, call it with the char as argument. */
375 unreadchar (Lisp_Object readcharfun
, int c
)
379 /* Don't back up the pointer if we're unreading the end-of-input mark,
380 since readchar didn't advance it when we read it. */
382 else if (BUFFERP (readcharfun
))
384 struct buffer
*b
= XBUFFER (readcharfun
);
385 ptrdiff_t charpos
= BUF_PT (b
);
386 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
388 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
389 BUF_DEC_POS (b
, bytepos
);
393 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
395 else if (MARKERP (readcharfun
))
397 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
398 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
400 XMARKER (readcharfun
)->charpos
--;
401 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
402 BUF_DEC_POS (b
, bytepos
);
406 XMARKER (readcharfun
)->bytepos
= bytepos
;
408 else if (STRINGP (readcharfun
))
410 read_from_string_index
--;
411 read_from_string_index_byte
412 = string_char_to_byte (readcharfun
, read_from_string_index
);
414 else if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
418 else if (EQ (readcharfun
, Qlambda
))
422 else if (FROM_FILE_P (readcharfun
))
427 call1 (readcharfun
, make_number (c
));
431 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
433 return read_bytecode_char (c
>= 0);
438 readbyte_from_file (int c
, Lisp_Object readcharfun
)
443 ungetc (c
, instream
);
451 /* Interrupted reads have been observed while reading over the network. */
452 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
463 return (c
== EOF
? -1 : c
);
467 readbyte_from_string (int c
, Lisp_Object readcharfun
)
469 Lisp_Object string
= XCAR (readcharfun
);
473 read_from_string_index
--;
474 read_from_string_index_byte
475 = string_char_to_byte (string
, read_from_string_index
);
478 if (read_from_string_index
>= read_from_string_limit
)
481 FETCH_STRING_CHAR_ADVANCE (c
, string
,
482 read_from_string_index
,
483 read_from_string_index_byte
);
488 /* Read one non-ASCII character from INSTREAM. The character is
489 encoded in `emacs-mule' and the first byte is already read in
493 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
495 /* Emacs-mule coding uses at most 4-byte for one character. */
496 unsigned char buf
[4];
497 int len
= emacs_mule_bytes
[c
];
498 struct charset
*charset
;
503 /* C is not a valid leading-code of `emacs-mule'. */
504 return BYTE8_TO_CHAR (c
);
510 c
= (*readbyte
) (-1, readcharfun
);
514 (*readbyte
) (buf
[i
], readcharfun
);
515 return BYTE8_TO_CHAR (buf
[0]);
522 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
523 code
= buf
[1] & 0x7F;
527 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
528 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
530 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
531 code
= buf
[2] & 0x7F;
535 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
536 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
541 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
542 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
544 c
= DECODE_CHAR (charset
, code
);
546 Fsignal (Qinvalid_read_syntax
,
547 list1 (build_string ("invalid multibyte form")));
552 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
554 static Lisp_Object
read0 (Lisp_Object
);
555 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
557 static Lisp_Object
read_list (bool, Lisp_Object
);
558 static Lisp_Object
read_vector (Lisp_Object
, bool);
560 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
562 static void substitute_object_in_subtree (Lisp_Object
,
564 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
567 /* Get a character from the tty. */
569 /* Read input events until we get one that's acceptable for our purposes.
571 If NO_SWITCH_FRAME, switch-frame events are stashed
572 until we get a character we like, and then stuffed into
575 If ASCII_REQUIRED, check function key events to see
576 if the unmodified version of the symbol has a Qascii_character
577 property, and use that character, if present.
579 If ERROR_NONASCII, signal an error if the input we
580 get isn't an ASCII character with modifiers. If it's false but
581 ASCII_REQUIRED is true, just re-read until we get an ASCII
584 If INPUT_METHOD, invoke the current input method
585 if the character warrants that.
587 If SECONDS is a number, wait that many seconds for input, and
588 return Qnil if no input arrives within that time. */
591 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
592 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
594 Lisp_Object val
, delayed_switch_frame
;
595 struct timespec end_time
;
597 #ifdef HAVE_WINDOW_SYSTEM
598 if (display_hourglass_p
)
602 delayed_switch_frame
= Qnil
;
604 /* Compute timeout. */
605 if (NUMBERP (seconds
))
607 double duration
= extract_float (seconds
);
608 struct timespec wait_time
= dtotimespec (duration
);
609 end_time
= timespec_add (current_timespec (), wait_time
);
612 /* Read until we get an acceptable event. */
615 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
616 NUMBERP (seconds
) ? &end_time
: NULL
);
617 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
622 /* `switch-frame' events are put off until after the next ASCII
623 character. This is better than signaling an error just because
624 the last characters were typed to a separate minibuffer frame,
625 for example. Eventually, some code which can deal with
626 switch-frame events will read it and process it. */
628 && EVENT_HAS_PARAMETERS (val
)
629 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
631 delayed_switch_frame
= val
;
635 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
637 /* Convert certain symbols to their ASCII equivalents. */
640 Lisp_Object tem
, tem1
;
641 tem
= Fget (val
, Qevent_symbol_element_mask
);
644 tem1
= Fget (Fcar (tem
), Qascii_character
);
645 /* Merge this symbol's modifier bits
646 with the ASCII equivalent of its basic code. */
648 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
652 /* If we don't have a character now, deal with it appropriately. */
657 Vunread_command_events
= list1 (val
);
658 error ("Non-character input-event");
665 if (! NILP (delayed_switch_frame
))
666 unread_switch_frame
= delayed_switch_frame
;
670 #ifdef HAVE_WINDOW_SYSTEM
671 if (display_hourglass_p
)
680 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
681 doc
: /* Read a character from the command input (keyboard or macro).
682 It is returned as a number.
683 If the character has modifiers, they are resolved and reflected to the
684 character code if possible (e.g. C-SPC -> 0).
686 If the user generates an event which is not a character (i.e. a mouse
687 click or function key event), `read-char' signals an error. As an
688 exception, switch-frame events are put off until non-character events
690 If you want to read non-character events, or ignore them, call
691 `read-event' or `read-char-exclusive' instead.
693 If the optional argument PROMPT is non-nil, display that as a prompt.
694 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
695 input method is turned on in the current buffer, that input method
696 is used for reading a character.
697 If the optional argument SECONDS is non-nil, it should be a number
698 specifying the maximum number of seconds to wait for input. If no
699 input arrives in that time, return nil. SECONDS may be a
700 floating-point value. */)
701 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
706 message_with_string ("%s", prompt
, 0);
707 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
709 return (NILP (val
) ? Qnil
710 : make_number (char_resolve_modifier_mask (XINT (val
))));
713 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
714 doc
: /* Read an event object from the input stream.
715 If the optional argument PROMPT is non-nil, display that as a prompt.
716 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
717 input method is turned on in the current buffer, that input method
718 is used for reading a character.
719 If the optional argument SECONDS is non-nil, it should be a number
720 specifying the maximum number of seconds to wait for input. If no
721 input arrives in that time, return nil. SECONDS may be a
722 floating-point value. */)
723 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
726 message_with_string ("%s", prompt
, 0);
727 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
730 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
731 doc
: /* Read a character from the command input (keyboard or macro).
732 It is returned as a number. Non-character events are ignored.
733 If the character has modifiers, they are resolved and reflected to the
734 character code if possible (e.g. C-SPC -> 0).
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
)
749 message_with_string ("%s", prompt
, 0);
751 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
753 return (NILP (val
) ? Qnil
754 : make_number (char_resolve_modifier_mask (XINT (val
))));
757 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
758 doc
: /* Don't use this yourself. */)
761 register Lisp_Object val
;
763 XSETINT (val
, getc (instream
));
771 /* Return true if the lisp code read using READCHARFUN defines a non-nil
772 `lexical-binding' file variable. After returning, the stream is
773 positioned following the first line, if it is a comment or #! line,
774 otherwise nothing is read. */
777 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
790 while (ch
!= '\n' && ch
!= EOF
)
792 if (ch
== '\n') ch
= READCHAR
;
793 /* It is OK to leave the position after a #! line, since
794 that is what read1 does. */
798 /* The first line isn't a comment, just give up. */
804 /* Look for an appropriate file-variable in the first line. */
808 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
809 } beg_end_state
= NOMINAL
;
810 bool in_file_vars
= 0;
812 #define UPDATE_BEG_END_STATE(ch) \
813 if (beg_end_state == NOMINAL) \
814 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
815 else if (beg_end_state == AFTER_FIRST_DASH) \
816 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
817 else if (beg_end_state == AFTER_ASTERIX) \
820 in_file_vars = !in_file_vars; \
821 beg_end_state = NOMINAL; \
824 /* Skip until we get to the file vars, if any. */
828 UPDATE_BEG_END_STATE (ch
);
830 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
834 char var
[100], val
[100];
839 /* Read a variable name. */
840 while (ch
== ' ' || ch
== '\t')
844 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
846 if (i
< sizeof var
- 1)
848 UPDATE_BEG_END_STATE (ch
);
852 /* Stop scanning if no colon was found before end marker. */
853 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
856 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
862 /* Read a variable value. */
865 while (ch
== ' ' || ch
== '\t')
869 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
871 if (i
< sizeof val
- 1)
873 UPDATE_BEG_END_STATE (ch
);
877 /* The value was terminated by an end-marker, which remove. */
879 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
883 if (strcmp (var
, "lexical-binding") == 0)
886 rv
= (strcmp (val
, "nil") != 0);
892 while (ch
!= '\n' && ch
!= EOF
)
899 /* Value is a version number of byte compiled code if the file
900 associated with file descriptor FD is a compiled Lisp file that's
901 safe to load. Only files compiled with Emacs are safe to load.
902 Files compiled with XEmacs can lead to a crash in Fbyte_code
903 because of an incompatible change in the byte compiler. */
906 safe_to_load_version (int fd
)
912 /* Read the first few bytes from the file, and look for a line
913 specifying the byte compiler version used. */
914 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
917 /* Skip to the next newline, skipping over the initial `ELC'
918 with NUL bytes following it, but note the version. */
919 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
924 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
925 buf
+ i
, nbytes
- i
) < 0)
929 lseek (fd
, 0, SEEK_SET
);
934 /* Callback for record_unwind_protect. Restore the old load list OLD,
935 after loading a file successfully. */
938 record_load_unwind (Lisp_Object old
)
940 Vloads_in_progress
= old
;
943 /* This handler function is used via internal_condition_case_1. */
946 load_error_handler (Lisp_Object data
)
952 load_warn_old_style_backquotes (Lisp_Object file
)
954 if (!NILP (Vold_style_backquotes
))
956 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
957 CALLN (Fmessage
, format
, file
);
961 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
962 doc
: /* Return the suffixes that `load' should try if a suffix is \
964 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
967 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
968 while (CONSP (suffixes
))
970 Lisp_Object exts
= Vload_file_rep_suffixes
;
971 suffix
= XCAR (suffixes
);
972 suffixes
= XCDR (suffixes
);
977 lst
= Fcons (concat2 (suffix
, ext
), lst
);
980 return Fnreverse (lst
);
983 /* Returns true if STRING ends with SUFFIX */
985 suffix_p (Lisp_Object string
, const char *suffix
)
987 ptrdiff_t suffix_len
= strlen (suffix
);
988 ptrdiff_t string_len
= SBYTES (string
);
990 return string_len
>= suffix_len
&& !strcmp (SSDATA (string
) + string_len
- suffix_len
, suffix
);
993 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
994 doc
: /* Execute a file of Lisp code named FILE.
995 First try FILE with `.elc' appended, then try with `.el', then try
996 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
997 then try FILE unmodified (the exact suffixes in the exact order are
998 determined by `load-suffixes'). Environment variable references in
999 FILE are replaced with their values by calling `substitute-in-file-name'.
1000 This function searches the directories in `load-path'.
1002 If optional second arg NOERROR is non-nil,
1003 report no error if FILE doesn't exist.
1004 Print messages at start and end of loading unless
1005 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1007 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1008 suffixes to the specified name FILE.
1009 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1010 the suffix `.elc' or `.el' or the module suffix; don't accept just
1011 FILE unless it ends in one of those suffixes or includes a directory name.
1013 If NOSUFFIX is nil, then if a file could not be found, try looking for
1014 a different representation of the file by adding non-empty suffixes to
1015 its name, before trying another file. Emacs uses this feature to find
1016 compressed versions of files when Auto Compression mode is enabled.
1017 If NOSUFFIX is non-nil, disable this feature.
1019 The suffixes that this function tries out, when NOSUFFIX is nil, are
1020 given by the return value of `get-load-suffixes' and the values listed
1021 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1022 return value of `get-load-suffixes' is used, i.e. the file name is
1023 required to have a non-empty suffix.
1025 When searching suffixes, this function normally stops at the first
1026 one that exists. If the option `load-prefer-newer' is non-nil,
1027 however, it tries all suffixes, and uses whichever file is the newest.
1029 Loading a file records its definitions, and its `provide' and
1030 `require' calls, in an element of `load-history' whose
1031 car is the file name loaded. See `load-history'.
1033 While the file is in the process of being loaded, the variable
1034 `load-in-progress' is non-nil and the variable `load-file-name'
1035 is bound to the file's name.
1037 Return t if the file exists and loads successfully. */)
1038 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1039 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1043 int fd_index UNINIT
;
1044 ptrdiff_t count
= SPECPDL_INDEX ();
1045 Lisp_Object found
, efound
, hist_file_name
;
1046 /* True means we printed the ".el is newer" message. */
1048 /* True means we are loading a compiled file. */
1050 Lisp_Object handler
;
1052 const char *fmode
= "r" FOPEN_TEXT
;
1055 CHECK_STRING (file
);
1057 /* If file name is magic, call the handler. */
1058 /* This shouldn't be necessary any more now that `openp' handles it right.
1059 handler = Ffind_file_name_handler (file, Qload);
1060 if (!NILP (handler))
1061 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1063 /* The presence of this call is the result of a historical accident:
1064 it used to be in every file-operation and when it got removed
1065 everywhere, it accidentally stayed here. Since then, enough people
1066 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1067 that it seemed risky to remove. */
1068 if (! NILP (noerror
))
1070 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1071 Qt
, load_error_handler
);
1076 file
= Fsubstitute_in_file_name (file
);
1078 /* Avoid weird lossage with null string as arg,
1079 since it would try to load a directory as a Lisp file. */
1080 if (SCHARS (file
) == 0)
1087 Lisp_Object suffixes
;
1090 if (! NILP (must_suffix
))
1092 /* Don't insist on adding a suffix if FILE already ends with one. */
1093 if (suffix_p (file
, ".el")
1094 || suffix_p (file
, ".elc")
1096 || suffix_p (file
, MODULES_SUFFIX
)
1100 /* Don't insist on adding a suffix
1101 if the argument includes a directory name. */
1102 else if (! NILP (Ffile_name_directory (file
)))
1106 if (!NILP (nosuffix
))
1110 suffixes
= Fget_load_suffixes ();
1111 if (NILP (must_suffix
))
1112 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1115 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1121 report_file_error ("Cannot open load file", file
);
1125 /* Tell startup.el whether or not we found the user's init file. */
1126 if (EQ (Qt
, Vuser_init_file
))
1127 Vuser_init_file
= found
;
1129 /* If FD is -2, that means openp found a magic file. */
1132 if (NILP (Fequal (found
, file
)))
1133 /* If FOUND is a different file name from FILE,
1134 find its handler even if we have already inhibited
1135 the `load' operation on FILE. */
1136 handler
= Ffind_file_name_handler (found
, Qt
);
1138 handler
= Ffind_file_name_handler (found
, Qload
);
1139 if (! NILP (handler
))
1140 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1142 /* Tramp has to deal with semi-broken packages that prepend
1143 drive letters to remote files. For that reason, Tramp
1144 catches file operations that test for file existence, which
1145 makes openp think X:/foo.elc files are remote. However,
1146 Tramp does not catch `load' operations for such files, so we
1147 end up with a nil as the `load' handler above. If we would
1148 continue with fd = -2, we will behave wrongly, and in
1149 particular try reading a .elc file in the "rt" mode instead
1150 of "rb". See bug #9311 for the results. To work around
1151 this, we try to open the file locally, and go with that if it
1153 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1161 fd_index
= SPECPDL_INDEX ();
1162 record_unwind_protect_int (close_file_unwind
, fd
);
1166 if (suffix_p (found
, MODULES_SUFFIX
))
1167 return unbind_to (count
, Fmodule_load (found
));
1170 /* Check if we're stuck in a recursive load cycle.
1172 2000-09-21: It's not possible to just check for the file loaded
1173 being a member of Vloads_in_progress. This fails because of the
1174 way the byte compiler currently works; `provide's are not
1175 evaluated, see font-lock.el/jit-lock.el as an example. This
1176 leads to a certain amount of ``normal'' recursion.
1178 Also, just loading a file recursively is not always an error in
1179 the general case; the second load may do something different. */
1183 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1184 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1185 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1186 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1187 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1190 /* All loads are by default dynamic, unless the file itself specifies
1191 otherwise using a file-variable in the first line. This is bound here
1192 so that it takes effect whether or not we use
1193 Vload_source_file_function. */
1194 specbind (Qlexical_binding
, Qnil
);
1196 /* Get the name for load-history. */
1197 hist_file_name
= (! NILP (Vpurify_flag
)
1198 ? concat2 (Ffile_name_directory (file
),
1199 Ffile_name_nondirectory (found
))
1204 /* Check for the presence of old-style quotes and warn about them. */
1205 specbind (Qold_style_backquotes
, Qnil
);
1206 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1208 if (suffix_p (found
, ".elc") || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1209 /* Load .elc files directly, but not when they are
1210 remote and have no handler! */
1218 && ! (version
= safe_to_load_version (fd
)))
1221 if (!load_dangerous_libraries
)
1222 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1223 else if (!NILP (nomessage
) && !force_load_messages
)
1224 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1229 efound
= ENCODE_FILE (found
);
1230 fmode
= "r" FOPEN_BINARY
;
1232 /* openp already checked for newness, no point doing it again.
1233 FIXME would be nice to get a message when openp
1234 ignores suffix order due to load_prefer_newer. */
1235 if (!load_prefer_newer
)
1237 result
= stat (SSDATA (efound
), &s1
);
1240 SSET (efound
, SBYTES (efound
) - 1, 0);
1241 result
= stat (SSDATA (efound
), &s2
);
1242 SSET (efound
, SBYTES (efound
) - 1, 'c');
1246 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1248 /* Make the progress messages mention that source is newer. */
1251 /* If we won't print another message, mention this anyway. */
1252 if (!NILP (nomessage
) && !force_load_messages
)
1254 Lisp_Object msg_file
;
1255 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1256 message_with_string ("Source file `%s' newer than byte-compiled file",
1260 } /* !load_prefer_newer */
1265 /* We are loading a source file (*.el). */
1266 if (!NILP (Vload_source_file_function
))
1273 clear_unwind_protect (fd_index
);
1275 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1276 NILP (noerror
) ? Qnil
: Qt
,
1277 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1278 return unbind_to (count
, val
);
1284 /* We somehow got here with fd == -2, meaning the file is deemed
1285 to be remote. Don't even try to reopen the file locally;
1286 just force a failure. */
1294 clear_unwind_protect (fd_index
);
1295 efound
= ENCODE_FILE (found
);
1296 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1298 stream
= fdopen (fd
, fmode
);
1302 report_file_error ("Opening stdio stream", file
);
1303 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1305 if (! NILP (Vpurify_flag
))
1306 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1308 if (NILP (nomessage
) || force_load_messages
)
1311 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1314 message_with_string ("Loading %s (source)...", file
, 1);
1316 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1318 else /* The typical case; compiled file newer than source file. */
1319 message_with_string ("Loading %s...", file
, 1);
1322 specbind (Qload_file_name
, found
);
1323 specbind (Qinhibit_file_name_operation
, Qnil
);
1324 specbind (Qload_in_progress
, Qt
);
1327 if (lisp_file_lexically_bound_p (Qget_file_char
))
1328 Fset (Qlexical_binding
, Qt
);
1330 if (! version
|| version
>= 22)
1331 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1332 0, Qnil
, Qnil
, Qnil
, Qnil
);
1335 /* We can't handle a file which was compiled with
1336 byte-compile-dynamic by older version of Emacs. */
1337 specbind (Qload_force_doc_strings
, Qt
);
1338 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1339 0, Qnil
, Qnil
, Qnil
, Qnil
);
1341 unbind_to (count
, Qnil
);
1343 /* Run any eval-after-load forms for this file. */
1344 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1345 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1347 xfree (saved_doc_string
);
1348 saved_doc_string
= 0;
1349 saved_doc_string_size
= 0;
1351 xfree (prev_saved_doc_string
);
1352 prev_saved_doc_string
= 0;
1353 prev_saved_doc_string_size
= 0;
1355 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1358 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1361 message_with_string ("Loading %s (source)...done", file
, 1);
1363 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1365 else /* The typical case; compiled file newer than source file. */
1366 message_with_string ("Loading %s...done", file
, 1);
1373 complete_filename_p (Lisp_Object pathname
)
1375 const unsigned char *s
= SDATA (pathname
);
1376 return (IS_DIRECTORY_SEP (s
[0])
1377 || (SCHARS (pathname
) > 2
1378 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1381 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1382 doc
: /* Search for FILENAME through PATH.
1383 Returns the file's name in absolute form, or nil if not found.
1384 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1385 file name when searching.
1386 If non-nil, PREDICATE is used instead of `file-readable-p'.
1387 PREDICATE can also be an integer to pass to the faccessat(2) function,
1388 in which case file-name-handlers are ignored.
1389 This function will normally skip directories, so if you want it to find
1390 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1391 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1394 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1395 if (NILP (predicate
) && fd
>= 0)
1400 /* Search for a file whose name is STR, looking in directories
1401 in the Lisp list PATH, and trying suffixes from SUFFIX.
1402 On success, return a file descriptor (or 1 or -2 as described below).
1403 On failure, return -1 and set errno.
1405 SUFFIXES is a list of strings containing possible suffixes.
1406 The empty suffix is automatically added if the list is empty.
1408 PREDICATE t means the files are binary.
1409 PREDICATE non-nil and non-t means don't open the files,
1410 just look for one that satisfies the predicate. In this case,
1411 return 1 on success. The predicate can be a lisp function or
1412 an integer to pass to `access' (in which case file-name-handlers
1415 If STOREPTR is nonzero, it points to a slot where the name of
1416 the file actually found should be stored as a Lisp string.
1417 nil is stored there on failure.
1419 If the file we find is remote, return -2
1420 but store the found remote file name in *STOREPTR.
1422 If NEWER is true, try all SUFFIXes and return the result for the
1423 newest file that exists. Does not apply to remote files,
1424 or if a non-nil and non-t PREDICATE is specified. */
1427 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1428 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1430 ptrdiff_t fn_size
= 100;
1434 ptrdiff_t want_length
;
1435 Lisp_Object filename
;
1436 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1437 ptrdiff_t max_suffix_len
= 0;
1438 int last_errno
= ENOENT
;
1442 /* The last-modified time of the newest matching file found.
1443 Initialize it to something less than all valid timestamps. */
1444 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1448 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1450 CHECK_STRING_CAR (tail
);
1451 max_suffix_len
= max (max_suffix_len
,
1452 SBYTES (XCAR (tail
)));
1455 string
= filename
= encoded_fn
= save_string
= Qnil
;
1460 absolute
= complete_filename_p (str
);
1462 for (; CONSP (path
); path
= XCDR (path
))
1464 filename
= Fexpand_file_name (str
, XCAR (path
));
1465 if (!complete_filename_p (filename
))
1466 /* If there are non-absolute elts in PATH (eg "."). */
1467 /* Of course, this could conceivably lose if luser sets
1468 default-directory to be something non-absolute... */
1470 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1471 if (!complete_filename_p (filename
))
1472 /* Give up on this path element! */
1476 /* Calculate maximum length of any filename made from
1477 this path element/specified file name and any possible suffix. */
1478 want_length
= max_suffix_len
+ SBYTES (filename
);
1479 if (fn_size
<= want_length
)
1481 fn_size
= 100 + want_length
;
1482 fn
= SAFE_ALLOCA (fn_size
);
1485 /* Loop over suffixes. */
1486 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1487 CONSP (tail
); tail
= XCDR (tail
))
1489 Lisp_Object suffix
= XCAR (tail
);
1490 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1491 Lisp_Object handler
;
1493 /* Concatenate path element/specified name with the suffix.
1494 If the directory starts with /:, remove that. */
1495 int prefixlen
= ((SCHARS (filename
) > 2
1496 && SREF (filename
, 0) == '/'
1497 && SREF (filename
, 1) == ':')
1499 fnlen
= SBYTES (filename
) - prefixlen
;
1500 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1501 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1503 /* Check that the file exists and is not a directory. */
1504 /* We used to only check for handlers on non-absolute file names:
1508 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1509 It's not clear why that was the case and it breaks things like
1510 (load "/bar.el") where the file is actually "/bar.el.gz". */
1511 /* make_string has its own ideas on when to return a unibyte
1512 string and when a multibyte string, but we know better.
1513 We must have a unibyte string when dumping, since
1514 file-name encoding is shaky at best at that time, and in
1515 particular default-file-name-coding-system is reset
1516 several times during loadup. We therefore don't want to
1517 encode the file before passing it to file I/O library
1519 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1520 string
= make_unibyte_string (fn
, fnlen
);
1522 string
= make_string (fn
, fnlen
);
1523 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1524 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1525 && !NATNUMP (predicate
))
1528 if (NILP (predicate
) || EQ (predicate
, Qt
))
1529 exists
= !NILP (Ffile_readable_p (string
));
1532 Lisp_Object tmp
= call1 (predicate
, string
);
1535 else if (EQ (tmp
, Qdir_ok
)
1536 || NILP (Ffile_directory_p (string
)))
1541 last_errno
= EISDIR
;
1547 /* We succeeded; return this descriptor and filename. */
1560 encoded_fn
= ENCODE_FILE (string
);
1561 pfn
= SSDATA (encoded_fn
);
1563 /* Check that we can access or open it. */
1564 if (NATNUMP (predicate
))
1567 if (INT_MAX
< XFASTINT (predicate
))
1568 last_errno
= EINVAL
;
1569 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1573 if (file_directory_p (pfn
))
1574 last_errno
= EISDIR
;
1581 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1584 if (errno
!= ENOENT
)
1589 int err
= (fstat (fd
, &st
) != 0 ? errno
1590 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1602 if (newer
&& !NATNUMP (predicate
))
1604 struct timespec mtime
= get_stat_mtime (&st
);
1606 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1611 emacs_close (save_fd
);
1614 save_string
= string
;
1619 /* We succeeded; return this descriptor and filename. */
1627 /* No more suffixes. Return the newest. */
1628 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1631 *storeptr
= save_string
;
1647 /* Merge the list we've accumulated of globals from the current input source
1648 into the load_history variable. The details depend on whether
1649 the source has an associated file name or not.
1651 FILENAME is the file name that we are loading from.
1653 ENTIRE is true if loading that entire file, false if evaluating
1657 build_load_history (Lisp_Object filename
, bool entire
)
1659 Lisp_Object tail
, prev
, newelt
;
1660 Lisp_Object tem
, tem2
;
1663 tail
= Vload_history
;
1666 while (CONSP (tail
))
1670 /* Find the feature's previous assoc list... */
1671 if (!NILP (Fequal (filename
, Fcar (tem
))))
1675 /* If we're loading the entire file, remove old data. */
1679 Vload_history
= XCDR (tail
);
1681 Fsetcdr (prev
, XCDR (tail
));
1684 /* Otherwise, cons on new symbols that are not already members. */
1687 tem2
= Vcurrent_load_list
;
1689 while (CONSP (tem2
))
1691 newelt
= XCAR (tem2
);
1693 if (NILP (Fmember (newelt
, tem
)))
1694 Fsetcar (tail
, Fcons (XCAR (tem
),
1695 Fcons (newelt
, XCDR (tem
))));
1708 /* If we're loading an entire file, cons the new assoc onto the
1709 front of load-history, the most-recently-loaded position. Also
1710 do this if we didn't find an existing member for the file. */
1711 if (entire
|| !foundit
)
1712 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1717 readevalloop_1 (int old
)
1719 load_convert_to_unibyte
= old
;
1722 /* Signal an `end-of-file' error, if possible with file name
1725 static _Noreturn
void
1726 end_of_file_error (void)
1728 if (STRINGP (Vload_file_name
))
1729 xsignal1 (Qend_of_file
, Vload_file_name
);
1731 xsignal0 (Qend_of_file
);
1735 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1737 /* If we macroexpand the toplevel form non-recursively and it ends
1738 up being a `progn' (or if it was a progn to start), treat each
1739 form in the progn as a top-level form. This way, if one form in
1740 the progn defines a macro, that macro is in effect when we expand
1741 the remaining forms. See similar code in bytecomp.el. */
1742 val
= call2 (macroexpand
, val
, Qnil
);
1743 if (EQ (CAR_SAFE (val
), Qprogn
))
1745 Lisp_Object subforms
= XCDR (val
);
1747 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1748 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1752 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1756 /* UNIBYTE specifies how to set load_convert_to_unibyte
1757 for this invocation.
1758 READFUN, if non-nil, is used instead of `read'.
1760 START, END specify region to read in current buffer (from eval-region).
1761 If the input is not from a buffer, they must be nil. */
1764 readevalloop (Lisp_Object readcharfun
,
1766 Lisp_Object sourcename
,
1768 Lisp_Object unibyte
, Lisp_Object readfun
,
1769 Lisp_Object start
, Lisp_Object end
)
1773 ptrdiff_t count
= SPECPDL_INDEX ();
1774 struct buffer
*b
= 0;
1775 bool continue_reading_p
;
1776 Lisp_Object lex_bound
;
1777 /* True if reading an entire buffer. */
1778 bool whole_buffer
= 0;
1779 /* True on the first time around. */
1780 bool first_sexp
= 1;
1781 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1783 if (NILP (Ffboundp (macroexpand
))
1784 /* Don't macroexpand in .elc files, since it should have been done
1785 already. We actually don't know whether we're in a .elc file or not,
1786 so we use circumstantial evidence: .el files normally go through
1787 Vload_source_file_function -> load-with-code-conversion
1789 || EQ (readcharfun
, Qget_file_char
)
1790 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1793 if (MARKERP (readcharfun
))
1796 start
= readcharfun
;
1799 if (BUFFERP (readcharfun
))
1800 b
= XBUFFER (readcharfun
);
1801 else if (MARKERP (readcharfun
))
1802 b
= XMARKER (readcharfun
)->buffer
;
1804 /* We assume START is nil when input is not from a buffer. */
1805 if (! NILP (start
) && !b
)
1808 specbind (Qstandard_input
, readcharfun
);
1809 specbind (Qcurrent_load_list
, Qnil
);
1810 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1811 load_convert_to_unibyte
= !NILP (unibyte
);
1813 /* If lexical binding is active (either because it was specified in
1814 the file's header, or via a buffer-local variable), create an empty
1815 lexical environment, otherwise, turn off lexical binding. */
1816 lex_bound
= find_symbol_value (Qlexical_binding
);
1817 specbind (Qinternal_interpreter_environment
,
1818 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1819 ? Qnil
: list1 (Qt
)));
1821 /* Try to ensure sourcename is a truename, except whilst preloading. */
1822 if (NILP (Vpurify_flag
)
1823 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1824 && !NILP (Ffboundp (Qfile_truename
)))
1825 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1827 LOADHIST_ATTACH (sourcename
);
1829 continue_reading_p
= 1;
1830 while (continue_reading_p
)
1832 ptrdiff_t count1
= SPECPDL_INDEX ();
1834 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1835 error ("Reading from killed buffer");
1839 /* Switch to the buffer we are reading from. */
1840 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1841 set_buffer_internal (b
);
1843 /* Save point in it. */
1844 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1845 /* Save ZV in it. */
1846 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1847 /* Those get unbound after we read one expression. */
1849 /* Set point and ZV around stuff to be read. */
1852 Fnarrow_to_region (make_number (BEGV
), end
);
1854 /* Just for cleanliness, convert END to a marker
1855 if it is an integer. */
1857 end
= Fpoint_max_marker ();
1860 /* On the first cycle, we can easily test here
1861 whether we are reading the whole buffer. */
1862 if (b
&& first_sexp
)
1863 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1870 while ((c
= READCHAR
) != '\n' && c
!= -1);
1875 unbind_to (count1
, Qnil
);
1879 /* Ignore whitespace here, so we can detect eof. */
1880 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1881 || c
== NO_BREAK_SPACE
)
1884 if (!NILP (Vpurify_flag
) && c
== '(')
1886 val
= read_list (0, readcharfun
);
1891 read_objects
= Qnil
;
1892 if (!NILP (readfun
))
1894 val
= call1 (readfun
, readcharfun
);
1896 /* If READCHARFUN has set point to ZV, we should
1897 stop reading, even if the form read sets point
1898 to a different value when evaluated. */
1899 if (BUFFERP (readcharfun
))
1901 struct buffer
*buf
= XBUFFER (readcharfun
);
1902 if (BUF_PT (buf
) == BUF_ZV (buf
))
1903 continue_reading_p
= 0;
1906 else if (! NILP (Vload_read_function
))
1907 val
= call1 (Vload_read_function
, readcharfun
);
1909 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1912 if (!NILP (start
) && continue_reading_p
)
1913 start
= Fpoint_marker ();
1915 /* Restore saved point and BEGV. */
1916 unbind_to (count1
, Qnil
);
1918 /* Now eval what we just read. */
1919 if (!NILP (macroexpand
))
1920 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1922 val
= eval_sub (val
);
1926 Vvalues
= Fcons (val
, Vvalues
);
1927 if (EQ (Vstandard_output
, Qt
))
1936 build_load_history (sourcename
,
1937 stream
|| whole_buffer
);
1939 unbind_to (count
, Qnil
);
1942 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1943 doc
: /* Execute the accessible portion of current buffer as Lisp code.
1944 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
1945 When called from a Lisp program (i.e., not interactively), this
1946 function accepts up to five optional arguments:
1947 BUFFER is the buffer to evaluate (nil means use current buffer),
1948 or a name of a buffer (a string).
1949 PRINTFLAG controls printing of output by any output functions in the
1950 evaluated code, such as `print', `princ', and `prin1':
1951 a value of nil means discard it; anything else is the stream to print to.
1952 See Info node `(elisp)Output Streams' for details on streams.
1953 FILENAME specifies the file name to use for `load-history'.
1954 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1956 DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
1957 evaluated code should work normally even if PRINTFLAG is nil, in
1958 which case the output is displayed in the echo area.
1960 This function preserves the position of point. */)
1961 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1963 ptrdiff_t count
= SPECPDL_INDEX ();
1964 Lisp_Object tem
, buf
;
1967 buf
= Fcurrent_buffer ();
1969 buf
= Fget_buffer (buffer
);
1971 error ("No such buffer");
1973 if (NILP (printflag
) && NILP (do_allow_print
))
1978 if (NILP (filename
))
1979 filename
= BVAR (XBUFFER (buf
), filename
);
1981 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1982 specbind (Qstandard_output
, tem
);
1983 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1984 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1985 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1986 readevalloop (buf
, 0, filename
,
1987 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1988 unbind_to (count
, Qnil
);
1993 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1994 doc
: /* Execute the region as Lisp code.
1995 When called from programs, expects two arguments,
1996 giving starting and ending indices in the current buffer
1997 of the text to be executed.
1998 Programs can pass third argument PRINTFLAG which controls output:
1999 a value of nil means discard it; anything else is stream for printing it.
2000 See Info node `(elisp)Output Streams' for details on streams.
2001 Also the fourth argument READ-FUNCTION, if non-nil, is used
2002 instead of `read' to read each expression. It gets one argument
2003 which is the input stream for reading characters.
2005 This function does not move point. */)
2006 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2008 /* FIXME: Do the eval-sexp-add-defvars dance! */
2009 ptrdiff_t count
= SPECPDL_INDEX ();
2010 Lisp_Object tem
, cbuf
;
2012 cbuf
= Fcurrent_buffer ();
2014 if (NILP (printflag
))
2018 specbind (Qstandard_output
, tem
);
2019 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2021 /* `readevalloop' calls functions which check the type of start and end. */
2022 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2023 !NILP (printflag
), Qnil
, read_function
,
2026 return unbind_to (count
, Qnil
);
2030 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2031 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2032 If STREAM is nil, use the value of `standard-input' (which see).
2033 STREAM or the value of `standard-input' may be:
2034 a buffer (read from point and advance it)
2035 a marker (read from where it points and advance it)
2036 a function (call it with no arguments for each character,
2037 call it with a char as argument to push a char back)
2038 a string (takes text from string, starting at the beginning)
2039 t (read text line using minibuffer and use it, or read from
2040 standard input in batch mode). */)
2041 (Lisp_Object stream
)
2044 stream
= Vstandard_input
;
2045 if (EQ (stream
, Qt
))
2046 stream
= Qread_char
;
2047 if (EQ (stream
, Qread_char
))
2048 /* FIXME: ?! When is this used !? */
2049 return call1 (intern ("read-minibuffer"),
2050 build_string ("Lisp expression: "));
2052 return read_internal_start (stream
, Qnil
, Qnil
);
2055 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2056 doc
: /* Read one Lisp expression which is represented as text by STRING.
2057 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2058 FINAL-STRING-INDEX is an integer giving the position of the next
2059 remaining character in STRING. START and END optionally delimit
2060 a substring of STRING from which to read; they default to 0 and
2061 \(length STRING) respectively. Negative values are counted from
2062 the end of STRING. */)
2063 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2066 CHECK_STRING (string
);
2067 /* `read_internal_start' sets `read_from_string_index'. */
2068 ret
= read_internal_start (string
, start
, end
);
2069 return Fcons (ret
, make_number (read_from_string_index
));
2072 /* Function to set up the global context we need in toplevel read
2073 calls. START and END only used when STREAM is a string. */
2075 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2080 new_backquote_flag
= 0;
2081 read_objects
= Qnil
;
2082 if (EQ (Vread_with_symbol_positions
, Qt
)
2083 || EQ (Vread_with_symbol_positions
, stream
))
2084 Vread_symbol_positions_list
= Qnil
;
2086 if (STRINGP (stream
)
2087 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2089 ptrdiff_t startval
, endval
;
2092 if (STRINGP (stream
))
2095 string
= XCAR (stream
);
2097 validate_subarray (string
, start
, end
, SCHARS (string
),
2098 &startval
, &endval
);
2100 read_from_string_index
= startval
;
2101 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2102 read_from_string_limit
= endval
;
2105 retval
= read0 (stream
);
2106 if (EQ (Vread_with_symbol_positions
, Qt
)
2107 || EQ (Vread_with_symbol_positions
, stream
))
2108 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2113 /* Signal Qinvalid_read_syntax error.
2114 S is error string of length N (if > 0) */
2116 static _Noreturn
void
2117 invalid_syntax (const char *s
)
2119 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2123 /* Use this for recursive reads, in contexts where internal tokens
2127 read0 (Lisp_Object readcharfun
)
2129 register Lisp_Object val
;
2132 val
= read1 (readcharfun
, &c
, 0);
2136 xsignal1 (Qinvalid_read_syntax
,
2137 Fmake_string (make_number (1), make_number (c
)));
2140 static ptrdiff_t read_buffer_size
;
2141 static char *read_buffer
;
2143 /* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes. */
2146 grow_read_buffer (void)
2148 read_buffer
= xpalloc (read_buffer
, &read_buffer_size
,
2149 MAX_MULTIBYTE_LENGTH
, -1, 1);
2152 /* Return the scalar value that has the Unicode character name NAME.
2153 Raise 'invalid-read-syntax' if there is no such character. */
2155 character_name_to_code (char const *name
, ptrdiff_t name_len
)
2157 /* For "U+XXXX", pass the leading '+' to string_to_number to reject
2158 monstrosities like "U+-0000". */
2160 = (name
[0] == 'U' && name
[1] == '+'
2161 ? string_to_number (name
+ 1, 16, false)
2162 : call2 (Qchar_from_name
, make_unibyte_string (name
, name_len
), Qt
));
2164 if (! RANGED_INTEGERP (0, code
, MAX_UNICODE_CHAR
)
2165 || char_surrogate_p (XINT (code
)))
2167 AUTO_STRING (format
, "\\N{%s}");
2168 AUTO_STRING_WITH_LEN (namestr
, name
, name_len
);
2169 xsignal1 (Qinvalid_read_syntax
, CALLN (Fformat
, format
, namestr
));
2175 /* Bound on the length of a Unicode character name. As of
2176 Unicode 9.0.0 the maximum is 83, so this should be safe. */
2177 enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND
= 200 };
2179 /* Read a \-escape sequence, assuming we already read the `\'.
2180 If the escape sequence forces unibyte, return eight-bit char. */
2183 read_escape (Lisp_Object readcharfun
, bool stringp
)
2186 /* \u allows up to four hex digits, \U up to eight. Default to the
2187 behavior for \u, and change this value in the case that \U is seen. */
2188 int unicode_hex_count
= 4;
2193 end_of_file_error ();
2223 error ("Invalid escape character syntax");
2226 c
= read_escape (readcharfun
, 0);
2227 return c
| meta_modifier
;
2232 error ("Invalid escape character syntax");
2235 c
= read_escape (readcharfun
, 0);
2236 return c
| shift_modifier
;
2241 error ("Invalid escape character syntax");
2244 c
= read_escape (readcharfun
, 0);
2245 return c
| hyper_modifier
;
2250 error ("Invalid escape character syntax");
2253 c
= read_escape (readcharfun
, 0);
2254 return c
| alt_modifier
;
2258 if (stringp
|| c
!= '-')
2265 c
= read_escape (readcharfun
, 0);
2266 return c
| super_modifier
;
2271 error ("Invalid escape character syntax");
2275 c
= read_escape (readcharfun
, 0);
2276 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2277 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2278 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2279 return c
| ctrl_modifier
;
2280 /* ASCII control chars are made from letters (both cases),
2281 as well as the non-letters within 0100...0137. */
2282 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2283 return (c
& (037 | ~0177));
2284 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2285 return (c
& (037 | ~0177));
2287 return c
| ctrl_modifier
;
2297 /* An octal escape, as in ANSI C. */
2299 register int i
= c
- '0';
2300 register int count
= 0;
2303 if ((c
= READCHAR
) >= '0' && c
<= '7')
2315 if (i
>= 0x80 && i
< 0x100)
2316 i
= BYTE8_TO_CHAR (i
);
2321 /* A hex escape, as in ANSI C. */
2328 if (c
>= '0' && c
<= '9')
2333 else if ((c
>= 'a' && c
<= 'f')
2334 || (c
>= 'A' && c
<= 'F'))
2337 if (c
>= 'a' && c
<= 'f')
2347 /* Allow hex escapes as large as ?\xfffffff, because some
2348 packages use them to denote characters with modifiers. */
2349 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2350 error ("Hex character out of range: \\x%x...", i
);
2354 if (count
< 3 && i
>= 0x80)
2355 return BYTE8_TO_CHAR (i
);
2360 /* Post-Unicode-2.0: Up to eight hex chars. */
2361 unicode_hex_count
= 8;
2364 /* A Unicode escape. We only permit them in strings and characters,
2365 not arbitrarily in the source code, as in some other languages. */
2370 while (++count
<= unicode_hex_count
)
2373 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2375 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2376 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2377 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2379 error ("Non-hex digit used for Unicode escape");
2382 error ("Non-Unicode character: 0x%x", i
);
2387 /* Named character. */
2391 invalid_syntax ("Expected opening brace after \\N");
2392 char name
[UNICODE_CHARACTER_NAME_LENGTH_BOUND
+ 1];
2393 bool whitespace
= false;
2394 ptrdiff_t length
= 0;
2399 end_of_file_error ();
2402 if (! (0 < c
&& c
< 0x80))
2404 AUTO_STRING (format
,
2405 "Invalid character U+%04X in character name");
2406 xsignal1 (Qinvalid_read_syntax
,
2407 CALLN (Fformat
, format
, make_natnum (c
)));
2409 /* Treat multiple adjacent whitespace characters as a
2410 single space character. This makes it easier to use
2411 character names in e.g. multi-line strings. */
2422 if (length
>= sizeof name
)
2423 invalid_syntax ("Character name too long");
2426 invalid_syntax ("Empty character name");
2427 name
[length
] = '\0';
2428 return character_name_to_code (name
, length
);
2436 /* Return the digit that CHARACTER stands for in the given BASE.
2437 Return -1 if CHARACTER is out of range for BASE,
2438 and -2 if CHARACTER is not valid for any supported BASE. */
2440 digit_to_number (int character
, int base
)
2444 if ('0' <= character
&& character
<= '9')
2445 digit
= character
- '0';
2446 else if ('a' <= character
&& character
<= 'z')
2447 digit
= character
- 'a' + 10;
2448 else if ('A' <= character
&& character
<= 'Z')
2449 digit
= character
- 'A' + 10;
2453 return digit
< base
? digit
: -1;
2456 /* Read an integer in radix RADIX using READCHARFUN to read
2457 characters. RADIX must be in the interval [2..36]; if it isn't, a
2458 read error is signaled . Value is the integer read. Signals an
2459 error if encountering invalid read syntax or if RADIX is out of
2463 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2465 /* Room for sign, leading 0, other digits, trailing null byte.
2466 Also, room for invalid syntax diagnostic. */
2467 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2468 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2470 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2472 if (radix
< 2 || radix
> 36)
2480 if (c
== '-' || c
== '+')
2491 /* Ignore redundant leading zeros, so the buffer doesn't
2492 fill up with them. */
2498 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2505 if (p
< buf
+ sizeof buf
- 1)
2519 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2520 invalid_syntax (buf
);
2523 return string_to_number (buf
, radix
, 0);
2527 /* If the next token is ')' or ']' or '.', we store that character
2528 in *PCH and the return value is not interesting. Else, we store
2529 zero in *PCH and we read and return one lisp object.
2531 FIRST_IN_LIST is true if this is the first element of a list. */
2534 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2537 bool uninterned_symbol
= 0;
2544 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2546 end_of_file_error ();
2551 return read_list (0, readcharfun
);
2554 return read_vector (readcharfun
, 0);
2570 /* Accept extended format for hashtables (extensible to
2572 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2573 Lisp_Object tmp
= read_list (0, readcharfun
);
2574 Lisp_Object head
= CAR_SAFE (tmp
);
2575 Lisp_Object data
= Qnil
;
2576 Lisp_Object val
= Qnil
;
2577 /* The size is 2 * number of allowed keywords to
2579 Lisp_Object params
[10];
2581 Lisp_Object key
= Qnil
;
2582 int param_count
= 0;
2584 if (!EQ (head
, Qhash_table
))
2585 error ("Invalid extended read marker at head of #s list "
2586 "(only hash-table allowed)");
2588 tmp
= CDR_SAFE (tmp
);
2590 /* This is repetitive but fast and simple. */
2591 params
[param_count
] = QCsize
;
2592 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2593 if (!NILP (params
[param_count
+ 1]))
2596 params
[param_count
] = QCtest
;
2597 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2598 if (!NILP (params
[param_count
+ 1]))
2601 params
[param_count
] = QCweakness
;
2602 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2603 if (!NILP (params
[param_count
+ 1]))
2606 params
[param_count
] = QCrehash_size
;
2607 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2608 if (!NILP (params
[param_count
+ 1]))
2611 params
[param_count
] = QCrehash_threshold
;
2612 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2613 if (!NILP (params
[param_count
+ 1]))
2616 /* This is the hashtable data. */
2617 data
= Fplist_get (tmp
, Qdata
);
2619 /* Now use params to make a new hashtable and fill it. */
2620 ht
= Fmake_hash_table (param_count
, params
);
2622 while (CONSP (data
))
2627 error ("Odd number of elements in hashtable data");
2630 Fputhash (key
, val
, ht
);
2636 invalid_syntax ("#");
2644 tmp
= read_vector (readcharfun
, 0);
2645 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2646 error ("Invalid size char-table");
2647 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2655 /* Sub char-table can't be read as a regular
2656 vector because of a two C integer fields. */
2657 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2658 ptrdiff_t size
= XINT (Flength (tmp
));
2659 int i
, depth
, min_char
;
2660 struct Lisp_Cons
*cell
;
2663 error ("Zero-sized sub char-table");
2665 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2666 error ("Invalid depth in sub char-table");
2667 depth
= XINT (XCAR (tmp
));
2668 if (chartab_size
[depth
] != size
- 2)
2669 error ("Invalid size in sub char-table");
2670 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2673 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2674 error ("Invalid minimum character in sub-char-table");
2675 min_char
= XINT (XCAR (tmp
));
2676 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2679 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2680 for (i
= 0; i
< size
; i
++)
2682 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2683 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2688 invalid_syntax ("#^^");
2690 invalid_syntax ("#^");
2695 length
= read1 (readcharfun
, pch
, first_in_list
);
2699 Lisp_Object tmp
, val
;
2700 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2701 unsigned char *data
;
2704 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2705 if (STRING_MULTIBYTE (tmp
)
2706 || (size_in_chars
!= SCHARS (tmp
)
2707 /* We used to print 1 char too many
2708 when the number of bits was a multiple of 8.
2709 Accept such input in case it came from an old
2711 && ! (XFASTINT (length
)
2712 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2713 invalid_syntax ("#&...");
2715 val
= make_uninit_bool_vector (XFASTINT (length
));
2716 data
= bool_vector_uchar_data (val
);
2717 memcpy (data
, SDATA (tmp
), size_in_chars
);
2718 /* Clear the extraneous bits in the last byte. */
2719 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2720 data
[size_in_chars
- 1]
2721 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2724 invalid_syntax ("#&...");
2728 /* Accept compiled functions at read-time so that we don't have to
2729 build them using function calls. */
2731 struct Lisp_Vector
*vec
;
2732 tmp
= read_vector (readcharfun
, 1);
2733 vec
= XVECTOR (tmp
);
2734 if (vec
->header
.size
== 0)
2735 invalid_syntax ("Empty byte-code object");
2736 make_byte_code (vec
);
2744 /* Read the string itself. */
2745 tmp
= read1 (readcharfun
, &ch
, 0);
2746 if (ch
!= 0 || !STRINGP (tmp
))
2747 invalid_syntax ("#");
2748 /* Read the intervals and their properties. */
2751 Lisp_Object beg
, end
, plist
;
2753 beg
= read1 (readcharfun
, &ch
, 0);
2758 end
= read1 (readcharfun
, &ch
, 0);
2760 plist
= read1 (readcharfun
, &ch
, 0);
2762 invalid_syntax ("Invalid string property list");
2763 Fset_text_properties (beg
, end
, plist
, tmp
);
2769 /* #@NUMBER is used to skip NUMBER following bytes.
2770 That's used in .elc files to skip over doc strings
2771 and function definitions. */
2774 enum { extra
= 100 };
2775 ptrdiff_t i
, nskip
= 0, digits
= 0;
2777 /* Read a decimal integer. */
2778 while ((c
= READCHAR
) >= 0
2779 && c
>= '0' && c
<= '9')
2781 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2786 if (digits
== 2 && nskip
== 0)
2787 { /* We've just seen #@00, which means "skip to end". */
2788 skip_dyn_eof (readcharfun
);
2793 /* We can't use UNREAD here, because in the code below we side-step
2794 READCHAR. Instead, assume the first char after #@NNN occupies
2795 a single byte, which is the case normally since it's just
2801 if (load_force_doc_strings
2802 && (FROM_FILE_P (readcharfun
)))
2804 /* If we are supposed to force doc strings into core right now,
2805 record the last string that we skipped,
2806 and record where in the file it comes from. */
2808 /* But first exchange saved_doc_string
2809 with prev_saved_doc_string, so we save two strings. */
2811 char *temp
= saved_doc_string
;
2812 ptrdiff_t temp_size
= saved_doc_string_size
;
2813 file_offset temp_pos
= saved_doc_string_position
;
2814 ptrdiff_t temp_len
= saved_doc_string_length
;
2816 saved_doc_string
= prev_saved_doc_string
;
2817 saved_doc_string_size
= prev_saved_doc_string_size
;
2818 saved_doc_string_position
= prev_saved_doc_string_position
;
2819 saved_doc_string_length
= prev_saved_doc_string_length
;
2821 prev_saved_doc_string
= temp
;
2822 prev_saved_doc_string_size
= temp_size
;
2823 prev_saved_doc_string_position
= temp_pos
;
2824 prev_saved_doc_string_length
= temp_len
;
2827 if (saved_doc_string_size
== 0)
2829 saved_doc_string
= xmalloc (nskip
+ extra
);
2830 saved_doc_string_size
= nskip
+ extra
;
2832 if (nskip
> saved_doc_string_size
)
2834 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2835 saved_doc_string_size
= nskip
+ extra
;
2838 saved_doc_string_position
= file_tell (instream
);
2840 /* Copy that many characters into saved_doc_string. */
2842 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2843 saved_doc_string
[i
] = c
= getc (instream
);
2846 saved_doc_string_length
= i
;
2849 /* Skip that many bytes. */
2850 skip_dyn_bytes (readcharfun
, nskip
);
2856 /* #! appears at the beginning of an executable file.
2857 Skip the first line. */
2858 while (c
!= '\n' && c
>= 0)
2863 return Vload_file_name
;
2865 return list2 (Qfunction
, read0 (readcharfun
));
2866 /* #:foo is the uninterned symbol named foo. */
2869 uninterned_symbol
= 1;
2872 && c
!= NO_BREAK_SPACE
2874 || strchr ("\"';()[]#`,", c
) == NULL
)))
2876 /* No symbol character follows, this is the empty
2879 return Fmake_symbol (empty_unibyte_string
);
2883 /* ## is the empty symbol. */
2885 return Fintern (empty_unibyte_string
, Qnil
);
2886 /* Reader forms that can reuse previously read objects. */
2887 if (c
>= '0' && c
<= '9')
2892 /* Read a non-negative integer. */
2893 while (c
>= '0' && c
<= '9')
2895 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2896 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2897 n
= MOST_POSITIVE_FIXNUM
+ 1;
2899 n
= n
* 10 + c
- '0';
2903 if (n
<= MOST_POSITIVE_FIXNUM
)
2905 if (c
== 'r' || c
== 'R')
2906 return read_integer (readcharfun
, n
);
2908 if (! NILP (Vread_circle
))
2910 /* #n=object returns object, but associates it with
2914 /* Make a placeholder for #n# to use temporarily. */
2915 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2916 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2917 read_objects
= Fcons (cell
, read_objects
);
2919 /* Read the object itself. */
2920 tem
= read0 (readcharfun
);
2922 /* Now put it everywhere the placeholder was... */
2923 substitute_object_in_subtree (tem
, placeholder
);
2925 /* ...and #n# will use the real value from now on. */
2926 Fsetcdr (cell
, tem
);
2931 /* #n# returns a previously read object. */
2934 tem
= Fassq (make_number (n
), read_objects
);
2940 /* Fall through to error message. */
2942 else if (c
== 'x' || c
== 'X')
2943 return read_integer (readcharfun
, 16);
2944 else if (c
== 'o' || c
== 'O')
2945 return read_integer (readcharfun
, 8);
2946 else if (c
== 'b' || c
== 'B')
2947 return read_integer (readcharfun
, 2);
2950 invalid_syntax ("#");
2953 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2957 return list2 (Qquote
, read0 (readcharfun
));
2961 int next_char
= READCHAR
;
2963 /* Transition from old-style to new-style:
2964 If we see "(`" it used to mean old-style, which usually works
2965 fine because ` should almost never appear in such a position
2966 for new-style. But occasionally we need "(`" to mean new
2967 style, so we try to distinguish the two by the fact that we
2968 can either write "( `foo" or "(` foo", where the first
2969 intends to use new-style whereas the second intends to use
2970 old-style. For Emacs-25, we should completely remove this
2971 first_in_list exception (old-style can still be obtained via
2973 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2975 Vold_style_backquotes
= Qt
;
2981 bool saved_new_backquote_flag
= new_backquote_flag
;
2983 new_backquote_flag
= 1;
2984 value
= read0 (readcharfun
);
2985 new_backquote_flag
= saved_new_backquote_flag
;
2987 return list2 (Qbackquote
, value
);
2992 int next_char
= READCHAR
;
2994 /* Transition from old-style to new-style:
2995 It used to be impossible to have a new-style , other than within
2996 a new-style `. This is sufficient when ` and , are used in the
2997 normal way, but ` and , can also appear in args to macros that
2998 will not interpret them in the usual way, in which case , may be
2999 used without any ` anywhere near.
3000 So we now use the same heuristic as for backquote: old-style
3001 unquotes are only recognized when first on a list, and when
3002 followed by a space.
3003 Because it's more difficult to peek 2 chars ahead, a new-style
3004 ,@ can still not be used outside of a `, unless it's in the middle
3006 if (new_backquote_flag
3008 || (next_char
!= ' ' && next_char
!= '@'))
3010 Lisp_Object comma_type
= Qnil
;
3015 comma_type
= Qcomma_at
;
3017 comma_type
= Qcomma_dot
;
3020 if (ch
>= 0) UNREAD (ch
);
3021 comma_type
= Qcomma
;
3024 value
= read0 (readcharfun
);
3025 return list2 (comma_type
, value
);
3029 Vold_style_backquotes
= Qt
;
3041 end_of_file_error ();
3043 /* Accept `single space' syntax like (list ? x) where the
3044 whitespace character is SPC or TAB.
3045 Other literal whitespace like NL, CR, and FF are not accepted,
3046 as there are well-established escape sequences for these. */
3047 if (c
== ' ' || c
== '\t')
3048 return make_number (c
);
3051 c
= read_escape (readcharfun
, 0);
3052 modifiers
= c
& CHAR_MODIFIER_MASK
;
3053 c
&= ~CHAR_MODIFIER_MASK
;
3054 if (CHAR_BYTE8_P (c
))
3055 c
= CHAR_TO_BYTE8 (c
);
3058 next_char
= READCHAR
;
3059 ok
= (next_char
<= 040
3060 || (next_char
< 0200
3061 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3064 return make_number (c
);
3066 invalid_syntax ("?");
3071 char *p
= read_buffer
;
3072 char *end
= read_buffer
+ read_buffer_size
;
3074 /* True if we saw an escape sequence specifying
3075 a multibyte character. */
3076 bool force_multibyte
= 0;
3077 /* True if we saw an escape sequence specifying
3078 a single-byte character. */
3079 bool force_singlebyte
= 0;
3081 ptrdiff_t nchars
= 0;
3083 while ((ch
= READCHAR
) >= 0
3086 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3088 ptrdiff_t offset
= p
- read_buffer
;
3089 grow_read_buffer ();
3090 p
= read_buffer
+ offset
;
3091 end
= read_buffer
+ read_buffer_size
;
3098 ch
= read_escape (readcharfun
, 1);
3100 /* CH is -1 if \ newline or \ space has just been seen. */
3103 if (p
== read_buffer
)
3108 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3109 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3111 if (CHAR_BYTE8_P (ch
))
3112 force_singlebyte
= 1;
3113 else if (! ASCII_CHAR_P (ch
))
3114 force_multibyte
= 1;
3115 else /* I.e. ASCII_CHAR_P (ch). */
3117 /* Allow `\C- ' and `\C-?'. */
3118 if (modifiers
== CHAR_CTL
)
3121 ch
= 0, modifiers
= 0;
3123 ch
= 127, modifiers
= 0;
3125 if (modifiers
& CHAR_SHIFT
)
3127 /* Shift modifier is valid only with [A-Za-z]. */
3128 if (ch
>= 'A' && ch
<= 'Z')
3129 modifiers
&= ~CHAR_SHIFT
;
3130 else if (ch
>= 'a' && ch
<= 'z')
3131 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3134 if (modifiers
& CHAR_META
)
3136 /* Move the meta bit to the right place for a
3138 modifiers
&= ~CHAR_META
;
3139 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3140 force_singlebyte
= 1;
3144 /* Any modifiers remaining are invalid. */
3146 error ("Invalid modifier in string");
3147 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3151 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3152 if (CHAR_BYTE8_P (ch
))
3153 force_singlebyte
= 1;
3154 else if (! ASCII_CHAR_P (ch
))
3155 force_multibyte
= 1;
3161 end_of_file_error ();
3163 /* If purifying, and string starts with \ newline,
3164 return zero instead. This is for doc strings
3165 that we are really going to find in etc/DOC.nn.nn. */
3166 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3167 return make_number (0);
3169 if (! force_multibyte
&& force_singlebyte
)
3171 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3172 forms. Convert it to unibyte. */
3173 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3175 p
= read_buffer
+ nchars
;
3178 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3180 || (p
- read_buffer
!= nchars
)));
3185 int next_char
= READCHAR
;
3188 if (next_char
<= 040
3189 || (next_char
< 0200
3190 && strchr ("\"';([#?`,", next_char
) != NULL
))
3196 /* Otherwise, we fall through! Note that the atom-reading loop
3197 below will now loop at least once, assuring that we will not
3198 try to UNREAD two characters in a row. */
3202 if (c
<= 040) goto retry
;
3203 if (c
== NO_BREAK_SPACE
)
3208 char *p
= read_buffer
;
3210 EMACS_INT start_position
= readchar_count
- 1;
3213 char *end
= read_buffer
+ read_buffer_size
;
3217 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3219 ptrdiff_t offset
= p
- read_buffer
;
3220 grow_read_buffer ();
3221 p
= read_buffer
+ offset
;
3222 end
= read_buffer
+ read_buffer_size
;
3229 end_of_file_error ();
3234 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3240 && c
!= NO_BREAK_SPACE
3242 || strchr ("\"';()[]#`,", c
) == NULL
));
3246 ptrdiff_t offset
= p
- read_buffer
;
3247 grow_read_buffer ();
3248 p
= read_buffer
+ offset
;
3249 end
= read_buffer
+ read_buffer_size
;
3255 if (!quoted
&& !uninterned_symbol
)
3257 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3258 if (! NILP (result
))
3262 Lisp_Object name
, result
;
3263 ptrdiff_t nbytes
= p
- read_buffer
;
3266 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3270 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3271 ? make_pure_string
: make_specified_string
)
3272 (read_buffer
, nchars
, nbytes
, multibyte
));
3273 result
= (uninterned_symbol
? Fmake_symbol (name
)
3274 : Fintern (name
, Qnil
));
3276 if (EQ (Vread_with_symbol_positions
, Qt
)
3277 || EQ (Vread_with_symbol_positions
, readcharfun
))
3278 Vread_symbol_positions_list
3279 = Fcons (Fcons (result
, make_number (start_position
)),
3280 Vread_symbol_positions_list
);
3288 /* List of nodes we've seen during substitute_object_in_subtree. */
3289 static Lisp_Object seen_list
;
3292 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3294 Lisp_Object check_object
;
3296 /* We haven't seen any objects when we start. */
3299 /* Make all the substitutions. */
3301 = substitute_object_recurse (object
, placeholder
, object
);
3303 /* Clear seen_list because we're done with it. */
3306 /* The returned object here is expected to always eq the
3308 if (!EQ (check_object
, object
))
3309 error ("Unexpected mutation error in reader");
3312 /* Feval doesn't get called from here, so no gc protection is needed. */
3313 #define SUBSTITUTE(get_val, set_val) \
3315 Lisp_Object old_value = get_val; \
3316 Lisp_Object true_value \
3317 = substitute_object_recurse (object, placeholder, \
3320 if (!EQ (old_value, true_value)) \
3327 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3329 /* If we find the placeholder, return the target object. */
3330 if (EQ (placeholder
, subtree
))
3333 /* If we've been to this node before, don't explore it again. */
3334 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3337 /* If this node can be the entry point to a cycle, remember that
3338 we've seen it. It can only be such an entry point if it was made
3339 by #n=, which means that we can find it as a value in
3341 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3342 seen_list
= Fcons (subtree
, seen_list
);
3344 /* Recurse according to subtree's type.
3345 Every branch must return a Lisp_Object. */
3346 switch (XTYPE (subtree
))
3348 case Lisp_Vectorlike
:
3350 ptrdiff_t i
= 0, length
= 0;
3351 if (BOOL_VECTOR_P (subtree
))
3352 return subtree
; /* No sub-objects anyway. */
3353 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3354 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3355 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3356 else if (VECTORP (subtree
))
3357 length
= ASIZE (subtree
);
3359 /* An unknown pseudovector may contain non-Lisp fields, so we
3360 can't just blindly traverse all its fields. We used to call
3361 `Flength' which signaled `sequencep', so I just preserved this
3363 wrong_type_argument (Qsequencep
, subtree
);
3365 if (SUB_CHAR_TABLE_P (subtree
))
3367 for ( ; i
< length
; i
++)
3368 SUBSTITUTE (AREF (subtree
, i
),
3369 ASET (subtree
, i
, true_value
));
3375 SUBSTITUTE (XCAR (subtree
),
3376 XSETCAR (subtree
, true_value
));
3377 SUBSTITUTE (XCDR (subtree
),
3378 XSETCDR (subtree
, true_value
));
3384 /* Check for text properties in each interval.
3385 substitute_in_interval contains part of the logic. */
3387 INTERVAL root_interval
= string_intervals (subtree
);
3388 AUTO_CONS (arg
, object
, placeholder
);
3390 traverse_intervals_noorder (root_interval
,
3391 &substitute_in_interval
, arg
);
3396 /* Other types don't recurse any further. */
3402 /* Helper function for substitute_object_recurse. */
3404 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3406 Lisp_Object object
= Fcar (arg
);
3407 Lisp_Object placeholder
= Fcdr (arg
);
3409 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3419 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3420 integer syntax and fits in a fixnum, else return the nearest float if CP has
3421 either floating point or integer syntax and BASE is 10, else return nil. If
3422 IGNORE_TRAILING, consider just the longest prefix of CP that has
3423 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3424 number has integer syntax but does not fit. */
3427 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3430 char const *cp
= string
;
3432 bool float_syntax
= 0;
3435 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3436 IEEE floating point hosts, and works around a formerly-common bug where
3437 atof ("-0.0") drops the sign. */
3438 bool negative
= *cp
== '-';
3440 bool signedp
= negative
|| *cp
== '+';
3445 leading_digit
= digit_to_number (*cp
, base
);
3446 if (leading_digit
>= 0)
3451 while (digit_to_number (*cp
, base
) >= 0);
3461 if ('0' <= *cp
&& *cp
<= '9')
3466 while ('0' <= *cp
&& *cp
<= '9');
3468 if (*cp
== 'e' || *cp
== 'E')
3470 char const *ecp
= cp
;
3472 if (*cp
== '+' || *cp
== '-')
3474 if ('0' <= *cp
&& *cp
<= '9')
3479 while ('0' <= *cp
&& *cp
<= '9');
3481 else if (cp
[-1] == '+'
3482 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3488 else if (cp
[-1] == '+'
3489 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3493 /* NAN is a "positive" NaN on all known Emacs hosts. */
3500 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3501 || state
== (LEAD_INT
|E_EXP
));
3504 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3505 any prefix that matches. Otherwise, the entire string must match. */
3506 if (! (ignore_trailing
3507 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3508 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3511 /* If the number uses integer and not float syntax, and is in C-language
3512 range, use its value, preferably as a fixnum. */
3513 if (leading_digit
>= 0 && ! float_syntax
)
3517 /* Fast special case for single-digit integers. This also avoids a
3518 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3519 case some versions of strtoumax accept numbers like "0x1" that Emacs
3521 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3522 return make_number (negative
? -leading_digit
: leading_digit
);
3525 n
= strtoumax (string
+ signedp
, NULL
, base
);
3526 if (errno
== ERANGE
)
3528 /* Unfortunately there's no simple and accurate way to convert
3529 non-base-10 numbers that are out of C-language range. */
3531 xsignal1 (Qoverflow_error
, build_string (string
));
3533 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3535 EMACS_INT signed_n
= n
;
3536 return make_number (negative
? -signed_n
: signed_n
);
3542 /* Either the number uses float syntax, or it does not fit into a fixnum.
3543 Convert it from string to floating point, unless the value is already
3544 known because it is an infinity, a NAN, or its absolute value fits in
3547 value
= atof (string
+ signedp
);
3549 return make_float (negative
? -value
: value
);
3554 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3558 Lisp_Object tem
, item
, vector
;
3559 struct Lisp_Cons
*otem
;
3562 tem
= read_list (1, readcharfun
);
3563 len
= Flength (tem
);
3564 vector
= Fmake_vector (len
, Qnil
);
3566 size
= ASIZE (vector
);
3567 ptr
= XVECTOR (vector
)->contents
;
3568 for (i
= 0; i
< size
; i
++)
3571 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3572 bytecode object, the docstring containing the bytecode and
3573 constants values must be treated as unibyte and passed to
3574 Fread, to get the actual bytecode string and constants vector. */
3575 if (bytecodeflag
&& load_force_doc_strings
)
3577 if (i
== COMPILED_BYTECODE
)
3579 if (!STRINGP (item
))
3580 error ("Invalid byte code");
3582 /* Delay handling the bytecode slot until we know whether
3583 it is lazily-loaded (we can tell by whether the
3584 constants slot is nil). */
3585 ASET (vector
, COMPILED_CONSTANTS
, item
);
3588 else if (i
== COMPILED_CONSTANTS
)
3590 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3594 /* Coerce string to unibyte (like string-as-unibyte,
3595 but without generating extra garbage and
3596 guaranteeing no change in the contents). */
3597 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3598 STRING_SET_UNIBYTE (bytestr
);
3600 item
= Fread (Fcons (bytestr
, readcharfun
));
3602 error ("Invalid byte code");
3604 otem
= XCONS (item
);
3605 bytestr
= XCAR (item
);
3610 /* Now handle the bytecode slot. */
3611 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3613 else if (i
== COMPILED_DOC_STRING
3615 && ! STRING_MULTIBYTE (item
))
3617 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3618 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3620 item
= Fstring_as_multibyte (item
);
3623 ASET (vector
, i
, item
);
3631 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3634 read_list (bool flag
, Lisp_Object readcharfun
)
3636 Lisp_Object val
, tail
;
3637 Lisp_Object elt
, tem
;
3638 /* 0 is the normal case.
3639 1 means this list is a doc reference; replace it with the number 0.
3640 2 means this list is a doc reference; replace it with the doc string. */
3641 int doc_reference
= 0;
3643 /* Initialize this to 1 if we are reading a list. */
3644 bool first_in_list
= flag
<= 0;
3652 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3656 /* While building, if the list starts with #$, treat it specially. */
3657 if (EQ (elt
, Vload_file_name
)
3659 && !NILP (Vpurify_flag
))
3661 if (NILP (Vdoc_file_name
))
3662 /* We have not yet called Snarf-documentation, so assume
3663 this file is described in the DOC file
3664 and Snarf-documentation will fill in the right value later.
3665 For now, replace the whole list with 0. */
3668 /* We have already called Snarf-documentation, so make a relative
3669 file name for this file, so it can be found properly
3670 in the installed Lisp directory.
3671 We don't use Fexpand_file_name because that would make
3672 the directory absolute now. */
3674 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3675 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3678 else if (EQ (elt
, Vload_file_name
)
3680 && load_force_doc_strings
)
3689 invalid_syntax (") or . in a vector");
3696 XSETCDR (tail
, read0 (readcharfun
));
3698 val
= read0 (readcharfun
);
3699 read1 (readcharfun
, &ch
, 0);
3703 if (doc_reference
== 1)
3704 return make_number (0);
3705 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3708 file_offset saved_position
;
3709 /* Get a doc string from the file we are loading.
3710 If it's in saved_doc_string, get it from there.
3712 Here, we don't know if the string is a
3713 bytecode string or a doc string. As a
3714 bytecode string must be unibyte, we always
3715 return a unibyte string. If it is actually a
3716 doc string, caller must make it
3719 /* Position is negative for user variables. */
3720 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3721 if (pos
>= saved_doc_string_position
3722 && pos
< (saved_doc_string_position
3723 + saved_doc_string_length
))
3725 saved
= saved_doc_string
;
3726 saved_position
= saved_doc_string_position
;
3728 /* Look in prev_saved_doc_string the same way. */
3729 else if (pos
>= prev_saved_doc_string_position
3730 && pos
< (prev_saved_doc_string_position
3731 + prev_saved_doc_string_length
))
3733 saved
= prev_saved_doc_string
;
3734 saved_position
= prev_saved_doc_string_position
;
3738 ptrdiff_t start
= pos
- saved_position
;
3741 /* Process quoting with ^A,
3742 and find the end of the string,
3743 which is marked with ^_ (037). */
3744 for (from
= start
, to
= start
;
3745 saved
[from
] != 037;)
3747 int c
= saved
[from
++];
3751 saved
[to
++] = (c
== 1 ? c
3760 return make_unibyte_string (saved
+ start
,
3764 return get_doc_string (val
, 1, 0);
3769 invalid_syntax (". in wrong context");
3771 invalid_syntax ("] in a list");
3775 XSETCDR (tail
, tem
);
3782 static Lisp_Object initial_obarray
;
3784 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3786 static size_t oblookup_last_bucket_number
;
3788 /* Get an error if OBARRAY is not an obarray.
3789 If it is one, return it. */
3792 check_obarray (Lisp_Object obarray
)
3794 /* We don't want to signal a wrong-type-argument error when we are
3795 shutting down due to a fatal error, and we don't want to hit
3796 assertions in VECTORP and ASIZE if the fatal error was during GC. */
3797 if (!fatal_error_in_progress
3798 && (!VECTORP (obarray
) || ASIZE (obarray
) == 0))
3800 /* If Vobarray is now invalid, force it to be valid. */
3801 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3802 wrong_type_argument (Qvectorp
, obarray
);
3807 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3810 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3814 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3815 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3818 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3820 XSYMBOL (sym
)->constant
= 1;
3821 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3822 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3825 ptr
= aref_addr (obarray
, XINT (index
));
3826 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3831 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3834 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3836 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3839 /* Intern the C string STR: return a symbol with that name,
3840 interned in the current obarray. */
3843 intern_1 (const char *str
, ptrdiff_t len
)
3845 Lisp_Object obarray
= check_obarray (Vobarray
);
3846 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3848 return (SYMBOLP (tem
) ? tem
3849 /* The above `oblookup' was done on the basis of nchars==nbytes, so
3850 the string has to be unibyte. */
3851 : intern_driver (make_unibyte_string (str
, len
),
3856 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3858 Lisp_Object obarray
= check_obarray (Vobarray
);
3859 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3863 /* Creating a non-pure string from a string literal not implemented yet.
3864 We could just use make_string here and live with the extra copy. */
3865 eassert (!NILP (Vpurify_flag
));
3866 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3872 define_symbol (Lisp_Object sym
, char const *str
)
3874 ptrdiff_t len
= strlen (str
);
3875 Lisp_Object string
= make_pure_c_string (str
, len
);
3876 init_symbol (sym
, string
);
3878 /* Qunbound is uninterned, so that it's not confused with any symbol
3879 'unbound' created by a Lisp program. */
3880 if (! EQ (sym
, Qunbound
))
3882 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3883 eassert (INTEGERP (bucket
));
3884 intern_sym (sym
, initial_obarray
, bucket
);
3888 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3889 doc
: /* Return the canonical symbol whose name is STRING.
3890 If there is none, one is created by this function and returned.
3891 A second optional argument specifies the obarray to use;
3892 it defaults to the value of `obarray'. */)
3893 (Lisp_Object string
, Lisp_Object obarray
)
3897 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3898 CHECK_STRING (string
);
3900 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3902 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3907 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3908 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3909 NAME may be a string or a symbol. If it is a symbol, that exact
3910 symbol is searched for.
3911 A second optional argument specifies the obarray to use;
3912 it defaults to the value of `obarray'. */)
3913 (Lisp_Object name
, Lisp_Object obarray
)
3915 register Lisp_Object tem
, string
;
3917 if (NILP (obarray
)) obarray
= Vobarray
;
3918 obarray
= check_obarray (obarray
);
3920 if (!SYMBOLP (name
))
3922 CHECK_STRING (name
);
3926 string
= SYMBOL_NAME (name
);
3928 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3929 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3935 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3936 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3937 The value is t if a symbol was found and deleted, nil otherwise.
3938 NAME may be a string or a symbol. If it is a symbol, that symbol
3939 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3940 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3941 usage: (unintern NAME OBARRAY) */)
3942 (Lisp_Object name
, Lisp_Object obarray
)
3944 register Lisp_Object string
, tem
;
3947 if (NILP (obarray
)) obarray
= Vobarray
;
3948 obarray
= check_obarray (obarray
);
3951 string
= SYMBOL_NAME (name
);
3954 CHECK_STRING (name
);
3958 tem
= oblookup (obarray
, SSDATA (string
),
3963 /* If arg was a symbol, don't delete anything but that symbol itself. */
3964 if (SYMBOLP (name
) && !EQ (name
, tem
))
3967 /* There are plenty of other symbols which will screw up the Emacs
3968 session if we unintern them, as well as even more ways to use
3969 `setq' or `fset' or whatnot to make the Emacs session
3970 unusable. Let's not go down this silly road. --Stef */
3971 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3972 error ("Attempt to unintern t or nil"); */
3974 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3976 hash
= oblookup_last_bucket_number
;
3978 if (EQ (AREF (obarray
, hash
), tem
))
3980 if (XSYMBOL (tem
)->next
)
3983 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3984 ASET (obarray
, hash
, sym
);
3987 ASET (obarray
, hash
, make_number (0));
3991 Lisp_Object tail
, following
;
3993 for (tail
= AREF (obarray
, hash
);
3994 XSYMBOL (tail
)->next
;
3997 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3998 if (EQ (following
, tem
))
4000 set_symbol_next (tail
, XSYMBOL (following
)->next
);
4009 /* Return the symbol in OBARRAY whose names matches the string
4010 of SIZE characters (SIZE_BYTE bytes) at PTR.
4011 If there is no such symbol, return the integer bucket number of
4012 where the symbol would be if it were present.
4014 Also store the bucket number in oblookup_last_bucket_number. */
4017 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
4021 register Lisp_Object tail
;
4022 Lisp_Object bucket
, tem
;
4024 obarray
= check_obarray (obarray
);
4025 /* This is sometimes needed in the middle of GC. */
4026 obsize
= gc_asize (obarray
);
4027 hash
= hash_string (ptr
, size_byte
) % obsize
;
4028 bucket
= AREF (obarray
, hash
);
4029 oblookup_last_bucket_number
= hash
;
4030 if (EQ (bucket
, make_number (0)))
4032 else if (!SYMBOLP (bucket
))
4033 error ("Bad data in guts of obarray"); /* Like CADR error message. */
4035 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
4037 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
4038 && SCHARS (SYMBOL_NAME (tail
)) == size
4039 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
4041 else if (XSYMBOL (tail
)->next
== 0)
4044 XSETINT (tem
, hash
);
4049 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
4052 register Lisp_Object tail
;
4053 CHECK_VECTOR (obarray
);
4054 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
4056 tail
= AREF (obarray
, i
);
4061 if (XSYMBOL (tail
)->next
== 0)
4063 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4069 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4071 call1 (function
, sym
);
4074 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4075 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4076 OBARRAY defaults to the value of `obarray'. */)
4077 (Lisp_Object function
, Lisp_Object obarray
)
4079 if (NILP (obarray
)) obarray
= Vobarray
;
4080 obarray
= check_obarray (obarray
);
4082 map_obarray (obarray
, mapatoms_1
, function
);
4086 #define OBARRAY_SIZE 1511
4091 Lisp_Object oblength
;
4092 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4094 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4096 Vobarray
= Fmake_vector (oblength
, make_number (0));
4097 initial_obarray
= Vobarray
;
4098 staticpro (&initial_obarray
);
4100 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4101 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4103 DEFSYM (Qunbound
, "unbound");
4105 DEFSYM (Qnil
, "nil");
4106 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4107 XSYMBOL (Qnil
)->constant
= 1;
4108 XSYMBOL (Qnil
)->declared_special
= true;
4111 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4112 XSYMBOL (Qt
)->constant
= 1;
4113 XSYMBOL (Qt
)->declared_special
= true;
4115 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4118 DEFSYM (Qvariable_documentation
, "variable-documentation");
4120 read_buffer
= xmalloc (size
);
4121 read_buffer_size
= size
;
4125 defsubr (struct Lisp_Subr
*sname
)
4127 Lisp_Object sym
, tem
;
4128 sym
= intern_c_string (sname
->symbol_name
);
4129 XSETPVECTYPE (sname
, PVEC_SUBR
);
4130 XSETSUBR (tem
, sname
);
4131 set_symbol_function (sym
, tem
);
4134 #ifdef NOTDEF /* Use fset in subr.el now! */
4136 defalias (struct Lisp_Subr
*sname
, char *string
)
4139 sym
= intern (string
);
4140 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4144 /* Define an "integer variable"; a symbol whose value is forwarded to a
4145 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4146 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4148 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4149 const char *namestring
, EMACS_INT
*address
)
4152 sym
= intern_c_string (namestring
);
4153 i_fwd
->type
= Lisp_Fwd_Int
;
4154 i_fwd
->intvar
= address
;
4155 XSYMBOL (sym
)->declared_special
= 1;
4156 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4157 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4160 /* Similar but define a variable whose value is t if address contains 1,
4161 nil if address contains 0. */
4163 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4164 const char *namestring
, bool *address
)
4167 sym
= intern_c_string (namestring
);
4168 b_fwd
->type
= Lisp_Fwd_Bool
;
4169 b_fwd
->boolvar
= address
;
4170 XSYMBOL (sym
)->declared_special
= 1;
4171 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4172 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4173 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4176 /* Similar but define a variable whose value is the Lisp Object stored
4177 at address. Two versions: with and without gc-marking of the C
4178 variable. The nopro version is used when that variable will be
4179 gc-marked for some other reason, since marking the same slot twice
4180 can cause trouble with strings. */
4182 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4183 const char *namestring
, Lisp_Object
*address
)
4186 sym
= intern_c_string (namestring
);
4187 o_fwd
->type
= Lisp_Fwd_Obj
;
4188 o_fwd
->objvar
= address
;
4189 XSYMBOL (sym
)->declared_special
= 1;
4190 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4191 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4195 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4196 const char *namestring
, Lisp_Object
*address
)
4198 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4199 staticpro (address
);
4202 /* Similar but define a variable whose value is the Lisp Object stored
4203 at a particular offset in the current kboard object. */
4206 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4207 const char *namestring
, int offset
)
4210 sym
= intern_c_string (namestring
);
4211 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4212 ko_fwd
->offset
= offset
;
4213 XSYMBOL (sym
)->declared_special
= 1;
4214 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4215 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4218 /* Check that the elements of lpath exist. */
4221 load_path_check (Lisp_Object lpath
)
4223 Lisp_Object path_tail
;
4225 /* The only elements that might not exist are those from
4226 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4228 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4230 Lisp_Object dirfile
;
4231 dirfile
= Fcar (path_tail
);
4232 if (STRINGP (dirfile
))
4234 dirfile
= Fdirectory_file_name (dirfile
);
4235 if (! file_accessible_directory_p (dirfile
))
4236 dir_warning ("Lisp directory", XCAR (path_tail
));
4241 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4242 This does not include the standard site-lisp directories
4243 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4244 but it does (unless no_site_lisp is set) include site-lisp
4245 directories in the source/build directories if those exist and we
4246 are running uninstalled.
4248 Uses the following logic:
4249 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4250 The remainder is what happens when dumping works:
4251 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4252 Otherwise use PATH_LOADSEARCH.
4254 If !initialized, then just return PATH_DUMPLOADSEARCH.
4256 If Vinstallation_directory is not nil (ie, running uninstalled):
4257 If installation-dir/lisp exists and not already a member,
4258 we must be running uninstalled. Reset the load-path
4259 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4260 refers to the eventual installation directories. Since we
4261 are not yet installed, we should not use them, even if they exist.)
4262 If installation-dir/lisp does not exist, just add
4263 PATH_DUMPLOADSEARCH at the end instead.
4264 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4265 and not already a member) at the front.
4266 If installation-dir != source-dir (ie running an uninstalled,
4267 out-of-tree build) AND install-dir/src/Makefile exists BUT
4268 install-dir/src/Makefile.in does NOT exist (this is a sanity
4269 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4272 load_path_default (void)
4274 Lisp_Object lpath
= Qnil
;
4279 const char *loadpath
= ns_load_path ();
4282 normal
= PATH_LOADSEARCH
;
4284 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4286 lpath
= decode_env_path (0, normal
, 0);
4289 #else /* !CANNOT_DUMP */
4291 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4296 const char *loadpath
= ns_load_path ();
4297 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4299 lpath
= decode_env_path (0, normal
, 0);
4301 if (!NILP (Vinstallation_directory
))
4303 Lisp_Object tem
, tem1
;
4305 /* Add to the path the lisp subdir of the installation
4306 dir, if it is accessible. Note: in out-of-tree builds,
4307 this directory is empty save for Makefile. */
4308 tem
= Fexpand_file_name (build_string ("lisp"),
4309 Vinstallation_directory
);
4310 tem1
= Ffile_accessible_directory_p (tem
);
4313 if (NILP (Fmember (tem
, lpath
)))
4315 /* We are running uninstalled. The default load-path
4316 points to the eventual installed lisp directories.
4317 We should not use those now, even if they exist,
4318 so start over from a clean slate. */
4319 lpath
= list1 (tem
);
4323 /* That dir doesn't exist, so add the build-time
4324 Lisp dirs instead. */
4326 Lisp_Object dump_path
=
4327 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4328 lpath
= nconc2 (lpath
, dump_path
);
4331 /* Add site-lisp under the installation dir, if it exists. */
4334 tem
= Fexpand_file_name (build_string ("site-lisp"),
4335 Vinstallation_directory
);
4336 tem1
= Ffile_accessible_directory_p (tem
);
4339 if (NILP (Fmember (tem
, lpath
)))
4340 lpath
= Fcons (tem
, lpath
);
4344 /* If Emacs was not built in the source directory,
4345 and it is run from where it was built, add to load-path
4346 the lisp and site-lisp dirs under that directory. */
4348 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4352 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4353 Vinstallation_directory
);
4354 tem1
= Ffile_exists_p (tem
);
4356 /* Don't be fooled if they moved the entire source tree
4357 AFTER dumping Emacs. If the build directory is indeed
4358 different from the source dir, src/Makefile.in and
4359 src/Makefile will not be found together. */
4360 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4361 Vinstallation_directory
);
4362 tem2
= Ffile_exists_p (tem
);
4363 if (!NILP (tem1
) && NILP (tem2
))
4365 tem
= Fexpand_file_name (build_string ("lisp"),
4368 if (NILP (Fmember (tem
, lpath
)))
4369 lpath
= Fcons (tem
, lpath
);
4373 tem
= Fexpand_file_name (build_string ("site-lisp"),
4375 tem1
= Ffile_accessible_directory_p (tem
);
4378 if (NILP (Fmember (tem
, lpath
)))
4379 lpath
= Fcons (tem
, lpath
);
4383 } /* Vinstallation_directory != Vsource_directory */
4385 } /* if Vinstallation_directory */
4387 else /* !initialized */
4389 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4390 source directory. We used to add ../lisp (ie the lisp dir in
4391 the build directory) at the front here, but that should not
4392 be necessary, since in out of tree builds lisp/ is empty, save
4394 lpath
= decode_env_path (0, normal
, 0);
4396 #endif /* !CANNOT_DUMP */
4404 /* First, set Vload_path. */
4406 /* Ignore EMACSLOADPATH when dumping. */
4408 bool use_loadpath
= true;
4410 bool use_loadpath
= NILP (Vpurify_flag
);
4413 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4415 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4417 /* Check (non-nil) user-supplied elements. */
4418 load_path_check (Vload_path
);
4420 /* If no nils in the environment variable, use as-is.
4421 Otherwise, replace any nils with the default. */
4422 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4424 Lisp_Object elem
, elpath
= Vload_path
;
4425 Lisp_Object default_lpath
= load_path_default ();
4427 /* Check defaults, before adding site-lisp. */
4428 load_path_check (default_lpath
);
4430 /* Add the site-lisp directories to the front of the default. */
4431 if (!no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4433 Lisp_Object sitelisp
;
4434 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4435 if (! NILP (sitelisp
))
4436 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4441 /* Replace nils from EMACSLOADPATH by default. */
4442 while (CONSP (elpath
))
4444 elem
= XCAR (elpath
);
4445 elpath
= XCDR (elpath
);
4446 Vload_path
= CALLN (Fappend
, Vload_path
,
4447 NILP (elem
) ? default_lpath
: list1 (elem
));
4449 } /* Fmemq (Qnil, Vload_path) */
4453 Vload_path
= load_path_default ();
4455 /* Check before adding site-lisp directories.
4456 The install should have created them, but they are not
4457 required, so no need to warn if they are absent.
4458 Or we might be running before installation. */
4459 load_path_check (Vload_path
);
4461 /* Add the site-lisp directories at the front. */
4462 if (initialized
&& !no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4464 Lisp_Object sitelisp
;
4465 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4466 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4472 load_in_progress
= 0;
4473 Vload_file_name
= Qnil
;
4474 Vstandard_input
= Qt
;
4475 Vloads_in_progress
= Qnil
;
4478 /* Print a warning that directory intended for use USE and with name
4479 DIRNAME cannot be accessed. On entry, errno should correspond to
4480 the access failure. Print the warning on stderr and put it in
4484 dir_warning (char const *use
, Lisp_Object dirname
)
4486 static char const format
[] = "Warning: %s '%s': %s\n";
4487 int access_errno
= errno
;
4488 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)),
4489 strerror (access_errno
));
4491 /* Don't log the warning before we've initialized!! */
4494 char const *diagnostic
= emacs_strerror (access_errno
);
4496 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4497 + strlen (use
) + SBYTES (dirname
)
4498 + strlen (diagnostic
));
4499 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4501 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4507 syms_of_lread (void)
4510 defsubr (&Sread_from_string
);
4512 defsubr (&Sintern_soft
);
4513 defsubr (&Sunintern
);
4514 defsubr (&Sget_load_suffixes
);
4516 defsubr (&Seval_buffer
);
4517 defsubr (&Seval_region
);
4518 defsubr (&Sread_char
);
4519 defsubr (&Sread_char_exclusive
);
4520 defsubr (&Sread_event
);
4521 defsubr (&Sget_file_char
);
4522 defsubr (&Smapatoms
);
4523 defsubr (&Slocate_file_internal
);
4525 DEFVAR_LISP ("obarray", Vobarray
,
4526 doc
: /* Symbol table for use by `intern' and `read'.
4527 It is a vector whose length ought to be prime for best results.
4528 The vector's contents don't make sense if examined from Lisp programs;
4529 to find all the symbols in an obarray, use `mapatoms'. */);
4531 DEFVAR_LISP ("values", Vvalues
,
4532 doc
: /* List of values of all expressions which were read, evaluated and printed.
4533 Order is reverse chronological. */);
4534 XSYMBOL (intern ("values"))->declared_special
= 0;
4536 DEFVAR_LISP ("standard-input", Vstandard_input
,
4537 doc
: /* Stream for read to get input from.
4538 See documentation of `read' for possible values. */);
4539 Vstandard_input
= Qt
;
4541 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4542 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4544 If this variable is a buffer, then only forms read from that buffer
4545 will be added to `read-symbol-positions-list'.
4546 If this variable is t, then all read forms will be added.
4547 The effect of all other values other than nil are not currently
4548 defined, although they may be in the future.
4550 The positions are relative to the last call to `read' or
4551 `read-from-string'. It is probably a bad idea to set this variable at
4552 the toplevel; bind it instead. */);
4553 Vread_with_symbol_positions
= Qnil
;
4555 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4556 doc
: /* A list mapping read symbols to their positions.
4557 This variable is modified during calls to `read' or
4558 `read-from-string', but only when `read-with-symbol-positions' is
4561 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4562 CHAR-POSITION is an integer giving the offset of that occurrence of the
4563 symbol from the position where `read' or `read-from-string' started.
4565 Note that a symbol will appear multiple times in this list, if it was
4566 read multiple times. The list is in the same order as the symbols
4568 Vread_symbol_positions_list
= Qnil
;
4570 DEFVAR_LISP ("read-circle", Vread_circle
,
4571 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4574 DEFVAR_LISP ("load-path", Vload_path
,
4575 doc
: /* List of directories to search for files to load.
4576 Each element is a string (directory file name) or nil (meaning
4577 `default-directory').
4578 This list is consulted by the `require' function.
4579 Initialized during startup as described in Info node `(elisp)Library Search'.
4580 Use `directory-file-name' when adding items to this path. However, Lisp
4581 programs that process this list should tolerate directories both with
4582 and without trailing slashes. */);
4584 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4585 doc
: /* List of suffixes for Emacs Lisp files and dynamic modules.
4586 This list includes suffixes for both compiled and source Emacs Lisp files.
4587 This list should not include the empty string.
4588 `load' and related functions try to append these suffixes, in order,
4589 to the specified file name if a suffix is allowed or required. */);
4591 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4592 build_pure_c_string (".el"),
4593 build_pure_c_string (MODULES_SUFFIX
));
4595 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4596 build_pure_c_string (".el"));
4598 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix
,
4599 doc
: /* Suffix of loadable module file, or nil of modules are not supported. */);
4601 Vmodule_file_suffix
= build_pure_c_string (MODULES_SUFFIX
);
4603 Vmodule_file_suffix
= Qnil
;
4605 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4606 doc
: /* List of suffixes that indicate representations of \
4608 This list should normally start with the empty string.
4610 Enabling Auto Compression mode appends the suffixes in
4611 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4612 mode removes them again. `load' and related functions use this list to
4613 determine whether they should look for compressed versions of a file
4614 and, if so, which suffixes they should try to append to the file name
4615 in order to do so. However, if you want to customize which suffixes
4616 the loading functions recognize as compression suffixes, you should
4617 customize `jka-compr-load-suffixes' rather than the present variable. */);
4618 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4620 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4621 doc
: /* Non-nil if inside of `load'. */);
4622 DEFSYM (Qload_in_progress
, "load-in-progress");
4624 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4625 doc
: /* An alist of functions to be evalled when particular files are loaded.
4626 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4628 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4629 a symbol (a feature name).
4631 When `load' is run and the file-name argument matches an element's
4632 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4633 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4635 An error in FORMS does not undo the load, but does prevent execution of
4636 the rest of the FORMS. */);
4637 Vafter_load_alist
= Qnil
;
4639 DEFVAR_LISP ("load-history", Vload_history
,
4640 doc
: /* Alist mapping loaded file names to symbols and features.
4641 Each alist element should be a list (FILE-NAME ENTRIES...), where
4642 FILE-NAME is the name of a file that has been loaded into Emacs.
4643 The file name is absolute and true (i.e. it doesn't contain symlinks).
4644 As an exception, one of the alist elements may have FILE-NAME nil,
4645 for symbols and features not associated with any file.
4647 The remaining ENTRIES in the alist element describe the functions and
4648 variables defined in that file, the features provided, and the
4649 features required. Each entry has the form `(provide . FEATURE)',
4650 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4651 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4652 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4653 autoload before this file redefined it as a function. In addition,
4654 entries may also be single symbols, which means that SYMBOL was
4655 defined by `defvar' or `defconst'.
4657 During preloading, the file name recorded is relative to the main Lisp
4658 directory. These file names are converted to absolute at startup. */);
4659 Vload_history
= Qnil
;
4661 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4662 doc
: /* Full name of file being loaded by `load'. */);
4663 Vload_file_name
= Qnil
;
4665 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4666 doc
: /* File name, including directory, of user's initialization file.
4667 If the file loaded had extension `.elc', and the corresponding source file
4668 exists, this variable contains the name of source file, suitable for use
4669 by functions like `custom-save-all' which edit the init file.
4670 While Emacs loads and evaluates the init file, value is the real name
4671 of the file, regardless of whether or not it has the `.elc' extension. */);
4672 Vuser_init_file
= Qnil
;
4674 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4675 doc
: /* Used for internal purposes by `load'. */);
4676 Vcurrent_load_list
= Qnil
;
4678 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4679 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4680 Called with a single argument (the stream from which to read).
4681 The default is to use the function `read'. */);
4682 DEFSYM (Qread
, "read");
4683 Vload_read_function
= Qread
;
4685 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4686 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4687 The value should be a function for doing code conversion before
4688 reading a source file. It can also be nil, in which case loading is
4689 done without any code conversion.
4691 If the value is a function, it is called with four arguments,
4692 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4693 the file to load, FILE is the non-absolute name (for messages etc.),
4694 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4695 `load'. The function should return t if the file was loaded. */);
4696 Vload_source_file_function
= Qnil
;
4698 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4699 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4700 This is useful when the file being loaded is a temporary copy. */);
4701 load_force_doc_strings
= 0;
4703 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4704 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4705 This is normally bound by `load' and `eval-buffer' to control `read',
4706 and is not meant for users to change. */);
4707 load_convert_to_unibyte
= 0;
4709 DEFVAR_LISP ("source-directory", Vsource_directory
,
4710 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4711 You cannot count on them to still be there! */);
4713 = Fexpand_file_name (build_string ("../"),
4714 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4716 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4717 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4718 Vpreloaded_file_list
= Qnil
;
4720 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4721 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4722 Vbyte_boolean_vars
= Qnil
;
4724 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4725 doc
: /* Non-nil means load dangerous compiled Lisp files.
4726 Some versions of XEmacs use different byte codes than Emacs. These
4727 incompatible byte codes can make Emacs crash when it tries to execute
4729 load_dangerous_libraries
= 0;
4731 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4732 doc
: /* Non-nil means force printing messages when loading Lisp files.
4733 This overrides the value of the NOMESSAGE argument to `load'. */);
4734 force_load_messages
= 0;
4736 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4737 doc
: /* Regular expression matching safe to load compiled Lisp files.
4738 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4739 from the file, and matches them against this regular expression.
4740 When the regular expression matches, the file is considered to be safe
4741 to load. See also `load-dangerous-libraries'. */);
4742 Vbytecomp_version_regexp
4743 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4745 DEFSYM (Qlexical_binding
, "lexical-binding");
4746 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4747 doc
: /* Whether to use lexical binding when evaluating code.
4748 Non-nil means that the code in the current buffer should be evaluated
4749 with lexical binding.
4750 This variable is automatically set from the file variables of an
4751 interpreted Lisp file read using `load'. Unlike other file local
4752 variables, this must be set in the first line of a file. */);
4753 Vlexical_binding
= Qnil
;
4754 Fmake_variable_buffer_local (Qlexical_binding
);
4756 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4757 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4758 Veval_buffer_list
= Qnil
;
4760 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4761 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4762 Vold_style_backquotes
= Qnil
;
4763 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4765 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4766 doc
: /* Non-nil means `load' prefers the newest version of a file.
4767 This applies when a filename suffix is not explicitly specified and
4768 `load' is trying various possible suffixes (see `load-suffixes' and
4769 `load-file-rep-suffixes'). Normally, it stops at the first file
4770 that exists unless you explicitly specify one or the other. If this
4771 option is non-nil, it checks all suffixes and uses whichever file is
4773 Note that if you customize this, obviously it will not affect files
4774 that are loaded before your customizations are read! */);
4775 load_prefer_newer
= 0;
4777 /* Vsource_directory was initialized in init_lread. */
4779 DEFSYM (Qcurrent_load_list
, "current-load-list");
4780 DEFSYM (Qstandard_input
, "standard-input");
4781 DEFSYM (Qread_char
, "read-char");
4782 DEFSYM (Qget_file_char
, "get-file-char");
4784 /* Used instead of Qget_file_char while loading *.elc files compiled
4785 by Emacs 21 or older. */
4786 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4788 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4790 DEFSYM (Qbackquote
, "`");
4791 DEFSYM (Qcomma
, ",");
4792 DEFSYM (Qcomma_at
, ",@");
4793 DEFSYM (Qcomma_dot
, ",.");
4795 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4796 DEFSYM (Qascii_character
, "ascii-character");
4797 DEFSYM (Qfunction
, "function");
4798 DEFSYM (Qload
, "load");
4799 DEFSYM (Qload_file_name
, "load-file-name");
4800 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4801 DEFSYM (Qfile_truename
, "file-truename");
4802 DEFSYM (Qdir_ok
, "dir-ok");
4803 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4805 staticpro (&read_objects
);
4806 read_objects
= Qnil
;
4807 staticpro (&seen_list
);
4810 Vloads_in_progress
= Qnil
;
4811 staticpro (&Vloads_in_progress
);
4813 DEFSYM (Qhash_table
, "hash-table");
4814 DEFSYM (Qdata
, "data");
4815 DEFSYM (Qtest
, "test");
4816 DEFSYM (Qsize
, "size");
4817 DEFSYM (Qweakness
, "weakness");
4818 DEFSYM (Qrehash_size
, "rehash-size");
4819 DEFSYM (Qrehash_threshold
, "rehash-threshold");
4821 DEFSYM (Qchar_from_name
, "char-from-name");