1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2015 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
11 (at 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"
59 #endif /* HAVE_SETLOCALE */
64 #define file_offset off_t
65 #define file_tell ftello
67 #define file_offset long
68 #define file_tell ftell
71 /* The association list of objects read with the #n=object form.
72 Each member of the list has the form (n . object), and is used to
73 look up the object for the corresponding #n# construct.
74 It must be set to nil before all top-level calls to read0. */
75 static Lisp_Object read_objects
;
77 /* File for get_file_char to read from. Use by load. */
78 static FILE *instream
;
80 /* For use within read-from-string (this reader is non-reentrant!!) */
81 static ptrdiff_t read_from_string_index
;
82 static ptrdiff_t read_from_string_index_byte
;
83 static ptrdiff_t read_from_string_limit
;
85 /* Number of characters read in the current call to Fread or
87 static EMACS_INT readchar_count
;
89 /* This contains the last string skipped with #@. */
90 static char *saved_doc_string
;
91 /* Length of buffer allocated in saved_doc_string. */
92 static ptrdiff_t saved_doc_string_size
;
93 /* Length of actual data in saved_doc_string. */
94 static ptrdiff_t saved_doc_string_length
;
95 /* This is the file position that string came from. */
96 static file_offset saved_doc_string_position
;
98 /* This contains the previous string skipped with #@.
99 We copy it from saved_doc_string when a new string
100 is put in saved_doc_string. */
101 static char *prev_saved_doc_string
;
102 /* Length of buffer allocated in prev_saved_doc_string. */
103 static ptrdiff_t prev_saved_doc_string_size
;
104 /* Length of actual data in prev_saved_doc_string. */
105 static ptrdiff_t prev_saved_doc_string_length
;
106 /* This is the file position that string came from. */
107 static file_offset prev_saved_doc_string_position
;
109 /* True means inside a new-style backquote
110 with no surrounding parentheses.
111 Fread initializes this to false, so we need not specbind it
112 or worry about what happens to it when there is an error. */
113 static bool new_backquote_flag
;
115 /* A list of file names for files being loaded in Fload. Used to
116 check for recursive loads. */
118 static Lisp_Object Vloads_in_progress
;
120 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
123 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
124 Lisp_Object
, Lisp_Object
,
125 Lisp_Object
, Lisp_Object
);
127 /* Functions that read one byte from the current source READCHARFUN
128 or unreads one byte. If the integer argument C is -1, it returns
129 one read byte, or -1 when there's no more byte in the source. If C
130 is 0 or positive, it unreads C, and the return value is not
133 static int readbyte_for_lambda (int, Lisp_Object
);
134 static int readbyte_from_file (int, Lisp_Object
);
135 static int readbyte_from_string (int, Lisp_Object
);
137 /* Handle unreading and rereading of characters.
138 Write READCHAR to read a character,
139 UNREAD(c) to unread c to be read again.
141 These macros correctly read/unread multibyte characters. */
143 #define READCHAR readchar (readcharfun, NULL)
144 #define UNREAD(c) unreadchar (readcharfun, c)
146 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
147 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
149 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
150 Qlambda, or a cons, we use this to keep an unread character because
151 a file stream can't handle multibyte-char unreading. The value -1
152 means that there's no unread character. */
153 static int unread_char
;
156 readchar (Lisp_Object readcharfun
, bool *multibyte
)
160 int (*readbyte
) (int, Lisp_Object
);
161 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
163 bool emacs_mule_encoding
= 0;
170 if (BUFFERP (readcharfun
))
172 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
174 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
176 if (! BUFFER_LIVE_P (inbuffer
))
179 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
182 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
184 /* Fetch the character code from the buffer. */
185 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
186 BUF_INC_POS (inbuffer
, pt_byte
);
193 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
194 if (! ASCII_CHAR_P (c
))
195 c
= BYTE8_TO_CHAR (c
);
198 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
202 if (MARKERP (readcharfun
))
204 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
206 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
208 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
211 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
213 /* Fetch the character code from the buffer. */
214 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
215 BUF_INC_POS (inbuffer
, bytepos
);
222 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
223 if (! ASCII_CHAR_P (c
))
224 c
= BYTE8_TO_CHAR (c
);
228 XMARKER (readcharfun
)->bytepos
= bytepos
;
229 XMARKER (readcharfun
)->charpos
++;
234 if (EQ (readcharfun
, Qlambda
))
236 readbyte
= readbyte_for_lambda
;
240 if (EQ (readcharfun
, Qget_file_char
))
242 readbyte
= readbyte_from_file
;
246 if (STRINGP (readcharfun
))
248 if (read_from_string_index
>= read_from_string_limit
)
250 else if (STRING_MULTIBYTE (readcharfun
))
254 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
255 read_from_string_index
,
256 read_from_string_index_byte
);
260 c
= SREF (readcharfun
, read_from_string_index_byte
);
261 read_from_string_index
++;
262 read_from_string_index_byte
++;
267 if (CONSP (readcharfun
))
269 /* This is the case that read_vector is reading from a unibyte
270 string that contains a byte sequence previously skipped
271 because of #@NUMBER. The car part of readcharfun is that
272 string, and the cdr part is a value of readcharfun given to
274 readbyte
= readbyte_from_string
;
275 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
276 emacs_mule_encoding
= 1;
280 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
282 readbyte
= readbyte_from_file
;
283 emacs_mule_encoding
= 1;
287 tem
= call0 (readcharfun
);
294 if (unread_char
>= 0)
300 c
= (*readbyte
) (-1, readcharfun
);
305 if (ASCII_CHAR_P (c
))
307 if (emacs_mule_encoding
)
308 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
311 len
= BYTES_BY_CHAR_HEAD (c
);
314 c
= (*readbyte
) (-1, readcharfun
);
315 if (c
< 0 || ! TRAILING_CODE_P (c
))
318 (*readbyte
) (buf
[i
], readcharfun
);
319 return BYTE8_TO_CHAR (buf
[0]);
323 return STRING_CHAR (buf
);
326 #define FROM_FILE_P(readcharfun) \
327 (EQ (readcharfun, Qget_file_char) \
328 || EQ (readcharfun, Qget_emacs_mule_file_char))
331 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
333 if (FROM_FILE_P (readcharfun
))
335 block_input (); /* FIXME: Not sure if it's needed. */
336 fseek (instream
, n
, SEEK_CUR
);
340 { /* We're not reading directly from a file. In that case, it's difficult
341 to reliably count bytes, since these are usually meant for the file's
342 encoding, whereas we're now typically in the internal encoding.
343 But luckily, skip_dyn_bytes is used to skip over a single
344 dynamic-docstring (or dynamic byte-code) which is always quoted such
345 that \037 is the final char. */
349 } while (c
>= 0 && c
!= '\037');
354 skip_dyn_eof (Lisp_Object readcharfun
)
356 if (FROM_FILE_P (readcharfun
))
358 block_input (); /* FIXME: Not sure if it's needed. */
359 fseek (instream
, 0, SEEK_END
);
363 while (READCHAR
>= 0);
366 /* Unread the character C in the way appropriate for the stream READCHARFUN.
367 If the stream is a user function, call it with the char as argument. */
370 unreadchar (Lisp_Object readcharfun
, int c
)
374 /* Don't back up the pointer if we're unreading the end-of-input mark,
375 since readchar didn't advance it when we read it. */
377 else if (BUFFERP (readcharfun
))
379 struct buffer
*b
= XBUFFER (readcharfun
);
380 ptrdiff_t charpos
= BUF_PT (b
);
381 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
383 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
384 BUF_DEC_POS (b
, bytepos
);
388 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
390 else if (MARKERP (readcharfun
))
392 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
393 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
395 XMARKER (readcharfun
)->charpos
--;
396 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
397 BUF_DEC_POS (b
, bytepos
);
401 XMARKER (readcharfun
)->bytepos
= bytepos
;
403 else if (STRINGP (readcharfun
))
405 read_from_string_index
--;
406 read_from_string_index_byte
407 = string_char_to_byte (readcharfun
, read_from_string_index
);
409 else if (CONSP (readcharfun
))
413 else if (EQ (readcharfun
, Qlambda
))
417 else if (FROM_FILE_P (readcharfun
))
422 call1 (readcharfun
, make_number (c
));
426 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
428 return read_bytecode_char (c
>= 0);
433 readbyte_from_file (int c
, Lisp_Object readcharfun
)
438 ungetc (c
, instream
);
446 /* Interrupted reads have been observed while reading over the network. */
447 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
458 return (c
== EOF
? -1 : c
);
462 readbyte_from_string (int c
, Lisp_Object readcharfun
)
464 Lisp_Object string
= XCAR (readcharfun
);
468 read_from_string_index
--;
469 read_from_string_index_byte
470 = string_char_to_byte (string
, read_from_string_index
);
473 if (read_from_string_index
>= read_from_string_limit
)
476 FETCH_STRING_CHAR_ADVANCE (c
, string
,
477 read_from_string_index
,
478 read_from_string_index_byte
);
483 /* Read one non-ASCII character from INSTREAM. The character is
484 encoded in `emacs-mule' and the first byte is already read in
488 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
490 /* Emacs-mule coding uses at most 4-byte for one character. */
491 unsigned char buf
[4];
492 int len
= emacs_mule_bytes
[c
];
493 struct charset
*charset
;
498 /* C is not a valid leading-code of `emacs-mule'. */
499 return BYTE8_TO_CHAR (c
);
505 c
= (*readbyte
) (-1, readcharfun
);
509 (*readbyte
) (buf
[i
], readcharfun
);
510 return BYTE8_TO_CHAR (buf
[0]);
517 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
518 code
= buf
[1] & 0x7F;
522 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
523 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
525 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
526 code
= buf
[2] & 0x7F;
530 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
531 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
536 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
537 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
539 c
= DECODE_CHAR (charset
, code
);
541 Fsignal (Qinvalid_read_syntax
,
542 list1 (build_string ("invalid multibyte form")));
547 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
549 static Lisp_Object
read0 (Lisp_Object
);
550 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
552 static Lisp_Object
read_list (bool, Lisp_Object
);
553 static Lisp_Object
read_vector (Lisp_Object
, bool);
555 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
557 static void substitute_object_in_subtree (Lisp_Object
,
559 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
562 /* Get a character from the tty. */
564 /* Read input events until we get one that's acceptable for our purposes.
566 If NO_SWITCH_FRAME, switch-frame events are stashed
567 until we get a character we like, and then stuffed into
570 If ASCII_REQUIRED, check function key events to see
571 if the unmodified version of the symbol has a Qascii_character
572 property, and use that character, if present.
574 If ERROR_NONASCII, signal an error if the input we
575 get isn't an ASCII character with modifiers. If it's false but
576 ASCII_REQUIRED is true, just re-read until we get an ASCII
579 If INPUT_METHOD, invoke the current input method
580 if the character warrants that.
582 If SECONDS is a number, wait that many seconds for input, and
583 return Qnil if no input arrives within that time. */
586 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
587 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
589 Lisp_Object val
, delayed_switch_frame
;
590 struct timespec end_time
;
592 #ifdef HAVE_WINDOW_SYSTEM
593 if (display_hourglass_p
)
597 delayed_switch_frame
= Qnil
;
599 /* Compute timeout. */
600 if (NUMBERP (seconds
))
602 double duration
= extract_float (seconds
);
603 struct timespec wait_time
= dtotimespec (duration
);
604 end_time
= timespec_add (current_timespec (), wait_time
);
607 /* Read until we get an acceptable event. */
610 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
611 NUMBERP (seconds
) ? &end_time
: NULL
);
612 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
617 /* `switch-frame' events are put off until after the next ASCII
618 character. This is better than signaling an error just because
619 the last characters were typed to a separate minibuffer frame,
620 for example. Eventually, some code which can deal with
621 switch-frame events will read it and process it. */
623 && EVENT_HAS_PARAMETERS (val
)
624 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
626 delayed_switch_frame
= val
;
630 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
632 /* Convert certain symbols to their ASCII equivalents. */
635 Lisp_Object tem
, tem1
;
636 tem
= Fget (val
, Qevent_symbol_element_mask
);
639 tem1
= Fget (Fcar (tem
), Qascii_character
);
640 /* Merge this symbol's modifier bits
641 with the ASCII equivalent of its basic code. */
643 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
647 /* If we don't have a character now, deal with it appropriately. */
652 Vunread_command_events
= list1 (val
);
653 error ("Non-character input-event");
660 if (! NILP (delayed_switch_frame
))
661 unread_switch_frame
= delayed_switch_frame
;
665 #ifdef HAVE_WINDOW_SYSTEM
666 if (display_hourglass_p
)
675 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
676 doc
: /* Read a character from the command input (keyboard or macro).
677 It is returned as a number.
678 If the character has modifiers, they are resolved and reflected to the
679 character code if possible (e.g. C-SPC -> 0).
681 If the user generates an event which is not a character (i.e. a mouse
682 click or function key event), `read-char' signals an error. As an
683 exception, switch-frame events are put off until non-character events
685 If you want to read non-character events, or ignore them, call
686 `read-event' or `read-char-exclusive' instead.
688 If the optional argument PROMPT is non-nil, display that as a prompt.
689 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
690 input method is turned on in the current buffer, that input method
691 is used for reading a character.
692 If the optional argument SECONDS is non-nil, it should be a number
693 specifying the maximum number of seconds to wait for input. If no
694 input arrives in that time, return nil. SECONDS may be a
695 floating-point value. */)
696 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
701 message_with_string ("%s", prompt
, 0);
702 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
704 return (NILP (val
) ? Qnil
705 : make_number (char_resolve_modifier_mask (XINT (val
))));
708 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
709 doc
: /* Read an event object from the input stream.
710 If the optional argument PROMPT is non-nil, display that as a prompt.
711 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
712 input method is turned on in the current buffer, that input method
713 is used for reading a character.
714 If the optional argument SECONDS is non-nil, it should be a number
715 specifying the maximum number of seconds to wait for input. If no
716 input arrives in that time, return nil. SECONDS may be a
717 floating-point value. */)
718 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
721 message_with_string ("%s", prompt
, 0);
722 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
725 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
726 doc
: /* Read a character from the command input (keyboard or macro).
727 It is returned as a number. Non-character events are ignored.
728 If the character has modifiers, they are resolved and reflected to the
729 character code if possible (e.g. C-SPC -> 0).
731 If the optional argument PROMPT is non-nil, display that as a prompt.
732 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
733 input method is turned on in the current buffer, that input method
734 is used for reading a character.
735 If the optional argument SECONDS is non-nil, it should be a number
736 specifying the maximum number of seconds to wait for input. If no
737 input arrives in that time, return nil. SECONDS may be a
738 floating-point value. */)
739 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
744 message_with_string ("%s", prompt
, 0);
746 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
748 return (NILP (val
) ? Qnil
749 : make_number (char_resolve_modifier_mask (XINT (val
))));
752 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
753 doc
: /* Don't use this yourself. */)
756 register Lisp_Object val
;
758 XSETINT (val
, getc (instream
));
766 /* Return true if the lisp code read using READCHARFUN defines a non-nil
767 `lexical-binding' file variable. After returning, the stream is
768 positioned following the first line, if it is a comment or #! line,
769 otherwise nothing is read. */
772 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
785 while (ch
!= '\n' && ch
!= EOF
)
787 if (ch
== '\n') ch
= READCHAR
;
788 /* It is OK to leave the position after a #! line, since
789 that is what read1 does. */
793 /* The first line isn't a comment, just give up. */
799 /* Look for an appropriate file-variable in the first line. */
803 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
804 } beg_end_state
= NOMINAL
;
805 bool in_file_vars
= 0;
807 #define UPDATE_BEG_END_STATE(ch) \
808 if (beg_end_state == NOMINAL) \
809 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
810 else if (beg_end_state == AFTER_FIRST_DASH) \
811 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
812 else if (beg_end_state == AFTER_ASTERIX) \
815 in_file_vars = !in_file_vars; \
816 beg_end_state = NOMINAL; \
819 /* Skip until we get to the file vars, if any. */
823 UPDATE_BEG_END_STATE (ch
);
825 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
829 char var
[100], val
[100];
834 /* Read a variable name. */
835 while (ch
== ' ' || ch
== '\t')
839 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
841 if (i
< sizeof var
- 1)
843 UPDATE_BEG_END_STATE (ch
);
847 /* Stop scanning if no colon was found before end marker. */
848 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
851 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
857 /* Read a variable value. */
860 while (ch
== ' ' || ch
== '\t')
864 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
866 if (i
< sizeof val
- 1)
868 UPDATE_BEG_END_STATE (ch
);
872 /* The value was terminated by an end-marker, which remove. */
874 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
878 if (strcmp (var
, "lexical-binding") == 0)
881 rv
= (strcmp (val
, "nil") != 0);
887 while (ch
!= '\n' && ch
!= EOF
)
894 /* Value is a version number of byte compiled code if the file
895 associated with file descriptor FD is a compiled Lisp file that's
896 safe to load. Only files compiled with Emacs are safe to load.
897 Files compiled with XEmacs can lead to a crash in Fbyte_code
898 because of an incompatible change in the byte compiler. */
901 safe_to_load_version (int fd
)
907 /* Read the first few bytes from the file, and look for a line
908 specifying the byte compiler version used. */
909 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
912 /* Skip to the next newline, skipping over the initial `ELC'
913 with NUL bytes following it, but note the version. */
914 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
919 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
920 buf
+ i
, nbytes
- i
) < 0)
924 lseek (fd
, 0, SEEK_SET
);
929 /* Callback for record_unwind_protect. Restore the old load list OLD,
930 after loading a file successfully. */
933 record_load_unwind (Lisp_Object old
)
935 Vloads_in_progress
= old
;
938 /* This handler function is used via internal_condition_case_1. */
941 load_error_handler (Lisp_Object data
)
947 load_warn_old_style_backquotes (Lisp_Object file
)
949 if (!NILP (Vold_style_backquotes
))
951 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
952 CALLN (Fmessage
, format
, file
);
956 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
957 doc
: /* Return the suffixes that `load' should try if a suffix is \
959 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
962 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
963 while (CONSP (suffixes
))
965 Lisp_Object exts
= Vload_file_rep_suffixes
;
966 suffix
= XCAR (suffixes
);
967 suffixes
= XCDR (suffixes
);
972 lst
= Fcons (concat2 (suffix
, ext
), lst
);
975 return Fnreverse (lst
);
978 /* Returns true if STRING ends with SUFFIX */
980 suffix_p (Lisp_Object string
, const char *suffix
)
982 ptrdiff_t suffix_len
= strlen (suffix
);
983 ptrdiff_t string_len
= SBYTES (string
);
985 return string_len
>= suffix_len
&& !strcmp (SSDATA (string
) + string_len
- suffix_len
, suffix
);
988 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
989 doc
: /* Execute a file of Lisp code named FILE.
990 First try FILE with `.elc' appended, then try with `.el', then try
991 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
992 then try FILE unmodified (the exact suffixes in the exact order are
993 determined by `load-suffixes'). Environment variable references in
994 FILE are replaced with their values by calling `substitute-in-file-name'.
995 This function searches the directories in `load-path'.
997 If optional second arg NOERROR is non-nil,
998 report no error if FILE doesn't exist.
999 Print messages at start and end of loading unless
1000 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1002 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1003 suffixes to the specified name FILE.
1004 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1005 the suffix `.elc' or `.el' or the module suffix; don't accept just
1006 FILE unless it ends in one of those suffixes or includes a directory name.
1008 If NOSUFFIX is nil, then if a file could not be found, try looking for
1009 a different representation of the file by adding non-empty suffixes to
1010 its name, before trying another file. Emacs uses this feature to find
1011 compressed versions of files when Auto Compression mode is enabled.
1012 If NOSUFFIX is non-nil, disable this feature.
1014 The suffixes that this function tries out, when NOSUFFIX is nil, are
1015 given by the return value of `get-load-suffixes' and the values listed
1016 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1017 return value of `get-load-suffixes' is used, i.e. the file name is
1018 required to have a non-empty suffix.
1020 When searching suffixes, this function normally stops at the first
1021 one that exists. If the option `load-prefer-newer' is non-nil,
1022 however, it tries all suffixes, and uses whichever file is the newest.
1024 Loading a file records its definitions, and its `provide' and
1025 `require' calls, in an element of `load-history' whose
1026 car is the file name loaded. See `load-history'.
1028 While the file is in the process of being loaded, the variable
1029 `load-in-progress' is non-nil and the variable `load-file-name'
1030 is bound to the file's name.
1032 Return t if the file exists and loads successfully. */)
1033 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1034 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1039 ptrdiff_t count
= SPECPDL_INDEX ();
1040 Lisp_Object found
, efound
, hist_file_name
;
1041 /* True means we printed the ".el is newer" message. */
1043 /* True means we are loading a compiled file. */
1045 Lisp_Object handler
;
1047 const char *fmode
= "r" FOPEN_TEXT
;
1050 CHECK_STRING (file
);
1052 /* If file name is magic, call the handler. */
1053 /* This shouldn't be necessary any more now that `openp' handles it right.
1054 handler = Ffind_file_name_handler (file, Qload);
1055 if (!NILP (handler))
1056 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1058 /* The presence of this call is the result of a historical accident:
1059 it used to be in every file-operation and when it got removed
1060 everywhere, it accidentally stayed here. Since then, enough people
1061 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1062 that it seemed risky to remove. */
1063 if (! NILP (noerror
))
1065 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1066 Qt
, load_error_handler
);
1071 file
= Fsubstitute_in_file_name (file
);
1073 /* Avoid weird lossage with null string as arg,
1074 since it would try to load a directory as a Lisp file. */
1075 if (SCHARS (file
) == 0)
1082 Lisp_Object suffixes
;
1085 if (! NILP (must_suffix
))
1087 /* Don't insist on adding a suffix if FILE already ends with one. */
1088 if (suffix_p (file
, ".el")
1089 || suffix_p (file
, ".elc")
1091 || suffix_p (file
, MODULES_SUFFIX
)
1095 /* Don't insist on adding a suffix
1096 if the argument includes a directory name. */
1097 else if (! NILP (Ffile_name_directory (file
)))
1101 if (!NILP (nosuffix
))
1105 suffixes
= Fget_load_suffixes ();
1106 if (NILP (must_suffix
))
1107 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1110 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1116 report_file_error ("Cannot open load file", file
);
1120 /* Tell startup.el whether or not we found the user's init file. */
1121 if (EQ (Qt
, Vuser_init_file
))
1122 Vuser_init_file
= found
;
1124 /* If FD is -2, that means openp found a magic file. */
1127 if (NILP (Fequal (found
, file
)))
1128 /* If FOUND is a different file name from FILE,
1129 find its handler even if we have already inhibited
1130 the `load' operation on FILE. */
1131 handler
= Ffind_file_name_handler (found
, Qt
);
1133 handler
= Ffind_file_name_handler (found
, Qload
);
1134 if (! NILP (handler
))
1135 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1137 /* Tramp has to deal with semi-broken packages that prepend
1138 drive letters to remote files. For that reason, Tramp
1139 catches file operations that test for file existence, which
1140 makes openp think X:/foo.elc files are remote. However,
1141 Tramp does not catch `load' operations for such files, so we
1142 end up with a nil as the `load' handler above. If we would
1143 continue with fd = -2, we will behave wrongly, and in
1144 particular try reading a .elc file in the "rt" mode instead
1145 of "rb". See bug #9311 for the results. To work around
1146 this, we try to open the file locally, and go with that if it
1148 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1156 /* Pacify older GCC with --enable-gcc-warnings. */
1157 IF_LINT (fd_index
= 0);
1161 fd_index
= SPECPDL_INDEX ();
1162 record_unwind_protect_int (close_file_unwind
, fd
);
1166 if (suffix_p (found
, MODULES_SUFFIX
))
1167 return unbind_to (count
, Fmodule_load (found
));
1170 /* Check if we're stuck in a recursive load cycle.
1172 2000-09-21: It's not possible to just check for the file loaded
1173 being a member of Vloads_in_progress. This fails because of the
1174 way the byte compiler currently works; `provide's are not
1175 evaluated, see font-lock.el/jit-lock.el as an example. This
1176 leads to a certain amount of ``normal'' recursion.
1178 Also, just loading a file recursively is not always an error in
1179 the general case; the second load may do something different. */
1183 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1184 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1185 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1186 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1187 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1190 /* All loads are by default dynamic, unless the file itself specifies
1191 otherwise using a file-variable in the first line. This is bound here
1192 so that it takes effect whether or not we use
1193 Vload_source_file_function. */
1194 specbind (Qlexical_binding
, Qnil
);
1196 /* Get the name for load-history. */
1197 hist_file_name
= (! NILP (Vpurify_flag
)
1198 ? concat2 (Ffile_name_directory (file
),
1199 Ffile_name_nondirectory (found
))
1204 /* Check for the presence of old-style quotes and warn about them. */
1205 specbind (Qold_style_backquotes
, Qnil
);
1206 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1208 if (suffix_p (found
, ".elc") || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1209 /* Load .elc files directly, but not when they are
1210 remote and have no handler! */
1218 && ! (version
= safe_to_load_version (fd
)))
1221 if (!load_dangerous_libraries
)
1222 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1223 else if (!NILP (nomessage
) && !force_load_messages
)
1224 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1229 efound
= ENCODE_FILE (found
);
1230 fmode
= "r" FOPEN_BINARY
;
1232 /* openp already checked for newness, no point doing it again.
1233 FIXME would be nice to get a message when openp
1234 ignores suffix order due to load_prefer_newer. */
1235 if (!load_prefer_newer
)
1237 result
= stat (SSDATA (efound
), &s1
);
1240 SSET (efound
, SBYTES (efound
) - 1, 0);
1241 result
= stat (SSDATA (efound
), &s2
);
1242 SSET (efound
, SBYTES (efound
) - 1, 'c');
1246 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1248 /* Make the progress messages mention that source is newer. */
1251 /* If we won't print another message, mention this anyway. */
1252 if (!NILP (nomessage
) && !force_load_messages
)
1254 Lisp_Object msg_file
;
1255 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1256 message_with_string ("Source file `%s' newer than byte-compiled file",
1260 } /* !load_prefer_newer */
1265 /* We are loading a source file (*.el). */
1266 if (!NILP (Vload_source_file_function
))
1273 clear_unwind_protect (fd_index
);
1275 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1276 NILP (noerror
) ? Qnil
: Qt
,
1277 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1278 return unbind_to (count
, val
);
1284 /* We somehow got here with fd == -2, meaning the file is deemed
1285 to be remote. Don't even try to reopen the file locally;
1286 just force a failure. */
1294 clear_unwind_protect (fd_index
);
1295 efound
= ENCODE_FILE (found
);
1296 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1298 stream
= fdopen (fd
, fmode
);
1302 report_file_error ("Opening stdio stream", file
);
1303 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1305 if (! NILP (Vpurify_flag
))
1306 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1308 if (NILP (nomessage
) || force_load_messages
)
1311 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1314 message_with_string ("Loading %s (source)...", file
, 1);
1316 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1318 else /* The typical case; compiled file newer than source file. */
1319 message_with_string ("Loading %s...", file
, 1);
1322 specbind (Qload_file_name
, found
);
1323 specbind (Qinhibit_file_name_operation
, Qnil
);
1324 specbind (Qload_in_progress
, Qt
);
1327 if (lisp_file_lexically_bound_p (Qget_file_char
))
1328 Fset (Qlexical_binding
, Qt
);
1330 if (! version
|| version
>= 22)
1331 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1332 0, Qnil
, Qnil
, Qnil
, Qnil
);
1335 /* We can't handle a file which was compiled with
1336 byte-compile-dynamic by older version of Emacs. */
1337 specbind (Qload_force_doc_strings
, Qt
);
1338 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1339 0, Qnil
, Qnil
, Qnil
, Qnil
);
1341 unbind_to (count
, Qnil
);
1343 /* Run any eval-after-load forms for this file. */
1344 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1345 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1347 xfree (saved_doc_string
);
1348 saved_doc_string
= 0;
1349 saved_doc_string_size
= 0;
1351 xfree (prev_saved_doc_string
);
1352 prev_saved_doc_string
= 0;
1353 prev_saved_doc_string_size
= 0;
1355 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1358 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1361 message_with_string ("Loading %s (source)...done", file
, 1);
1363 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1365 else /* The typical case; compiled file newer than source file. */
1366 message_with_string ("Loading %s...done", file
, 1);
1373 complete_filename_p (Lisp_Object pathname
)
1375 const unsigned char *s
= SDATA (pathname
);
1376 return (IS_DIRECTORY_SEP (s
[0])
1377 || (SCHARS (pathname
) > 2
1378 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1381 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1382 doc
: /* Search for FILENAME through PATH.
1383 Returns the file's name in absolute form, or nil if not found.
1384 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1385 file name when searching.
1386 If non-nil, PREDICATE is used instead of `file-readable-p'.
1387 PREDICATE can also be an integer to pass to the faccessat(2) function,
1388 in which case file-name-handlers are ignored.
1389 This function will normally skip directories, so if you want it to find
1390 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1391 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1394 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1395 if (NILP (predicate
) && fd
>= 0)
1400 /* Search for a file whose name is STR, looking in directories
1401 in the Lisp list PATH, and trying suffixes from SUFFIX.
1402 On success, return a file descriptor (or 1 or -2 as described below).
1403 On failure, return -1 and set errno.
1405 SUFFIXES is a list of strings containing possible suffixes.
1406 The empty suffix is automatically added if the list is empty.
1408 PREDICATE t means the files are binary.
1409 PREDICATE non-nil and non-t means don't open the files,
1410 just look for one that satisfies the predicate. In this case,
1411 return 1 on success. The predicate can be a lisp function or
1412 an integer to pass to `access' (in which case file-name-handlers
1415 If STOREPTR is nonzero, it points to a slot where the name of
1416 the file actually found should be stored as a Lisp string.
1417 nil is stored there on failure.
1419 If the file we find is remote, return -2
1420 but store the found remote file name in *STOREPTR.
1422 If NEWER is true, try all SUFFIXes and return the result for the
1423 newest file that exists. Does not apply to remote files,
1424 or if a non-nil and non-t PREDICATE is specified. */
1427 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1428 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1430 ptrdiff_t fn_size
= 100;
1434 ptrdiff_t want_length
;
1435 Lisp_Object filename
;
1436 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1437 ptrdiff_t max_suffix_len
= 0;
1438 int last_errno
= ENOENT
;
1442 /* The last-modified time of the newest matching file found.
1443 Initialize it to something less than all valid timestamps. */
1444 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1448 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1450 CHECK_STRING_CAR (tail
);
1451 max_suffix_len
= max (max_suffix_len
,
1452 SBYTES (XCAR (tail
)));
1455 string
= filename
= encoded_fn
= save_string
= Qnil
;
1460 absolute
= complete_filename_p (str
);
1462 for (; CONSP (path
); path
= XCDR (path
))
1464 filename
= Fexpand_file_name (str
, XCAR (path
));
1465 if (!complete_filename_p (filename
))
1466 /* If there are non-absolute elts in PATH (eg "."). */
1467 /* Of course, this could conceivably lose if luser sets
1468 default-directory to be something non-absolute... */
1470 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1471 if (!complete_filename_p (filename
))
1472 /* Give up on this path element! */
1476 /* Calculate maximum length of any filename made from
1477 this path element/specified file name and any possible suffix. */
1478 want_length
= max_suffix_len
+ SBYTES (filename
);
1479 if (fn_size
<= want_length
)
1481 fn_size
= 100 + want_length
;
1482 fn
= SAFE_ALLOCA (fn_size
);
1485 /* Loop over suffixes. */
1486 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1487 CONSP (tail
); tail
= XCDR (tail
))
1489 Lisp_Object suffix
= XCAR (tail
);
1490 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1491 Lisp_Object handler
;
1493 /* Concatenate path element/specified name with the suffix.
1494 If the directory starts with /:, remove that. */
1495 int prefixlen
= ((SCHARS (filename
) > 2
1496 && SREF (filename
, 0) == '/'
1497 && SREF (filename
, 1) == ':')
1499 fnlen
= SBYTES (filename
) - prefixlen
;
1500 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1501 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1503 /* Check that the file exists and is not a directory. */
1504 /* We used to only check for handlers on non-absolute file names:
1508 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1509 It's not clear why that was the case and it breaks things like
1510 (load "/bar.el") where the file is actually "/bar.el.gz". */
1511 /* make_string has its own ideas on when to return a unibyte
1512 string and when a multibyte string, but we know better.
1513 We must have a unibyte string when dumping, since
1514 file-name encoding is shaky at best at that time, and in
1515 particular default-file-name-coding-system is reset
1516 several times during loadup. We therefore don't want to
1517 encode the file before passing it to file I/O library
1519 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1520 string
= make_unibyte_string (fn
, fnlen
);
1522 string
= make_string (fn
, fnlen
);
1523 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1524 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1525 && !NATNUMP (predicate
))
1528 if (NILP (predicate
) || EQ (predicate
, Qt
))
1529 exists
= !NILP (Ffile_readable_p (string
));
1532 Lisp_Object tmp
= call1 (predicate
, string
);
1535 else if (EQ (tmp
, Qdir_ok
)
1536 || NILP (Ffile_directory_p (string
)))
1541 last_errno
= EISDIR
;
1547 /* We succeeded; return this descriptor and filename. */
1560 encoded_fn
= ENCODE_FILE (string
);
1561 pfn
= SSDATA (encoded_fn
);
1563 /* Check that we can access or open it. */
1564 if (NATNUMP (predicate
))
1567 if (INT_MAX
< XFASTINT (predicate
))
1568 last_errno
= EINVAL
;
1569 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1573 if (file_directory_p (pfn
))
1574 last_errno
= EISDIR
;
1581 int oflags
= O_RDONLY
+ (NILP (predicate
) ? 0 : O_BINARY
);
1582 fd
= emacs_open (pfn
, oflags
, 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 current buffer as Lisp code.
1945 When called from a Lisp program (i.e., not interactively), this
1946 function accepts up to five optional arguments:
1947 BUFFER is the buffer to evaluate (nil means use current buffer).
1948 PRINTFLAG controls printing of output:
1949 A value of nil means discard it; anything else is stream for print.
1950 FILENAME specifies the file name to use for `load-history'.
1951 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1953 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1954 functions should work normally even if PRINTFLAG is nil.
1956 This function preserves the position of point. */)
1957 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1959 ptrdiff_t count
= SPECPDL_INDEX ();
1960 Lisp_Object tem
, buf
;
1963 buf
= Fcurrent_buffer ();
1965 buf
= Fget_buffer (buffer
);
1967 error ("No such buffer");
1969 if (NILP (printflag
) && NILP (do_allow_print
))
1974 if (NILP (filename
))
1975 filename
= BVAR (XBUFFER (buf
), filename
);
1977 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1978 specbind (Qstandard_output
, tem
);
1979 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1980 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1981 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1982 readevalloop (buf
, 0, filename
,
1983 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1984 unbind_to (count
, Qnil
);
1989 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1990 doc
: /* Execute the region as Lisp code.
1991 When called from programs, expects two arguments,
1992 giving starting and ending indices in the current buffer
1993 of the text to be executed.
1994 Programs can pass third argument PRINTFLAG which controls output:
1995 A value of nil means discard it; anything else is stream for printing it.
1996 Also the fourth argument READ-FUNCTION, if non-nil, is used
1997 instead of `read' to read each expression. It gets one argument
1998 which is the input stream for reading characters.
2000 This function does not move point. */)
2001 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2003 /* FIXME: Do the eval-sexp-add-defvars dance! */
2004 ptrdiff_t count
= SPECPDL_INDEX ();
2005 Lisp_Object tem
, cbuf
;
2007 cbuf
= Fcurrent_buffer ();
2009 if (NILP (printflag
))
2013 specbind (Qstandard_output
, tem
);
2014 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2016 /* `readevalloop' calls functions which check the type of start and end. */
2017 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2018 !NILP (printflag
), Qnil
, read_function
,
2021 return unbind_to (count
, Qnil
);
2025 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2026 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2027 If STREAM is nil, use the value of `standard-input' (which see).
2028 STREAM or the value of `standard-input' may be:
2029 a buffer (read from point and advance it)
2030 a marker (read from where it points and advance it)
2031 a function (call it with no arguments for each character,
2032 call it with a char as argument to push a char back)
2033 a string (takes text from string, starting at the beginning)
2034 t (read text line using minibuffer and use it, or read from
2035 standard input in batch mode). */)
2036 (Lisp_Object stream
)
2039 stream
= Vstandard_input
;
2040 if (EQ (stream
, Qt
))
2041 stream
= Qread_char
;
2042 if (EQ (stream
, Qread_char
))
2043 /* FIXME: ?! When is this used !? */
2044 return call1 (intern ("read-minibuffer"),
2045 build_string ("Lisp expression: "));
2047 return read_internal_start (stream
, Qnil
, Qnil
);
2050 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2051 doc
: /* Read one Lisp expression which is represented as text by STRING.
2052 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2053 FINAL-STRING-INDEX is an integer giving the position of the next
2054 remaining character in STRING. START and END optionally delimit
2055 a substring of STRING from which to read; they default to 0 and
2056 (length STRING) respectively. Negative values are counted from
2057 the end of STRING. */)
2058 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2061 CHECK_STRING (string
);
2062 /* `read_internal_start' sets `read_from_string_index'. */
2063 ret
= read_internal_start (string
, start
, end
);
2064 return Fcons (ret
, make_number (read_from_string_index
));
2067 /* Function to set up the global context we need in toplevel read
2068 calls. START and END only used when STREAM is a string. */
2070 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2075 new_backquote_flag
= 0;
2076 read_objects
= Qnil
;
2077 if (EQ (Vread_with_symbol_positions
, Qt
)
2078 || EQ (Vread_with_symbol_positions
, stream
))
2079 Vread_symbol_positions_list
= Qnil
;
2081 if (STRINGP (stream
)
2082 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2084 ptrdiff_t startval
, endval
;
2087 if (STRINGP (stream
))
2090 string
= XCAR (stream
);
2092 validate_subarray (string
, start
, end
, SCHARS (string
),
2093 &startval
, &endval
);
2095 read_from_string_index
= startval
;
2096 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2097 read_from_string_limit
= endval
;
2100 retval
= read0 (stream
);
2101 if (EQ (Vread_with_symbol_positions
, Qt
)
2102 || EQ (Vread_with_symbol_positions
, stream
))
2103 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2108 /* Signal Qinvalid_read_syntax error.
2109 S is error string of length N (if > 0) */
2111 static _Noreturn
void
2112 invalid_syntax (const char *s
)
2114 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2118 /* Use this for recursive reads, in contexts where internal tokens
2122 read0 (Lisp_Object readcharfun
)
2124 register Lisp_Object val
;
2127 val
= read1 (readcharfun
, &c
, 0);
2131 xsignal1 (Qinvalid_read_syntax
,
2132 Fmake_string (make_number (1), make_number (c
)));
2135 static ptrdiff_t read_buffer_size
;
2136 static char *read_buffer
;
2138 /* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes. */
2141 grow_read_buffer (void)
2143 read_buffer
= xpalloc (read_buffer
, &read_buffer_size
,
2144 MAX_MULTIBYTE_LENGTH
, -1, 1);
2147 /* Read a \-escape sequence, assuming we already read the `\'.
2148 If the escape sequence forces unibyte, return eight-bit char. */
2151 read_escape (Lisp_Object readcharfun
, bool stringp
)
2154 /* \u allows up to four hex digits, \U up to eight. Default to the
2155 behavior for \u, and change this value in the case that \U is seen. */
2156 int unicode_hex_count
= 4;
2161 end_of_file_error ();
2191 error ("Invalid escape character syntax");
2194 c
= read_escape (readcharfun
, 0);
2195 return c
| meta_modifier
;
2200 error ("Invalid escape character syntax");
2203 c
= read_escape (readcharfun
, 0);
2204 return c
| shift_modifier
;
2209 error ("Invalid escape character syntax");
2212 c
= read_escape (readcharfun
, 0);
2213 return c
| hyper_modifier
;
2218 error ("Invalid escape character syntax");
2221 c
= read_escape (readcharfun
, 0);
2222 return c
| alt_modifier
;
2226 if (stringp
|| c
!= '-')
2233 c
= read_escape (readcharfun
, 0);
2234 return c
| super_modifier
;
2239 error ("Invalid escape character syntax");
2243 c
= read_escape (readcharfun
, 0);
2244 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2245 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2246 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2247 return c
| ctrl_modifier
;
2248 /* ASCII control chars are made from letters (both cases),
2249 as well as the non-letters within 0100...0137. */
2250 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2251 return (c
& (037 | ~0177));
2252 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2253 return (c
& (037 | ~0177));
2255 return c
| ctrl_modifier
;
2265 /* An octal escape, as in ANSI C. */
2267 register int i
= c
- '0';
2268 register int count
= 0;
2271 if ((c
= READCHAR
) >= '0' && c
<= '7')
2283 if (i
>= 0x80 && i
< 0x100)
2284 i
= BYTE8_TO_CHAR (i
);
2289 /* A hex escape, as in ANSI C. */
2296 if (c
>= '0' && c
<= '9')
2301 else if ((c
>= 'a' && c
<= 'f')
2302 || (c
>= 'A' && c
<= 'F'))
2305 if (c
>= 'a' && c
<= 'f')
2315 /* Allow hex escapes as large as ?\xfffffff, because some
2316 packages use them to denote characters with modifiers. */
2317 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2318 error ("Hex character out of range: \\x%x...", i
);
2322 if (count
< 3 && i
>= 0x80)
2323 return BYTE8_TO_CHAR (i
);
2328 /* Post-Unicode-2.0: Up to eight hex chars. */
2329 unicode_hex_count
= 8;
2332 /* A Unicode escape. We only permit them in strings and characters,
2333 not arbitrarily in the source code, as in some other languages. */
2338 while (++count
<= unicode_hex_count
)
2341 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2343 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2344 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2345 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2347 error ("Non-hex digit used for Unicode escape");
2350 error ("Non-Unicode character: 0x%x", i
);
2359 /* Return the digit that CHARACTER stands for in the given BASE.
2360 Return -1 if CHARACTER is out of range for BASE,
2361 and -2 if CHARACTER is not valid for any supported BASE. */
2363 digit_to_number (int character
, int base
)
2367 if ('0' <= character
&& character
<= '9')
2368 digit
= character
- '0';
2369 else if ('a' <= character
&& character
<= 'z')
2370 digit
= character
- 'a' + 10;
2371 else if ('A' <= character
&& character
<= 'Z')
2372 digit
= character
- 'A' + 10;
2376 return digit
< base
? digit
: -1;
2379 /* Read an integer in radix RADIX using READCHARFUN to read
2380 characters. RADIX must be in the interval [2..36]; if it isn't, a
2381 read error is signaled . Value is the integer read. Signals an
2382 error if encountering invalid read syntax or if RADIX is out of
2386 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2388 /* Room for sign, leading 0, other digits, trailing null byte.
2389 Also, room for invalid syntax diagnostic. */
2390 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2391 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2393 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2395 if (radix
< 2 || radix
> 36)
2403 if (c
== '-' || c
== '+')
2414 /* Ignore redundant leading zeros, so the buffer doesn't
2415 fill up with them. */
2421 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2428 if (p
< buf
+ sizeof buf
- 1)
2442 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2443 invalid_syntax (buf
);
2446 return string_to_number (buf
, radix
, 0);
2450 /* If the next token is ')' or ']' or '.', we store that character
2451 in *PCH and the return value is not interesting. Else, we store
2452 zero in *PCH and we read and return one lisp object.
2454 FIRST_IN_LIST is true if this is the first element of a list. */
2457 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2460 bool uninterned_symbol
= 0;
2467 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2469 end_of_file_error ();
2474 return read_list (0, readcharfun
);
2477 return read_vector (readcharfun
, 0);
2493 /* Accept extended format for hashtables (extensible to
2495 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2496 Lisp_Object tmp
= read_list (0, readcharfun
);
2497 Lisp_Object head
= CAR_SAFE (tmp
);
2498 Lisp_Object data
= Qnil
;
2499 Lisp_Object val
= Qnil
;
2500 /* The size is 2 * number of allowed keywords to
2502 Lisp_Object params
[10];
2504 Lisp_Object key
= Qnil
;
2505 int param_count
= 0;
2507 if (!EQ (head
, Qhash_table
))
2508 error ("Invalid extended read marker at head of #s list "
2509 "(only hash-table allowed)");
2511 tmp
= CDR_SAFE (tmp
);
2513 /* This is repetitive but fast and simple. */
2514 params
[param_count
] = QCsize
;
2515 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2516 if (!NILP (params
[param_count
+ 1]))
2519 params
[param_count
] = QCtest
;
2520 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2521 if (!NILP (params
[param_count
+ 1]))
2524 params
[param_count
] = QCweakness
;
2525 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2526 if (!NILP (params
[param_count
+ 1]))
2529 params
[param_count
] = QCrehash_size
;
2530 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2531 if (!NILP (params
[param_count
+ 1]))
2534 params
[param_count
] = QCrehash_threshold
;
2535 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2536 if (!NILP (params
[param_count
+ 1]))
2539 /* This is the hashtable data. */
2540 data
= Fplist_get (tmp
, Qdata
);
2542 /* Now use params to make a new hashtable and fill it. */
2543 ht
= Fmake_hash_table (param_count
, params
);
2545 while (CONSP (data
))
2550 error ("Odd number of elements in hashtable data");
2553 Fputhash (key
, val
, ht
);
2559 invalid_syntax ("#");
2567 tmp
= read_vector (readcharfun
, 0);
2568 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2569 error ("Invalid size char-table");
2570 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2578 /* Sub char-table can't be read as a regular
2579 vector because of a two C integer fields. */
2580 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2581 ptrdiff_t size
= XINT (Flength (tmp
));
2582 int i
, depth
, min_char
;
2583 struct Lisp_Cons
*cell
;
2586 error ("Zero-sized sub char-table");
2588 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2589 error ("Invalid depth in sub char-table");
2590 depth
= XINT (XCAR (tmp
));
2591 if (chartab_size
[depth
] != size
- 2)
2592 error ("Invalid size in sub char-table");
2593 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2596 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2597 error ("Invalid minimum character in sub-char-table");
2598 min_char
= XINT (XCAR (tmp
));
2599 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2602 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2603 for (i
= 0; i
< size
; i
++)
2605 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2606 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2611 invalid_syntax ("#^^");
2613 invalid_syntax ("#^");
2618 length
= read1 (readcharfun
, pch
, first_in_list
);
2622 Lisp_Object tmp
, val
;
2623 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2624 unsigned char *data
;
2627 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2628 if (STRING_MULTIBYTE (tmp
)
2629 || (size_in_chars
!= SCHARS (tmp
)
2630 /* We used to print 1 char too many
2631 when the number of bits was a multiple of 8.
2632 Accept such input in case it came from an old
2634 && ! (XFASTINT (length
)
2635 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2636 invalid_syntax ("#&...");
2638 val
= make_uninit_bool_vector (XFASTINT (length
));
2639 data
= bool_vector_uchar_data (val
);
2640 memcpy (data
, SDATA (tmp
), size_in_chars
);
2641 /* Clear the extraneous bits in the last byte. */
2642 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2643 data
[size_in_chars
- 1]
2644 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2647 invalid_syntax ("#&...");
2651 /* Accept compiled functions at read-time so that we don't have to
2652 build them using function calls. */
2654 struct Lisp_Vector
*vec
;
2655 tmp
= read_vector (readcharfun
, 1);
2656 vec
= XVECTOR (tmp
);
2657 if (vec
->header
.size
== 0)
2658 invalid_syntax ("Empty byte-code object");
2659 make_byte_code (vec
);
2667 /* Read the string itself. */
2668 tmp
= read1 (readcharfun
, &ch
, 0);
2669 if (ch
!= 0 || !STRINGP (tmp
))
2670 invalid_syntax ("#");
2671 /* Read the intervals and their properties. */
2674 Lisp_Object beg
, end
, plist
;
2676 beg
= read1 (readcharfun
, &ch
, 0);
2681 end
= read1 (readcharfun
, &ch
, 0);
2683 plist
= read1 (readcharfun
, &ch
, 0);
2685 invalid_syntax ("Invalid string property list");
2686 Fset_text_properties (beg
, end
, plist
, tmp
);
2692 /* #@NUMBER is used to skip NUMBER following bytes.
2693 That's used in .elc files to skip over doc strings
2694 and function definitions. */
2697 enum { extra
= 100 };
2698 ptrdiff_t i
, nskip
= 0, digits
= 0;
2700 /* Read a decimal integer. */
2701 while ((c
= READCHAR
) >= 0
2702 && c
>= '0' && c
<= '9')
2704 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2709 if (digits
== 2 && nskip
== 0)
2710 { /* We've just seen #@00, which means "skip to end". */
2711 skip_dyn_eof (readcharfun
);
2716 /* We can't use UNREAD here, because in the code below we side-step
2717 READCHAR. Instead, assume the first char after #@NNN occupies
2718 a single byte, which is the case normally since it's just
2724 if (load_force_doc_strings
2725 && (FROM_FILE_P (readcharfun
)))
2727 /* If we are supposed to force doc strings into core right now,
2728 record the last string that we skipped,
2729 and record where in the file it comes from. */
2731 /* But first exchange saved_doc_string
2732 with prev_saved_doc_string, so we save two strings. */
2734 char *temp
= saved_doc_string
;
2735 ptrdiff_t temp_size
= saved_doc_string_size
;
2736 file_offset temp_pos
= saved_doc_string_position
;
2737 ptrdiff_t temp_len
= saved_doc_string_length
;
2739 saved_doc_string
= prev_saved_doc_string
;
2740 saved_doc_string_size
= prev_saved_doc_string_size
;
2741 saved_doc_string_position
= prev_saved_doc_string_position
;
2742 saved_doc_string_length
= prev_saved_doc_string_length
;
2744 prev_saved_doc_string
= temp
;
2745 prev_saved_doc_string_size
= temp_size
;
2746 prev_saved_doc_string_position
= temp_pos
;
2747 prev_saved_doc_string_length
= temp_len
;
2750 if (saved_doc_string_size
== 0)
2752 saved_doc_string
= xmalloc (nskip
+ extra
);
2753 saved_doc_string_size
= nskip
+ extra
;
2755 if (nskip
> saved_doc_string_size
)
2757 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2758 saved_doc_string_size
= nskip
+ extra
;
2761 saved_doc_string_position
= file_tell (instream
);
2763 /* Copy that many characters into saved_doc_string. */
2765 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2766 saved_doc_string
[i
] = c
= getc (instream
);
2769 saved_doc_string_length
= i
;
2772 /* Skip that many bytes. */
2773 skip_dyn_bytes (readcharfun
, nskip
);
2779 /* #! appears at the beginning of an executable file.
2780 Skip the first line. */
2781 while (c
!= '\n' && c
>= 0)
2786 return Vload_file_name
;
2788 return list2 (Qfunction
, read0 (readcharfun
));
2789 /* #:foo is the uninterned symbol named foo. */
2792 uninterned_symbol
= 1;
2795 && c
!= NO_BREAK_SPACE
2797 || strchr ("\"';()[]#`,", c
) == NULL
)))
2799 /* No symbol character follows, this is the empty
2802 return Fmake_symbol (empty_unibyte_string
);
2806 /* ## is the empty symbol. */
2808 return Fintern (empty_unibyte_string
, Qnil
);
2809 /* Reader forms that can reuse previously read objects. */
2810 if (c
>= '0' && c
<= '9')
2815 /* Read a non-negative integer. */
2816 while (c
>= '0' && c
<= '9')
2818 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2819 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2820 n
= MOST_POSITIVE_FIXNUM
+ 1;
2822 n
= n
* 10 + c
- '0';
2826 if (n
<= MOST_POSITIVE_FIXNUM
)
2828 if (c
== 'r' || c
== 'R')
2829 return read_integer (readcharfun
, n
);
2831 if (! NILP (Vread_circle
))
2833 /* #n=object returns object, but associates it with
2837 /* Make a placeholder for #n# to use temporarily. */
2838 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2839 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2840 read_objects
= Fcons (cell
, read_objects
);
2842 /* Read the object itself. */
2843 tem
= read0 (readcharfun
);
2845 /* Now put it everywhere the placeholder was... */
2846 substitute_object_in_subtree (tem
, placeholder
);
2848 /* ...and #n# will use the real value from now on. */
2849 Fsetcdr (cell
, tem
);
2854 /* #n# returns a previously read object. */
2857 tem
= Fassq (make_number (n
), read_objects
);
2863 /* Fall through to error message. */
2865 else if (c
== 'x' || c
== 'X')
2866 return read_integer (readcharfun
, 16);
2867 else if (c
== 'o' || c
== 'O')
2868 return read_integer (readcharfun
, 8);
2869 else if (c
== 'b' || c
== 'B')
2870 return read_integer (readcharfun
, 2);
2873 invalid_syntax ("#");
2876 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2880 return list2 (Qquote
, read0 (readcharfun
));
2884 int next_char
= READCHAR
;
2886 /* Transition from old-style to new-style:
2887 If we see "(`" it used to mean old-style, which usually works
2888 fine because ` should almost never appear in such a position
2889 for new-style. But occasionally we need "(`" to mean new
2890 style, so we try to distinguish the two by the fact that we
2891 can either write "( `foo" or "(` foo", where the first
2892 intends to use new-style whereas the second intends to use
2893 old-style. For Emacs-25, we should completely remove this
2894 first_in_list exception (old-style can still be obtained via
2896 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2898 Vold_style_backquotes
= Qt
;
2904 bool saved_new_backquote_flag
= new_backquote_flag
;
2906 new_backquote_flag
= 1;
2907 value
= read0 (readcharfun
);
2908 new_backquote_flag
= saved_new_backquote_flag
;
2910 return list2 (Qbackquote
, value
);
2915 int next_char
= READCHAR
;
2917 /* Transition from old-style to new-style:
2918 It used to be impossible to have a new-style , other than within
2919 a new-style `. This is sufficient when ` and , are used in the
2920 normal way, but ` and , can also appear in args to macros that
2921 will not interpret them in the usual way, in which case , may be
2922 used without any ` anywhere near.
2923 So we now use the same heuristic as for backquote: old-style
2924 unquotes are only recognized when first on a list, and when
2925 followed by a space.
2926 Because it's more difficult to peek 2 chars ahead, a new-style
2927 ,@ can still not be used outside of a `, unless it's in the middle
2929 if (new_backquote_flag
2931 || (next_char
!= ' ' && next_char
!= '@'))
2933 Lisp_Object comma_type
= Qnil
;
2938 comma_type
= Qcomma_at
;
2940 comma_type
= Qcomma_dot
;
2943 if (ch
>= 0) UNREAD (ch
);
2944 comma_type
= Qcomma
;
2947 value
= read0 (readcharfun
);
2948 return list2 (comma_type
, value
);
2952 Vold_style_backquotes
= Qt
;
2964 end_of_file_error ();
2966 /* Accept `single space' syntax like (list ? x) where the
2967 whitespace character is SPC or TAB.
2968 Other literal whitespace like NL, CR, and FF are not accepted,
2969 as there are well-established escape sequences for these. */
2970 if (c
== ' ' || c
== '\t')
2971 return make_number (c
);
2974 c
= read_escape (readcharfun
, 0);
2975 modifiers
= c
& CHAR_MODIFIER_MASK
;
2976 c
&= ~CHAR_MODIFIER_MASK
;
2977 if (CHAR_BYTE8_P (c
))
2978 c
= CHAR_TO_BYTE8 (c
);
2981 next_char
= READCHAR
;
2982 ok
= (next_char
<= 040
2983 || (next_char
< 0200
2984 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2987 return make_number (c
);
2989 invalid_syntax ("?");
2994 char *p
= read_buffer
;
2995 char *end
= read_buffer
+ read_buffer_size
;
2997 /* True if we saw an escape sequence specifying
2998 a multibyte character. */
2999 bool force_multibyte
= 0;
3000 /* True if we saw an escape sequence specifying
3001 a single-byte character. */
3002 bool force_singlebyte
= 0;
3004 ptrdiff_t nchars
= 0;
3006 while ((ch
= READCHAR
) >= 0
3009 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3011 ptrdiff_t offset
= p
- read_buffer
;
3012 grow_read_buffer ();
3013 p
= read_buffer
+ offset
;
3014 end
= read_buffer
+ read_buffer_size
;
3021 ch
= read_escape (readcharfun
, 1);
3023 /* CH is -1 if \ newline or \ space has just been seen. */
3026 if (p
== read_buffer
)
3031 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3032 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3034 if (CHAR_BYTE8_P (ch
))
3035 force_singlebyte
= 1;
3036 else if (! ASCII_CHAR_P (ch
))
3037 force_multibyte
= 1;
3038 else /* I.e. ASCII_CHAR_P (ch). */
3040 /* Allow `\C- ' and `\C-?'. */
3041 if (modifiers
== CHAR_CTL
)
3044 ch
= 0, modifiers
= 0;
3046 ch
= 127, modifiers
= 0;
3048 if (modifiers
& CHAR_SHIFT
)
3050 /* Shift modifier is valid only with [A-Za-z]. */
3051 if (ch
>= 'A' && ch
<= 'Z')
3052 modifiers
&= ~CHAR_SHIFT
;
3053 else if (ch
>= 'a' && ch
<= 'z')
3054 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3057 if (modifiers
& CHAR_META
)
3059 /* Move the meta bit to the right place for a
3061 modifiers
&= ~CHAR_META
;
3062 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3063 force_singlebyte
= 1;
3067 /* Any modifiers remaining are invalid. */
3069 error ("Invalid modifier in string");
3070 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3074 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3075 if (CHAR_BYTE8_P (ch
))
3076 force_singlebyte
= 1;
3077 else if (! ASCII_CHAR_P (ch
))
3078 force_multibyte
= 1;
3084 end_of_file_error ();
3086 /* If purifying, and string starts with \ newline,
3087 return zero instead. This is for doc strings
3088 that we are really going to find in etc/DOC.nn.nn. */
3089 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3090 return make_number (0);
3092 if (! force_multibyte
&& force_singlebyte
)
3094 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3095 forms. Convert it to unibyte. */
3096 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3098 p
= read_buffer
+ nchars
;
3101 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3103 || (p
- read_buffer
!= nchars
)));
3108 int next_char
= READCHAR
;
3111 if (next_char
<= 040
3112 || (next_char
< 0200
3113 && strchr ("\"';([#?`,", next_char
) != NULL
))
3119 /* Otherwise, we fall through! Note that the atom-reading loop
3120 below will now loop at least once, assuring that we will not
3121 try to UNREAD two characters in a row. */
3125 if (c
<= 040) goto retry
;
3126 if (c
== NO_BREAK_SPACE
)
3131 char *p
= read_buffer
;
3133 EMACS_INT start_position
= readchar_count
- 1;
3136 char *end
= read_buffer
+ read_buffer_size
;
3140 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3142 ptrdiff_t offset
= p
- read_buffer
;
3143 grow_read_buffer ();
3144 p
= read_buffer
+ offset
;
3145 end
= read_buffer
+ read_buffer_size
;
3152 end_of_file_error ();
3157 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3163 && c
!= NO_BREAK_SPACE
3165 || strchr ("\"';()[]#`,", c
) == NULL
));
3169 ptrdiff_t offset
= p
- read_buffer
;
3170 grow_read_buffer ();
3171 p
= read_buffer
+ offset
;
3172 end
= read_buffer
+ read_buffer_size
;
3178 if (!quoted
&& !uninterned_symbol
)
3180 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3181 if (! NILP (result
))
3185 Lisp_Object name
, result
;
3186 ptrdiff_t nbytes
= p
- read_buffer
;
3189 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3193 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3194 ? make_pure_string
: make_specified_string
)
3195 (read_buffer
, nchars
, nbytes
, multibyte
));
3196 result
= (uninterned_symbol
? Fmake_symbol (name
)
3197 : Fintern (name
, Qnil
));
3199 if (EQ (Vread_with_symbol_positions
, Qt
)
3200 || EQ (Vread_with_symbol_positions
, readcharfun
))
3201 Vread_symbol_positions_list
3202 = Fcons (Fcons (result
, make_number (start_position
)),
3203 Vread_symbol_positions_list
);
3211 /* List of nodes we've seen during substitute_object_in_subtree. */
3212 static Lisp_Object seen_list
;
3215 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3217 Lisp_Object check_object
;
3219 /* We haven't seen any objects when we start. */
3222 /* Make all the substitutions. */
3224 = substitute_object_recurse (object
, placeholder
, object
);
3226 /* Clear seen_list because we're done with it. */
3229 /* The returned object here is expected to always eq the
3231 if (!EQ (check_object
, object
))
3232 error ("Unexpected mutation error in reader");
3235 /* Feval doesn't get called from here, so no gc protection is needed. */
3236 #define SUBSTITUTE(get_val, set_val) \
3238 Lisp_Object old_value = get_val; \
3239 Lisp_Object true_value \
3240 = substitute_object_recurse (object, placeholder, \
3243 if (!EQ (old_value, true_value)) \
3250 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3252 /* If we find the placeholder, return the target object. */
3253 if (EQ (placeholder
, subtree
))
3256 /* If we've been to this node before, don't explore it again. */
3257 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3260 /* If this node can be the entry point to a cycle, remember that
3261 we've seen it. It can only be such an entry point if it was made
3262 by #n=, which means that we can find it as a value in
3264 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3265 seen_list
= Fcons (subtree
, seen_list
);
3267 /* Recurse according to subtree's type.
3268 Every branch must return a Lisp_Object. */
3269 switch (XTYPE (subtree
))
3271 case Lisp_Vectorlike
:
3273 ptrdiff_t i
= 0, length
= 0;
3274 if (BOOL_VECTOR_P (subtree
))
3275 return subtree
; /* No sub-objects anyway. */
3276 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3277 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3278 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3279 else if (VECTORP (subtree
))
3280 length
= ASIZE (subtree
);
3282 /* An unknown pseudovector may contain non-Lisp fields, so we
3283 can't just blindly traverse all its fields. We used to call
3284 `Flength' which signaled `sequencep', so I just preserved this
3286 wrong_type_argument (Qsequencep
, subtree
);
3288 if (SUB_CHAR_TABLE_P (subtree
))
3290 for ( ; i
< length
; i
++)
3291 SUBSTITUTE (AREF (subtree
, i
),
3292 ASET (subtree
, i
, true_value
));
3298 SUBSTITUTE (XCAR (subtree
),
3299 XSETCAR (subtree
, true_value
));
3300 SUBSTITUTE (XCDR (subtree
),
3301 XSETCDR (subtree
, true_value
));
3307 /* Check for text properties in each interval.
3308 substitute_in_interval contains part of the logic. */
3310 INTERVAL root_interval
= string_intervals (subtree
);
3311 AUTO_CONS (arg
, object
, placeholder
);
3313 traverse_intervals_noorder (root_interval
,
3314 &substitute_in_interval
, arg
);
3319 /* Other types don't recurse any further. */
3325 /* Helper function for substitute_object_recurse. */
3327 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3329 Lisp_Object object
= Fcar (arg
);
3330 Lisp_Object placeholder
= Fcdr (arg
);
3332 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3342 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3343 integer syntax and fits in a fixnum, else return the nearest float if CP has
3344 either floating point or integer syntax and BASE is 10, else return nil. If
3345 IGNORE_TRAILING, consider just the longest prefix of CP that has
3346 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3347 number has integer syntax but does not fit. */
3350 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3353 char const *cp
= string
;
3355 bool float_syntax
= 0;
3358 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3359 IEEE floating point hosts, and works around a formerly-common bug where
3360 atof ("-0.0") drops the sign. */
3361 bool negative
= *cp
== '-';
3363 bool signedp
= negative
|| *cp
== '+';
3368 leading_digit
= digit_to_number (*cp
, base
);
3369 if (leading_digit
>= 0)
3374 while (digit_to_number (*cp
, base
) >= 0);
3384 if ('0' <= *cp
&& *cp
<= '9')
3389 while ('0' <= *cp
&& *cp
<= '9');
3391 if (*cp
== 'e' || *cp
== 'E')
3393 char const *ecp
= cp
;
3395 if (*cp
== '+' || *cp
== '-')
3397 if ('0' <= *cp
&& *cp
<= '9')
3402 while ('0' <= *cp
&& *cp
<= '9');
3404 else if (cp
[-1] == '+'
3405 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3411 else if (cp
[-1] == '+'
3412 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3416 /* NAN is a "positive" NaN on all known Emacs hosts. */
3423 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3424 || state
== (LEAD_INT
|E_EXP
));
3427 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3428 any prefix that matches. Otherwise, the entire string must match. */
3429 if (! (ignore_trailing
3430 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3431 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3434 /* If the number uses integer and not float syntax, and is in C-language
3435 range, use its value, preferably as a fixnum. */
3436 if (leading_digit
>= 0 && ! float_syntax
)
3440 /* Fast special case for single-digit integers. This also avoids a
3441 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3442 case some versions of strtoumax accept numbers like "0x1" that Emacs
3444 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3445 return make_number (negative
? -leading_digit
: leading_digit
);
3448 n
= strtoumax (string
+ signedp
, NULL
, base
);
3449 if (errno
== ERANGE
)
3451 /* Unfortunately there's no simple and accurate way to convert
3452 non-base-10 numbers that are out of C-language range. */
3454 xsignal1 (Qoverflow_error
, build_string (string
));
3456 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3458 EMACS_INT signed_n
= n
;
3459 return make_number (negative
? -signed_n
: signed_n
);
3465 /* Either the number uses float syntax, or it does not fit into a fixnum.
3466 Convert it from string to floating point, unless the value is already
3467 known because it is an infinity, a NAN, or its absolute value fits in
3470 value
= atof (string
+ signedp
);
3472 return make_float (negative
? -value
: value
);
3477 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3481 Lisp_Object tem
, item
, vector
;
3482 struct Lisp_Cons
*otem
;
3485 tem
= read_list (1, readcharfun
);
3486 len
= Flength (tem
);
3487 vector
= Fmake_vector (len
, Qnil
);
3489 size
= ASIZE (vector
);
3490 ptr
= XVECTOR (vector
)->contents
;
3491 for (i
= 0; i
< size
; i
++)
3494 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3495 bytecode object, the docstring containing the bytecode and
3496 constants values must be treated as unibyte and passed to
3497 Fread, to get the actual bytecode string and constants vector. */
3498 if (bytecodeflag
&& load_force_doc_strings
)
3500 if (i
== COMPILED_BYTECODE
)
3502 if (!STRINGP (item
))
3503 error ("Invalid byte code");
3505 /* Delay handling the bytecode slot until we know whether
3506 it is lazily-loaded (we can tell by whether the
3507 constants slot is nil). */
3508 ASET (vector
, COMPILED_CONSTANTS
, item
);
3511 else if (i
== COMPILED_CONSTANTS
)
3513 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3517 /* Coerce string to unibyte (like string-as-unibyte,
3518 but without generating extra garbage and
3519 guaranteeing no change in the contents). */
3520 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3521 STRING_SET_UNIBYTE (bytestr
);
3523 item
= Fread (Fcons (bytestr
, readcharfun
));
3525 error ("Invalid byte code");
3527 otem
= XCONS (item
);
3528 bytestr
= XCAR (item
);
3533 /* Now handle the bytecode slot. */
3534 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3536 else if (i
== COMPILED_DOC_STRING
3538 && ! STRING_MULTIBYTE (item
))
3540 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3541 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3543 item
= Fstring_as_multibyte (item
);
3546 ASET (vector
, i
, item
);
3554 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3557 read_list (bool flag
, Lisp_Object readcharfun
)
3559 Lisp_Object val
, tail
;
3560 Lisp_Object elt
, tem
;
3561 /* 0 is the normal case.
3562 1 means this list is a doc reference; replace it with the number 0.
3563 2 means this list is a doc reference; replace it with the doc string. */
3564 int doc_reference
= 0;
3566 /* Initialize this to 1 if we are reading a list. */
3567 bool first_in_list
= flag
<= 0;
3575 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3579 /* While building, if the list starts with #$, treat it specially. */
3580 if (EQ (elt
, Vload_file_name
)
3582 && !NILP (Vpurify_flag
))
3584 if (NILP (Vdoc_file_name
))
3585 /* We have not yet called Snarf-documentation, so assume
3586 this file is described in the DOC file
3587 and Snarf-documentation will fill in the right value later.
3588 For now, replace the whole list with 0. */
3591 /* We have already called Snarf-documentation, so make a relative
3592 file name for this file, so it can be found properly
3593 in the installed Lisp directory.
3594 We don't use Fexpand_file_name because that would make
3595 the directory absolute now. */
3597 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3598 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3601 else if (EQ (elt
, Vload_file_name
)
3603 && load_force_doc_strings
)
3612 invalid_syntax (") or . in a vector");
3619 XSETCDR (tail
, read0 (readcharfun
));
3621 val
= read0 (readcharfun
);
3622 read1 (readcharfun
, &ch
, 0);
3626 if (doc_reference
== 1)
3627 return make_number (0);
3628 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3631 file_offset saved_position
;
3632 /* Get a doc string from the file we are loading.
3633 If it's in saved_doc_string, get it from there.
3635 Here, we don't know if the string is a
3636 bytecode string or a doc string. As a
3637 bytecode string must be unibyte, we always
3638 return a unibyte string. If it is actually a
3639 doc string, caller must make it
3642 /* Position is negative for user variables. */
3643 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3644 if (pos
>= saved_doc_string_position
3645 && pos
< (saved_doc_string_position
3646 + saved_doc_string_length
))
3648 saved
= saved_doc_string
;
3649 saved_position
= saved_doc_string_position
;
3651 /* Look in prev_saved_doc_string the same way. */
3652 else if (pos
>= prev_saved_doc_string_position
3653 && pos
< (prev_saved_doc_string_position
3654 + prev_saved_doc_string_length
))
3656 saved
= prev_saved_doc_string
;
3657 saved_position
= prev_saved_doc_string_position
;
3661 ptrdiff_t start
= pos
- saved_position
;
3664 /* Process quoting with ^A,
3665 and find the end of the string,
3666 which is marked with ^_ (037). */
3667 for (from
= start
, to
= start
;
3668 saved
[from
] != 037;)
3670 int c
= saved
[from
++];
3674 saved
[to
++] = (c
== 1 ? c
3683 return make_unibyte_string (saved
+ start
,
3687 return get_doc_string (val
, 1, 0);
3692 invalid_syntax (". in wrong context");
3694 invalid_syntax ("] in a list");
3698 XSETCDR (tail
, tem
);
3705 static Lisp_Object initial_obarray
;
3707 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3709 static size_t oblookup_last_bucket_number
;
3711 /* Get an error if OBARRAY is not an obarray.
3712 If it is one, return it. */
3715 check_obarray (Lisp_Object obarray
)
3717 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3719 /* If Vobarray is now invalid, force it to be valid. */
3720 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3721 wrong_type_argument (Qvectorp
, obarray
);
3726 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3729 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3733 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3734 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3737 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3739 XSYMBOL (sym
)->constant
= 1;
3740 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3741 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3744 ptr
= aref_addr (obarray
, XINT (index
));
3745 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3750 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3753 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3755 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3758 /* Intern the C string STR: return a symbol with that name,
3759 interned in the current obarray. */
3762 intern_1 (const char *str
, ptrdiff_t len
)
3764 Lisp_Object obarray
= check_obarray (Vobarray
);
3765 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3767 return (SYMBOLP (tem
) ? tem
3768 /* The above `oblookup' was done on the basis of nchars==nbytes, so
3769 the string has to be unibyte. */
3770 : intern_driver (make_unibyte_string (str
, len
),
3775 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3777 Lisp_Object obarray
= check_obarray (Vobarray
);
3778 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3782 /* Creating a non-pure string from a string literal not implemented yet.
3783 We could just use make_string here and live with the extra copy. */
3784 eassert (!NILP (Vpurify_flag
));
3785 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3791 define_symbol (Lisp_Object sym
, char const *str
)
3793 ptrdiff_t len
= strlen (str
);
3794 Lisp_Object string
= make_pure_c_string (str
, len
);
3795 init_symbol (sym
, string
);
3797 /* Qunbound is uninterned, so that it's not confused with any symbol
3798 'unbound' created by a Lisp program. */
3799 if (! EQ (sym
, Qunbound
))
3801 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3802 eassert (INTEGERP (bucket
));
3803 intern_sym (sym
, initial_obarray
, bucket
);
3807 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3808 doc
: /* Return the canonical symbol whose name is STRING.
3809 If there is none, one is created by this function and returned.
3810 A second optional argument specifies the obarray to use;
3811 it defaults to the value of `obarray'. */)
3812 (Lisp_Object string
, Lisp_Object obarray
)
3816 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3817 CHECK_STRING (string
);
3819 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3821 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3826 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3827 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3828 NAME may be a string or a symbol. If it is a symbol, that exact
3829 symbol is searched for.
3830 A second optional argument specifies the obarray to use;
3831 it defaults to the value of `obarray'. */)
3832 (Lisp_Object name
, Lisp_Object obarray
)
3834 register Lisp_Object tem
, string
;
3836 if (NILP (obarray
)) obarray
= Vobarray
;
3837 obarray
= check_obarray (obarray
);
3839 if (!SYMBOLP (name
))
3841 CHECK_STRING (name
);
3845 string
= SYMBOL_NAME (name
);
3847 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3848 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3854 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3855 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3856 The value is t if a symbol was found and deleted, nil otherwise.
3857 NAME may be a string or a symbol. If it is a symbol, that symbol
3858 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3859 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3860 usage: (unintern NAME OBARRAY) */)
3861 (Lisp_Object name
, Lisp_Object obarray
)
3863 register Lisp_Object string
, tem
;
3866 if (NILP (obarray
)) obarray
= Vobarray
;
3867 obarray
= check_obarray (obarray
);
3870 string
= SYMBOL_NAME (name
);
3873 CHECK_STRING (name
);
3877 tem
= oblookup (obarray
, SSDATA (string
),
3882 /* If arg was a symbol, don't delete anything but that symbol itself. */
3883 if (SYMBOLP (name
) && !EQ (name
, tem
))
3886 /* There are plenty of other symbols which will screw up the Emacs
3887 session if we unintern them, as well as even more ways to use
3888 `setq' or `fset' or whatnot to make the Emacs session
3889 unusable. Let's not go down this silly road. --Stef */
3890 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3891 error ("Attempt to unintern t or nil"); */
3893 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3895 hash
= oblookup_last_bucket_number
;
3897 if (EQ (AREF (obarray
, hash
), tem
))
3899 if (XSYMBOL (tem
)->next
)
3902 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3903 ASET (obarray
, hash
, sym
);
3906 ASET (obarray
, hash
, make_number (0));
3910 Lisp_Object tail
, following
;
3912 for (tail
= AREF (obarray
, hash
);
3913 XSYMBOL (tail
)->next
;
3916 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3917 if (EQ (following
, tem
))
3919 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3928 /* Return the symbol in OBARRAY whose names matches the string
3929 of SIZE characters (SIZE_BYTE bytes) at PTR.
3930 If there is no such symbol, return the integer bucket number of
3931 where the symbol would be if it were present.
3933 Also store the bucket number in oblookup_last_bucket_number. */
3936 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3940 register Lisp_Object tail
;
3941 Lisp_Object bucket
, tem
;
3943 obarray
= check_obarray (obarray
);
3944 /* This is sometimes needed in the middle of GC. */
3945 obsize
= gc_asize (obarray
);
3946 hash
= hash_string (ptr
, size_byte
) % obsize
;
3947 bucket
= AREF (obarray
, hash
);
3948 oblookup_last_bucket_number
= hash
;
3949 if (EQ (bucket
, make_number (0)))
3951 else if (!SYMBOLP (bucket
))
3952 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3954 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3956 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3957 && SCHARS (SYMBOL_NAME (tail
)) == size
3958 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3960 else if (XSYMBOL (tail
)->next
== 0)
3963 XSETINT (tem
, hash
);
3968 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3971 register Lisp_Object tail
;
3972 CHECK_VECTOR (obarray
);
3973 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3975 tail
= AREF (obarray
, i
);
3980 if (XSYMBOL (tail
)->next
== 0)
3982 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3988 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3990 call1 (function
, sym
);
3993 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3994 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3995 OBARRAY defaults to the value of `obarray'. */)
3996 (Lisp_Object function
, Lisp_Object obarray
)
3998 if (NILP (obarray
)) obarray
= Vobarray
;
3999 obarray
= check_obarray (obarray
);
4001 map_obarray (obarray
, mapatoms_1
, function
);
4005 #define OBARRAY_SIZE 1511
4010 Lisp_Object oblength
;
4011 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4013 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4015 Vobarray
= Fmake_vector (oblength
, make_number (0));
4016 initial_obarray
= Vobarray
;
4017 staticpro (&initial_obarray
);
4019 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4020 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4022 DEFSYM (Qunbound
, "unbound");
4024 DEFSYM (Qnil
, "nil");
4025 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4026 XSYMBOL (Qnil
)->constant
= 1;
4027 XSYMBOL (Qnil
)->declared_special
= true;
4030 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4031 XSYMBOL (Qt
)->constant
= 1;
4032 XSYMBOL (Qt
)->declared_special
= true;
4034 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4037 DEFSYM (Qvariable_documentation
, "variable-documentation");
4039 read_buffer
= xmalloc (size
);
4040 read_buffer_size
= size
;
4044 defsubr (struct Lisp_Subr
*sname
)
4046 Lisp_Object sym
, tem
;
4047 sym
= intern_c_string (sname
->symbol_name
);
4048 XSETPVECTYPE (sname
, PVEC_SUBR
);
4049 XSETSUBR (tem
, sname
);
4050 set_symbol_function (sym
, tem
);
4053 #ifdef NOTDEF /* Use fset in subr.el now! */
4055 defalias (struct Lisp_Subr
*sname
, char *string
)
4058 sym
= intern (string
);
4059 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4063 /* Define an "integer variable"; a symbol whose value is forwarded to a
4064 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4065 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4067 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4068 const char *namestring
, EMACS_INT
*address
)
4071 sym
= intern_c_string (namestring
);
4072 i_fwd
->type
= Lisp_Fwd_Int
;
4073 i_fwd
->intvar
= address
;
4074 XSYMBOL (sym
)->declared_special
= 1;
4075 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4076 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4079 /* Similar but define a variable whose value is t if address contains 1,
4080 nil if address contains 0. */
4082 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4083 const char *namestring
, bool *address
)
4086 sym
= intern_c_string (namestring
);
4087 b_fwd
->type
= Lisp_Fwd_Bool
;
4088 b_fwd
->boolvar
= address
;
4089 XSYMBOL (sym
)->declared_special
= 1;
4090 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4091 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4092 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4095 /* Similar but define a variable whose value is the Lisp Object stored
4096 at address. Two versions: with and without gc-marking of the C
4097 variable. The nopro version is used when that variable will be
4098 gc-marked for some other reason, since marking the same slot twice
4099 can cause trouble with strings. */
4101 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4102 const char *namestring
, Lisp_Object
*address
)
4105 sym
= intern_c_string (namestring
);
4106 o_fwd
->type
= Lisp_Fwd_Obj
;
4107 o_fwd
->objvar
= address
;
4108 XSYMBOL (sym
)->declared_special
= 1;
4109 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4110 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4114 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4115 const char *namestring
, Lisp_Object
*address
)
4117 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4118 staticpro (address
);
4121 /* Similar but define a variable whose value is the Lisp Object stored
4122 at a particular offset in the current kboard object. */
4125 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4126 const char *namestring
, int offset
)
4129 sym
= intern_c_string (namestring
);
4130 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4131 ko_fwd
->offset
= offset
;
4132 XSYMBOL (sym
)->declared_special
= 1;
4133 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4134 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4137 /* Check that the elements of lpath exist. */
4140 load_path_check (Lisp_Object lpath
)
4142 Lisp_Object path_tail
;
4144 /* The only elements that might not exist are those from
4145 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4147 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4149 Lisp_Object dirfile
;
4150 dirfile
= Fcar (path_tail
);
4151 if (STRINGP (dirfile
))
4153 dirfile
= Fdirectory_file_name (dirfile
);
4154 if (! file_accessible_directory_p (dirfile
))
4155 dir_warning ("Lisp directory", XCAR (path_tail
));
4160 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4161 This does not include the standard site-lisp directories
4162 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4163 but it does (unless no_site_lisp is set) include site-lisp
4164 directories in the source/build directories if those exist and we
4165 are running uninstalled.
4167 Uses the following logic:
4168 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4169 The remainder is what happens when dumping works:
4170 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4171 Otherwise use PATH_LOADSEARCH.
4173 If !initialized, then just return PATH_DUMPLOADSEARCH.
4175 If Vinstallation_directory is not nil (ie, running uninstalled):
4176 If installation-dir/lisp exists and not already a member,
4177 we must be running uninstalled. Reset the load-path
4178 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4179 refers to the eventual installation directories. Since we
4180 are not yet installed, we should not use them, even if they exist.)
4181 If installation-dir/lisp does not exist, just add
4182 PATH_DUMPLOADSEARCH at the end instead.
4183 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4184 and not already a member) at the front.
4185 If installation-dir != source-dir (ie running an uninstalled,
4186 out-of-tree build) AND install-dir/src/Makefile exists BUT
4187 install-dir/src/Makefile.in does NOT exist (this is a sanity
4188 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4191 load_path_default (void)
4193 Lisp_Object lpath
= Qnil
;
4198 const char *loadpath
= ns_load_path ();
4201 normal
= PATH_LOADSEARCH
;
4203 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4205 lpath
= decode_env_path (0, normal
, 0);
4208 #else /* !CANNOT_DUMP */
4210 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4215 const char *loadpath
= ns_load_path ();
4216 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4218 lpath
= decode_env_path (0, normal
, 0);
4220 if (!NILP (Vinstallation_directory
))
4222 Lisp_Object tem
, tem1
;
4224 /* Add to the path the lisp subdir of the installation
4225 dir, if it is accessible. Note: in out-of-tree builds,
4226 this directory is empty save for Makefile. */
4227 tem
= Fexpand_file_name (build_string ("lisp"),
4228 Vinstallation_directory
);
4229 tem1
= Ffile_accessible_directory_p (tem
);
4232 if (NILP (Fmember (tem
, lpath
)))
4234 /* We are running uninstalled. The default load-path
4235 points to the eventual installed lisp directories.
4236 We should not use those now, even if they exist,
4237 so start over from a clean slate. */
4238 lpath
= list1 (tem
);
4242 /* That dir doesn't exist, so add the build-time
4243 Lisp dirs instead. */
4245 Lisp_Object dump_path
=
4246 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4247 lpath
= nconc2 (lpath
, dump_path
);
4250 /* Add site-lisp under the installation dir, if it exists. */
4253 tem
= Fexpand_file_name (build_string ("site-lisp"),
4254 Vinstallation_directory
);
4255 tem1
= Ffile_accessible_directory_p (tem
);
4258 if (NILP (Fmember (tem
, lpath
)))
4259 lpath
= Fcons (tem
, lpath
);
4263 /* If Emacs was not built in the source directory,
4264 and it is run from where it was built, add to load-path
4265 the lisp and site-lisp dirs under that directory. */
4267 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4271 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4272 Vinstallation_directory
);
4273 tem1
= Ffile_exists_p (tem
);
4275 /* Don't be fooled if they moved the entire source tree
4276 AFTER dumping Emacs. If the build directory is indeed
4277 different from the source dir, src/Makefile.in and
4278 src/Makefile will not be found together. */
4279 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4280 Vinstallation_directory
);
4281 tem2
= Ffile_exists_p (tem
);
4282 if (!NILP (tem1
) && NILP (tem2
))
4284 tem
= Fexpand_file_name (build_string ("lisp"),
4287 if (NILP (Fmember (tem
, lpath
)))
4288 lpath
= Fcons (tem
, lpath
);
4292 tem
= Fexpand_file_name (build_string ("site-lisp"),
4294 tem1
= Ffile_accessible_directory_p (tem
);
4297 if (NILP (Fmember (tem
, lpath
)))
4298 lpath
= Fcons (tem
, lpath
);
4302 } /* Vinstallation_directory != Vsource_directory */
4304 } /* if Vinstallation_directory */
4306 else /* !initialized */
4308 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4309 source directory. We used to add ../lisp (ie the lisp dir in
4310 the build directory) at the front here, but that should not
4311 be necessary, since in out of tree builds lisp/ is empty, save
4313 lpath
= decode_env_path (0, normal
, 0);
4315 #endif /* !CANNOT_DUMP */
4323 /* First, set Vload_path. */
4325 /* Ignore EMACSLOADPATH when dumping. */
4327 bool use_loadpath
= true;
4329 bool use_loadpath
= NILP (Vpurify_flag
);
4332 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4334 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4336 /* Check (non-nil) user-supplied elements. */
4337 load_path_check (Vload_path
);
4339 /* If no nils in the environment variable, use as-is.
4340 Otherwise, replace any nils with the default. */
4341 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4343 Lisp_Object elem
, elpath
= Vload_path
;
4344 Lisp_Object default_lpath
= load_path_default ();
4346 /* Check defaults, before adding site-lisp. */
4347 load_path_check (default_lpath
);
4349 /* Add the site-lisp directories to the front of the default. */
4352 Lisp_Object sitelisp
;
4353 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4354 if (! NILP (sitelisp
))
4355 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4360 /* Replace nils from EMACSLOADPATH by default. */
4361 while (CONSP (elpath
))
4363 elem
= XCAR (elpath
);
4364 elpath
= XCDR (elpath
);
4365 Vload_path
= CALLN (Fappend
, Vload_path
,
4366 NILP (elem
) ? default_lpath
: list1 (elem
));
4368 } /* Fmemq (Qnil, Vload_path) */
4372 Vload_path
= load_path_default ();
4374 /* Check before adding site-lisp directories.
4375 The install should have created them, but they are not
4376 required, so no need to warn if they are absent.
4377 Or we might be running before installation. */
4378 load_path_check (Vload_path
);
4380 /* Add the site-lisp directories at the front. */
4381 if (initialized
&& !no_site_lisp
)
4383 Lisp_Object sitelisp
;
4384 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4385 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4391 load_in_progress
= 0;
4392 Vload_file_name
= Qnil
;
4393 Vstandard_input
= Qt
;
4394 Vloads_in_progress
= Qnil
;
4397 /* Print a warning that directory intended for use USE and with name
4398 DIRNAME cannot be accessed. On entry, errno should correspond to
4399 the access failure. Print the warning on stderr and put it in
4403 dir_warning (char const *use
, Lisp_Object dirname
)
4405 static char const format
[] = "Warning: %s '%s': %s\n";
4406 int access_errno
= errno
;
4407 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)),
4408 strerror (access_errno
));
4410 /* Don't log the warning before we've initialized!! */
4413 char const *diagnostic
= emacs_strerror (access_errno
);
4415 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4416 + strlen (use
) + SBYTES (dirname
)
4417 + strlen (diagnostic
));
4418 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4420 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4426 syms_of_lread (void)
4429 defsubr (&Sread_from_string
);
4431 defsubr (&Sintern_soft
);
4432 defsubr (&Sunintern
);
4433 defsubr (&Sget_load_suffixes
);
4435 defsubr (&Seval_buffer
);
4436 defsubr (&Seval_region
);
4437 defsubr (&Sread_char
);
4438 defsubr (&Sread_char_exclusive
);
4439 defsubr (&Sread_event
);
4440 defsubr (&Sget_file_char
);
4441 defsubr (&Smapatoms
);
4442 defsubr (&Slocate_file_internal
);
4444 DEFVAR_LISP ("obarray", Vobarray
,
4445 doc
: /* Symbol table for use by `intern' and `read'.
4446 It is a vector whose length ought to be prime for best results.
4447 The vector's contents don't make sense if examined from Lisp programs;
4448 to find all the symbols in an obarray, use `mapatoms'. */);
4450 DEFVAR_LISP ("values", Vvalues
,
4451 doc
: /* List of values of all expressions which were read, evaluated and printed.
4452 Order is reverse chronological. */);
4453 XSYMBOL (intern ("values"))->declared_special
= 0;
4455 DEFVAR_LISP ("standard-input", Vstandard_input
,
4456 doc
: /* Stream for read to get input from.
4457 See documentation of `read' for possible values. */);
4458 Vstandard_input
= Qt
;
4460 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4461 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4463 If this variable is a buffer, then only forms read from that buffer
4464 will be added to `read-symbol-positions-list'.
4465 If this variable is t, then all read forms will be added.
4466 The effect of all other values other than nil are not currently
4467 defined, although they may be in the future.
4469 The positions are relative to the last call to `read' or
4470 `read-from-string'. It is probably a bad idea to set this variable at
4471 the toplevel; bind it instead. */);
4472 Vread_with_symbol_positions
= Qnil
;
4474 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4475 doc
: /* A list mapping read symbols to their positions.
4476 This variable is modified during calls to `read' or
4477 `read-from-string', but only when `read-with-symbol-positions' is
4480 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4481 CHAR-POSITION is an integer giving the offset of that occurrence of the
4482 symbol from the position where `read' or `read-from-string' started.
4484 Note that a symbol will appear multiple times in this list, if it was
4485 read multiple times. The list is in the same order as the symbols
4487 Vread_symbol_positions_list
= Qnil
;
4489 DEFVAR_LISP ("read-circle", Vread_circle
,
4490 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4493 DEFVAR_LISP ("load-path", Vload_path
,
4494 doc
: /* List of directories to search for files to load.
4495 Each element is a string (directory file name) or nil (meaning
4496 `default-directory').
4497 Initialized during startup as described in Info node `(elisp)Library Search'.
4498 Use `directory-file-name' when adding items to this path. However, Lisp
4499 programs that process this list should tolerate directories both with
4500 and without trailing slashes. */);
4502 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4503 doc
: /* List of suffixes for Emacs Lisp files and dynamic modules.
4504 This list includes suffixes for both compiled and source Emacs Lisp files.
4505 This list should not include the empty string.
4506 `load' and related functions try to append these suffixes, in order,
4507 to the specified file name if a suffix is allowed or required. */);
4509 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4510 build_pure_c_string (".el"),
4511 build_pure_c_string (MODULES_SUFFIX
));
4513 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4514 build_pure_c_string (".el"));
4516 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix
,
4517 doc
: /* Suffix of loadable module file, or nil of modules are not supported. */);
4519 Vmodule_file_suffix
= build_pure_c_string (MODULES_SUFFIX
);
4521 Vmodule_file_suffix
= Qnil
;
4523 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4524 doc
: /* List of suffixes that indicate representations of \
4526 This list should normally start with the empty string.
4528 Enabling Auto Compression mode appends the suffixes in
4529 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4530 mode removes them again. `load' and related functions use this list to
4531 determine whether they should look for compressed versions of a file
4532 and, if so, which suffixes they should try to append to the file name
4533 in order to do so. However, if you want to customize which suffixes
4534 the loading functions recognize as compression suffixes, you should
4535 customize `jka-compr-load-suffixes' rather than the present variable. */);
4536 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4538 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4539 doc
: /* Non-nil if inside of `load'. */);
4540 DEFSYM (Qload_in_progress
, "load-in-progress");
4542 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4543 doc
: /* An alist of functions to be evalled when particular files are loaded.
4544 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4546 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4547 a symbol (a feature name).
4549 When `load' is run and the file-name argument matches an element's
4550 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4551 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4553 An error in FORMS does not undo the load, but does prevent execution of
4554 the rest of the FORMS. */);
4555 Vafter_load_alist
= Qnil
;
4557 DEFVAR_LISP ("load-history", Vload_history
,
4558 doc
: /* Alist mapping loaded file names to symbols and features.
4559 Each alist element should be a list (FILE-NAME ENTRIES...), where
4560 FILE-NAME is the name of a file that has been loaded into Emacs.
4561 The file name is absolute and true (i.e. it doesn't contain symlinks).
4562 As an exception, one of the alist elements may have FILE-NAME nil,
4563 for symbols and features not associated with any file.
4565 The remaining ENTRIES in the alist element describe the functions and
4566 variables defined in that file, the features provided, and the
4567 features required. Each entry has the form `(provide . FEATURE)',
4568 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4569 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4570 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4571 autoload before this file redefined it as a function. In addition,
4572 entries may also be single symbols, which means that SYMBOL was
4573 defined by `defvar' or `defconst'.
4575 During preloading, the file name recorded is relative to the main Lisp
4576 directory. These file names are converted to absolute at startup. */);
4577 Vload_history
= Qnil
;
4579 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4580 doc
: /* Full name of file being loaded by `load'. */);
4581 Vload_file_name
= Qnil
;
4583 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4584 doc
: /* File name, including directory, of user's initialization file.
4585 If the file loaded had extension `.elc', and the corresponding source file
4586 exists, this variable contains the name of source file, suitable for use
4587 by functions like `custom-save-all' which edit the init file.
4588 While Emacs loads and evaluates the init file, value is the real name
4589 of the file, regardless of whether or not it has the `.elc' extension. */);
4590 Vuser_init_file
= Qnil
;
4592 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4593 doc
: /* Used for internal purposes by `load'. */);
4594 Vcurrent_load_list
= Qnil
;
4596 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4597 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4598 Called with a single argument (the stream from which to read).
4599 The default is to use the function `read'. */);
4600 DEFSYM (Qread
, "read");
4601 Vload_read_function
= Qread
;
4603 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4604 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4605 The value should be a function for doing code conversion before
4606 reading a source file. It can also be nil, in which case loading is
4607 done without any code conversion.
4609 If the value is a function, it is called with four arguments,
4610 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4611 the file to load, FILE is the non-absolute name (for messages etc.),
4612 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4613 `load'. The function should return t if the file was loaded. */);
4614 Vload_source_file_function
= Qnil
;
4616 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4617 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4618 This is useful when the file being loaded is a temporary copy. */);
4619 load_force_doc_strings
= 0;
4621 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4622 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4623 This is normally bound by `load' and `eval-buffer' to control `read',
4624 and is not meant for users to change. */);
4625 load_convert_to_unibyte
= 0;
4627 DEFVAR_LISP ("source-directory", Vsource_directory
,
4628 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4629 You cannot count on them to still be there! */);
4631 = Fexpand_file_name (build_string ("../"),
4632 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4634 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4635 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4636 Vpreloaded_file_list
= Qnil
;
4638 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4639 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4640 Vbyte_boolean_vars
= Qnil
;
4642 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4643 doc
: /* Non-nil means load dangerous compiled Lisp files.
4644 Some versions of XEmacs use different byte codes than Emacs. These
4645 incompatible byte codes can make Emacs crash when it tries to execute
4647 load_dangerous_libraries
= 0;
4649 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4650 doc
: /* Non-nil means force printing messages when loading Lisp files.
4651 This overrides the value of the NOMESSAGE argument to `load'. */);
4652 force_load_messages
= 0;
4654 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4655 doc
: /* Regular expression matching safe to load compiled Lisp files.
4656 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4657 from the file, and matches them against this regular expression.
4658 When the regular expression matches, the file is considered to be safe
4659 to load. See also `load-dangerous-libraries'. */);
4660 Vbytecomp_version_regexp
4661 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4663 DEFSYM (Qlexical_binding
, "lexical-binding");
4664 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4665 doc
: /* Whether to use lexical binding when evaluating code.
4666 Non-nil means that the code in the current buffer should be evaluated
4667 with lexical binding.
4668 This variable is automatically set from the file variables of an
4669 interpreted Lisp file read using `load'. Unlike other file local
4670 variables, this must be set in the first line of a file. */);
4671 Vlexical_binding
= Qnil
;
4672 Fmake_variable_buffer_local (Qlexical_binding
);
4674 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4675 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4676 Veval_buffer_list
= Qnil
;
4678 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4679 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4680 Vold_style_backquotes
= Qnil
;
4681 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4683 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4684 doc
: /* Non-nil means `load' prefers the newest version of a file.
4685 This applies when a filename suffix is not explicitly specified and
4686 `load' is trying various possible suffixes (see `load-suffixes' and
4687 `load-file-rep-suffixes'). Normally, it stops at the first file
4688 that exists unless you explicitly specify one or the other. If this
4689 option is non-nil, it checks all suffixes and uses whichever file is
4691 Note that if you customize this, obviously it will not affect files
4692 that are loaded before your customizations are read! */);
4693 load_prefer_newer
= 0;
4695 /* Vsource_directory was initialized in init_lread. */
4697 DEFSYM (Qcurrent_load_list
, "current-load-list");
4698 DEFSYM (Qstandard_input
, "standard-input");
4699 DEFSYM (Qread_char
, "read-char");
4700 DEFSYM (Qget_file_char
, "get-file-char");
4702 /* Used instead of Qget_file_char while loading *.elc files compiled
4703 by Emacs 21 or older. */
4704 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4706 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4708 DEFSYM (Qbackquote
, "`");
4709 DEFSYM (Qcomma
, ",");
4710 DEFSYM (Qcomma_at
, ",@");
4711 DEFSYM (Qcomma_dot
, ",.");
4713 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4714 DEFSYM (Qascii_character
, "ascii-character");
4715 DEFSYM (Qfunction
, "function");
4716 DEFSYM (Qload
, "load");
4717 DEFSYM (Qload_file_name
, "load-file-name");
4718 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4719 DEFSYM (Qfile_truename
, "file-truename");
4720 DEFSYM (Qdir_ok
, "dir-ok");
4721 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4723 staticpro (&read_objects
);
4724 read_objects
= Qnil
;
4725 staticpro (&seen_list
);
4728 Vloads_in_progress
= Qnil
;
4729 staticpro (&Vloads_in_progress
);
4731 DEFSYM (Qhash_table
, "hash-table");
4732 DEFSYM (Qdata
, "data");
4733 DEFSYM (Qtest
, "test");
4734 DEFSYM (Qsize
, "size");
4735 DEFSYM (Qweakness
, "weakness");
4736 DEFSYM (Qrehash_size
, "rehash-size");
4737 DEFSYM (Qrehash_threshold
, "rehash-threshold");