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"
60 #endif /* HAVE_SETLOCALE */
65 #define file_offset off_t
66 #define file_tell ftello
68 #define file_offset long
69 #define file_tell ftell
72 /* The association list of objects read with the #n=object form.
73 Each member of the list has the form (n . object), and is used to
74 look up the object for the corresponding #n# construct.
75 It must be set to nil before all top-level calls to read0. */
76 static Lisp_Object read_objects
;
78 /* File for get_file_char to read from. Use by load. */
79 static FILE *instream
;
81 /* For use within read-from-string (this reader is non-reentrant!!) */
82 static ptrdiff_t read_from_string_index
;
83 static ptrdiff_t read_from_string_index_byte
;
84 static ptrdiff_t read_from_string_limit
;
86 /* Number of characters read in the current call to Fread or
88 static EMACS_INT readchar_count
;
90 /* This contains the last string skipped with #@. */
91 static char *saved_doc_string
;
92 /* Length of buffer allocated in saved_doc_string. */
93 static ptrdiff_t saved_doc_string_size
;
94 /* Length of actual data in saved_doc_string. */
95 static ptrdiff_t saved_doc_string_length
;
96 /* This is the file position that string came from. */
97 static file_offset saved_doc_string_position
;
99 /* This contains the previous string skipped with #@.
100 We copy it from saved_doc_string when a new string
101 is put in saved_doc_string. */
102 static char *prev_saved_doc_string
;
103 /* Length of buffer allocated in prev_saved_doc_string. */
104 static ptrdiff_t prev_saved_doc_string_size
;
105 /* Length of actual data in prev_saved_doc_string. */
106 static ptrdiff_t prev_saved_doc_string_length
;
107 /* This is the file position that string came from. */
108 static file_offset prev_saved_doc_string_position
;
110 /* True means inside a new-style backquote
111 with no surrounding parentheses.
112 Fread initializes this to false, so we need not specbind it
113 or worry about what happens to it when there is an error. */
114 static bool new_backquote_flag
;
116 /* A list of file names for files being loaded in Fload. Used to
117 check for recursive loads. */
119 static Lisp_Object Vloads_in_progress
;
121 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
124 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
125 Lisp_Object
, Lisp_Object
,
126 Lisp_Object
, Lisp_Object
);
128 /* Functions that read one byte from the current source READCHARFUN
129 or unreads one byte. If the integer argument C is -1, it returns
130 one read byte, or -1 when there's no more byte in the source. If C
131 is 0 or positive, it unreads C, and the return value is not
134 static int readbyte_for_lambda (int, Lisp_Object
);
135 static int readbyte_from_file (int, Lisp_Object
);
136 static int readbyte_from_string (int, Lisp_Object
);
138 /* Handle unreading and rereading of characters.
139 Write READCHAR to read a character,
140 UNREAD(c) to unread c to be read again.
142 These macros correctly read/unread multibyte characters. */
144 #define READCHAR readchar (readcharfun, NULL)
145 #define UNREAD(c) unreadchar (readcharfun, c)
147 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
148 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
150 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
151 Qlambda, or a cons, we use this to keep an unread character because
152 a file stream can't handle multibyte-char unreading. The value -1
153 means that there's no unread character. */
154 static int unread_char
;
157 readchar (Lisp_Object readcharfun
, bool *multibyte
)
161 int (*readbyte
) (int, Lisp_Object
);
162 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
164 bool emacs_mule_encoding
= 0;
171 if (BUFFERP (readcharfun
))
173 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
175 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
177 if (! BUFFER_LIVE_P (inbuffer
))
180 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
183 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
185 /* Fetch the character code from the buffer. */
186 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
187 BUF_INC_POS (inbuffer
, pt_byte
);
194 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
195 if (! ASCII_CHAR_P (c
))
196 c
= BYTE8_TO_CHAR (c
);
199 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
203 if (MARKERP (readcharfun
))
205 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
207 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
209 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
212 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
214 /* Fetch the character code from the buffer. */
215 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
216 BUF_INC_POS (inbuffer
, bytepos
);
223 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
224 if (! ASCII_CHAR_P (c
))
225 c
= BYTE8_TO_CHAR (c
);
229 XMARKER (readcharfun
)->bytepos
= bytepos
;
230 XMARKER (readcharfun
)->charpos
++;
235 if (EQ (readcharfun
, Qlambda
))
237 readbyte
= readbyte_for_lambda
;
241 if (EQ (readcharfun
, Qget_file_char
))
243 readbyte
= readbyte_from_file
;
247 if (STRINGP (readcharfun
))
249 if (read_from_string_index
>= read_from_string_limit
)
251 else if (STRING_MULTIBYTE (readcharfun
))
255 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
256 read_from_string_index
,
257 read_from_string_index_byte
);
261 c
= SREF (readcharfun
, read_from_string_index_byte
);
262 read_from_string_index
++;
263 read_from_string_index_byte
++;
268 if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
270 /* This is the case that read_vector is reading from a unibyte
271 string that contains a byte sequence previously skipped
272 because of #@NUMBER. The car part of readcharfun is that
273 string, and the cdr part is a value of readcharfun given to
275 readbyte
= readbyte_from_string
;
276 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
277 emacs_mule_encoding
= 1;
281 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
283 readbyte
= readbyte_from_file
;
284 emacs_mule_encoding
= 1;
288 tem
= call0 (readcharfun
);
295 if (unread_char
>= 0)
301 c
= (*readbyte
) (-1, readcharfun
);
306 if (ASCII_CHAR_P (c
))
308 if (emacs_mule_encoding
)
309 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
312 len
= BYTES_BY_CHAR_HEAD (c
);
315 c
= (*readbyte
) (-1, readcharfun
);
316 if (c
< 0 || ! TRAILING_CODE_P (c
))
319 (*readbyte
) (buf
[i
], readcharfun
);
320 return BYTE8_TO_CHAR (buf
[0]);
324 return STRING_CHAR (buf
);
327 #define FROM_FILE_P(readcharfun) \
328 (EQ (readcharfun, Qget_file_char) \
329 || EQ (readcharfun, Qget_emacs_mule_file_char))
332 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
334 if (FROM_FILE_P (readcharfun
))
336 block_input (); /* FIXME: Not sure if it's needed. */
337 fseek (instream
, n
, SEEK_CUR
);
341 { /* We're not reading directly from a file. In that case, it's difficult
342 to reliably count bytes, since these are usually meant for the file's
343 encoding, whereas we're now typically in the internal encoding.
344 But luckily, skip_dyn_bytes is used to skip over a single
345 dynamic-docstring (or dynamic byte-code) which is always quoted such
346 that \037 is the final char. */
350 } while (c
>= 0 && c
!= '\037');
355 skip_dyn_eof (Lisp_Object readcharfun
)
357 if (FROM_FILE_P (readcharfun
))
359 block_input (); /* FIXME: Not sure if it's needed. */
360 fseek (instream
, 0, SEEK_END
);
364 while (READCHAR
>= 0);
367 /* Unread the character C in the way appropriate for the stream READCHARFUN.
368 If the stream is a user function, call it with the char as argument. */
371 unreadchar (Lisp_Object readcharfun
, int c
)
375 /* Don't back up the pointer if we're unreading the end-of-input mark,
376 since readchar didn't advance it when we read it. */
378 else if (BUFFERP (readcharfun
))
380 struct buffer
*b
= XBUFFER (readcharfun
);
381 ptrdiff_t charpos
= BUF_PT (b
);
382 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
384 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
385 BUF_DEC_POS (b
, bytepos
);
389 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
391 else if (MARKERP (readcharfun
))
393 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
394 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
396 XMARKER (readcharfun
)->charpos
--;
397 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
398 BUF_DEC_POS (b
, bytepos
);
402 XMARKER (readcharfun
)->bytepos
= bytepos
;
404 else if (STRINGP (readcharfun
))
406 read_from_string_index
--;
407 read_from_string_index_byte
408 = string_char_to_byte (readcharfun
, read_from_string_index
);
410 else if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
414 else if (EQ (readcharfun
, Qlambda
))
418 else if (FROM_FILE_P (readcharfun
))
423 call1 (readcharfun
, make_number (c
));
427 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
429 return read_bytecode_char (c
>= 0);
434 readbyte_from_file (int c
, Lisp_Object readcharfun
)
439 ungetc (c
, instream
);
447 /* Interrupted reads have been observed while reading over the network. */
448 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
459 return (c
== EOF
? -1 : c
);
463 readbyte_from_string (int c
, Lisp_Object readcharfun
)
465 Lisp_Object string
= XCAR (readcharfun
);
469 read_from_string_index
--;
470 read_from_string_index_byte
471 = string_char_to_byte (string
, read_from_string_index
);
474 if (read_from_string_index
>= read_from_string_limit
)
477 FETCH_STRING_CHAR_ADVANCE (c
, string
,
478 read_from_string_index
,
479 read_from_string_index_byte
);
484 /* Read one non-ASCII character from INSTREAM. The character is
485 encoded in `emacs-mule' and the first byte is already read in
489 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
491 /* Emacs-mule coding uses at most 4-byte for one character. */
492 unsigned char buf
[4];
493 int len
= emacs_mule_bytes
[c
];
494 struct charset
*charset
;
499 /* C is not a valid leading-code of `emacs-mule'. */
500 return BYTE8_TO_CHAR (c
);
506 c
= (*readbyte
) (-1, readcharfun
);
510 (*readbyte
) (buf
[i
], readcharfun
);
511 return BYTE8_TO_CHAR (buf
[0]);
518 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
519 code
= buf
[1] & 0x7F;
523 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
524 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
526 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
527 code
= buf
[2] & 0x7F;
531 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
532 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
537 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
538 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
540 c
= DECODE_CHAR (charset
, code
);
542 Fsignal (Qinvalid_read_syntax
,
543 list1 (build_string ("invalid multibyte form")));
548 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
550 static Lisp_Object
read0 (Lisp_Object
);
551 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
553 static Lisp_Object
read_list (bool, Lisp_Object
);
554 static Lisp_Object
read_vector (Lisp_Object
, bool);
556 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
558 static void substitute_object_in_subtree (Lisp_Object
,
560 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
563 /* Get a character from the tty. */
565 /* Read input events until we get one that's acceptable for our purposes.
567 If NO_SWITCH_FRAME, switch-frame events are stashed
568 until we get a character we like, and then stuffed into
571 If ASCII_REQUIRED, check function key events to see
572 if the unmodified version of the symbol has a Qascii_character
573 property, and use that character, if present.
575 If ERROR_NONASCII, signal an error if the input we
576 get isn't an ASCII character with modifiers. If it's false but
577 ASCII_REQUIRED is true, just re-read until we get an ASCII
580 If INPUT_METHOD, invoke the current input method
581 if the character warrants that.
583 If SECONDS is a number, wait that many seconds for input, and
584 return Qnil if no input arrives within that time. */
587 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
588 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
590 Lisp_Object val
, delayed_switch_frame
;
591 struct timespec end_time
;
593 #ifdef HAVE_WINDOW_SYSTEM
594 if (display_hourglass_p
)
598 delayed_switch_frame
= Qnil
;
600 /* Compute timeout. */
601 if (NUMBERP (seconds
))
603 double duration
= extract_float (seconds
);
604 struct timespec wait_time
= dtotimespec (duration
);
605 end_time
= timespec_add (current_timespec (), wait_time
);
608 /* Read until we get an acceptable event. */
611 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
612 NUMBERP (seconds
) ? &end_time
: NULL
);
613 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
618 /* `switch-frame' events are put off until after the next ASCII
619 character. This is better than signaling an error just because
620 the last characters were typed to a separate minibuffer frame,
621 for example. Eventually, some code which can deal with
622 switch-frame events will read it and process it. */
624 && EVENT_HAS_PARAMETERS (val
)
625 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
627 delayed_switch_frame
= val
;
631 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
633 /* Convert certain symbols to their ASCII equivalents. */
636 Lisp_Object tem
, tem1
;
637 tem
= Fget (val
, Qevent_symbol_element_mask
);
640 tem1
= Fget (Fcar (tem
), Qascii_character
);
641 /* Merge this symbol's modifier bits
642 with the ASCII equivalent of its basic code. */
644 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
648 /* If we don't have a character now, deal with it appropriately. */
653 Vunread_command_events
= list1 (val
);
654 error ("Non-character input-event");
661 if (! NILP (delayed_switch_frame
))
662 unread_switch_frame
= delayed_switch_frame
;
666 #ifdef HAVE_WINDOW_SYSTEM
667 if (display_hourglass_p
)
676 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
677 doc
: /* Read a character from the command input (keyboard or macro).
678 It is returned as a number.
679 If the character has modifiers, they are resolved and reflected to the
680 character code if possible (e.g. C-SPC -> 0).
682 If the user generates an event which is not a character (i.e. a mouse
683 click or function key event), `read-char' signals an error. As an
684 exception, switch-frame events are put off until non-character events
686 If you want to read non-character events, or ignore them, call
687 `read-event' or `read-char-exclusive' instead.
689 If the optional argument PROMPT is non-nil, display that as a prompt.
690 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
691 input method is turned on in the current buffer, that input method
692 is used for reading a character.
693 If the optional argument SECONDS is non-nil, it should be a number
694 specifying the maximum number of seconds to wait for input. If no
695 input arrives in that time, return nil. SECONDS may be a
696 floating-point value. */)
697 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
702 message_with_string ("%s", prompt
, 0);
703 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
705 return (NILP (val
) ? Qnil
706 : make_number (char_resolve_modifier_mask (XINT (val
))));
709 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
710 doc
: /* Read an event object from the input stream.
711 If the optional argument PROMPT is non-nil, display that as a prompt.
712 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
713 input method is turned on in the current buffer, that input method
714 is used for reading a character.
715 If the optional argument SECONDS is non-nil, it should be a number
716 specifying the maximum number of seconds to wait for input. If no
717 input arrives in that time, return nil. SECONDS may be a
718 floating-point value. */)
719 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
722 message_with_string ("%s", prompt
, 0);
723 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
726 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
727 doc
: /* Read a character from the command input (keyboard or macro).
728 It is returned as a number. Non-character events are ignored.
729 If the character has modifiers, they are resolved and reflected to the
730 character code if possible (e.g. C-SPC -> 0).
732 If the optional argument PROMPT is non-nil, display that as a prompt.
733 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
734 input method is turned on in the current buffer, that input method
735 is used for reading a character.
736 If the optional argument SECONDS is non-nil, it should be a number
737 specifying the maximum number of seconds to wait for input. If no
738 input arrives in that time, return nil. SECONDS may be a
739 floating-point value. */)
740 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
745 message_with_string ("%s", prompt
, 0);
747 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
749 return (NILP (val
) ? Qnil
750 : make_number (char_resolve_modifier_mask (XINT (val
))));
753 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
754 doc
: /* Don't use this yourself. */)
757 register Lisp_Object val
;
759 XSETINT (val
, getc (instream
));
767 /* Return true if the lisp code read using READCHARFUN defines a non-nil
768 `lexical-binding' file variable. After returning, the stream is
769 positioned following the first line, if it is a comment or #! line,
770 otherwise nothing is read. */
773 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
786 while (ch
!= '\n' && ch
!= EOF
)
788 if (ch
== '\n') ch
= READCHAR
;
789 /* It is OK to leave the position after a #! line, since
790 that is what read1 does. */
794 /* The first line isn't a comment, just give up. */
800 /* Look for an appropriate file-variable in the first line. */
804 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
805 } beg_end_state
= NOMINAL
;
806 bool in_file_vars
= 0;
808 #define UPDATE_BEG_END_STATE(ch) \
809 if (beg_end_state == NOMINAL) \
810 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
811 else if (beg_end_state == AFTER_FIRST_DASH) \
812 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
813 else if (beg_end_state == AFTER_ASTERIX) \
816 in_file_vars = !in_file_vars; \
817 beg_end_state = NOMINAL; \
820 /* Skip until we get to the file vars, if any. */
824 UPDATE_BEG_END_STATE (ch
);
826 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
830 char var
[100], val
[100];
835 /* Read a variable name. */
836 while (ch
== ' ' || ch
== '\t')
840 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
842 if (i
< sizeof var
- 1)
844 UPDATE_BEG_END_STATE (ch
);
848 /* Stop scanning if no colon was found before end marker. */
849 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
852 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
858 /* Read a variable value. */
861 while (ch
== ' ' || ch
== '\t')
865 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
867 if (i
< sizeof val
- 1)
869 UPDATE_BEG_END_STATE (ch
);
873 /* The value was terminated by an end-marker, which remove. */
875 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
879 if (strcmp (var
, "lexical-binding") == 0)
882 rv
= (strcmp (val
, "nil") != 0);
888 while (ch
!= '\n' && ch
!= EOF
)
895 /* Value is a version number of byte compiled code if the file
896 associated with file descriptor FD is a compiled Lisp file that's
897 safe to load. Only files compiled with Emacs are safe to load.
898 Files compiled with XEmacs can lead to a crash in Fbyte_code
899 because of an incompatible change in the byte compiler. */
902 safe_to_load_version (int fd
)
908 /* Read the first few bytes from the file, and look for a line
909 specifying the byte compiler version used. */
910 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
913 /* Skip to the next newline, skipping over the initial `ELC'
914 with NUL bytes following it, but note the version. */
915 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
920 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
921 buf
+ i
, nbytes
- i
) < 0)
925 lseek (fd
, 0, SEEK_SET
);
930 /* Callback for record_unwind_protect. Restore the old load list OLD,
931 after loading a file successfully. */
934 record_load_unwind (Lisp_Object old
)
936 Vloads_in_progress
= old
;
939 /* This handler function is used via internal_condition_case_1. */
942 load_error_handler (Lisp_Object data
)
948 load_warn_old_style_backquotes (Lisp_Object file
)
950 if (!NILP (Vold_style_backquotes
))
952 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
953 CALLN (Fmessage
, format
, file
);
957 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
958 doc
: /* Return the suffixes that `load' should try if a suffix is \
960 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
963 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
964 while (CONSP (suffixes
))
966 Lisp_Object exts
= Vload_file_rep_suffixes
;
967 suffix
= XCAR (suffixes
);
968 suffixes
= XCDR (suffixes
);
973 lst
= Fcons (concat2 (suffix
, ext
), lst
);
976 return Fnreverse (lst
);
979 /* Returns true if STRING ends with SUFFIX */
981 suffix_p (Lisp_Object string
, const char *suffix
)
983 ptrdiff_t suffix_len
= strlen (suffix
);
984 ptrdiff_t string_len
= SBYTES (string
);
986 return string_len
>= suffix_len
&& !strcmp (SSDATA (string
) + string_len
- suffix_len
, suffix
);
989 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
990 doc
: /* Execute a file of Lisp code named FILE.
991 First try FILE with `.elc' appended, then try with `.el', then try
992 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
993 then try FILE unmodified (the exact suffixes in the exact order are
994 determined by `load-suffixes'). Environment variable references in
995 FILE are replaced with their values by calling `substitute-in-file-name'.
996 This function searches the directories in `load-path'.
998 If optional second arg NOERROR is non-nil,
999 report no error if FILE doesn't exist.
1000 Print messages at start and end of loading unless
1001 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1003 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1004 suffixes to the specified name FILE.
1005 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1006 the suffix `.elc' or `.el' or the module suffix; don't accept just
1007 FILE unless it ends in one of those suffixes or includes a directory name.
1009 If NOSUFFIX is nil, then if a file could not be found, try looking for
1010 a different representation of the file by adding non-empty suffixes to
1011 its name, before trying another file. Emacs uses this feature to find
1012 compressed versions of files when Auto Compression mode is enabled.
1013 If NOSUFFIX is non-nil, disable this feature.
1015 The suffixes that this function tries out, when NOSUFFIX is nil, are
1016 given by the return value of `get-load-suffixes' and the values listed
1017 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1018 return value of `get-load-suffixes' is used, i.e. the file name is
1019 required to have a non-empty suffix.
1021 When searching suffixes, this function normally stops at the first
1022 one that exists. If the option `load-prefer-newer' is non-nil,
1023 however, it tries all suffixes, and uses whichever file is the newest.
1025 Loading a file records its definitions, and its `provide' and
1026 `require' calls, in an element of `load-history' whose
1027 car is the file name loaded. See `load-history'.
1029 While the file is in the process of being loaded, the variable
1030 `load-in-progress' is non-nil and the variable `load-file-name'
1031 is bound to the file's name.
1033 Return t if the file exists and loads successfully. */)
1034 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1035 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1040 ptrdiff_t count
= SPECPDL_INDEX ();
1041 Lisp_Object found
, efound
, hist_file_name
;
1042 /* True means we printed the ".el is newer" message. */
1044 /* True means we are loading a compiled file. */
1046 Lisp_Object handler
;
1048 const char *fmode
= "r" FOPEN_TEXT
;
1051 CHECK_STRING (file
);
1053 /* If file name is magic, call the handler. */
1054 /* This shouldn't be necessary any more now that `openp' handles it right.
1055 handler = Ffind_file_name_handler (file, Qload);
1056 if (!NILP (handler))
1057 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1059 /* The presence of this call is the result of a historical accident:
1060 it used to be in every file-operation and when it got removed
1061 everywhere, it accidentally stayed here. Since then, enough people
1062 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1063 that it seemed risky to remove. */
1064 if (! NILP (noerror
))
1066 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1067 Qt
, load_error_handler
);
1072 file
= Fsubstitute_in_file_name (file
);
1074 /* Avoid weird lossage with null string as arg,
1075 since it would try to load a directory as a Lisp file. */
1076 if (SCHARS (file
) == 0)
1083 Lisp_Object suffixes
;
1086 if (! NILP (must_suffix
))
1088 /* Don't insist on adding a suffix if FILE already ends with one. */
1089 if (suffix_p (file
, ".el")
1090 || suffix_p (file
, ".elc")
1092 || suffix_p (file
, MODULES_SUFFIX
)
1096 /* Don't insist on adding a suffix
1097 if the argument includes a directory name. */
1098 else if (! NILP (Ffile_name_directory (file
)))
1102 if (!NILP (nosuffix
))
1106 suffixes
= Fget_load_suffixes ();
1107 if (NILP (must_suffix
))
1108 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1111 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1117 report_file_error ("Cannot open load file", file
);
1121 /* Tell startup.el whether or not we found the user's init file. */
1122 if (EQ (Qt
, Vuser_init_file
))
1123 Vuser_init_file
= found
;
1125 /* If FD is -2, that means openp found a magic file. */
1128 if (NILP (Fequal (found
, file
)))
1129 /* If FOUND is a different file name from FILE,
1130 find its handler even if we have already inhibited
1131 the `load' operation on FILE. */
1132 handler
= Ffind_file_name_handler (found
, Qt
);
1134 handler
= Ffind_file_name_handler (found
, Qload
);
1135 if (! NILP (handler
))
1136 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1138 /* Tramp has to deal with semi-broken packages that prepend
1139 drive letters to remote files. For that reason, Tramp
1140 catches file operations that test for file existence, which
1141 makes openp think X:/foo.elc files are remote. However,
1142 Tramp does not catch `load' operations for such files, so we
1143 end up with a nil as the `load' handler above. If we would
1144 continue with fd = -2, we will behave wrongly, and in
1145 particular try reading a .elc file in the "rt" mode instead
1146 of "rb". See bug #9311 for the results. To work around
1147 this, we try to open the file locally, and go with that if it
1149 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1157 /* Pacify older GCC with --enable-gcc-warnings. */
1158 IF_LINT (fd_index
= 0);
1162 fd_index
= SPECPDL_INDEX ();
1163 record_unwind_protect_int (close_file_unwind
, fd
);
1167 if (suffix_p (found
, MODULES_SUFFIX
))
1168 return unbind_to (count
, Fmodule_load (found
));
1171 /* Check if we're stuck in a recursive load cycle.
1173 2000-09-21: It's not possible to just check for the file loaded
1174 being a member of Vloads_in_progress. This fails because of the
1175 way the byte compiler currently works; `provide's are not
1176 evaluated, see font-lock.el/jit-lock.el as an example. This
1177 leads to a certain amount of ``normal'' recursion.
1179 Also, just loading a file recursively is not always an error in
1180 the general case; the second load may do something different. */
1184 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1185 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1186 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1187 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1188 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1191 /* All loads are by default dynamic, unless the file itself specifies
1192 otherwise using a file-variable in the first line. This is bound here
1193 so that it takes effect whether or not we use
1194 Vload_source_file_function. */
1195 specbind (Qlexical_binding
, Qnil
);
1197 /* Get the name for load-history. */
1198 hist_file_name
= (! NILP (Vpurify_flag
)
1199 ? concat2 (Ffile_name_directory (file
),
1200 Ffile_name_nondirectory (found
))
1205 /* Check for the presence of old-style quotes and warn about them. */
1206 specbind (Qold_style_backquotes
, Qnil
);
1207 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1209 if (suffix_p (found
, ".elc") || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1210 /* Load .elc files directly, but not when they are
1211 remote and have no handler! */
1219 && ! (version
= safe_to_load_version (fd
)))
1222 if (!load_dangerous_libraries
)
1223 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1224 else if (!NILP (nomessage
) && !force_load_messages
)
1225 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1230 efound
= ENCODE_FILE (found
);
1231 fmode
= "r" FOPEN_BINARY
;
1233 /* openp already checked for newness, no point doing it again.
1234 FIXME would be nice to get a message when openp
1235 ignores suffix order due to load_prefer_newer. */
1236 if (!load_prefer_newer
)
1238 result
= stat (SSDATA (efound
), &s1
);
1241 SSET (efound
, SBYTES (efound
) - 1, 0);
1242 result
= stat (SSDATA (efound
), &s2
);
1243 SSET (efound
, SBYTES (efound
) - 1, 'c');
1247 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1249 /* Make the progress messages mention that source is newer. */
1252 /* If we won't print another message, mention this anyway. */
1253 if (!NILP (nomessage
) && !force_load_messages
)
1255 Lisp_Object msg_file
;
1256 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1257 message_with_string ("Source file `%s' newer than byte-compiled file",
1261 } /* !load_prefer_newer */
1266 /* We are loading a source file (*.el). */
1267 if (!NILP (Vload_source_file_function
))
1274 clear_unwind_protect (fd_index
);
1276 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1277 NILP (noerror
) ? Qnil
: Qt
,
1278 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1279 return unbind_to (count
, val
);
1285 /* We somehow got here with fd == -2, meaning the file is deemed
1286 to be remote. Don't even try to reopen the file locally;
1287 just force a failure. */
1295 clear_unwind_protect (fd_index
);
1296 efound
= ENCODE_FILE (found
);
1297 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1299 stream
= fdopen (fd
, fmode
);
1303 report_file_error ("Opening stdio stream", file
);
1304 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1306 if (! NILP (Vpurify_flag
))
1307 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1309 if (NILP (nomessage
) || force_load_messages
)
1312 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1315 message_with_string ("Loading %s (source)...", file
, 1);
1317 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1319 else /* The typical case; compiled file newer than source file. */
1320 message_with_string ("Loading %s...", file
, 1);
1323 specbind (Qload_file_name
, found
);
1324 specbind (Qinhibit_file_name_operation
, Qnil
);
1325 specbind (Qload_in_progress
, Qt
);
1328 if (lisp_file_lexically_bound_p (Qget_file_char
))
1329 Fset (Qlexical_binding
, Qt
);
1331 if (! version
|| version
>= 22)
1332 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1333 0, Qnil
, Qnil
, Qnil
, Qnil
);
1336 /* We can't handle a file which was compiled with
1337 byte-compile-dynamic by older version of Emacs. */
1338 specbind (Qload_force_doc_strings
, Qt
);
1339 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1340 0, Qnil
, Qnil
, Qnil
, Qnil
);
1342 unbind_to (count
, Qnil
);
1344 /* Run any eval-after-load forms for this file. */
1345 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1346 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1348 xfree (saved_doc_string
);
1349 saved_doc_string
= 0;
1350 saved_doc_string_size
= 0;
1352 xfree (prev_saved_doc_string
);
1353 prev_saved_doc_string
= 0;
1354 prev_saved_doc_string_size
= 0;
1356 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1359 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1362 message_with_string ("Loading %s (source)...done", file
, 1);
1364 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1366 else /* The typical case; compiled file newer than source file. */
1367 message_with_string ("Loading %s...done", file
, 1);
1374 complete_filename_p (Lisp_Object pathname
)
1376 const unsigned char *s
= SDATA (pathname
);
1377 return (IS_DIRECTORY_SEP (s
[0])
1378 || (SCHARS (pathname
) > 2
1379 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1382 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1383 doc
: /* Search for FILENAME through PATH.
1384 Returns the file's name in absolute form, or nil if not found.
1385 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1386 file name when searching.
1387 If non-nil, PREDICATE is used instead of `file-readable-p'.
1388 PREDICATE can also be an integer to pass to the faccessat(2) function,
1389 in which case file-name-handlers are ignored.
1390 This function will normally skip directories, so if you want it to find
1391 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1392 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1395 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1396 if (NILP (predicate
) && fd
>= 0)
1401 /* Search for a file whose name is STR, looking in directories
1402 in the Lisp list PATH, and trying suffixes from SUFFIX.
1403 On success, return a file descriptor (or 1 or -2 as described below).
1404 On failure, return -1 and set errno.
1406 SUFFIXES is a list of strings containing possible suffixes.
1407 The empty suffix is automatically added if the list is empty.
1409 PREDICATE t means the files are binary.
1410 PREDICATE non-nil and non-t means don't open the files,
1411 just look for one that satisfies the predicate. In this case,
1412 return 1 on success. The predicate can be a lisp function or
1413 an integer to pass to `access' (in which case file-name-handlers
1416 If STOREPTR is nonzero, it points to a slot where the name of
1417 the file actually found should be stored as a Lisp string.
1418 nil is stored there on failure.
1420 If the file we find is remote, return -2
1421 but store the found remote file name in *STOREPTR.
1423 If NEWER is true, try all SUFFIXes and return the result for the
1424 newest file that exists. Does not apply to remote files,
1425 or if a non-nil and non-t PREDICATE is specified. */
1428 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1429 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1431 ptrdiff_t fn_size
= 100;
1435 ptrdiff_t want_length
;
1436 Lisp_Object filename
;
1437 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1438 ptrdiff_t max_suffix_len
= 0;
1439 int last_errno
= ENOENT
;
1443 /* The last-modified time of the newest matching file found.
1444 Initialize it to something less than all valid timestamps. */
1445 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1449 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1451 CHECK_STRING_CAR (tail
);
1452 max_suffix_len
= max (max_suffix_len
,
1453 SBYTES (XCAR (tail
)));
1456 string
= filename
= encoded_fn
= save_string
= Qnil
;
1461 absolute
= complete_filename_p (str
);
1463 for (; CONSP (path
); path
= XCDR (path
))
1465 filename
= Fexpand_file_name (str
, XCAR (path
));
1466 if (!complete_filename_p (filename
))
1467 /* If there are non-absolute elts in PATH (eg "."). */
1468 /* Of course, this could conceivably lose if luser sets
1469 default-directory to be something non-absolute... */
1471 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1472 if (!complete_filename_p (filename
))
1473 /* Give up on this path element! */
1477 /* Calculate maximum length of any filename made from
1478 this path element/specified file name and any possible suffix. */
1479 want_length
= max_suffix_len
+ SBYTES (filename
);
1480 if (fn_size
<= want_length
)
1482 fn_size
= 100 + want_length
;
1483 fn
= SAFE_ALLOCA (fn_size
);
1486 /* Loop over suffixes. */
1487 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1488 CONSP (tail
); tail
= XCDR (tail
))
1490 Lisp_Object suffix
= XCAR (tail
);
1491 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1492 Lisp_Object handler
;
1494 /* Concatenate path element/specified name with the suffix.
1495 If the directory starts with /:, remove that. */
1496 int prefixlen
= ((SCHARS (filename
) > 2
1497 && SREF (filename
, 0) == '/'
1498 && SREF (filename
, 1) == ':')
1500 fnlen
= SBYTES (filename
) - prefixlen
;
1501 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1502 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1504 /* Check that the file exists and is not a directory. */
1505 /* We used to only check for handlers on non-absolute file names:
1509 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1510 It's not clear why that was the case and it breaks things like
1511 (load "/bar.el") where the file is actually "/bar.el.gz". */
1512 /* make_string has its own ideas on when to return a unibyte
1513 string and when a multibyte string, but we know better.
1514 We must have a unibyte string when dumping, since
1515 file-name encoding is shaky at best at that time, and in
1516 particular default-file-name-coding-system is reset
1517 several times during loadup. We therefore don't want to
1518 encode the file before passing it to file I/O library
1520 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1521 string
= make_unibyte_string (fn
, fnlen
);
1523 string
= make_string (fn
, fnlen
);
1524 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1525 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1526 && !NATNUMP (predicate
))
1529 if (NILP (predicate
) || EQ (predicate
, Qt
))
1530 exists
= !NILP (Ffile_readable_p (string
));
1533 Lisp_Object tmp
= call1 (predicate
, string
);
1536 else if (EQ (tmp
, Qdir_ok
)
1537 || NILP (Ffile_directory_p (string
)))
1542 last_errno
= EISDIR
;
1548 /* We succeeded; return this descriptor and filename. */
1561 encoded_fn
= ENCODE_FILE (string
);
1562 pfn
= SSDATA (encoded_fn
);
1564 /* Check that we can access or open it. */
1565 if (NATNUMP (predicate
))
1568 if (INT_MAX
< XFASTINT (predicate
))
1569 last_errno
= EINVAL
;
1570 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1574 if (file_directory_p (pfn
))
1575 last_errno
= EISDIR
;
1582 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1585 if (errno
!= ENOENT
)
1590 int err
= (fstat (fd
, &st
) != 0 ? errno
1591 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1603 if (newer
&& !NATNUMP (predicate
))
1605 struct timespec mtime
= get_stat_mtime (&st
);
1607 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1612 emacs_close (save_fd
);
1615 save_string
= string
;
1620 /* We succeeded; return this descriptor and filename. */
1628 /* No more suffixes. Return the newest. */
1629 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1632 *storeptr
= save_string
;
1648 /* Merge the list we've accumulated of globals from the current input source
1649 into the load_history variable. The details depend on whether
1650 the source has an associated file name or not.
1652 FILENAME is the file name that we are loading from.
1654 ENTIRE is true if loading that entire file, false if evaluating
1658 build_load_history (Lisp_Object filename
, bool entire
)
1660 Lisp_Object tail
, prev
, newelt
;
1661 Lisp_Object tem
, tem2
;
1664 tail
= Vload_history
;
1667 while (CONSP (tail
))
1671 /* Find the feature's previous assoc list... */
1672 if (!NILP (Fequal (filename
, Fcar (tem
))))
1676 /* If we're loading the entire file, remove old data. */
1680 Vload_history
= XCDR (tail
);
1682 Fsetcdr (prev
, XCDR (tail
));
1685 /* Otherwise, cons on new symbols that are not already members. */
1688 tem2
= Vcurrent_load_list
;
1690 while (CONSP (tem2
))
1692 newelt
= XCAR (tem2
);
1694 if (NILP (Fmember (newelt
, tem
)))
1695 Fsetcar (tail
, Fcons (XCAR (tem
),
1696 Fcons (newelt
, XCDR (tem
))));
1709 /* If we're loading an entire file, cons the new assoc onto the
1710 front of load-history, the most-recently-loaded position. Also
1711 do this if we didn't find an existing member for the file. */
1712 if (entire
|| !foundit
)
1713 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1718 readevalloop_1 (int old
)
1720 load_convert_to_unibyte
= old
;
1723 /* Signal an `end-of-file' error, if possible with file name
1726 static _Noreturn
void
1727 end_of_file_error (void)
1729 if (STRINGP (Vload_file_name
))
1730 xsignal1 (Qend_of_file
, Vload_file_name
);
1732 xsignal0 (Qend_of_file
);
1736 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1738 /* If we macroexpand the toplevel form non-recursively and it ends
1739 up being a `progn' (or if it was a progn to start), treat each
1740 form in the progn as a top-level form. This way, if one form in
1741 the progn defines a macro, that macro is in effect when we expand
1742 the remaining forms. See similar code in bytecomp.el. */
1743 val
= call2 (macroexpand
, val
, Qnil
);
1744 if (EQ (CAR_SAFE (val
), Qprogn
))
1746 Lisp_Object subforms
= XCDR (val
);
1748 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1749 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1753 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1757 /* UNIBYTE specifies how to set load_convert_to_unibyte
1758 for this invocation.
1759 READFUN, if non-nil, is used instead of `read'.
1761 START, END specify region to read in current buffer (from eval-region).
1762 If the input is not from a buffer, they must be nil. */
1765 readevalloop (Lisp_Object readcharfun
,
1767 Lisp_Object sourcename
,
1769 Lisp_Object unibyte
, Lisp_Object readfun
,
1770 Lisp_Object start
, Lisp_Object end
)
1774 ptrdiff_t count
= SPECPDL_INDEX ();
1775 struct buffer
*b
= 0;
1776 bool continue_reading_p
;
1777 Lisp_Object lex_bound
;
1778 /* True if reading an entire buffer. */
1779 bool whole_buffer
= 0;
1780 /* True on the first time around. */
1781 bool first_sexp
= 1;
1782 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1784 if (NILP (Ffboundp (macroexpand
))
1785 /* Don't macroexpand in .elc files, since it should have been done
1786 already. We actually don't know whether we're in a .elc file or not,
1787 so we use circumstantial evidence: .el files normally go through
1788 Vload_source_file_function -> load-with-code-conversion
1790 || EQ (readcharfun
, Qget_file_char
)
1791 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1794 if (MARKERP (readcharfun
))
1797 start
= readcharfun
;
1800 if (BUFFERP (readcharfun
))
1801 b
= XBUFFER (readcharfun
);
1802 else if (MARKERP (readcharfun
))
1803 b
= XMARKER (readcharfun
)->buffer
;
1805 /* We assume START is nil when input is not from a buffer. */
1806 if (! NILP (start
) && !b
)
1809 specbind (Qstandard_input
, readcharfun
);
1810 specbind (Qcurrent_load_list
, Qnil
);
1811 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1812 load_convert_to_unibyte
= !NILP (unibyte
);
1814 /* If lexical binding is active (either because it was specified in
1815 the file's header, or via a buffer-local variable), create an empty
1816 lexical environment, otherwise, turn off lexical binding. */
1817 lex_bound
= find_symbol_value (Qlexical_binding
);
1818 specbind (Qinternal_interpreter_environment
,
1819 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1820 ? Qnil
: list1 (Qt
)));
1822 /* Try to ensure sourcename is a truename, except whilst preloading. */
1823 if (NILP (Vpurify_flag
)
1824 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1825 && !NILP (Ffboundp (Qfile_truename
)))
1826 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1828 LOADHIST_ATTACH (sourcename
);
1830 continue_reading_p
= 1;
1831 while (continue_reading_p
)
1833 ptrdiff_t count1
= SPECPDL_INDEX ();
1835 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1836 error ("Reading from killed buffer");
1840 /* Switch to the buffer we are reading from. */
1841 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1842 set_buffer_internal (b
);
1844 /* Save point in it. */
1845 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1846 /* Save ZV in it. */
1847 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1848 /* Those get unbound after we read one expression. */
1850 /* Set point and ZV around stuff to be read. */
1853 Fnarrow_to_region (make_number (BEGV
), end
);
1855 /* Just for cleanliness, convert END to a marker
1856 if it is an integer. */
1858 end
= Fpoint_max_marker ();
1861 /* On the first cycle, we can easily test here
1862 whether we are reading the whole buffer. */
1863 if (b
&& first_sexp
)
1864 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1871 while ((c
= READCHAR
) != '\n' && c
!= -1);
1876 unbind_to (count1
, Qnil
);
1880 /* Ignore whitespace here, so we can detect eof. */
1881 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1882 || c
== NO_BREAK_SPACE
)
1885 if (!NILP (Vpurify_flag
) && c
== '(')
1887 val
= read_list (0, readcharfun
);
1892 read_objects
= Qnil
;
1893 if (!NILP (readfun
))
1895 val
= call1 (readfun
, readcharfun
);
1897 /* If READCHARFUN has set point to ZV, we should
1898 stop reading, even if the form read sets point
1899 to a different value when evaluated. */
1900 if (BUFFERP (readcharfun
))
1902 struct buffer
*buf
= XBUFFER (readcharfun
);
1903 if (BUF_PT (buf
) == BUF_ZV (buf
))
1904 continue_reading_p
= 0;
1907 else if (! NILP (Vload_read_function
))
1908 val
= call1 (Vload_read_function
, readcharfun
);
1910 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1913 if (!NILP (start
) && continue_reading_p
)
1914 start
= Fpoint_marker ();
1916 /* Restore saved point and BEGV. */
1917 unbind_to (count1
, Qnil
);
1919 /* Now eval what we just read. */
1920 if (!NILP (macroexpand
))
1921 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1923 val
= eval_sub (val
);
1927 Vvalues
= Fcons (val
, Vvalues
);
1928 if (EQ (Vstandard_output
, Qt
))
1937 build_load_history (sourcename
,
1938 stream
|| whole_buffer
);
1940 unbind_to (count
, Qnil
);
1943 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1944 doc
: /* Execute the accessible portion of current buffer as Lisp code.
1945 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
1946 When called from a Lisp program (i.e., not interactively), this
1947 function accepts up to five optional arguments:
1948 BUFFER is the buffer to evaluate (nil means use current buffer),
1949 or a name of a buffer (a string).
1950 PRINTFLAG controls printing of output by any output functions in the
1951 evaluated code, such as `print', `princ', and `prin1':
1952 a value of nil means discard it; anything else is the stream to print to.
1953 See Info node `(elisp)Output Streams' for details on streams.
1954 FILENAME specifies the file name to use for `load-history'.
1955 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1957 DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
1958 evaluated code should work normally even if PRINTFLAG is nil, in
1959 which case the output is displayed in the echo area.
1961 This function preserves the position of point. */)
1962 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1964 ptrdiff_t count
= SPECPDL_INDEX ();
1965 Lisp_Object tem
, buf
;
1968 buf
= Fcurrent_buffer ();
1970 buf
= Fget_buffer (buffer
);
1972 error ("No such buffer");
1974 if (NILP (printflag
) && NILP (do_allow_print
))
1979 if (NILP (filename
))
1980 filename
= BVAR (XBUFFER (buf
), filename
);
1982 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1983 specbind (Qstandard_output
, tem
);
1984 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1985 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1986 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1987 readevalloop (buf
, 0, filename
,
1988 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1989 unbind_to (count
, Qnil
);
1994 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1995 doc
: /* Execute the region as Lisp code.
1996 When called from programs, expects two arguments,
1997 giving starting and ending indices in the current buffer
1998 of the text to be executed.
1999 Programs can pass third argument PRINTFLAG which controls output:
2000 a value of nil means discard it; anything else is stream for printing it.
2001 See Info node `(elisp)Output Streams' for details on streams.
2002 Also the fourth argument READ-FUNCTION, if non-nil, is used
2003 instead of `read' to read each expression. It gets one argument
2004 which is the input stream for reading characters.
2006 This function does not move point. */)
2007 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2009 /* FIXME: Do the eval-sexp-add-defvars dance! */
2010 ptrdiff_t count
= SPECPDL_INDEX ();
2011 Lisp_Object tem
, cbuf
;
2013 cbuf
= Fcurrent_buffer ();
2015 if (NILP (printflag
))
2019 specbind (Qstandard_output
, tem
);
2020 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2022 /* `readevalloop' calls functions which check the type of start and end. */
2023 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2024 !NILP (printflag
), Qnil
, read_function
,
2027 return unbind_to (count
, Qnil
);
2031 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2032 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2033 If STREAM is nil, use the value of `standard-input' (which see).
2034 STREAM or the value of `standard-input' may be:
2035 a buffer (read from point and advance it)
2036 a marker (read from where it points and advance it)
2037 a function (call it with no arguments for each character,
2038 call it with a char as argument to push a char back)
2039 a string (takes text from string, starting at the beginning)
2040 t (read text line using minibuffer and use it, or read from
2041 standard input in batch mode). */)
2042 (Lisp_Object stream
)
2045 stream
= Vstandard_input
;
2046 if (EQ (stream
, Qt
))
2047 stream
= Qread_char
;
2048 if (EQ (stream
, Qread_char
))
2049 /* FIXME: ?! When is this used !? */
2050 return call1 (intern ("read-minibuffer"),
2051 build_string ("Lisp expression: "));
2053 return read_internal_start (stream
, Qnil
, Qnil
);
2056 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2057 doc
: /* Read one Lisp expression which is represented as text by STRING.
2058 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2059 FINAL-STRING-INDEX is an integer giving the position of the next
2060 remaining character in STRING. START and END optionally delimit
2061 a substring of STRING from which to read; they default to 0 and
2062 \(length STRING) respectively. Negative values are counted from
2063 the end of STRING. */)
2064 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2067 CHECK_STRING (string
);
2068 /* `read_internal_start' sets `read_from_string_index'. */
2069 ret
= read_internal_start (string
, start
, end
);
2070 return Fcons (ret
, make_number (read_from_string_index
));
2073 /* Function to set up the global context we need in toplevel read
2074 calls. START and END only used when STREAM is a string. */
2076 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2081 new_backquote_flag
= 0;
2082 read_objects
= Qnil
;
2083 if (EQ (Vread_with_symbol_positions
, Qt
)
2084 || EQ (Vread_with_symbol_positions
, stream
))
2085 Vread_symbol_positions_list
= Qnil
;
2087 if (STRINGP (stream
)
2088 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2090 ptrdiff_t startval
, endval
;
2093 if (STRINGP (stream
))
2096 string
= XCAR (stream
);
2098 validate_subarray (string
, start
, end
, SCHARS (string
),
2099 &startval
, &endval
);
2101 read_from_string_index
= startval
;
2102 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2103 read_from_string_limit
= endval
;
2106 retval
= read0 (stream
);
2107 if (EQ (Vread_with_symbol_positions
, Qt
)
2108 || EQ (Vread_with_symbol_positions
, stream
))
2109 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2114 /* Signal Qinvalid_read_syntax error.
2115 S is error string of length N (if > 0) */
2117 static _Noreturn
void
2118 invalid_syntax (const char *s
)
2120 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2124 /* Use this for recursive reads, in contexts where internal tokens
2128 read0 (Lisp_Object readcharfun
)
2130 register Lisp_Object val
;
2133 val
= read1 (readcharfun
, &c
, 0);
2137 xsignal1 (Qinvalid_read_syntax
,
2138 Fmake_string (make_number (1), make_number (c
)));
2141 static ptrdiff_t read_buffer_size
;
2142 static char *read_buffer
;
2144 /* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes. */
2147 grow_read_buffer (void)
2149 read_buffer
= xpalloc (read_buffer
, &read_buffer_size
,
2150 MAX_MULTIBYTE_LENGTH
, -1, 1);
2153 /* Return the scalar value that has the Unicode character name NAME.
2154 Raise 'invalid-read-syntax' if there is no such character. */
2156 character_name_to_code (char const *name
, ptrdiff_t name_len
)
2158 /* For "U+XXXX", pass the leading '+' to string_to_number to reject
2159 monstrosities like "U+-0000". */
2161 = (name
[0] == 'U' && name
[1] == '+'
2162 ? string_to_number (name
+ 1, 16, false)
2163 : call2 (Qchar_from_name
, make_unibyte_string (name
, name_len
), Qt
));
2165 if (! RANGED_INTEGERP (0, code
, MAX_UNICODE_CHAR
)
2166 || char_surrogate_p (XINT (code
)))
2168 AUTO_STRING (format
, "\\N{%s}");
2169 AUTO_STRING_WITH_LEN (namestr
, name
, name_len
);
2170 xsignal1 (Qinvalid_read_syntax
, CALLN (Fformat
, format
, namestr
));
2176 /* Bound on the length of a Unicode character name. As of
2177 Unicode 9.0.0 the maximum is 83, so this should be safe. */
2178 enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND
= 200 };
2180 /* Read a \-escape sequence, assuming we already read the `\'.
2181 If the escape sequence forces unibyte, return eight-bit char. */
2184 read_escape (Lisp_Object readcharfun
, bool stringp
)
2187 /* \u allows up to four hex digits, \U up to eight. Default to the
2188 behavior for \u, and change this value in the case that \U is seen. */
2189 int unicode_hex_count
= 4;
2194 end_of_file_error ();
2224 error ("Invalid escape character syntax");
2227 c
= read_escape (readcharfun
, 0);
2228 return c
| meta_modifier
;
2233 error ("Invalid escape character syntax");
2236 c
= read_escape (readcharfun
, 0);
2237 return c
| shift_modifier
;
2242 error ("Invalid escape character syntax");
2245 c
= read_escape (readcharfun
, 0);
2246 return c
| hyper_modifier
;
2251 error ("Invalid escape character syntax");
2254 c
= read_escape (readcharfun
, 0);
2255 return c
| alt_modifier
;
2259 if (stringp
|| c
!= '-')
2266 c
= read_escape (readcharfun
, 0);
2267 return c
| super_modifier
;
2272 error ("Invalid escape character syntax");
2276 c
= read_escape (readcharfun
, 0);
2277 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2278 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2279 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2280 return c
| ctrl_modifier
;
2281 /* ASCII control chars are made from letters (both cases),
2282 as well as the non-letters within 0100...0137. */
2283 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2284 return (c
& (037 | ~0177));
2285 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2286 return (c
& (037 | ~0177));
2288 return c
| ctrl_modifier
;
2298 /* An octal escape, as in ANSI C. */
2300 register int i
= c
- '0';
2301 register int count
= 0;
2304 if ((c
= READCHAR
) >= '0' && c
<= '7')
2316 if (i
>= 0x80 && i
< 0x100)
2317 i
= BYTE8_TO_CHAR (i
);
2322 /* A hex escape, as in ANSI C. */
2329 if (c
>= '0' && c
<= '9')
2334 else if ((c
>= 'a' && c
<= 'f')
2335 || (c
>= 'A' && c
<= 'F'))
2338 if (c
>= 'a' && c
<= 'f')
2348 /* Allow hex escapes as large as ?\xfffffff, because some
2349 packages use them to denote characters with modifiers. */
2350 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2351 error ("Hex character out of range: \\x%x...", i
);
2355 if (count
< 3 && i
>= 0x80)
2356 return BYTE8_TO_CHAR (i
);
2361 /* Post-Unicode-2.0: Up to eight hex chars. */
2362 unicode_hex_count
= 8;
2365 /* A Unicode escape. We only permit them in strings and characters,
2366 not arbitrarily in the source code, as in some other languages. */
2371 while (++count
<= unicode_hex_count
)
2374 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2376 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2377 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2378 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2380 error ("Non-hex digit used for Unicode escape");
2383 error ("Non-Unicode character: 0x%x", i
);
2388 /* Named character. */
2392 invalid_syntax ("Expected opening brace after \\N");
2393 char name
[UNICODE_CHARACTER_NAME_LENGTH_BOUND
+ 1];
2394 bool whitespace
= false;
2395 ptrdiff_t length
= 0;
2400 end_of_file_error ();
2403 if (! (0 < c
&& c
< 0x80))
2405 AUTO_STRING (format
,
2406 "Invalid character U+%04X in character name");
2407 xsignal1 (Qinvalid_read_syntax
,
2408 CALLN (Fformat
, format
, make_natnum (c
)));
2410 /* Treat multiple adjacent whitespace characters as a
2411 single space character. This makes it easier to use
2412 character names in e.g. multi-line strings. */
2423 if (length
>= sizeof name
)
2424 invalid_syntax ("Character name too long");
2427 invalid_syntax ("Empty character name");
2428 name
[length
] = '\0';
2429 return character_name_to_code (name
, length
);
2437 /* Return the digit that CHARACTER stands for in the given BASE.
2438 Return -1 if CHARACTER is out of range for BASE,
2439 and -2 if CHARACTER is not valid for any supported BASE. */
2441 digit_to_number (int character
, int base
)
2445 if ('0' <= character
&& character
<= '9')
2446 digit
= character
- '0';
2447 else if ('a' <= character
&& character
<= 'z')
2448 digit
= character
- 'a' + 10;
2449 else if ('A' <= character
&& character
<= 'Z')
2450 digit
= character
- 'A' + 10;
2454 return digit
< base
? digit
: -1;
2457 /* Read an integer in radix RADIX using READCHARFUN to read
2458 characters. RADIX must be in the interval [2..36]; if it isn't, a
2459 read error is signaled . Value is the integer read. Signals an
2460 error if encountering invalid read syntax or if RADIX is out of
2464 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2466 /* Room for sign, leading 0, other digits, trailing null byte.
2467 Also, room for invalid syntax diagnostic. */
2468 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2469 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2471 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2473 if (radix
< 2 || radix
> 36)
2481 if (c
== '-' || c
== '+')
2492 /* Ignore redundant leading zeros, so the buffer doesn't
2493 fill up with them. */
2499 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2506 if (p
< buf
+ sizeof buf
- 1)
2520 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2521 invalid_syntax (buf
);
2524 return string_to_number (buf
, radix
, 0);
2528 /* If the next token is ')' or ']' or '.', we store that character
2529 in *PCH and the return value is not interesting. Else, we store
2530 zero in *PCH and we read and return one lisp object.
2532 FIRST_IN_LIST is true if this is the first element of a list. */
2535 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2538 bool uninterned_symbol
= 0;
2545 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2547 end_of_file_error ();
2552 return read_list (0, readcharfun
);
2555 return read_vector (readcharfun
, 0);
2571 /* Accept extended format for hashtables (extensible to
2573 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2574 Lisp_Object tmp
= read_list (0, readcharfun
);
2575 Lisp_Object head
= CAR_SAFE (tmp
);
2576 Lisp_Object data
= Qnil
;
2577 Lisp_Object val
= Qnil
;
2578 /* The size is 2 * number of allowed keywords to
2580 Lisp_Object params
[10];
2582 Lisp_Object key
= Qnil
;
2583 int param_count
= 0;
2585 if (!EQ (head
, Qhash_table
))
2586 error ("Invalid extended read marker at head of #s list "
2587 "(only hash-table allowed)");
2589 tmp
= CDR_SAFE (tmp
);
2591 /* This is repetitive but fast and simple. */
2592 params
[param_count
] = QCsize
;
2593 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2594 if (!NILP (params
[param_count
+ 1]))
2597 params
[param_count
] = QCtest
;
2598 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2599 if (!NILP (params
[param_count
+ 1]))
2602 params
[param_count
] = QCweakness
;
2603 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2604 if (!NILP (params
[param_count
+ 1]))
2607 params
[param_count
] = QCrehash_size
;
2608 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2609 if (!NILP (params
[param_count
+ 1]))
2612 params
[param_count
] = QCrehash_threshold
;
2613 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2614 if (!NILP (params
[param_count
+ 1]))
2617 /* This is the hashtable data. */
2618 data
= Fplist_get (tmp
, Qdata
);
2620 /* Now use params to make a new hashtable and fill it. */
2621 ht
= Fmake_hash_table (param_count
, params
);
2623 while (CONSP (data
))
2628 error ("Odd number of elements in hashtable data");
2631 Fputhash (key
, val
, ht
);
2637 invalid_syntax ("#");
2645 tmp
= read_vector (readcharfun
, 0);
2646 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2647 error ("Invalid size char-table");
2648 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2656 /* Sub char-table can't be read as a regular
2657 vector because of a two C integer fields. */
2658 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2659 ptrdiff_t size
= XINT (Flength (tmp
));
2660 int i
, depth
, min_char
;
2661 struct Lisp_Cons
*cell
;
2664 error ("Zero-sized sub char-table");
2666 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2667 error ("Invalid depth in sub char-table");
2668 depth
= XINT (XCAR (tmp
));
2669 if (chartab_size
[depth
] != size
- 2)
2670 error ("Invalid size in sub char-table");
2671 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2674 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2675 error ("Invalid minimum character in sub-char-table");
2676 min_char
= XINT (XCAR (tmp
));
2677 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2680 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2681 for (i
= 0; i
< size
; i
++)
2683 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2684 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2689 invalid_syntax ("#^^");
2691 invalid_syntax ("#^");
2696 length
= read1 (readcharfun
, pch
, first_in_list
);
2700 Lisp_Object tmp
, val
;
2701 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2702 unsigned char *data
;
2705 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2706 if (STRING_MULTIBYTE (tmp
)
2707 || (size_in_chars
!= SCHARS (tmp
)
2708 /* We used to print 1 char too many
2709 when the number of bits was a multiple of 8.
2710 Accept such input in case it came from an old
2712 && ! (XFASTINT (length
)
2713 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2714 invalid_syntax ("#&...");
2716 val
= make_uninit_bool_vector (XFASTINT (length
));
2717 data
= bool_vector_uchar_data (val
);
2718 memcpy (data
, SDATA (tmp
), size_in_chars
);
2719 /* Clear the extraneous bits in the last byte. */
2720 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2721 data
[size_in_chars
- 1]
2722 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2725 invalid_syntax ("#&...");
2729 /* Accept compiled functions at read-time so that we don't have to
2730 build them using function calls. */
2732 struct Lisp_Vector
*vec
;
2733 tmp
= read_vector (readcharfun
, 1);
2734 vec
= XVECTOR (tmp
);
2735 if (vec
->header
.size
== 0)
2736 invalid_syntax ("Empty byte-code object");
2737 make_byte_code (vec
);
2745 /* Read the string itself. */
2746 tmp
= read1 (readcharfun
, &ch
, 0);
2747 if (ch
!= 0 || !STRINGP (tmp
))
2748 invalid_syntax ("#");
2749 /* Read the intervals and their properties. */
2752 Lisp_Object beg
, end
, plist
;
2754 beg
= read1 (readcharfun
, &ch
, 0);
2759 end
= read1 (readcharfun
, &ch
, 0);
2761 plist
= read1 (readcharfun
, &ch
, 0);
2763 invalid_syntax ("Invalid string property list");
2764 Fset_text_properties (beg
, end
, plist
, tmp
);
2770 /* #@NUMBER is used to skip NUMBER following bytes.
2771 That's used in .elc files to skip over doc strings
2772 and function definitions. */
2775 enum { extra
= 100 };
2776 ptrdiff_t i
, nskip
= 0, digits
= 0;
2778 /* Read a decimal integer. */
2779 while ((c
= READCHAR
) >= 0
2780 && c
>= '0' && c
<= '9')
2782 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2787 if (digits
== 2 && nskip
== 0)
2788 { /* We've just seen #@00, which means "skip to end". */
2789 skip_dyn_eof (readcharfun
);
2794 /* We can't use UNREAD here, because in the code below we side-step
2795 READCHAR. Instead, assume the first char after #@NNN occupies
2796 a single byte, which is the case normally since it's just
2802 if (load_force_doc_strings
2803 && (FROM_FILE_P (readcharfun
)))
2805 /* If we are supposed to force doc strings into core right now,
2806 record the last string that we skipped,
2807 and record where in the file it comes from. */
2809 /* But first exchange saved_doc_string
2810 with prev_saved_doc_string, so we save two strings. */
2812 char *temp
= saved_doc_string
;
2813 ptrdiff_t temp_size
= saved_doc_string_size
;
2814 file_offset temp_pos
= saved_doc_string_position
;
2815 ptrdiff_t temp_len
= saved_doc_string_length
;
2817 saved_doc_string
= prev_saved_doc_string
;
2818 saved_doc_string_size
= prev_saved_doc_string_size
;
2819 saved_doc_string_position
= prev_saved_doc_string_position
;
2820 saved_doc_string_length
= prev_saved_doc_string_length
;
2822 prev_saved_doc_string
= temp
;
2823 prev_saved_doc_string_size
= temp_size
;
2824 prev_saved_doc_string_position
= temp_pos
;
2825 prev_saved_doc_string_length
= temp_len
;
2828 if (saved_doc_string_size
== 0)
2830 saved_doc_string
= xmalloc (nskip
+ extra
);
2831 saved_doc_string_size
= nskip
+ extra
;
2833 if (nskip
> saved_doc_string_size
)
2835 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2836 saved_doc_string_size
= nskip
+ extra
;
2839 saved_doc_string_position
= file_tell (instream
);
2841 /* Copy that many characters into saved_doc_string. */
2843 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2844 saved_doc_string
[i
] = c
= getc (instream
);
2847 saved_doc_string_length
= i
;
2850 /* Skip that many bytes. */
2851 skip_dyn_bytes (readcharfun
, nskip
);
2857 /* #! appears at the beginning of an executable file.
2858 Skip the first line. */
2859 while (c
!= '\n' && c
>= 0)
2864 return Vload_file_name
;
2866 return list2 (Qfunction
, read0 (readcharfun
));
2867 /* #:foo is the uninterned symbol named foo. */
2870 uninterned_symbol
= 1;
2873 && c
!= NO_BREAK_SPACE
2875 || strchr ("\"';()[]#`,", c
) == NULL
)))
2877 /* No symbol character follows, this is the empty
2880 return Fmake_symbol (empty_unibyte_string
);
2884 /* ## is the empty symbol. */
2886 return Fintern (empty_unibyte_string
, Qnil
);
2887 /* Reader forms that can reuse previously read objects. */
2888 if (c
>= '0' && c
<= '9')
2893 /* Read a non-negative integer. */
2894 while (c
>= '0' && c
<= '9')
2896 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2897 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2898 n
= MOST_POSITIVE_FIXNUM
+ 1;
2900 n
= n
* 10 + c
- '0';
2904 if (n
<= MOST_POSITIVE_FIXNUM
)
2906 if (c
== 'r' || c
== 'R')
2907 return read_integer (readcharfun
, n
);
2909 if (! NILP (Vread_circle
))
2911 /* #n=object returns object, but associates it with
2915 /* Make a placeholder for #n# to use temporarily. */
2916 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2917 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2918 read_objects
= Fcons (cell
, read_objects
);
2920 /* Read the object itself. */
2921 tem
= read0 (readcharfun
);
2923 /* Now put it everywhere the placeholder was... */
2924 substitute_object_in_subtree (tem
, placeholder
);
2926 /* ...and #n# will use the real value from now on. */
2927 Fsetcdr (cell
, tem
);
2932 /* #n# returns a previously read object. */
2935 tem
= Fassq (make_number (n
), read_objects
);
2941 /* Fall through to error message. */
2943 else if (c
== 'x' || c
== 'X')
2944 return read_integer (readcharfun
, 16);
2945 else if (c
== 'o' || c
== 'O')
2946 return read_integer (readcharfun
, 8);
2947 else if (c
== 'b' || c
== 'B')
2948 return read_integer (readcharfun
, 2);
2951 invalid_syntax ("#");
2954 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2958 return list2 (Qquote
, read0 (readcharfun
));
2962 int next_char
= READCHAR
;
2964 /* Transition from old-style to new-style:
2965 If we see "(`" it used to mean old-style, which usually works
2966 fine because ` should almost never appear in such a position
2967 for new-style. But occasionally we need "(`" to mean new
2968 style, so we try to distinguish the two by the fact that we
2969 can either write "( `foo" or "(` foo", where the first
2970 intends to use new-style whereas the second intends to use
2971 old-style. For Emacs-25, we should completely remove this
2972 first_in_list exception (old-style can still be obtained via
2974 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2976 Vold_style_backquotes
= Qt
;
2982 bool saved_new_backquote_flag
= new_backquote_flag
;
2984 new_backquote_flag
= 1;
2985 value
= read0 (readcharfun
);
2986 new_backquote_flag
= saved_new_backquote_flag
;
2988 return list2 (Qbackquote
, value
);
2993 int next_char
= READCHAR
;
2995 /* Transition from old-style to new-style:
2996 It used to be impossible to have a new-style , other than within
2997 a new-style `. This is sufficient when ` and , are used in the
2998 normal way, but ` and , can also appear in args to macros that
2999 will not interpret them in the usual way, in which case , may be
3000 used without any ` anywhere near.
3001 So we now use the same heuristic as for backquote: old-style
3002 unquotes are only recognized when first on a list, and when
3003 followed by a space.
3004 Because it's more difficult to peek 2 chars ahead, a new-style
3005 ,@ can still not be used outside of a `, unless it's in the middle
3007 if (new_backquote_flag
3009 || (next_char
!= ' ' && next_char
!= '@'))
3011 Lisp_Object comma_type
= Qnil
;
3016 comma_type
= Qcomma_at
;
3018 comma_type
= Qcomma_dot
;
3021 if (ch
>= 0) UNREAD (ch
);
3022 comma_type
= Qcomma
;
3025 value
= read0 (readcharfun
);
3026 return list2 (comma_type
, value
);
3030 Vold_style_backquotes
= Qt
;
3042 end_of_file_error ();
3044 /* Accept `single space' syntax like (list ? x) where the
3045 whitespace character is SPC or TAB.
3046 Other literal whitespace like NL, CR, and FF are not accepted,
3047 as there are well-established escape sequences for these. */
3048 if (c
== ' ' || c
== '\t')
3049 return make_number (c
);
3052 c
= read_escape (readcharfun
, 0);
3053 modifiers
= c
& CHAR_MODIFIER_MASK
;
3054 c
&= ~CHAR_MODIFIER_MASK
;
3055 if (CHAR_BYTE8_P (c
))
3056 c
= CHAR_TO_BYTE8 (c
);
3059 next_char
= READCHAR
;
3060 ok
= (next_char
<= 040
3061 || (next_char
< 0200
3062 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3065 return make_number (c
);
3067 invalid_syntax ("?");
3072 char *p
= read_buffer
;
3073 char *end
= read_buffer
+ read_buffer_size
;
3075 /* True if we saw an escape sequence specifying
3076 a multibyte character. */
3077 bool force_multibyte
= 0;
3078 /* True if we saw an escape sequence specifying
3079 a single-byte character. */
3080 bool force_singlebyte
= 0;
3082 ptrdiff_t nchars
= 0;
3084 while ((ch
= READCHAR
) >= 0
3087 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3089 ptrdiff_t offset
= p
- read_buffer
;
3090 grow_read_buffer ();
3091 p
= read_buffer
+ offset
;
3092 end
= read_buffer
+ read_buffer_size
;
3099 ch
= read_escape (readcharfun
, 1);
3101 /* CH is -1 if \ newline or \ space has just been seen. */
3104 if (p
== read_buffer
)
3109 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3110 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3112 if (CHAR_BYTE8_P (ch
))
3113 force_singlebyte
= 1;
3114 else if (! ASCII_CHAR_P (ch
))
3115 force_multibyte
= 1;
3116 else /* I.e. ASCII_CHAR_P (ch). */
3118 /* Allow `\C- ' and `\C-?'. */
3119 if (modifiers
== CHAR_CTL
)
3122 ch
= 0, modifiers
= 0;
3124 ch
= 127, modifiers
= 0;
3126 if (modifiers
& CHAR_SHIFT
)
3128 /* Shift modifier is valid only with [A-Za-z]. */
3129 if (ch
>= 'A' && ch
<= 'Z')
3130 modifiers
&= ~CHAR_SHIFT
;
3131 else if (ch
>= 'a' && ch
<= 'z')
3132 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3135 if (modifiers
& CHAR_META
)
3137 /* Move the meta bit to the right place for a
3139 modifiers
&= ~CHAR_META
;
3140 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3141 force_singlebyte
= 1;
3145 /* Any modifiers remaining are invalid. */
3147 error ("Invalid modifier in string");
3148 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3152 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3153 if (CHAR_BYTE8_P (ch
))
3154 force_singlebyte
= 1;
3155 else if (! ASCII_CHAR_P (ch
))
3156 force_multibyte
= 1;
3162 end_of_file_error ();
3164 /* If purifying, and string starts with \ newline,
3165 return zero instead. This is for doc strings
3166 that we are really going to find in etc/DOC.nn.nn. */
3167 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3168 return make_number (0);
3170 if (! force_multibyte
&& force_singlebyte
)
3172 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3173 forms. Convert it to unibyte. */
3174 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3176 p
= read_buffer
+ nchars
;
3179 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3181 || (p
- read_buffer
!= nchars
)));
3186 int next_char
= READCHAR
;
3189 if (next_char
<= 040
3190 || (next_char
< 0200
3191 && strchr ("\"';([#?`,", next_char
) != NULL
))
3197 /* Otherwise, we fall through! Note that the atom-reading loop
3198 below will now loop at least once, assuring that we will not
3199 try to UNREAD two characters in a row. */
3203 if (c
<= 040) goto retry
;
3204 if (c
== NO_BREAK_SPACE
)
3209 char *p
= read_buffer
;
3211 EMACS_INT start_position
= readchar_count
- 1;
3214 char *end
= read_buffer
+ read_buffer_size
;
3218 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3220 ptrdiff_t offset
= p
- read_buffer
;
3221 grow_read_buffer ();
3222 p
= read_buffer
+ offset
;
3223 end
= read_buffer
+ read_buffer_size
;
3230 end_of_file_error ();
3235 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3241 && c
!= NO_BREAK_SPACE
3243 || strchr ("\"';()[]#`,", c
) == NULL
));
3247 ptrdiff_t offset
= p
- read_buffer
;
3248 grow_read_buffer ();
3249 p
= read_buffer
+ offset
;
3250 end
= read_buffer
+ read_buffer_size
;
3256 if (!quoted
&& !uninterned_symbol
)
3258 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3259 if (! NILP (result
))
3263 Lisp_Object name
, result
;
3264 ptrdiff_t nbytes
= p
- read_buffer
;
3267 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3271 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3272 ? make_pure_string
: make_specified_string
)
3273 (read_buffer
, nchars
, nbytes
, multibyte
));
3274 result
= (uninterned_symbol
? Fmake_symbol (name
)
3275 : Fintern (name
, Qnil
));
3277 if (EQ (Vread_with_symbol_positions
, Qt
)
3278 || EQ (Vread_with_symbol_positions
, readcharfun
))
3279 Vread_symbol_positions_list
3280 = Fcons (Fcons (result
, make_number (start_position
)),
3281 Vread_symbol_positions_list
);
3289 /* List of nodes we've seen during substitute_object_in_subtree. */
3290 static Lisp_Object seen_list
;
3293 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3295 Lisp_Object check_object
;
3297 /* We haven't seen any objects when we start. */
3300 /* Make all the substitutions. */
3302 = substitute_object_recurse (object
, placeholder
, object
);
3304 /* Clear seen_list because we're done with it. */
3307 /* The returned object here is expected to always eq the
3309 if (!EQ (check_object
, object
))
3310 error ("Unexpected mutation error in reader");
3313 /* Feval doesn't get called from here, so no gc protection is needed. */
3314 #define SUBSTITUTE(get_val, set_val) \
3316 Lisp_Object old_value = get_val; \
3317 Lisp_Object true_value \
3318 = substitute_object_recurse (object, placeholder, \
3321 if (!EQ (old_value, true_value)) \
3328 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3330 /* If we find the placeholder, return the target object. */
3331 if (EQ (placeholder
, subtree
))
3334 /* If we've been to this node before, don't explore it again. */
3335 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3338 /* If this node can be the entry point to a cycle, remember that
3339 we've seen it. It can only be such an entry point if it was made
3340 by #n=, which means that we can find it as a value in
3342 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3343 seen_list
= Fcons (subtree
, seen_list
);
3345 /* Recurse according to subtree's type.
3346 Every branch must return a Lisp_Object. */
3347 switch (XTYPE (subtree
))
3349 case Lisp_Vectorlike
:
3351 ptrdiff_t i
= 0, length
= 0;
3352 if (BOOL_VECTOR_P (subtree
))
3353 return subtree
; /* No sub-objects anyway. */
3354 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3355 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3356 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3357 else if (VECTORP (subtree
))
3358 length
= ASIZE (subtree
);
3360 /* An unknown pseudovector may contain non-Lisp fields, so we
3361 can't just blindly traverse all its fields. We used to call
3362 `Flength' which signaled `sequencep', so I just preserved this
3364 wrong_type_argument (Qsequencep
, subtree
);
3366 if (SUB_CHAR_TABLE_P (subtree
))
3368 for ( ; i
< length
; i
++)
3369 SUBSTITUTE (AREF (subtree
, i
),
3370 ASET (subtree
, i
, true_value
));
3376 SUBSTITUTE (XCAR (subtree
),
3377 XSETCAR (subtree
, true_value
));
3378 SUBSTITUTE (XCDR (subtree
),
3379 XSETCDR (subtree
, true_value
));
3385 /* Check for text properties in each interval.
3386 substitute_in_interval contains part of the logic. */
3388 INTERVAL root_interval
= string_intervals (subtree
);
3389 AUTO_CONS (arg
, object
, placeholder
);
3391 traverse_intervals_noorder (root_interval
,
3392 &substitute_in_interval
, arg
);
3397 /* Other types don't recurse any further. */
3403 /* Helper function for substitute_object_recurse. */
3405 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3407 Lisp_Object object
= Fcar (arg
);
3408 Lisp_Object placeholder
= Fcdr (arg
);
3410 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3420 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3421 integer syntax and fits in a fixnum, else return the nearest float if CP has
3422 either floating point or integer syntax and BASE is 10, else return nil. If
3423 IGNORE_TRAILING, consider just the longest prefix of CP that has
3424 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3425 number has integer syntax but does not fit. */
3428 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3431 char const *cp
= string
;
3433 bool float_syntax
= 0;
3436 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3437 IEEE floating point hosts, and works around a formerly-common bug where
3438 atof ("-0.0") drops the sign. */
3439 bool negative
= *cp
== '-';
3441 bool signedp
= negative
|| *cp
== '+';
3446 leading_digit
= digit_to_number (*cp
, base
);
3447 if (leading_digit
>= 0)
3452 while (digit_to_number (*cp
, base
) >= 0);
3462 if ('0' <= *cp
&& *cp
<= '9')
3467 while ('0' <= *cp
&& *cp
<= '9');
3469 if (*cp
== 'e' || *cp
== 'E')
3471 char const *ecp
= cp
;
3473 if (*cp
== '+' || *cp
== '-')
3475 if ('0' <= *cp
&& *cp
<= '9')
3480 while ('0' <= *cp
&& *cp
<= '9');
3482 else if (cp
[-1] == '+'
3483 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3489 else if (cp
[-1] == '+'
3490 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3494 /* NAN is a "positive" NaN on all known Emacs hosts. */
3501 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3502 || state
== (LEAD_INT
|E_EXP
));
3505 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3506 any prefix that matches. Otherwise, the entire string must match. */
3507 if (! (ignore_trailing
3508 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3509 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3512 /* If the number uses integer and not float syntax, and is in C-language
3513 range, use its value, preferably as a fixnum. */
3514 if (leading_digit
>= 0 && ! float_syntax
)
3518 /* Fast special case for single-digit integers. This also avoids a
3519 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3520 case some versions of strtoumax accept numbers like "0x1" that Emacs
3522 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3523 return make_number (negative
? -leading_digit
: leading_digit
);
3526 n
= strtoumax (string
+ signedp
, NULL
, base
);
3527 if (errno
== ERANGE
)
3529 /* Unfortunately there's no simple and accurate way to convert
3530 non-base-10 numbers that are out of C-language range. */
3532 xsignal1 (Qoverflow_error
, build_string (string
));
3534 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3536 EMACS_INT signed_n
= n
;
3537 return make_number (negative
? -signed_n
: signed_n
);
3543 /* Either the number uses float syntax, or it does not fit into a fixnum.
3544 Convert it from string to floating point, unless the value is already
3545 known because it is an infinity, a NAN, or its absolute value fits in
3548 value
= atof (string
+ signedp
);
3550 return make_float (negative
? -value
: value
);
3555 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3559 Lisp_Object tem
, item
, vector
;
3560 struct Lisp_Cons
*otem
;
3563 tem
= read_list (1, readcharfun
);
3564 len
= Flength (tem
);
3565 vector
= Fmake_vector (len
, Qnil
);
3567 size
= ASIZE (vector
);
3568 ptr
= XVECTOR (vector
)->contents
;
3569 for (i
= 0; i
< size
; i
++)
3572 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3573 bytecode object, the docstring containing the bytecode and
3574 constants values must be treated as unibyte and passed to
3575 Fread, to get the actual bytecode string and constants vector. */
3576 if (bytecodeflag
&& load_force_doc_strings
)
3578 if (i
== COMPILED_BYTECODE
)
3580 if (!STRINGP (item
))
3581 error ("Invalid byte code");
3583 /* Delay handling the bytecode slot until we know whether
3584 it is lazily-loaded (we can tell by whether the
3585 constants slot is nil). */
3586 ASET (vector
, COMPILED_CONSTANTS
, item
);
3589 else if (i
== COMPILED_CONSTANTS
)
3591 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3595 /* Coerce string to unibyte (like string-as-unibyte,
3596 but without generating extra garbage and
3597 guaranteeing no change in the contents). */
3598 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3599 STRING_SET_UNIBYTE (bytestr
);
3601 item
= Fread (Fcons (bytestr
, readcharfun
));
3603 error ("Invalid byte code");
3605 otem
= XCONS (item
);
3606 bytestr
= XCAR (item
);
3611 /* Now handle the bytecode slot. */
3612 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3614 else if (i
== COMPILED_DOC_STRING
3616 && ! STRING_MULTIBYTE (item
))
3618 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3619 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3621 item
= Fstring_as_multibyte (item
);
3624 ASET (vector
, i
, item
);
3632 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3635 read_list (bool flag
, Lisp_Object readcharfun
)
3637 Lisp_Object val
, tail
;
3638 Lisp_Object elt
, tem
;
3639 /* 0 is the normal case.
3640 1 means this list is a doc reference; replace it with the number 0.
3641 2 means this list is a doc reference; replace it with the doc string. */
3642 int doc_reference
= 0;
3644 /* Initialize this to 1 if we are reading a list. */
3645 bool first_in_list
= flag
<= 0;
3653 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3657 /* While building, if the list starts with #$, treat it specially. */
3658 if (EQ (elt
, Vload_file_name
)
3660 && !NILP (Vpurify_flag
))
3662 if (NILP (Vdoc_file_name
))
3663 /* We have not yet called Snarf-documentation, so assume
3664 this file is described in the DOC file
3665 and Snarf-documentation will fill in the right value later.
3666 For now, replace the whole list with 0. */
3669 /* We have already called Snarf-documentation, so make a relative
3670 file name for this file, so it can be found properly
3671 in the installed Lisp directory.
3672 We don't use Fexpand_file_name because that would make
3673 the directory absolute now. */
3675 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3676 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3679 else if (EQ (elt
, Vload_file_name
)
3681 && load_force_doc_strings
)
3690 invalid_syntax (") or . in a vector");
3697 XSETCDR (tail
, read0 (readcharfun
));
3699 val
= read0 (readcharfun
);
3700 read1 (readcharfun
, &ch
, 0);
3704 if (doc_reference
== 1)
3705 return make_number (0);
3706 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3709 file_offset saved_position
;
3710 /* Get a doc string from the file we are loading.
3711 If it's in saved_doc_string, get it from there.
3713 Here, we don't know if the string is a
3714 bytecode string or a doc string. As a
3715 bytecode string must be unibyte, we always
3716 return a unibyte string. If it is actually a
3717 doc string, caller must make it
3720 /* Position is negative for user variables. */
3721 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3722 if (pos
>= saved_doc_string_position
3723 && pos
< (saved_doc_string_position
3724 + saved_doc_string_length
))
3726 saved
= saved_doc_string
;
3727 saved_position
= saved_doc_string_position
;
3729 /* Look in prev_saved_doc_string the same way. */
3730 else if (pos
>= prev_saved_doc_string_position
3731 && pos
< (prev_saved_doc_string_position
3732 + prev_saved_doc_string_length
))
3734 saved
= prev_saved_doc_string
;
3735 saved_position
= prev_saved_doc_string_position
;
3739 ptrdiff_t start
= pos
- saved_position
;
3742 /* Process quoting with ^A,
3743 and find the end of the string,
3744 which is marked with ^_ (037). */
3745 for (from
= start
, to
= start
;
3746 saved
[from
] != 037;)
3748 int c
= saved
[from
++];
3752 saved
[to
++] = (c
== 1 ? c
3761 return make_unibyte_string (saved
+ start
,
3765 return get_doc_string (val
, 1, 0);
3770 invalid_syntax (". in wrong context");
3772 invalid_syntax ("] in a list");
3776 XSETCDR (tail
, tem
);
3783 static Lisp_Object initial_obarray
;
3785 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3787 static size_t oblookup_last_bucket_number
;
3789 /* Get an error if OBARRAY is not an obarray.
3790 If it is one, return it. */
3793 check_obarray (Lisp_Object obarray
)
3795 /* We don't want to signal a wrong-type-argument error when we are
3796 shutting down due to a fatal error, and we don't want to hit
3797 assertions in VECTORP and ASIZE if the fatal error was during GC. */
3798 if (!fatal_error_in_progress
3799 && (!VECTORP (obarray
) || ASIZE (obarray
) == 0))
3801 /* If Vobarray is now invalid, force it to be valid. */
3802 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3803 wrong_type_argument (Qvectorp
, obarray
);
3808 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3811 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3815 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3816 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3819 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3821 XSYMBOL (sym
)->constant
= 1;
3822 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3823 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3826 ptr
= aref_addr (obarray
, XINT (index
));
3827 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3832 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3835 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3837 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3840 /* Intern the C string STR: return a symbol with that name,
3841 interned in the current obarray. */
3844 intern_1 (const char *str
, ptrdiff_t len
)
3846 Lisp_Object obarray
= check_obarray (Vobarray
);
3847 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3849 return (SYMBOLP (tem
) ? tem
3850 /* The above `oblookup' was done on the basis of nchars==nbytes, so
3851 the string has to be unibyte. */
3852 : intern_driver (make_unibyte_string (str
, len
),
3857 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3859 Lisp_Object obarray
= check_obarray (Vobarray
);
3860 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3864 /* Creating a non-pure string from a string literal not implemented yet.
3865 We could just use make_string here and live with the extra copy. */
3866 eassert (!NILP (Vpurify_flag
));
3867 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3873 define_symbol (Lisp_Object sym
, char const *str
)
3875 ptrdiff_t len
= strlen (str
);
3876 Lisp_Object string
= make_pure_c_string (str
, len
);
3877 init_symbol (sym
, string
);
3879 /* Qunbound is uninterned, so that it's not confused with any symbol
3880 'unbound' created by a Lisp program. */
3881 if (! EQ (sym
, Qunbound
))
3883 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3884 eassert (INTEGERP (bucket
));
3885 intern_sym (sym
, initial_obarray
, bucket
);
3889 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3890 doc
: /* Return the canonical symbol whose name is STRING.
3891 If there is none, one is created by this function and returned.
3892 A second optional argument specifies the obarray to use;
3893 it defaults to the value of `obarray'. */)
3894 (Lisp_Object string
, Lisp_Object obarray
)
3898 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3899 CHECK_STRING (string
);
3901 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3903 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3908 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3909 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3910 NAME may be a string or a symbol. If it is a symbol, that exact
3911 symbol is searched for.
3912 A second optional argument specifies the obarray to use;
3913 it defaults to the value of `obarray'. */)
3914 (Lisp_Object name
, Lisp_Object obarray
)
3916 register Lisp_Object tem
, string
;
3918 if (NILP (obarray
)) obarray
= Vobarray
;
3919 obarray
= check_obarray (obarray
);
3921 if (!SYMBOLP (name
))
3923 CHECK_STRING (name
);
3927 string
= SYMBOL_NAME (name
);
3929 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3930 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3936 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3937 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3938 The value is t if a symbol was found and deleted, nil otherwise.
3939 NAME may be a string or a symbol. If it is a symbol, that symbol
3940 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3941 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3942 usage: (unintern NAME OBARRAY) */)
3943 (Lisp_Object name
, Lisp_Object obarray
)
3945 register Lisp_Object string
, tem
;
3948 if (NILP (obarray
)) obarray
= Vobarray
;
3949 obarray
= check_obarray (obarray
);
3952 string
= SYMBOL_NAME (name
);
3955 CHECK_STRING (name
);
3959 tem
= oblookup (obarray
, SSDATA (string
),
3964 /* If arg was a symbol, don't delete anything but that symbol itself. */
3965 if (SYMBOLP (name
) && !EQ (name
, tem
))
3968 /* There are plenty of other symbols which will screw up the Emacs
3969 session if we unintern them, as well as even more ways to use
3970 `setq' or `fset' or whatnot to make the Emacs session
3971 unusable. Let's not go down this silly road. --Stef */
3972 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3973 error ("Attempt to unintern t or nil"); */
3975 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3977 hash
= oblookup_last_bucket_number
;
3979 if (EQ (AREF (obarray
, hash
), tem
))
3981 if (XSYMBOL (tem
)->next
)
3984 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3985 ASET (obarray
, hash
, sym
);
3988 ASET (obarray
, hash
, make_number (0));
3992 Lisp_Object tail
, following
;
3994 for (tail
= AREF (obarray
, hash
);
3995 XSYMBOL (tail
)->next
;
3998 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3999 if (EQ (following
, tem
))
4001 set_symbol_next (tail
, XSYMBOL (following
)->next
);
4010 /* Return the symbol in OBARRAY whose names matches the string
4011 of SIZE characters (SIZE_BYTE bytes) at PTR.
4012 If there is no such symbol, return the integer bucket number of
4013 where the symbol would be if it were present.
4015 Also store the bucket number in oblookup_last_bucket_number. */
4018 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
4022 register Lisp_Object tail
;
4023 Lisp_Object bucket
, tem
;
4025 obarray
= check_obarray (obarray
);
4026 /* This is sometimes needed in the middle of GC. */
4027 obsize
= gc_asize (obarray
);
4028 hash
= hash_string (ptr
, size_byte
) % obsize
;
4029 bucket
= AREF (obarray
, hash
);
4030 oblookup_last_bucket_number
= hash
;
4031 if (EQ (bucket
, make_number (0)))
4033 else if (!SYMBOLP (bucket
))
4034 error ("Bad data in guts of obarray"); /* Like CADR error message. */
4036 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
4038 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
4039 && SCHARS (SYMBOL_NAME (tail
)) == size
4040 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
4042 else if (XSYMBOL (tail
)->next
== 0)
4045 XSETINT (tem
, hash
);
4050 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
4053 register Lisp_Object tail
;
4054 CHECK_VECTOR (obarray
);
4055 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
4057 tail
= AREF (obarray
, i
);
4062 if (XSYMBOL (tail
)->next
== 0)
4064 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4070 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4072 call1 (function
, sym
);
4075 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4076 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4077 OBARRAY defaults to the value of `obarray'. */)
4078 (Lisp_Object function
, Lisp_Object obarray
)
4080 if (NILP (obarray
)) obarray
= Vobarray
;
4081 obarray
= check_obarray (obarray
);
4083 map_obarray (obarray
, mapatoms_1
, function
);
4087 #define OBARRAY_SIZE 1511
4092 Lisp_Object oblength
;
4093 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4095 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4097 Vobarray
= Fmake_vector (oblength
, make_number (0));
4098 initial_obarray
= Vobarray
;
4099 staticpro (&initial_obarray
);
4101 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4102 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4104 DEFSYM (Qunbound
, "unbound");
4106 DEFSYM (Qnil
, "nil");
4107 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4108 XSYMBOL (Qnil
)->constant
= 1;
4109 XSYMBOL (Qnil
)->declared_special
= true;
4112 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4113 XSYMBOL (Qt
)->constant
= 1;
4114 XSYMBOL (Qt
)->declared_special
= true;
4116 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4119 DEFSYM (Qvariable_documentation
, "variable-documentation");
4121 read_buffer
= xmalloc (size
);
4122 read_buffer_size
= size
;
4126 defsubr (struct Lisp_Subr
*sname
)
4128 Lisp_Object sym
, tem
;
4129 sym
= intern_c_string (sname
->symbol_name
);
4130 XSETPVECTYPE (sname
, PVEC_SUBR
);
4131 XSETSUBR (tem
, sname
);
4132 set_symbol_function (sym
, tem
);
4135 #ifdef NOTDEF /* Use fset in subr.el now! */
4137 defalias (struct Lisp_Subr
*sname
, char *string
)
4140 sym
= intern (string
);
4141 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4145 /* Define an "integer variable"; a symbol whose value is forwarded to a
4146 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4147 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4149 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4150 const char *namestring
, EMACS_INT
*address
)
4153 sym
= intern_c_string (namestring
);
4154 i_fwd
->type
= Lisp_Fwd_Int
;
4155 i_fwd
->intvar
= address
;
4156 XSYMBOL (sym
)->declared_special
= 1;
4157 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4158 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4161 /* Similar but define a variable whose value is t if address contains 1,
4162 nil if address contains 0. */
4164 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4165 const char *namestring
, bool *address
)
4168 sym
= intern_c_string (namestring
);
4169 b_fwd
->type
= Lisp_Fwd_Bool
;
4170 b_fwd
->boolvar
= address
;
4171 XSYMBOL (sym
)->declared_special
= 1;
4172 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4173 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4174 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4177 /* Similar but define a variable whose value is the Lisp Object stored
4178 at address. Two versions: with and without gc-marking of the C
4179 variable. The nopro version is used when that variable will be
4180 gc-marked for some other reason, since marking the same slot twice
4181 can cause trouble with strings. */
4183 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4184 const char *namestring
, Lisp_Object
*address
)
4187 sym
= intern_c_string (namestring
);
4188 o_fwd
->type
= Lisp_Fwd_Obj
;
4189 o_fwd
->objvar
= address
;
4190 XSYMBOL (sym
)->declared_special
= 1;
4191 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4192 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4196 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4197 const char *namestring
, Lisp_Object
*address
)
4199 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4200 staticpro (address
);
4203 /* Similar but define a variable whose value is the Lisp Object stored
4204 at a particular offset in the current kboard object. */
4207 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4208 const char *namestring
, int offset
)
4211 sym
= intern_c_string (namestring
);
4212 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4213 ko_fwd
->offset
= offset
;
4214 XSYMBOL (sym
)->declared_special
= 1;
4215 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4216 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4219 /* Check that the elements of lpath exist. */
4222 load_path_check (Lisp_Object lpath
)
4224 Lisp_Object path_tail
;
4226 /* The only elements that might not exist are those from
4227 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4229 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4231 Lisp_Object dirfile
;
4232 dirfile
= Fcar (path_tail
);
4233 if (STRINGP (dirfile
))
4235 dirfile
= Fdirectory_file_name (dirfile
);
4236 if (! file_accessible_directory_p (dirfile
))
4237 dir_warning ("Lisp directory", XCAR (path_tail
));
4242 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4243 This does not include the standard site-lisp directories
4244 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4245 but it does (unless no_site_lisp is set) include site-lisp
4246 directories in the source/build directories if those exist and we
4247 are running uninstalled.
4249 Uses the following logic:
4250 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4251 The remainder is what happens when dumping works:
4252 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4253 Otherwise use PATH_LOADSEARCH.
4255 If !initialized, then just return PATH_DUMPLOADSEARCH.
4257 If Vinstallation_directory is not nil (ie, running uninstalled):
4258 If installation-dir/lisp exists and not already a member,
4259 we must be running uninstalled. Reset the load-path
4260 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4261 refers to the eventual installation directories. Since we
4262 are not yet installed, we should not use them, even if they exist.)
4263 If installation-dir/lisp does not exist, just add
4264 PATH_DUMPLOADSEARCH at the end instead.
4265 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4266 and not already a member) at the front.
4267 If installation-dir != source-dir (ie running an uninstalled,
4268 out-of-tree build) AND install-dir/src/Makefile exists BUT
4269 install-dir/src/Makefile.in does NOT exist (this is a sanity
4270 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4273 load_path_default (void)
4275 Lisp_Object lpath
= Qnil
;
4280 const char *loadpath
= ns_load_path ();
4283 normal
= PATH_LOADSEARCH
;
4285 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4287 lpath
= decode_env_path (0, normal
, 0);
4290 #else /* !CANNOT_DUMP */
4292 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4297 const char *loadpath
= ns_load_path ();
4298 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4300 lpath
= decode_env_path (0, normal
, 0);
4302 if (!NILP (Vinstallation_directory
))
4304 Lisp_Object tem
, tem1
;
4306 /* Add to the path the lisp subdir of the installation
4307 dir, if it is accessible. Note: in out-of-tree builds,
4308 this directory is empty save for Makefile. */
4309 tem
= Fexpand_file_name (build_string ("lisp"),
4310 Vinstallation_directory
);
4311 tem1
= Ffile_accessible_directory_p (tem
);
4314 if (NILP (Fmember (tem
, lpath
)))
4316 /* We are running uninstalled. The default load-path
4317 points to the eventual installed lisp directories.
4318 We should not use those now, even if they exist,
4319 so start over from a clean slate. */
4320 lpath
= list1 (tem
);
4324 /* That dir doesn't exist, so add the build-time
4325 Lisp dirs instead. */
4327 Lisp_Object dump_path
=
4328 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4329 lpath
= nconc2 (lpath
, dump_path
);
4332 /* Add site-lisp under the installation dir, if it exists. */
4335 tem
= Fexpand_file_name (build_string ("site-lisp"),
4336 Vinstallation_directory
);
4337 tem1
= Ffile_accessible_directory_p (tem
);
4340 if (NILP (Fmember (tem
, lpath
)))
4341 lpath
= Fcons (tem
, lpath
);
4345 /* If Emacs was not built in the source directory,
4346 and it is run from where it was built, add to load-path
4347 the lisp and site-lisp dirs under that directory. */
4349 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4353 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4354 Vinstallation_directory
);
4355 tem1
= Ffile_exists_p (tem
);
4357 /* Don't be fooled if they moved the entire source tree
4358 AFTER dumping Emacs. If the build directory is indeed
4359 different from the source dir, src/Makefile.in and
4360 src/Makefile will not be found together. */
4361 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4362 Vinstallation_directory
);
4363 tem2
= Ffile_exists_p (tem
);
4364 if (!NILP (tem1
) && NILP (tem2
))
4366 tem
= Fexpand_file_name (build_string ("lisp"),
4369 if (NILP (Fmember (tem
, lpath
)))
4370 lpath
= Fcons (tem
, lpath
);
4374 tem
= Fexpand_file_name (build_string ("site-lisp"),
4376 tem1
= Ffile_accessible_directory_p (tem
);
4379 if (NILP (Fmember (tem
, lpath
)))
4380 lpath
= Fcons (tem
, lpath
);
4384 } /* Vinstallation_directory != Vsource_directory */
4386 } /* if Vinstallation_directory */
4388 else /* !initialized */
4390 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4391 source directory. We used to add ../lisp (ie the lisp dir in
4392 the build directory) at the front here, but that should not
4393 be necessary, since in out of tree builds lisp/ is empty, save
4395 lpath
= decode_env_path (0, normal
, 0);
4397 #endif /* !CANNOT_DUMP */
4405 /* First, set Vload_path. */
4407 /* Ignore EMACSLOADPATH when dumping. */
4409 bool use_loadpath
= true;
4411 bool use_loadpath
= NILP (Vpurify_flag
);
4414 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4416 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4418 /* Check (non-nil) user-supplied elements. */
4419 load_path_check (Vload_path
);
4421 /* If no nils in the environment variable, use as-is.
4422 Otherwise, replace any nils with the default. */
4423 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4425 Lisp_Object elem
, elpath
= Vload_path
;
4426 Lisp_Object default_lpath
= load_path_default ();
4428 /* Check defaults, before adding site-lisp. */
4429 load_path_check (default_lpath
);
4431 /* Add the site-lisp directories to the front of the default. */
4432 if (!no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4434 Lisp_Object sitelisp
;
4435 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4436 if (! NILP (sitelisp
))
4437 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4442 /* Replace nils from EMACSLOADPATH by default. */
4443 while (CONSP (elpath
))
4445 elem
= XCAR (elpath
);
4446 elpath
= XCDR (elpath
);
4447 Vload_path
= CALLN (Fappend
, Vload_path
,
4448 NILP (elem
) ? default_lpath
: list1 (elem
));
4450 } /* Fmemq (Qnil, Vload_path) */
4454 Vload_path
= load_path_default ();
4456 /* Check before adding site-lisp directories.
4457 The install should have created them, but they are not
4458 required, so no need to warn if they are absent.
4459 Or we might be running before installation. */
4460 load_path_check (Vload_path
);
4462 /* Add the site-lisp directories at the front. */
4463 if (initialized
&& !no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4465 Lisp_Object sitelisp
;
4466 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4467 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4473 load_in_progress
= 0;
4474 Vload_file_name
= Qnil
;
4475 Vstandard_input
= Qt
;
4476 Vloads_in_progress
= Qnil
;
4479 /* Print a warning that directory intended for use USE and with name
4480 DIRNAME cannot be accessed. On entry, errno should correspond to
4481 the access failure. Print the warning on stderr and put it in
4485 dir_warning (char const *use
, Lisp_Object dirname
)
4487 static char const format
[] = "Warning: %s '%s': %s\n";
4488 int access_errno
= errno
;
4489 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)),
4490 strerror (access_errno
));
4492 /* Don't log the warning before we've initialized!! */
4495 char const *diagnostic
= emacs_strerror (access_errno
);
4497 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4498 + strlen (use
) + SBYTES (dirname
)
4499 + strlen (diagnostic
));
4500 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4502 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4508 syms_of_lread (void)
4511 defsubr (&Sread_from_string
);
4513 defsubr (&Sintern_soft
);
4514 defsubr (&Sunintern
);
4515 defsubr (&Sget_load_suffixes
);
4517 defsubr (&Seval_buffer
);
4518 defsubr (&Seval_region
);
4519 defsubr (&Sread_char
);
4520 defsubr (&Sread_char_exclusive
);
4521 defsubr (&Sread_event
);
4522 defsubr (&Sget_file_char
);
4523 defsubr (&Smapatoms
);
4524 defsubr (&Slocate_file_internal
);
4526 DEFVAR_LISP ("obarray", Vobarray
,
4527 doc
: /* Symbol table for use by `intern' and `read'.
4528 It is a vector whose length ought to be prime for best results.
4529 The vector's contents don't make sense if examined from Lisp programs;
4530 to find all the symbols in an obarray, use `mapatoms'. */);
4532 DEFVAR_LISP ("values", Vvalues
,
4533 doc
: /* List of values of all expressions which were read, evaluated and printed.
4534 Order is reverse chronological. */);
4535 XSYMBOL (intern ("values"))->declared_special
= 0;
4537 DEFVAR_LISP ("standard-input", Vstandard_input
,
4538 doc
: /* Stream for read to get input from.
4539 See documentation of `read' for possible values. */);
4540 Vstandard_input
= Qt
;
4542 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4543 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4545 If this variable is a buffer, then only forms read from that buffer
4546 will be added to `read-symbol-positions-list'.
4547 If this variable is t, then all read forms will be added.
4548 The effect of all other values other than nil are not currently
4549 defined, although they may be in the future.
4551 The positions are relative to the last call to `read' or
4552 `read-from-string'. It is probably a bad idea to set this variable at
4553 the toplevel; bind it instead. */);
4554 Vread_with_symbol_positions
= Qnil
;
4556 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4557 doc
: /* A list mapping read symbols to their positions.
4558 This variable is modified during calls to `read' or
4559 `read-from-string', but only when `read-with-symbol-positions' is
4562 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4563 CHAR-POSITION is an integer giving the offset of that occurrence of the
4564 symbol from the position where `read' or `read-from-string' started.
4566 Note that a symbol will appear multiple times in this list, if it was
4567 read multiple times. The list is in the same order as the symbols
4569 Vread_symbol_positions_list
= Qnil
;
4571 DEFVAR_LISP ("read-circle", Vread_circle
,
4572 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4575 DEFVAR_LISP ("load-path", Vload_path
,
4576 doc
: /* List of directories to search for files to load.
4577 Each element is a string (directory file name) or nil (meaning
4578 `default-directory').
4579 This list is consulted by the `require' function.
4580 Initialized during startup as described in Info node `(elisp)Library Search'.
4581 Use `directory-file-name' when adding items to this path. However, Lisp
4582 programs that process this list should tolerate directories both with
4583 and without trailing slashes. */);
4585 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4586 doc
: /* List of suffixes for Emacs Lisp files and dynamic modules.
4587 This list includes suffixes for both compiled and source Emacs Lisp files.
4588 This list should not include the empty string.
4589 `load' and related functions try to append these suffixes, in order,
4590 to the specified file name if a suffix is allowed or required. */);
4592 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4593 build_pure_c_string (".el"),
4594 build_pure_c_string (MODULES_SUFFIX
));
4596 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4597 build_pure_c_string (".el"));
4599 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix
,
4600 doc
: /* Suffix of loadable module file, or nil of modules are not supported. */);
4602 Vmodule_file_suffix
= build_pure_c_string (MODULES_SUFFIX
);
4604 Vmodule_file_suffix
= Qnil
;
4606 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4607 doc
: /* List of suffixes that indicate representations of \
4609 This list should normally start with the empty string.
4611 Enabling Auto Compression mode appends the suffixes in
4612 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4613 mode removes them again. `load' and related functions use this list to
4614 determine whether they should look for compressed versions of a file
4615 and, if so, which suffixes they should try to append to the file name
4616 in order to do so. However, if you want to customize which suffixes
4617 the loading functions recognize as compression suffixes, you should
4618 customize `jka-compr-load-suffixes' rather than the present variable. */);
4619 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4621 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4622 doc
: /* Non-nil if inside of `load'. */);
4623 DEFSYM (Qload_in_progress
, "load-in-progress");
4625 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4626 doc
: /* An alist of functions to be evalled when particular files are loaded.
4627 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4629 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4630 a symbol (a feature name).
4632 When `load' is run and the file-name argument matches an element's
4633 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4634 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4636 An error in FORMS does not undo the load, but does prevent execution of
4637 the rest of the FORMS. */);
4638 Vafter_load_alist
= Qnil
;
4640 DEFVAR_LISP ("load-history", Vload_history
,
4641 doc
: /* Alist mapping loaded file names to symbols and features.
4642 Each alist element should be a list (FILE-NAME ENTRIES...), where
4643 FILE-NAME is the name of a file that has been loaded into Emacs.
4644 The file name is absolute and true (i.e. it doesn't contain symlinks).
4645 As an exception, one of the alist elements may have FILE-NAME nil,
4646 for symbols and features not associated with any file.
4648 The remaining ENTRIES in the alist element describe the functions and
4649 variables defined in that file, the features provided, and the
4650 features required. Each entry has the form `(provide . FEATURE)',
4651 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4652 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4653 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4654 autoload before this file redefined it as a function. In addition,
4655 entries may also be single symbols, which means that SYMBOL was
4656 defined by `defvar' or `defconst'.
4658 During preloading, the file name recorded is relative to the main Lisp
4659 directory. These file names are converted to absolute at startup. */);
4660 Vload_history
= Qnil
;
4662 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4663 doc
: /* Full name of file being loaded by `load'. */);
4664 Vload_file_name
= Qnil
;
4666 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4667 doc
: /* File name, including directory, of user's initialization file.
4668 If the file loaded had extension `.elc', and the corresponding source file
4669 exists, this variable contains the name of source file, suitable for use
4670 by functions like `custom-save-all' which edit the init file.
4671 While Emacs loads and evaluates the init file, value is the real name
4672 of the file, regardless of whether or not it has the `.elc' extension. */);
4673 Vuser_init_file
= Qnil
;
4675 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4676 doc
: /* Used for internal purposes by `load'. */);
4677 Vcurrent_load_list
= Qnil
;
4679 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4680 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4681 Called with a single argument (the stream from which to read).
4682 The default is to use the function `read'. */);
4683 DEFSYM (Qread
, "read");
4684 Vload_read_function
= Qread
;
4686 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4687 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4688 The value should be a function for doing code conversion before
4689 reading a source file. It can also be nil, in which case loading is
4690 done without any code conversion.
4692 If the value is a function, it is called with four arguments,
4693 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4694 the file to load, FILE is the non-absolute name (for messages etc.),
4695 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4696 `load'. The function should return t if the file was loaded. */);
4697 Vload_source_file_function
= Qnil
;
4699 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4700 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4701 This is useful when the file being loaded is a temporary copy. */);
4702 load_force_doc_strings
= 0;
4704 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4705 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4706 This is normally bound by `load' and `eval-buffer' to control `read',
4707 and is not meant for users to change. */);
4708 load_convert_to_unibyte
= 0;
4710 DEFVAR_LISP ("source-directory", Vsource_directory
,
4711 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4712 You cannot count on them to still be there! */);
4714 = Fexpand_file_name (build_string ("../"),
4715 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4717 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4718 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4719 Vpreloaded_file_list
= Qnil
;
4721 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4722 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4723 Vbyte_boolean_vars
= Qnil
;
4725 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4726 doc
: /* Non-nil means load dangerous compiled Lisp files.
4727 Some versions of XEmacs use different byte codes than Emacs. These
4728 incompatible byte codes can make Emacs crash when it tries to execute
4730 load_dangerous_libraries
= 0;
4732 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4733 doc
: /* Non-nil means force printing messages when loading Lisp files.
4734 This overrides the value of the NOMESSAGE argument to `load'. */);
4735 force_load_messages
= 0;
4737 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4738 doc
: /* Regular expression matching safe to load compiled Lisp files.
4739 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4740 from the file, and matches them against this regular expression.
4741 When the regular expression matches, the file is considered to be safe
4742 to load. See also `load-dangerous-libraries'. */);
4743 Vbytecomp_version_regexp
4744 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4746 DEFSYM (Qlexical_binding
, "lexical-binding");
4747 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4748 doc
: /* Whether to use lexical binding when evaluating code.
4749 Non-nil means that the code in the current buffer should be evaluated
4750 with lexical binding.
4751 This variable is automatically set from the file variables of an
4752 interpreted Lisp file read using `load'. Unlike other file local
4753 variables, this must be set in the first line of a file. */);
4754 Vlexical_binding
= Qnil
;
4755 Fmake_variable_buffer_local (Qlexical_binding
);
4757 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4758 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4759 Veval_buffer_list
= Qnil
;
4761 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4762 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4763 Vold_style_backquotes
= Qnil
;
4764 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4766 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4767 doc
: /* Non-nil means `load' prefers the newest version of a file.
4768 This applies when a filename suffix is not explicitly specified and
4769 `load' is trying various possible suffixes (see `load-suffixes' and
4770 `load-file-rep-suffixes'). Normally, it stops at the first file
4771 that exists unless you explicitly specify one or the other. If this
4772 option is non-nil, it checks all suffixes and uses whichever file is
4774 Note that if you customize this, obviously it will not affect files
4775 that are loaded before your customizations are read! */);
4776 load_prefer_newer
= 0;
4778 /* Vsource_directory was initialized in init_lread. */
4780 DEFSYM (Qcurrent_load_list
, "current-load-list");
4781 DEFSYM (Qstandard_input
, "standard-input");
4782 DEFSYM (Qread_char
, "read-char");
4783 DEFSYM (Qget_file_char
, "get-file-char");
4785 /* Used instead of Qget_file_char while loading *.elc files compiled
4786 by Emacs 21 or older. */
4787 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4789 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4791 DEFSYM (Qbackquote
, "`");
4792 DEFSYM (Qcomma
, ",");
4793 DEFSYM (Qcomma_at
, ",@");
4794 DEFSYM (Qcomma_dot
, ",.");
4796 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4797 DEFSYM (Qascii_character
, "ascii-character");
4798 DEFSYM (Qfunction
, "function");
4799 DEFSYM (Qload
, "load");
4800 DEFSYM (Qload_file_name
, "load-file-name");
4801 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4802 DEFSYM (Qfile_truename
, "file-truename");
4803 DEFSYM (Qdir_ok
, "dir-ok");
4804 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4806 staticpro (&read_objects
);
4807 read_objects
= Qnil
;
4808 staticpro (&seen_list
);
4811 Vloads_in_progress
= Qnil
;
4812 staticpro (&Vloads_in_progress
);
4814 DEFSYM (Qhash_table
, "hash-table");
4815 DEFSYM (Qdata
, "data");
4816 DEFSYM (Qtest
, "test");
4817 DEFSYM (Qsize
, "size");
4818 DEFSYM (Qweakness
, "weakness");
4819 DEFSYM (Qrehash_size
, "rehash-size");
4820 DEFSYM (Qrehash_threshold
, "rehash-threshold");
4822 DEFSYM (Qchar_from_name
, "char-from-name");