1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2016 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 /* Tell globals.h to define tables needed by init_obarray. */
22 #define DEFINE_SYMBOLS
26 #include <sys/types.h>
30 #include <limits.h> /* For CHAR_BIT. */
32 #include <stat-time.h>
34 #include "dispextern.h"
35 #include "intervals.h"
36 #include "character.h"
44 #include "termhooks.h"
45 #include "blockinput.h"
49 #if __DJGPP__ == 2 && __DJGPP_MINOR__ < 5
50 # define INFINITY __builtin_inf()
51 # define NAN __builtin_nan("")
63 #endif /* HAVE_SETLOCALE */
68 #define file_offset off_t
69 #define file_tell ftello
71 #define file_offset long
72 #define file_tell ftell
75 /* The association list of objects read with the #n=object form.
76 Each member of the list has the form (n . object), and is used to
77 look up the object for the corresponding #n# construct.
78 It must be set to nil before all top-level calls to read0. */
79 static Lisp_Object read_objects
;
81 /* File for get_file_char to read from. Use by load. */
82 static FILE *instream
;
84 /* For use within read-from-string (this reader is non-reentrant!!) */
85 static ptrdiff_t read_from_string_index
;
86 static ptrdiff_t read_from_string_index_byte
;
87 static ptrdiff_t read_from_string_limit
;
89 /* Number of characters read in the current call to Fread or
91 static EMACS_INT readchar_count
;
93 /* This contains the last string skipped with #@. */
94 static char *saved_doc_string
;
95 /* Length of buffer allocated in saved_doc_string. */
96 static ptrdiff_t saved_doc_string_size
;
97 /* Length of actual data in saved_doc_string. */
98 static ptrdiff_t saved_doc_string_length
;
99 /* This is the file position that string came from. */
100 static file_offset saved_doc_string_position
;
102 /* This contains the previous string skipped with #@.
103 We copy it from saved_doc_string when a new string
104 is put in saved_doc_string. */
105 static char *prev_saved_doc_string
;
106 /* Length of buffer allocated in prev_saved_doc_string. */
107 static ptrdiff_t prev_saved_doc_string_size
;
108 /* Length of actual data in prev_saved_doc_string. */
109 static ptrdiff_t prev_saved_doc_string_length
;
110 /* This is the file position that string came from. */
111 static file_offset prev_saved_doc_string_position
;
113 /* True means inside a new-style backquote
114 with no surrounding parentheses.
115 Fread initializes this to false, so we need not specbind it
116 or worry about what happens to it when there is an error. */
117 static bool new_backquote_flag
;
119 /* A list of file names for files being loaded in Fload. Used to
120 check for recursive loads. */
122 static Lisp_Object Vloads_in_progress
;
124 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
127 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
128 Lisp_Object
, Lisp_Object
,
129 Lisp_Object
, Lisp_Object
);
131 /* Functions that read one byte from the current source READCHARFUN
132 or unreads one byte. If the integer argument C is -1, it returns
133 one read byte, or -1 when there's no more byte in the source. If C
134 is 0 or positive, it unreads C, and the return value is not
137 static int readbyte_for_lambda (int, Lisp_Object
);
138 static int readbyte_from_file (int, Lisp_Object
);
139 static int readbyte_from_string (int, Lisp_Object
);
141 /* Handle unreading and rereading of characters.
142 Write READCHAR to read a character,
143 UNREAD(c) to unread c to be read again.
145 These macros correctly read/unread multibyte characters. */
147 #define READCHAR readchar (readcharfun, NULL)
148 #define UNREAD(c) unreadchar (readcharfun, c)
150 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
151 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
153 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
154 Qlambda, or a cons, we use this to keep an unread character because
155 a file stream can't handle multibyte-char unreading. The value -1
156 means that there's no unread character. */
157 static int unread_char
;
160 readchar (Lisp_Object readcharfun
, bool *multibyte
)
164 int (*readbyte
) (int, Lisp_Object
);
165 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
167 bool emacs_mule_encoding
= 0;
174 if (BUFFERP (readcharfun
))
176 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
178 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
180 if (! BUFFER_LIVE_P (inbuffer
))
183 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
186 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
188 /* Fetch the character code from the buffer. */
189 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
190 BUF_INC_POS (inbuffer
, pt_byte
);
197 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
198 if (! ASCII_CHAR_P (c
))
199 c
= BYTE8_TO_CHAR (c
);
202 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
206 if (MARKERP (readcharfun
))
208 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
210 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
212 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
215 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
217 /* Fetch the character code from the buffer. */
218 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
219 BUF_INC_POS (inbuffer
, bytepos
);
226 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
227 if (! ASCII_CHAR_P (c
))
228 c
= BYTE8_TO_CHAR (c
);
232 XMARKER (readcharfun
)->bytepos
= bytepos
;
233 XMARKER (readcharfun
)->charpos
++;
238 if (EQ (readcharfun
, Qlambda
))
240 readbyte
= readbyte_for_lambda
;
244 if (EQ (readcharfun
, Qget_file_char
))
246 readbyte
= readbyte_from_file
;
250 if (STRINGP (readcharfun
))
252 if (read_from_string_index
>= read_from_string_limit
)
254 else if (STRING_MULTIBYTE (readcharfun
))
258 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
259 read_from_string_index
,
260 read_from_string_index_byte
);
264 c
= SREF (readcharfun
, read_from_string_index_byte
);
265 read_from_string_index
++;
266 read_from_string_index_byte
++;
271 if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
273 /* This is the case that read_vector is reading from a unibyte
274 string that contains a byte sequence previously skipped
275 because of #@NUMBER. The car part of readcharfun is that
276 string, and the cdr part is a value of readcharfun given to
278 readbyte
= readbyte_from_string
;
279 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
280 emacs_mule_encoding
= 1;
284 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
286 readbyte
= readbyte_from_file
;
287 emacs_mule_encoding
= 1;
291 tem
= call0 (readcharfun
);
298 if (unread_char
>= 0)
304 c
= (*readbyte
) (-1, readcharfun
);
309 if (ASCII_CHAR_P (c
))
311 if (emacs_mule_encoding
)
312 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
315 len
= BYTES_BY_CHAR_HEAD (c
);
318 c
= (*readbyte
) (-1, readcharfun
);
319 if (c
< 0 || ! TRAILING_CODE_P (c
))
322 (*readbyte
) (buf
[i
], readcharfun
);
323 return BYTE8_TO_CHAR (buf
[0]);
327 return STRING_CHAR (buf
);
330 #define FROM_FILE_P(readcharfun) \
331 (EQ (readcharfun, Qget_file_char) \
332 || EQ (readcharfun, Qget_emacs_mule_file_char))
335 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
337 if (FROM_FILE_P (readcharfun
))
339 block_input (); /* FIXME: Not sure if it's needed. */
340 fseek (instream
, n
, SEEK_CUR
);
344 { /* We're not reading directly from a file. In that case, it's difficult
345 to reliably count bytes, since these are usually meant for the file's
346 encoding, whereas we're now typically in the internal encoding.
347 But luckily, skip_dyn_bytes is used to skip over a single
348 dynamic-docstring (or dynamic byte-code) which is always quoted such
349 that \037 is the final char. */
353 } while (c
>= 0 && c
!= '\037');
358 skip_dyn_eof (Lisp_Object readcharfun
)
360 if (FROM_FILE_P (readcharfun
))
362 block_input (); /* FIXME: Not sure if it's needed. */
363 fseek (instream
, 0, SEEK_END
);
367 while (READCHAR
>= 0);
370 /* Unread the character C in the way appropriate for the stream READCHARFUN.
371 If the stream is a user function, call it with the char as argument. */
374 unreadchar (Lisp_Object readcharfun
, int c
)
378 /* Don't back up the pointer if we're unreading the end-of-input mark,
379 since readchar didn't advance it when we read it. */
381 else if (BUFFERP (readcharfun
))
383 struct buffer
*b
= XBUFFER (readcharfun
);
384 ptrdiff_t charpos
= BUF_PT (b
);
385 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
387 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
388 BUF_DEC_POS (b
, bytepos
);
392 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
394 else if (MARKERP (readcharfun
))
396 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
397 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
399 XMARKER (readcharfun
)->charpos
--;
400 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
401 BUF_DEC_POS (b
, bytepos
);
405 XMARKER (readcharfun
)->bytepos
= bytepos
;
407 else if (STRINGP (readcharfun
))
409 read_from_string_index
--;
410 read_from_string_index_byte
411 = string_char_to_byte (readcharfun
, read_from_string_index
);
413 else if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
417 else if (EQ (readcharfun
, Qlambda
))
421 else if (FROM_FILE_P (readcharfun
))
426 call1 (readcharfun
, make_number (c
));
430 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
432 return read_bytecode_char (c
>= 0);
437 readbyte_from_file (int c
, Lisp_Object readcharfun
)
442 ungetc (c
, instream
);
450 /* Interrupted reads have been observed while reading over the network. */
451 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
462 return (c
== EOF
? -1 : c
);
466 readbyte_from_string (int c
, Lisp_Object readcharfun
)
468 Lisp_Object string
= XCAR (readcharfun
);
472 read_from_string_index
--;
473 read_from_string_index_byte
474 = string_char_to_byte (string
, read_from_string_index
);
477 if (read_from_string_index
>= read_from_string_limit
)
480 FETCH_STRING_CHAR_ADVANCE (c
, string
,
481 read_from_string_index
,
482 read_from_string_index_byte
);
487 /* Read one non-ASCII character from INSTREAM. The character is
488 encoded in `emacs-mule' and the first byte is already read in
492 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
494 /* Emacs-mule coding uses at most 4-byte for one character. */
495 unsigned char buf
[4];
496 int len
= emacs_mule_bytes
[c
];
497 struct charset
*charset
;
502 /* C is not a valid leading-code of `emacs-mule'. */
503 return BYTE8_TO_CHAR (c
);
509 c
= (*readbyte
) (-1, readcharfun
);
513 (*readbyte
) (buf
[i
], readcharfun
);
514 return BYTE8_TO_CHAR (buf
[0]);
521 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
522 code
= buf
[1] & 0x7F;
526 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
527 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
529 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
530 code
= buf
[2] & 0x7F;
534 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
535 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
540 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
541 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
543 c
= DECODE_CHAR (charset
, code
);
545 Fsignal (Qinvalid_read_syntax
,
546 list1 (build_string ("invalid multibyte form")));
551 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
553 static Lisp_Object
read0 (Lisp_Object
);
554 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
556 static Lisp_Object
read_list (bool, Lisp_Object
);
557 static Lisp_Object
read_vector (Lisp_Object
, bool);
559 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
561 static void substitute_object_in_subtree (Lisp_Object
,
563 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
566 /* Get a character from the tty. */
568 /* Read input events until we get one that's acceptable for our purposes.
570 If NO_SWITCH_FRAME, switch-frame events are stashed
571 until we get a character we like, and then stuffed into
574 If ASCII_REQUIRED, check function key events to see
575 if the unmodified version of the symbol has a Qascii_character
576 property, and use that character, if present.
578 If ERROR_NONASCII, signal an error if the input we
579 get isn't an ASCII character with modifiers. If it's false but
580 ASCII_REQUIRED is true, just re-read until we get an ASCII
583 If INPUT_METHOD, invoke the current input method
584 if the character warrants that.
586 If SECONDS is a number, wait that many seconds for input, and
587 return Qnil if no input arrives within that time. */
590 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
591 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
593 Lisp_Object val
, delayed_switch_frame
;
594 struct timespec end_time
;
596 #ifdef HAVE_WINDOW_SYSTEM
597 if (display_hourglass_p
)
601 delayed_switch_frame
= Qnil
;
603 /* Compute timeout. */
604 if (NUMBERP (seconds
))
606 double duration
= extract_float (seconds
);
607 struct timespec wait_time
= dtotimespec (duration
);
608 end_time
= timespec_add (current_timespec (), wait_time
);
611 /* Read until we get an acceptable event. */
614 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
615 NUMBERP (seconds
) ? &end_time
: NULL
);
616 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
621 /* `switch-frame' events are put off until after the next ASCII
622 character. This is better than signaling an error just because
623 the last characters were typed to a separate minibuffer frame,
624 for example. Eventually, some code which can deal with
625 switch-frame events will read it and process it. */
627 && EVENT_HAS_PARAMETERS (val
)
628 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
630 delayed_switch_frame
= val
;
634 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
636 /* Convert certain symbols to their ASCII equivalents. */
639 Lisp_Object tem
, tem1
;
640 tem
= Fget (val
, Qevent_symbol_element_mask
);
643 tem1
= Fget (Fcar (tem
), Qascii_character
);
644 /* Merge this symbol's modifier bits
645 with the ASCII equivalent of its basic code. */
647 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
651 /* If we don't have a character now, deal with it appropriately. */
656 Vunread_command_events
= list1 (val
);
657 error ("Non-character input-event");
664 if (! NILP (delayed_switch_frame
))
665 unread_switch_frame
= delayed_switch_frame
;
669 #ifdef HAVE_WINDOW_SYSTEM
670 if (display_hourglass_p
)
679 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
680 doc
: /* Read a character from the command input (keyboard or macro).
681 It is returned as a number.
682 If the character has modifiers, they are resolved and reflected to the
683 character code if possible (e.g. C-SPC -> 0).
685 If the user generates an event which is not a character (i.e. a mouse
686 click or function key event), `read-char' signals an error. As an
687 exception, switch-frame events are put off until non-character events
689 If you want to read non-character events, or ignore them, call
690 `read-event' or `read-char-exclusive' instead.
692 If the optional argument PROMPT is non-nil, display that as a prompt.
693 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
694 input method is turned on in the current buffer, that input method
695 is used for reading a character.
696 If the optional argument SECONDS is non-nil, it should be a number
697 specifying the maximum number of seconds to wait for input. If no
698 input arrives in that time, return nil. SECONDS may be a
699 floating-point value. */)
700 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
705 message_with_string ("%s", prompt
, 0);
706 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
708 return (NILP (val
) ? Qnil
709 : make_number (char_resolve_modifier_mask (XINT (val
))));
712 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
713 doc
: /* Read an event object from the input stream.
714 If the optional argument PROMPT is non-nil, display that as a prompt.
715 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
716 input method is turned on in the current buffer, that input method
717 is used for reading a character.
718 If the optional argument SECONDS is non-nil, it should be a number
719 specifying the maximum number of seconds to wait for input. If no
720 input arrives in that time, return nil. SECONDS may be a
721 floating-point value. */)
722 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
725 message_with_string ("%s", prompt
, 0);
726 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
729 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
730 doc
: /* Read a character from the command input (keyboard or macro).
731 It is returned as a number. Non-character events are ignored.
732 If the character has modifiers, they are resolved and reflected to the
733 character code if possible (e.g. C-SPC -> 0).
735 If the optional argument PROMPT is non-nil, display that as a prompt.
736 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
737 input method is turned on in the current buffer, that input method
738 is used for reading a character.
739 If the optional argument SECONDS is non-nil, it should be a number
740 specifying the maximum number of seconds to wait for input. If no
741 input arrives in that time, return nil. SECONDS may be a
742 floating-point value. */)
743 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
748 message_with_string ("%s", prompt
, 0);
750 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
752 return (NILP (val
) ? Qnil
753 : make_number (char_resolve_modifier_mask (XINT (val
))));
756 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
757 doc
: /* Don't use this yourself. */)
760 register Lisp_Object val
;
762 XSETINT (val
, getc (instream
));
770 /* Return true if the lisp code read using READCHARFUN defines a non-nil
771 `lexical-binding' file variable. After returning, the stream is
772 positioned following the first line, if it is a comment or #! line,
773 otherwise nothing is read. */
776 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
789 while (ch
!= '\n' && ch
!= EOF
)
791 if (ch
== '\n') ch
= READCHAR
;
792 /* It is OK to leave the position after a #! line, since
793 that is what read1 does. */
797 /* The first line isn't a comment, just give up. */
803 /* Look for an appropriate file-variable in the first line. */
807 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
808 } beg_end_state
= NOMINAL
;
809 bool in_file_vars
= 0;
811 #define UPDATE_BEG_END_STATE(ch) \
812 if (beg_end_state == NOMINAL) \
813 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
814 else if (beg_end_state == AFTER_FIRST_DASH) \
815 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
816 else if (beg_end_state == AFTER_ASTERIX) \
819 in_file_vars = !in_file_vars; \
820 beg_end_state = NOMINAL; \
823 /* Skip until we get to the file vars, if any. */
827 UPDATE_BEG_END_STATE (ch
);
829 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
833 char var
[100], val
[100];
838 /* Read a variable name. */
839 while (ch
== ' ' || ch
== '\t')
843 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
845 if (i
< sizeof var
- 1)
847 UPDATE_BEG_END_STATE (ch
);
851 /* Stop scanning if no colon was found before end marker. */
852 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
855 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
861 /* Read a variable value. */
864 while (ch
== ' ' || ch
== '\t')
868 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
870 if (i
< sizeof val
- 1)
872 UPDATE_BEG_END_STATE (ch
);
876 /* The value was terminated by an end-marker, which remove. */
878 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
882 if (strcmp (var
, "lexical-binding") == 0)
885 rv
= (strcmp (val
, "nil") != 0);
891 while (ch
!= '\n' && ch
!= EOF
)
898 /* Value is a version number of byte compiled code if the file
899 associated with file descriptor FD is a compiled Lisp file that's
900 safe to load. Only files compiled with Emacs are safe to load.
901 Files compiled with XEmacs can lead to a crash in Fbyte_code
902 because of an incompatible change in the byte compiler. */
905 safe_to_load_version (int fd
)
911 /* Read the first few bytes from the file, and look for a line
912 specifying the byte compiler version used. */
913 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
916 /* Skip to the next newline, skipping over the initial `ELC'
917 with NUL bytes following it, but note the version. */
918 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
923 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
924 buf
+ i
, nbytes
- i
) < 0)
928 lseek (fd
, 0, SEEK_SET
);
933 /* Callback for record_unwind_protect. Restore the old load list OLD,
934 after loading a file successfully. */
937 record_load_unwind (Lisp_Object old
)
939 Vloads_in_progress
= old
;
942 /* This handler function is used via internal_condition_case_1. */
945 load_error_handler (Lisp_Object data
)
951 load_warn_old_style_backquotes (Lisp_Object file
)
953 if (!NILP (Vold_style_backquotes
))
955 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
956 CALLN (Fmessage
, format
, file
);
960 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
961 doc
: /* Return the suffixes that `load' should try if a suffix is \
963 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
966 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
967 while (CONSP (suffixes
))
969 Lisp_Object exts
= Vload_file_rep_suffixes
;
970 suffix
= XCAR (suffixes
);
971 suffixes
= XCDR (suffixes
);
976 lst
= Fcons (concat2 (suffix
, ext
), lst
);
979 return Fnreverse (lst
);
982 /* Returns true if STRING ends with SUFFIX */
984 suffix_p (Lisp_Object string
, const char *suffix
)
986 ptrdiff_t suffix_len
= strlen (suffix
);
987 ptrdiff_t string_len
= SBYTES (string
);
989 return string_len
>= suffix_len
&& !strcmp (SSDATA (string
) + string_len
- suffix_len
, suffix
);
992 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
993 doc
: /* Execute a file of Lisp code named FILE.
994 First try FILE with `.elc' appended, then try with `.el', then try
995 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
996 then try FILE unmodified (the exact suffixes in the exact order are
997 determined by `load-suffixes'). Environment variable references in
998 FILE are replaced with their values by calling `substitute-in-file-name'.
999 This function searches the directories in `load-path'.
1001 If optional second arg NOERROR is non-nil,
1002 report no error if FILE doesn't exist.
1003 Print messages at start and end of loading unless
1004 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1006 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1007 suffixes to the specified name FILE.
1008 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1009 the suffix `.elc' or `.el' or the module suffix; don't accept just
1010 FILE unless it ends in one of those suffixes or includes a directory name.
1012 If NOSUFFIX is nil, then if a file could not be found, try looking for
1013 a different representation of the file by adding non-empty suffixes to
1014 its name, before trying another file. Emacs uses this feature to find
1015 compressed versions of files when Auto Compression mode is enabled.
1016 If NOSUFFIX is non-nil, disable this feature.
1018 The suffixes that this function tries out, when NOSUFFIX is nil, are
1019 given by the return value of `get-load-suffixes' and the values listed
1020 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1021 return value of `get-load-suffixes' is used, i.e. the file name is
1022 required to have a non-empty suffix.
1024 When searching suffixes, this function normally stops at the first
1025 one that exists. If the option `load-prefer-newer' is non-nil,
1026 however, it tries all suffixes, and uses whichever file is the newest.
1028 Loading a file records its definitions, and its `provide' and
1029 `require' calls, in an element of `load-history' whose
1030 car is the file name loaded. See `load-history'.
1032 While the file is in the process of being loaded, the variable
1033 `load-in-progress' is non-nil and the variable `load-file-name'
1034 is bound to the file's name.
1036 Return t if the file exists and loads successfully. */)
1037 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1038 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1043 ptrdiff_t count
= SPECPDL_INDEX ();
1044 Lisp_Object found
, efound
, hist_file_name
;
1045 /* True means we printed the ".el is newer" message. */
1047 /* True means we are loading a compiled file. */
1049 Lisp_Object handler
;
1051 const char *fmode
= "r" FOPEN_TEXT
;
1054 CHECK_STRING (file
);
1056 /* If file name is magic, call the handler. */
1057 /* This shouldn't be necessary any more now that `openp' handles it right.
1058 handler = Ffind_file_name_handler (file, Qload);
1059 if (!NILP (handler))
1060 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1062 /* The presence of this call is the result of a historical accident:
1063 it used to be in every file-operation and when it got removed
1064 everywhere, it accidentally stayed here. Since then, enough people
1065 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1066 that it seemed risky to remove. */
1067 if (! NILP (noerror
))
1069 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1070 Qt
, load_error_handler
);
1075 file
= Fsubstitute_in_file_name (file
);
1077 /* Avoid weird lossage with null string as arg,
1078 since it would try to load a directory as a Lisp file. */
1079 if (SCHARS (file
) == 0)
1086 Lisp_Object suffixes
;
1089 if (! NILP (must_suffix
))
1091 /* Don't insist on adding a suffix if FILE already ends with one. */
1092 if (suffix_p (file
, ".el")
1093 || suffix_p (file
, ".elc")
1095 || suffix_p (file
, MODULES_SUFFIX
)
1099 /* Don't insist on adding a suffix
1100 if the argument includes a directory name. */
1101 else if (! NILP (Ffile_name_directory (file
)))
1105 if (!NILP (nosuffix
))
1109 suffixes
= Fget_load_suffixes ();
1110 if (NILP (must_suffix
))
1111 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1114 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1120 report_file_error ("Cannot open load file", file
);
1124 /* Tell startup.el whether or not we found the user's init file. */
1125 if (EQ (Qt
, Vuser_init_file
))
1126 Vuser_init_file
= found
;
1128 /* If FD is -2, that means openp found a magic file. */
1131 if (NILP (Fequal (found
, file
)))
1132 /* If FOUND is a different file name from FILE,
1133 find its handler even if we have already inhibited
1134 the `load' operation on FILE. */
1135 handler
= Ffind_file_name_handler (found
, Qt
);
1137 handler
= Ffind_file_name_handler (found
, Qload
);
1138 if (! NILP (handler
))
1139 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1141 /* Tramp has to deal with semi-broken packages that prepend
1142 drive letters to remote files. For that reason, Tramp
1143 catches file operations that test for file existence, which
1144 makes openp think X:/foo.elc files are remote. However,
1145 Tramp does not catch `load' operations for such files, so we
1146 end up with a nil as the `load' handler above. If we would
1147 continue with fd = -2, we will behave wrongly, and in
1148 particular try reading a .elc file in the "rt" mode instead
1149 of "rb". See bug #9311 for the results. To work around
1150 this, we try to open the file locally, and go with that if it
1152 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1160 /* Pacify older GCC with --enable-gcc-warnings. */
1161 IF_LINT (fd_index
= 0);
1165 fd_index
= SPECPDL_INDEX ();
1166 record_unwind_protect_int (close_file_unwind
, fd
);
1170 if (suffix_p (found
, MODULES_SUFFIX
))
1171 return unbind_to (count
, Fmodule_load (found
));
1174 /* Check if we're stuck in a recursive load cycle.
1176 2000-09-21: It's not possible to just check for the file loaded
1177 being a member of Vloads_in_progress. This fails because of the
1178 way the byte compiler currently works; `provide's are not
1179 evaluated, see font-lock.el/jit-lock.el as an example. This
1180 leads to a certain amount of ``normal'' recursion.
1182 Also, just loading a file recursively is not always an error in
1183 the general case; the second load may do something different. */
1187 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1188 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1189 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1190 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1191 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1194 /* All loads are by default dynamic, unless the file itself specifies
1195 otherwise using a file-variable in the first line. This is bound here
1196 so that it takes effect whether or not we use
1197 Vload_source_file_function. */
1198 specbind (Qlexical_binding
, Qnil
);
1200 /* Get the name for load-history. */
1201 hist_file_name
= (! NILP (Vpurify_flag
)
1202 ? concat2 (Ffile_name_directory (file
),
1203 Ffile_name_nondirectory (found
))
1208 /* Check for the presence of old-style quotes and warn about them. */
1209 specbind (Qold_style_backquotes
, Qnil
);
1210 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1212 if (suffix_p (found
, ".elc") || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1213 /* Load .elc files directly, but not when they are
1214 remote and have no handler! */
1222 && ! (version
= safe_to_load_version (fd
)))
1225 if (!load_dangerous_libraries
)
1226 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1227 else if (!NILP (nomessage
) && !force_load_messages
)
1228 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1233 efound
= ENCODE_FILE (found
);
1234 fmode
= "r" FOPEN_BINARY
;
1236 /* openp already checked for newness, no point doing it again.
1237 FIXME would be nice to get a message when openp
1238 ignores suffix order due to load_prefer_newer. */
1239 if (!load_prefer_newer
)
1241 result
= stat (SSDATA (efound
), &s1
);
1244 SSET (efound
, SBYTES (efound
) - 1, 0);
1245 result
= stat (SSDATA (efound
), &s2
);
1246 SSET (efound
, SBYTES (efound
) - 1, 'c');
1250 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1252 /* Make the progress messages mention that source is newer. */
1255 /* If we won't print another message, mention this anyway. */
1256 if (!NILP (nomessage
) && !force_load_messages
)
1258 Lisp_Object msg_file
;
1259 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1260 message_with_string ("Source file `%s' newer than byte-compiled file",
1264 } /* !load_prefer_newer */
1269 /* We are loading a source file (*.el). */
1270 if (!NILP (Vload_source_file_function
))
1277 clear_unwind_protect (fd_index
);
1279 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1280 NILP (noerror
) ? Qnil
: Qt
,
1281 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1282 return unbind_to (count
, val
);
1288 /* We somehow got here with fd == -2, meaning the file is deemed
1289 to be remote. Don't even try to reopen the file locally;
1290 just force a failure. */
1298 clear_unwind_protect (fd_index
);
1299 efound
= ENCODE_FILE (found
);
1300 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1302 stream
= fdopen (fd
, fmode
);
1306 report_file_error ("Opening stdio stream", file
);
1307 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1309 if (! NILP (Vpurify_flag
))
1310 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1312 if (NILP (nomessage
) || force_load_messages
)
1315 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1318 message_with_string ("Loading %s (source)...", file
, 1);
1320 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1322 else /* The typical case; compiled file newer than source file. */
1323 message_with_string ("Loading %s...", file
, 1);
1326 specbind (Qload_file_name
, found
);
1327 specbind (Qinhibit_file_name_operation
, Qnil
);
1328 specbind (Qload_in_progress
, Qt
);
1331 if (lisp_file_lexically_bound_p (Qget_file_char
))
1332 Fset (Qlexical_binding
, Qt
);
1334 if (! version
|| version
>= 22)
1335 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1336 0, Qnil
, Qnil
, Qnil
, Qnil
);
1339 /* We can't handle a file which was compiled with
1340 byte-compile-dynamic by older version of Emacs. */
1341 specbind (Qload_force_doc_strings
, Qt
);
1342 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1343 0, Qnil
, Qnil
, Qnil
, Qnil
);
1345 unbind_to (count
, Qnil
);
1347 /* Run any eval-after-load forms for this file. */
1348 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1349 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1351 xfree (saved_doc_string
);
1352 saved_doc_string
= 0;
1353 saved_doc_string_size
= 0;
1355 xfree (prev_saved_doc_string
);
1356 prev_saved_doc_string
= 0;
1357 prev_saved_doc_string_size
= 0;
1359 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1362 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1365 message_with_string ("Loading %s (source)...done", file
, 1);
1367 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1369 else /* The typical case; compiled file newer than source file. */
1370 message_with_string ("Loading %s...done", file
, 1);
1377 complete_filename_p (Lisp_Object pathname
)
1379 const unsigned char *s
= SDATA (pathname
);
1380 return (IS_DIRECTORY_SEP (s
[0])
1381 || (SCHARS (pathname
) > 2
1382 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1385 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1386 doc
: /* Search for FILENAME through PATH.
1387 Returns the file's name in absolute form, or nil if not found.
1388 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1389 file name when searching.
1390 If non-nil, PREDICATE is used instead of `file-readable-p'.
1391 PREDICATE can also be an integer to pass to the faccessat(2) function,
1392 in which case file-name-handlers are ignored.
1393 This function will normally skip directories, so if you want it to find
1394 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1395 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1398 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1399 if (NILP (predicate
) && fd
>= 0)
1404 /* Search for a file whose name is STR, looking in directories
1405 in the Lisp list PATH, and trying suffixes from SUFFIX.
1406 On success, return a file descriptor (or 1 or -2 as described below).
1407 On failure, return -1 and set errno.
1409 SUFFIXES is a list of strings containing possible suffixes.
1410 The empty suffix is automatically added if the list is empty.
1412 PREDICATE t means the files are binary.
1413 PREDICATE non-nil and non-t means don't open the files,
1414 just look for one that satisfies the predicate. In this case,
1415 return 1 on success. The predicate can be a lisp function or
1416 an integer to pass to `access' (in which case file-name-handlers
1419 If STOREPTR is nonzero, it points to a slot where the name of
1420 the file actually found should be stored as a Lisp string.
1421 nil is stored there on failure.
1423 If the file we find is remote, return -2
1424 but store the found remote file name in *STOREPTR.
1426 If NEWER is true, try all SUFFIXes and return the result for the
1427 newest file that exists. Does not apply to remote files,
1428 or if a non-nil and non-t PREDICATE is specified. */
1431 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1432 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1434 ptrdiff_t fn_size
= 100;
1438 ptrdiff_t want_length
;
1439 Lisp_Object filename
;
1440 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1441 ptrdiff_t max_suffix_len
= 0;
1442 int last_errno
= ENOENT
;
1446 /* The last-modified time of the newest matching file found.
1447 Initialize it to something less than all valid timestamps. */
1448 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1452 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1454 CHECK_STRING_CAR (tail
);
1455 max_suffix_len
= max (max_suffix_len
,
1456 SBYTES (XCAR (tail
)));
1459 string
= filename
= encoded_fn
= save_string
= Qnil
;
1464 absolute
= complete_filename_p (str
);
1466 for (; CONSP (path
); path
= XCDR (path
))
1468 filename
= Fexpand_file_name (str
, XCAR (path
));
1469 if (!complete_filename_p (filename
))
1470 /* If there are non-absolute elts in PATH (eg "."). */
1471 /* Of course, this could conceivably lose if luser sets
1472 default-directory to be something non-absolute... */
1474 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1475 if (!complete_filename_p (filename
))
1476 /* Give up on this path element! */
1480 /* Calculate maximum length of any filename made from
1481 this path element/specified file name and any possible suffix. */
1482 want_length
= max_suffix_len
+ SBYTES (filename
);
1483 if (fn_size
<= want_length
)
1485 fn_size
= 100 + want_length
;
1486 fn
= SAFE_ALLOCA (fn_size
);
1489 /* Loop over suffixes. */
1490 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1491 CONSP (tail
); tail
= XCDR (tail
))
1493 Lisp_Object suffix
= XCAR (tail
);
1494 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1495 Lisp_Object handler
;
1497 /* Concatenate path element/specified name with the suffix.
1498 If the directory starts with /:, remove that. */
1499 int prefixlen
= ((SCHARS (filename
) > 2
1500 && SREF (filename
, 0) == '/'
1501 && SREF (filename
, 1) == ':')
1503 fnlen
= SBYTES (filename
) - prefixlen
;
1504 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1505 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1507 /* Check that the file exists and is not a directory. */
1508 /* We used to only check for handlers on non-absolute file names:
1512 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1513 It's not clear why that was the case and it breaks things like
1514 (load "/bar.el") where the file is actually "/bar.el.gz". */
1515 /* make_string has its own ideas on when to return a unibyte
1516 string and when a multibyte string, but we know better.
1517 We must have a unibyte string when dumping, since
1518 file-name encoding is shaky at best at that time, and in
1519 particular default-file-name-coding-system is reset
1520 several times during loadup. We therefore don't want to
1521 encode the file before passing it to file I/O library
1523 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1524 string
= make_unibyte_string (fn
, fnlen
);
1526 string
= make_string (fn
, fnlen
);
1527 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1528 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1529 && !NATNUMP (predicate
))
1532 if (NILP (predicate
) || EQ (predicate
, Qt
))
1533 exists
= !NILP (Ffile_readable_p (string
));
1536 Lisp_Object tmp
= call1 (predicate
, string
);
1539 else if (EQ (tmp
, Qdir_ok
)
1540 || NILP (Ffile_directory_p (string
)))
1545 last_errno
= EISDIR
;
1551 /* We succeeded; return this descriptor and filename. */
1564 encoded_fn
= ENCODE_FILE (string
);
1565 pfn
= SSDATA (encoded_fn
);
1567 /* Check that we can access or open it. */
1568 if (NATNUMP (predicate
))
1571 if (INT_MAX
< XFASTINT (predicate
))
1572 last_errno
= EINVAL
;
1573 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1577 if (file_directory_p (pfn
))
1578 last_errno
= EISDIR
;
1585 int oflags
= O_RDONLY
+ (NILP (predicate
) ? 0 : O_BINARY
);
1586 fd
= emacs_open (pfn
, oflags
, 0);
1589 if (errno
!= ENOENT
)
1594 int err
= (fstat (fd
, &st
) != 0 ? errno
1595 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1607 if (newer
&& !NATNUMP (predicate
))
1609 struct timespec mtime
= get_stat_mtime (&st
);
1611 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1616 emacs_close (save_fd
);
1619 save_string
= string
;
1624 /* We succeeded; return this descriptor and filename. */
1632 /* No more suffixes. Return the newest. */
1633 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1636 *storeptr
= save_string
;
1652 /* Merge the list we've accumulated of globals from the current input source
1653 into the load_history variable. The details depend on whether
1654 the source has an associated file name or not.
1656 FILENAME is the file name that we are loading from.
1658 ENTIRE is true if loading that entire file, false if evaluating
1662 build_load_history (Lisp_Object filename
, bool entire
)
1664 Lisp_Object tail
, prev
, newelt
;
1665 Lisp_Object tem
, tem2
;
1668 tail
= Vload_history
;
1671 while (CONSP (tail
))
1675 /* Find the feature's previous assoc list... */
1676 if (!NILP (Fequal (filename
, Fcar (tem
))))
1680 /* If we're loading the entire file, remove old data. */
1684 Vload_history
= XCDR (tail
);
1686 Fsetcdr (prev
, XCDR (tail
));
1689 /* Otherwise, cons on new symbols that are not already members. */
1692 tem2
= Vcurrent_load_list
;
1694 while (CONSP (tem2
))
1696 newelt
= XCAR (tem2
);
1698 if (NILP (Fmember (newelt
, tem
)))
1699 Fsetcar (tail
, Fcons (XCAR (tem
),
1700 Fcons (newelt
, XCDR (tem
))));
1713 /* If we're loading an entire file, cons the new assoc onto the
1714 front of load-history, the most-recently-loaded position. Also
1715 do this if we didn't find an existing member for the file. */
1716 if (entire
|| !foundit
)
1717 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1722 readevalloop_1 (int old
)
1724 load_convert_to_unibyte
= old
;
1727 /* Signal an `end-of-file' error, if possible with file name
1730 static _Noreturn
void
1731 end_of_file_error (void)
1733 if (STRINGP (Vload_file_name
))
1734 xsignal1 (Qend_of_file
, Vload_file_name
);
1736 xsignal0 (Qend_of_file
);
1740 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1742 /* If we macroexpand the toplevel form non-recursively and it ends
1743 up being a `progn' (or if it was a progn to start), treat each
1744 form in the progn as a top-level form. This way, if one form in
1745 the progn defines a macro, that macro is in effect when we expand
1746 the remaining forms. See similar code in bytecomp.el. */
1747 val
= call2 (macroexpand
, val
, Qnil
);
1748 if (EQ (CAR_SAFE (val
), Qprogn
))
1750 Lisp_Object subforms
= XCDR (val
);
1752 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1753 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1757 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1761 /* UNIBYTE specifies how to set load_convert_to_unibyte
1762 for this invocation.
1763 READFUN, if non-nil, is used instead of `read'.
1765 START, END specify region to read in current buffer (from eval-region).
1766 If the input is not from a buffer, they must be nil. */
1769 readevalloop (Lisp_Object readcharfun
,
1771 Lisp_Object sourcename
,
1773 Lisp_Object unibyte
, Lisp_Object readfun
,
1774 Lisp_Object start
, Lisp_Object end
)
1778 ptrdiff_t count
= SPECPDL_INDEX ();
1779 struct buffer
*b
= 0;
1780 bool continue_reading_p
;
1781 Lisp_Object lex_bound
;
1782 /* True if reading an entire buffer. */
1783 bool whole_buffer
= 0;
1784 /* True on the first time around. */
1785 bool first_sexp
= 1;
1786 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1788 if (NILP (Ffboundp (macroexpand
))
1789 /* Don't macroexpand in .elc files, since it should have been done
1790 already. We actually don't know whether we're in a .elc file or not,
1791 so we use circumstantial evidence: .el files normally go through
1792 Vload_source_file_function -> load-with-code-conversion
1794 || EQ (readcharfun
, Qget_file_char
)
1795 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1798 if (MARKERP (readcharfun
))
1801 start
= readcharfun
;
1804 if (BUFFERP (readcharfun
))
1805 b
= XBUFFER (readcharfun
);
1806 else if (MARKERP (readcharfun
))
1807 b
= XMARKER (readcharfun
)->buffer
;
1809 /* We assume START is nil when input is not from a buffer. */
1810 if (! NILP (start
) && !b
)
1813 specbind (Qstandard_input
, readcharfun
);
1814 specbind (Qcurrent_load_list
, Qnil
);
1815 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1816 load_convert_to_unibyte
= !NILP (unibyte
);
1818 /* If lexical binding is active (either because it was specified in
1819 the file's header, or via a buffer-local variable), create an empty
1820 lexical environment, otherwise, turn off lexical binding. */
1821 lex_bound
= find_symbol_value (Qlexical_binding
);
1822 specbind (Qinternal_interpreter_environment
,
1823 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1824 ? Qnil
: list1 (Qt
)));
1826 /* Try to ensure sourcename is a truename, except whilst preloading. */
1827 if (NILP (Vpurify_flag
)
1828 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1829 && !NILP (Ffboundp (Qfile_truename
)))
1830 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1832 LOADHIST_ATTACH (sourcename
);
1834 continue_reading_p
= 1;
1835 while (continue_reading_p
)
1837 ptrdiff_t count1
= SPECPDL_INDEX ();
1839 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1840 error ("Reading from killed buffer");
1844 /* Switch to the buffer we are reading from. */
1845 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1846 set_buffer_internal (b
);
1848 /* Save point in it. */
1849 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1850 /* Save ZV in it. */
1851 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1852 /* Those get unbound after we read one expression. */
1854 /* Set point and ZV around stuff to be read. */
1857 Fnarrow_to_region (make_number (BEGV
), end
);
1859 /* Just for cleanliness, convert END to a marker
1860 if it is an integer. */
1862 end
= Fpoint_max_marker ();
1865 /* On the first cycle, we can easily test here
1866 whether we are reading the whole buffer. */
1867 if (b
&& first_sexp
)
1868 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1875 while ((c
= READCHAR
) != '\n' && c
!= -1);
1880 unbind_to (count1
, Qnil
);
1884 /* Ignore whitespace here, so we can detect eof. */
1885 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1886 || c
== NO_BREAK_SPACE
)
1889 if (!NILP (Vpurify_flag
) && c
== '(')
1891 val
= read_list (0, readcharfun
);
1896 read_objects
= Qnil
;
1897 if (!NILP (readfun
))
1899 val
= call1 (readfun
, readcharfun
);
1901 /* If READCHARFUN has set point to ZV, we should
1902 stop reading, even if the form read sets point
1903 to a different value when evaluated. */
1904 if (BUFFERP (readcharfun
))
1906 struct buffer
*buf
= XBUFFER (readcharfun
);
1907 if (BUF_PT (buf
) == BUF_ZV (buf
))
1908 continue_reading_p
= 0;
1911 else if (! NILP (Vload_read_function
))
1912 val
= call1 (Vload_read_function
, readcharfun
);
1914 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1917 if (!NILP (start
) && continue_reading_p
)
1918 start
= Fpoint_marker ();
1920 /* Restore saved point and BEGV. */
1921 unbind_to (count1
, Qnil
);
1923 /* Now eval what we just read. */
1924 if (!NILP (macroexpand
))
1925 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1927 val
= eval_sub (val
);
1931 Vvalues
= Fcons (val
, Vvalues
);
1932 if (EQ (Vstandard_output
, Qt
))
1941 build_load_history (sourcename
,
1942 stream
|| whole_buffer
);
1944 unbind_to (count
, Qnil
);
1947 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1948 doc
: /* Execute the accessible portion of current buffer as Lisp code.
1949 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
1950 When called from a Lisp program (i.e., not interactively), this
1951 function accepts up to five optional arguments:
1952 BUFFER is the buffer to evaluate (nil means use current buffer),
1953 or a name of a buffer (a string).
1954 PRINTFLAG controls printing of output by any output functions in the
1955 evaluated code, such as `print', `princ', and `prin1':
1956 a value of nil means discard it; anything else is the stream to print to.
1957 See Info node `(elisp)Output Streams' for details on streams.
1958 FILENAME specifies the file name to use for `load-history'.
1959 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1961 DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
1962 evaluated code should work normally even if PRINTFLAG is nil, in
1963 which case the output is displayed in the echo area.
1965 This function preserves the position of point. */)
1966 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1968 ptrdiff_t count
= SPECPDL_INDEX ();
1969 Lisp_Object tem
, buf
;
1972 buf
= Fcurrent_buffer ();
1974 buf
= Fget_buffer (buffer
);
1976 error ("No such buffer");
1978 if (NILP (printflag
) && NILP (do_allow_print
))
1983 if (NILP (filename
))
1984 filename
= BVAR (XBUFFER (buf
), filename
);
1986 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1987 specbind (Qstandard_output
, tem
);
1988 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1989 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1990 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1991 readevalloop (buf
, 0, filename
,
1992 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1993 unbind_to (count
, Qnil
);
1998 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1999 doc
: /* Execute the region as Lisp code.
2000 When called from programs, expects two arguments,
2001 giving starting and ending indices in the current buffer
2002 of the text to be executed.
2003 Programs can pass third argument PRINTFLAG which controls output:
2004 a value of nil means discard it; anything else is stream for printing it.
2005 See Info node `(elisp)Output Streams' for details on streams.
2006 Also the fourth argument READ-FUNCTION, if non-nil, is used
2007 instead of `read' to read each expression. It gets one argument
2008 which is the input stream for reading characters.
2010 This function does not move point. */)
2011 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2013 /* FIXME: Do the eval-sexp-add-defvars dance! */
2014 ptrdiff_t count
= SPECPDL_INDEX ();
2015 Lisp_Object tem
, cbuf
;
2017 cbuf
= Fcurrent_buffer ();
2019 if (NILP (printflag
))
2023 specbind (Qstandard_output
, tem
);
2024 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2026 /* `readevalloop' calls functions which check the type of start and end. */
2027 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2028 !NILP (printflag
), Qnil
, read_function
,
2031 return unbind_to (count
, Qnil
);
2035 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2036 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2037 If STREAM is nil, use the value of `standard-input' (which see).
2038 STREAM or the value of `standard-input' may be:
2039 a buffer (read from point and advance it)
2040 a marker (read from where it points and advance it)
2041 a function (call it with no arguments for each character,
2042 call it with a char as argument to push a char back)
2043 a string (takes text from string, starting at the beginning)
2044 t (read text line using minibuffer and use it, or read from
2045 standard input in batch mode). */)
2046 (Lisp_Object stream
)
2049 stream
= Vstandard_input
;
2050 if (EQ (stream
, Qt
))
2051 stream
= Qread_char
;
2052 if (EQ (stream
, Qread_char
))
2053 /* FIXME: ?! When is this used !? */
2054 return call1 (intern ("read-minibuffer"),
2055 build_string ("Lisp expression: "));
2057 return read_internal_start (stream
, Qnil
, Qnil
);
2060 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2061 doc
: /* Read one Lisp expression which is represented as text by STRING.
2062 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2063 FINAL-STRING-INDEX is an integer giving the position of the next
2064 remaining character in STRING. START and END optionally delimit
2065 a substring of STRING from which to read; they default to 0 and
2066 \(length STRING) respectively. Negative values are counted from
2067 the end of STRING. */)
2068 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2071 CHECK_STRING (string
);
2072 /* `read_internal_start' sets `read_from_string_index'. */
2073 ret
= read_internal_start (string
, start
, end
);
2074 return Fcons (ret
, make_number (read_from_string_index
));
2077 /* Function to set up the global context we need in toplevel read
2078 calls. START and END only used when STREAM is a string. */
2080 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2085 new_backquote_flag
= 0;
2086 read_objects
= Qnil
;
2087 if (EQ (Vread_with_symbol_positions
, Qt
)
2088 || EQ (Vread_with_symbol_positions
, stream
))
2089 Vread_symbol_positions_list
= Qnil
;
2091 if (STRINGP (stream
)
2092 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2094 ptrdiff_t startval
, endval
;
2097 if (STRINGP (stream
))
2100 string
= XCAR (stream
);
2102 validate_subarray (string
, start
, end
, SCHARS (string
),
2103 &startval
, &endval
);
2105 read_from_string_index
= startval
;
2106 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2107 read_from_string_limit
= endval
;
2110 retval
= read0 (stream
);
2111 if (EQ (Vread_with_symbol_positions
, Qt
)
2112 || EQ (Vread_with_symbol_positions
, stream
))
2113 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2118 /* Signal Qinvalid_read_syntax error.
2119 S is error string of length N (if > 0) */
2121 static _Noreturn
void
2122 invalid_syntax (const char *s
)
2124 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2128 /* Use this for recursive reads, in contexts where internal tokens
2132 read0 (Lisp_Object readcharfun
)
2134 register Lisp_Object val
;
2137 val
= read1 (readcharfun
, &c
, 0);
2141 xsignal1 (Qinvalid_read_syntax
,
2142 Fmake_string (make_number (1), make_number (c
)));
2145 static ptrdiff_t read_buffer_size
;
2146 static char *read_buffer
;
2148 /* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes. */
2151 grow_read_buffer (void)
2153 read_buffer
= xpalloc (read_buffer
, &read_buffer_size
,
2154 MAX_MULTIBYTE_LENGTH
, -1, 1);
2157 /* Read a \-escape sequence, assuming we already read the `\'.
2158 If the escape sequence forces unibyte, return eight-bit char. */
2161 read_escape (Lisp_Object readcharfun
, bool stringp
)
2164 /* \u allows up to four hex digits, \U up to eight. Default to the
2165 behavior for \u, and change this value in the case that \U is seen. */
2166 int unicode_hex_count
= 4;
2171 end_of_file_error ();
2201 error ("Invalid escape character syntax");
2204 c
= read_escape (readcharfun
, 0);
2205 return c
| meta_modifier
;
2210 error ("Invalid escape character syntax");
2213 c
= read_escape (readcharfun
, 0);
2214 return c
| shift_modifier
;
2219 error ("Invalid escape character syntax");
2222 c
= read_escape (readcharfun
, 0);
2223 return c
| hyper_modifier
;
2228 error ("Invalid escape character syntax");
2231 c
= read_escape (readcharfun
, 0);
2232 return c
| alt_modifier
;
2236 if (stringp
|| c
!= '-')
2243 c
= read_escape (readcharfun
, 0);
2244 return c
| super_modifier
;
2249 error ("Invalid escape character syntax");
2253 c
= read_escape (readcharfun
, 0);
2254 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2255 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2256 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2257 return c
| ctrl_modifier
;
2258 /* ASCII control chars are made from letters (both cases),
2259 as well as the non-letters within 0100...0137. */
2260 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2261 return (c
& (037 | ~0177));
2262 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2263 return (c
& (037 | ~0177));
2265 return c
| ctrl_modifier
;
2275 /* An octal escape, as in ANSI C. */
2277 register int i
= c
- '0';
2278 register int count
= 0;
2281 if ((c
= READCHAR
) >= '0' && c
<= '7')
2293 if (i
>= 0x80 && i
< 0x100)
2294 i
= BYTE8_TO_CHAR (i
);
2299 /* A hex escape, as in ANSI C. */
2306 if (c
>= '0' && c
<= '9')
2311 else if ((c
>= 'a' && c
<= 'f')
2312 || (c
>= 'A' && c
<= 'F'))
2315 if (c
>= 'a' && c
<= 'f')
2325 /* Allow hex escapes as large as ?\xfffffff, because some
2326 packages use them to denote characters with modifiers. */
2327 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2328 error ("Hex character out of range: \\x%x...", i
);
2332 if (count
< 3 && i
>= 0x80)
2333 return BYTE8_TO_CHAR (i
);
2338 /* Post-Unicode-2.0: Up to eight hex chars. */
2339 unicode_hex_count
= 8;
2342 /* A Unicode escape. We only permit them in strings and characters,
2343 not arbitrarily in the source code, as in some other languages. */
2348 while (++count
<= unicode_hex_count
)
2351 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2353 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2354 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2355 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2357 error ("Non-hex digit used for Unicode escape");
2360 error ("Non-Unicode character: 0x%x", i
);
2369 /* Return the digit that CHARACTER stands for in the given BASE.
2370 Return -1 if CHARACTER is out of range for BASE,
2371 and -2 if CHARACTER is not valid for any supported BASE. */
2373 digit_to_number (int character
, int base
)
2377 if ('0' <= character
&& character
<= '9')
2378 digit
= character
- '0';
2379 else if ('a' <= character
&& character
<= 'z')
2380 digit
= character
- 'a' + 10;
2381 else if ('A' <= character
&& character
<= 'Z')
2382 digit
= character
- 'A' + 10;
2386 return digit
< base
? digit
: -1;
2389 /* Read an integer in radix RADIX using READCHARFUN to read
2390 characters. RADIX must be in the interval [2..36]; if it isn't, a
2391 read error is signaled . Value is the integer read. Signals an
2392 error if encountering invalid read syntax or if RADIX is out of
2396 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2398 /* Room for sign, leading 0, other digits, trailing null byte.
2399 Also, room for invalid syntax diagnostic. */
2400 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2401 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2403 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2405 if (radix
< 2 || radix
> 36)
2413 if (c
== '-' || c
== '+')
2424 /* Ignore redundant leading zeros, so the buffer doesn't
2425 fill up with them. */
2431 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2438 if (p
< buf
+ sizeof buf
- 1)
2452 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2453 invalid_syntax (buf
);
2456 return string_to_number (buf
, radix
, 0);
2460 /* If the next token is ')' or ']' or '.', we store that character
2461 in *PCH and the return value is not interesting. Else, we store
2462 zero in *PCH and we read and return one lisp object.
2464 FIRST_IN_LIST is true if this is the first element of a list. */
2467 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2470 bool uninterned_symbol
= 0;
2477 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2479 end_of_file_error ();
2484 return read_list (0, readcharfun
);
2487 return read_vector (readcharfun
, 0);
2503 /* Accept extended format for hashtables (extensible to
2505 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2506 Lisp_Object tmp
= read_list (0, readcharfun
);
2507 Lisp_Object head
= CAR_SAFE (tmp
);
2508 Lisp_Object data
= Qnil
;
2509 Lisp_Object val
= Qnil
;
2510 /* The size is 2 * number of allowed keywords to
2512 Lisp_Object params
[10];
2514 Lisp_Object key
= Qnil
;
2515 int param_count
= 0;
2517 if (!EQ (head
, Qhash_table
))
2518 error ("Invalid extended read marker at head of #s list "
2519 "(only hash-table allowed)");
2521 tmp
= CDR_SAFE (tmp
);
2523 /* This is repetitive but fast and simple. */
2524 params
[param_count
] = QCsize
;
2525 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2526 if (!NILP (params
[param_count
+ 1]))
2529 params
[param_count
] = QCtest
;
2530 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2531 if (!NILP (params
[param_count
+ 1]))
2534 params
[param_count
] = QCweakness
;
2535 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2536 if (!NILP (params
[param_count
+ 1]))
2539 params
[param_count
] = QCrehash_size
;
2540 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2541 if (!NILP (params
[param_count
+ 1]))
2544 params
[param_count
] = QCrehash_threshold
;
2545 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2546 if (!NILP (params
[param_count
+ 1]))
2549 /* This is the hashtable data. */
2550 data
= Fplist_get (tmp
, Qdata
);
2552 /* Now use params to make a new hashtable and fill it. */
2553 ht
= Fmake_hash_table (param_count
, params
);
2555 while (CONSP (data
))
2560 error ("Odd number of elements in hashtable data");
2563 Fputhash (key
, val
, ht
);
2569 invalid_syntax ("#");
2577 tmp
= read_vector (readcharfun
, 0);
2578 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2579 error ("Invalid size char-table");
2580 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2588 /* Sub char-table can't be read as a regular
2589 vector because of a two C integer fields. */
2590 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2591 ptrdiff_t size
= XINT (Flength (tmp
));
2592 int i
, depth
, min_char
;
2593 struct Lisp_Cons
*cell
;
2596 error ("Zero-sized sub char-table");
2598 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2599 error ("Invalid depth in sub char-table");
2600 depth
= XINT (XCAR (tmp
));
2601 if (chartab_size
[depth
] != size
- 2)
2602 error ("Invalid size in sub char-table");
2603 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2606 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2607 error ("Invalid minimum character in sub-char-table");
2608 min_char
= XINT (XCAR (tmp
));
2609 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2612 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2613 for (i
= 0; i
< size
; i
++)
2615 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2616 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2621 invalid_syntax ("#^^");
2623 invalid_syntax ("#^");
2628 length
= read1 (readcharfun
, pch
, first_in_list
);
2632 Lisp_Object tmp
, val
;
2633 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2634 unsigned char *data
;
2637 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2638 if (STRING_MULTIBYTE (tmp
)
2639 || (size_in_chars
!= SCHARS (tmp
)
2640 /* We used to print 1 char too many
2641 when the number of bits was a multiple of 8.
2642 Accept such input in case it came from an old
2644 && ! (XFASTINT (length
)
2645 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2646 invalid_syntax ("#&...");
2648 val
= make_uninit_bool_vector (XFASTINT (length
));
2649 data
= bool_vector_uchar_data (val
);
2650 memcpy (data
, SDATA (tmp
), size_in_chars
);
2651 /* Clear the extraneous bits in the last byte. */
2652 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2653 data
[size_in_chars
- 1]
2654 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2657 invalid_syntax ("#&...");
2661 /* Accept compiled functions at read-time so that we don't have to
2662 build them using function calls. */
2664 struct Lisp_Vector
*vec
;
2665 tmp
= read_vector (readcharfun
, 1);
2666 vec
= XVECTOR (tmp
);
2667 if (vec
->header
.size
== 0)
2668 invalid_syntax ("Empty byte-code object");
2669 make_byte_code (vec
);
2677 /* Read the string itself. */
2678 tmp
= read1 (readcharfun
, &ch
, 0);
2679 if (ch
!= 0 || !STRINGP (tmp
))
2680 invalid_syntax ("#");
2681 /* Read the intervals and their properties. */
2684 Lisp_Object beg
, end
, plist
;
2686 beg
= read1 (readcharfun
, &ch
, 0);
2691 end
= read1 (readcharfun
, &ch
, 0);
2693 plist
= read1 (readcharfun
, &ch
, 0);
2695 invalid_syntax ("Invalid string property list");
2696 Fset_text_properties (beg
, end
, plist
, tmp
);
2702 /* #@NUMBER is used to skip NUMBER following bytes.
2703 That's used in .elc files to skip over doc strings
2704 and function definitions. */
2707 enum { extra
= 100 };
2708 ptrdiff_t i
, nskip
= 0, digits
= 0;
2710 /* Read a decimal integer. */
2711 while ((c
= READCHAR
) >= 0
2712 && c
>= '0' && c
<= '9')
2714 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2719 if (digits
== 2 && nskip
== 0)
2720 { /* We've just seen #@00, which means "skip to end". */
2721 skip_dyn_eof (readcharfun
);
2726 /* We can't use UNREAD here, because in the code below we side-step
2727 READCHAR. Instead, assume the first char after #@NNN occupies
2728 a single byte, which is the case normally since it's just
2734 if (load_force_doc_strings
2735 && (FROM_FILE_P (readcharfun
)))
2737 /* If we are supposed to force doc strings into core right now,
2738 record the last string that we skipped,
2739 and record where in the file it comes from. */
2741 /* But first exchange saved_doc_string
2742 with prev_saved_doc_string, so we save two strings. */
2744 char *temp
= saved_doc_string
;
2745 ptrdiff_t temp_size
= saved_doc_string_size
;
2746 file_offset temp_pos
= saved_doc_string_position
;
2747 ptrdiff_t temp_len
= saved_doc_string_length
;
2749 saved_doc_string
= prev_saved_doc_string
;
2750 saved_doc_string_size
= prev_saved_doc_string_size
;
2751 saved_doc_string_position
= prev_saved_doc_string_position
;
2752 saved_doc_string_length
= prev_saved_doc_string_length
;
2754 prev_saved_doc_string
= temp
;
2755 prev_saved_doc_string_size
= temp_size
;
2756 prev_saved_doc_string_position
= temp_pos
;
2757 prev_saved_doc_string_length
= temp_len
;
2760 if (saved_doc_string_size
== 0)
2762 saved_doc_string
= xmalloc (nskip
+ extra
);
2763 saved_doc_string_size
= nskip
+ extra
;
2765 if (nskip
> saved_doc_string_size
)
2767 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2768 saved_doc_string_size
= nskip
+ extra
;
2771 saved_doc_string_position
= file_tell (instream
);
2773 /* Copy that many characters into saved_doc_string. */
2775 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2776 saved_doc_string
[i
] = c
= getc (instream
);
2779 saved_doc_string_length
= i
;
2782 /* Skip that many bytes. */
2783 skip_dyn_bytes (readcharfun
, nskip
);
2789 /* #! appears at the beginning of an executable file.
2790 Skip the first line. */
2791 while (c
!= '\n' && c
>= 0)
2796 return Vload_file_name
;
2798 return list2 (Qfunction
, read0 (readcharfun
));
2799 /* #:foo is the uninterned symbol named foo. */
2802 uninterned_symbol
= 1;
2805 && c
!= NO_BREAK_SPACE
2807 || strchr ("\"';()[]#`,", c
) == NULL
)))
2809 /* No symbol character follows, this is the empty
2812 return Fmake_symbol (empty_unibyte_string
);
2816 /* ## is the empty symbol. */
2818 return Fintern (empty_unibyte_string
, Qnil
);
2819 /* Reader forms that can reuse previously read objects. */
2820 if (c
>= '0' && c
<= '9')
2825 /* Read a non-negative integer. */
2826 while (c
>= '0' && c
<= '9')
2828 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2829 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2830 n
= MOST_POSITIVE_FIXNUM
+ 1;
2832 n
= n
* 10 + c
- '0';
2836 if (n
<= MOST_POSITIVE_FIXNUM
)
2838 if (c
== 'r' || c
== 'R')
2839 return read_integer (readcharfun
, n
);
2841 if (! NILP (Vread_circle
))
2843 /* #n=object returns object, but associates it with
2847 /* Make a placeholder for #n# to use temporarily. */
2848 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2849 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2850 read_objects
= Fcons (cell
, read_objects
);
2852 /* Read the object itself. */
2853 tem
= read0 (readcharfun
);
2855 /* Now put it everywhere the placeholder was... */
2856 substitute_object_in_subtree (tem
, placeholder
);
2858 /* ...and #n# will use the real value from now on. */
2859 Fsetcdr (cell
, tem
);
2864 /* #n# returns a previously read object. */
2867 tem
= Fassq (make_number (n
), read_objects
);
2873 /* Fall through to error message. */
2875 else if (c
== 'x' || c
== 'X')
2876 return read_integer (readcharfun
, 16);
2877 else if (c
== 'o' || c
== 'O')
2878 return read_integer (readcharfun
, 8);
2879 else if (c
== 'b' || c
== 'B')
2880 return read_integer (readcharfun
, 2);
2883 invalid_syntax ("#");
2886 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2890 return list2 (Qquote
, read0 (readcharfun
));
2894 int next_char
= READCHAR
;
2896 /* Transition from old-style to new-style:
2897 If we see "(`" it used to mean old-style, which usually works
2898 fine because ` should almost never appear in such a position
2899 for new-style. But occasionally we need "(`" to mean new
2900 style, so we try to distinguish the two by the fact that we
2901 can either write "( `foo" or "(` foo", where the first
2902 intends to use new-style whereas the second intends to use
2903 old-style. For Emacs-25, we should completely remove this
2904 first_in_list exception (old-style can still be obtained via
2906 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2908 Vold_style_backquotes
= Qt
;
2914 bool saved_new_backquote_flag
= new_backquote_flag
;
2916 new_backquote_flag
= 1;
2917 value
= read0 (readcharfun
);
2918 new_backquote_flag
= saved_new_backquote_flag
;
2920 return list2 (Qbackquote
, value
);
2925 int next_char
= READCHAR
;
2927 /* Transition from old-style to new-style:
2928 It used to be impossible to have a new-style , other than within
2929 a new-style `. This is sufficient when ` and , are used in the
2930 normal way, but ` and , can also appear in args to macros that
2931 will not interpret them in the usual way, in which case , may be
2932 used without any ` anywhere near.
2933 So we now use the same heuristic as for backquote: old-style
2934 unquotes are only recognized when first on a list, and when
2935 followed by a space.
2936 Because it's more difficult to peek 2 chars ahead, a new-style
2937 ,@ can still not be used outside of a `, unless it's in the middle
2939 if (new_backquote_flag
2941 || (next_char
!= ' ' && next_char
!= '@'))
2943 Lisp_Object comma_type
= Qnil
;
2948 comma_type
= Qcomma_at
;
2950 comma_type
= Qcomma_dot
;
2953 if (ch
>= 0) UNREAD (ch
);
2954 comma_type
= Qcomma
;
2957 value
= read0 (readcharfun
);
2958 return list2 (comma_type
, value
);
2962 Vold_style_backquotes
= Qt
;
2974 end_of_file_error ();
2976 /* Accept `single space' syntax like (list ? x) where the
2977 whitespace character is SPC or TAB.
2978 Other literal whitespace like NL, CR, and FF are not accepted,
2979 as there are well-established escape sequences for these. */
2980 if (c
== ' ' || c
== '\t')
2981 return make_number (c
);
2984 c
= read_escape (readcharfun
, 0);
2985 modifiers
= c
& CHAR_MODIFIER_MASK
;
2986 c
&= ~CHAR_MODIFIER_MASK
;
2987 if (CHAR_BYTE8_P (c
))
2988 c
= CHAR_TO_BYTE8 (c
);
2991 next_char
= READCHAR
;
2992 ok
= (next_char
<= 040
2993 || (next_char
< 0200
2994 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2997 return make_number (c
);
2999 invalid_syntax ("?");
3004 char *p
= read_buffer
;
3005 char *end
= read_buffer
+ read_buffer_size
;
3007 /* True if we saw an escape sequence specifying
3008 a multibyte character. */
3009 bool force_multibyte
= 0;
3010 /* True if we saw an escape sequence specifying
3011 a single-byte character. */
3012 bool force_singlebyte
= 0;
3014 ptrdiff_t nchars
= 0;
3016 while ((ch
= READCHAR
) >= 0
3019 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3021 ptrdiff_t offset
= p
- read_buffer
;
3022 grow_read_buffer ();
3023 p
= read_buffer
+ offset
;
3024 end
= read_buffer
+ read_buffer_size
;
3031 ch
= read_escape (readcharfun
, 1);
3033 /* CH is -1 if \ newline or \ space has just been seen. */
3036 if (p
== read_buffer
)
3041 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3042 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3044 if (CHAR_BYTE8_P (ch
))
3045 force_singlebyte
= 1;
3046 else if (! ASCII_CHAR_P (ch
))
3047 force_multibyte
= 1;
3048 else /* I.e. ASCII_CHAR_P (ch). */
3050 /* Allow `\C- ' and `\C-?'. */
3051 if (modifiers
== CHAR_CTL
)
3054 ch
= 0, modifiers
= 0;
3056 ch
= 127, modifiers
= 0;
3058 if (modifiers
& CHAR_SHIFT
)
3060 /* Shift modifier is valid only with [A-Za-z]. */
3061 if (ch
>= 'A' && ch
<= 'Z')
3062 modifiers
&= ~CHAR_SHIFT
;
3063 else if (ch
>= 'a' && ch
<= 'z')
3064 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3067 if (modifiers
& CHAR_META
)
3069 /* Move the meta bit to the right place for a
3071 modifiers
&= ~CHAR_META
;
3072 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3073 force_singlebyte
= 1;
3077 /* Any modifiers remaining are invalid. */
3079 error ("Invalid modifier in string");
3080 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3084 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3085 if (CHAR_BYTE8_P (ch
))
3086 force_singlebyte
= 1;
3087 else if (! ASCII_CHAR_P (ch
))
3088 force_multibyte
= 1;
3094 end_of_file_error ();
3096 /* If purifying, and string starts with \ newline,
3097 return zero instead. This is for doc strings
3098 that we are really going to find in etc/DOC.nn.nn. */
3099 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3100 return make_number (0);
3102 if (! force_multibyte
&& force_singlebyte
)
3104 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3105 forms. Convert it to unibyte. */
3106 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3108 p
= read_buffer
+ nchars
;
3111 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3113 || (p
- read_buffer
!= nchars
)));
3118 int next_char
= READCHAR
;
3121 if (next_char
<= 040
3122 || (next_char
< 0200
3123 && strchr ("\"';([#?`,", next_char
) != NULL
))
3129 /* Otherwise, we fall through! Note that the atom-reading loop
3130 below will now loop at least once, assuring that we will not
3131 try to UNREAD two characters in a row. */
3135 if (c
<= 040) goto retry
;
3136 if (c
== NO_BREAK_SPACE
)
3141 char *p
= read_buffer
;
3143 EMACS_INT start_position
= readchar_count
- 1;
3146 char *end
= read_buffer
+ read_buffer_size
;
3150 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3152 ptrdiff_t offset
= p
- read_buffer
;
3153 grow_read_buffer ();
3154 p
= read_buffer
+ offset
;
3155 end
= read_buffer
+ read_buffer_size
;
3162 end_of_file_error ();
3167 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3173 && c
!= NO_BREAK_SPACE
3175 || strchr ("\"';()[]#`,", c
) == NULL
));
3179 ptrdiff_t offset
= p
- read_buffer
;
3180 grow_read_buffer ();
3181 p
= read_buffer
+ offset
;
3182 end
= read_buffer
+ read_buffer_size
;
3188 if (!quoted
&& !uninterned_symbol
)
3190 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3191 if (! NILP (result
))
3195 Lisp_Object name
, result
;
3196 ptrdiff_t nbytes
= p
- read_buffer
;
3199 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3203 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3204 ? make_pure_string
: make_specified_string
)
3205 (read_buffer
, nchars
, nbytes
, multibyte
));
3206 result
= (uninterned_symbol
? Fmake_symbol (name
)
3207 : Fintern (name
, Qnil
));
3209 if (EQ (Vread_with_symbol_positions
, Qt
)
3210 || EQ (Vread_with_symbol_positions
, readcharfun
))
3211 Vread_symbol_positions_list
3212 = Fcons (Fcons (result
, make_number (start_position
)),
3213 Vread_symbol_positions_list
);
3221 /* List of nodes we've seen during substitute_object_in_subtree. */
3222 static Lisp_Object seen_list
;
3225 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3227 Lisp_Object check_object
;
3229 /* We haven't seen any objects when we start. */
3232 /* Make all the substitutions. */
3234 = substitute_object_recurse (object
, placeholder
, object
);
3236 /* Clear seen_list because we're done with it. */
3239 /* The returned object here is expected to always eq the
3241 if (!EQ (check_object
, object
))
3242 error ("Unexpected mutation error in reader");
3245 /* Feval doesn't get called from here, so no gc protection is needed. */
3246 #define SUBSTITUTE(get_val, set_val) \
3248 Lisp_Object old_value = get_val; \
3249 Lisp_Object true_value \
3250 = substitute_object_recurse (object, placeholder, \
3253 if (!EQ (old_value, true_value)) \
3260 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3262 /* If we find the placeholder, return the target object. */
3263 if (EQ (placeholder
, subtree
))
3266 /* If we've been to this node before, don't explore it again. */
3267 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3270 /* If this node can be the entry point to a cycle, remember that
3271 we've seen it. It can only be such an entry point if it was made
3272 by #n=, which means that we can find it as a value in
3274 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3275 seen_list
= Fcons (subtree
, seen_list
);
3277 /* Recurse according to subtree's type.
3278 Every branch must return a Lisp_Object. */
3279 switch (XTYPE (subtree
))
3281 case Lisp_Vectorlike
:
3283 ptrdiff_t i
= 0, length
= 0;
3284 if (BOOL_VECTOR_P (subtree
))
3285 return subtree
; /* No sub-objects anyway. */
3286 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3287 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3288 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3289 else if (VECTORP (subtree
))
3290 length
= ASIZE (subtree
);
3292 /* An unknown pseudovector may contain non-Lisp fields, so we
3293 can't just blindly traverse all its fields. We used to call
3294 `Flength' which signaled `sequencep', so I just preserved this
3296 wrong_type_argument (Qsequencep
, subtree
);
3298 if (SUB_CHAR_TABLE_P (subtree
))
3300 for ( ; i
< length
; i
++)
3301 SUBSTITUTE (AREF (subtree
, i
),
3302 ASET (subtree
, i
, true_value
));
3308 SUBSTITUTE (XCAR (subtree
),
3309 XSETCAR (subtree
, true_value
));
3310 SUBSTITUTE (XCDR (subtree
),
3311 XSETCDR (subtree
, true_value
));
3317 /* Check for text properties in each interval.
3318 substitute_in_interval contains part of the logic. */
3320 INTERVAL root_interval
= string_intervals (subtree
);
3321 AUTO_CONS (arg
, object
, placeholder
);
3323 traverse_intervals_noorder (root_interval
,
3324 &substitute_in_interval
, arg
);
3329 /* Other types don't recurse any further. */
3335 /* Helper function for substitute_object_recurse. */
3337 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3339 Lisp_Object object
= Fcar (arg
);
3340 Lisp_Object placeholder
= Fcdr (arg
);
3342 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3352 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3353 integer syntax and fits in a fixnum, else return the nearest float if CP has
3354 either floating point or integer syntax and BASE is 10, else return nil. If
3355 IGNORE_TRAILING, consider just the longest prefix of CP that has
3356 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3357 number has integer syntax but does not fit. */
3360 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3363 char const *cp
= string
;
3365 bool float_syntax
= 0;
3368 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3369 IEEE floating point hosts, and works around a formerly-common bug where
3370 atof ("-0.0") drops the sign. */
3371 bool negative
= *cp
== '-';
3373 bool signedp
= negative
|| *cp
== '+';
3378 leading_digit
= digit_to_number (*cp
, base
);
3379 if (leading_digit
>= 0)
3384 while (digit_to_number (*cp
, base
) >= 0);
3394 if ('0' <= *cp
&& *cp
<= '9')
3399 while ('0' <= *cp
&& *cp
<= '9');
3401 if (*cp
== 'e' || *cp
== 'E')
3403 char const *ecp
= cp
;
3405 if (*cp
== '+' || *cp
== '-')
3407 if ('0' <= *cp
&& *cp
<= '9')
3412 while ('0' <= *cp
&& *cp
<= '9');
3414 else if (cp
[-1] == '+'
3415 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3421 else if (cp
[-1] == '+'
3422 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3426 /* NAN is a "positive" NaN on all known Emacs hosts. */
3433 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3434 || state
== (LEAD_INT
|E_EXP
));
3437 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3438 any prefix that matches. Otherwise, the entire string must match. */
3439 if (! (ignore_trailing
3440 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3441 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3444 /* If the number uses integer and not float syntax, and is in C-language
3445 range, use its value, preferably as a fixnum. */
3446 if (leading_digit
>= 0 && ! float_syntax
)
3450 /* Fast special case for single-digit integers. This also avoids a
3451 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3452 case some versions of strtoumax accept numbers like "0x1" that Emacs
3454 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3455 return make_number (negative
? -leading_digit
: leading_digit
);
3458 n
= strtoumax (string
+ signedp
, NULL
, base
);
3459 if (errno
== ERANGE
)
3461 /* Unfortunately there's no simple and accurate way to convert
3462 non-base-10 numbers that are out of C-language range. */
3464 xsignal1 (Qoverflow_error
, build_string (string
));
3466 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3468 EMACS_INT signed_n
= n
;
3469 return make_number (negative
? -signed_n
: signed_n
);
3475 /* Either the number uses float syntax, or it does not fit into a fixnum.
3476 Convert it from string to floating point, unless the value is already
3477 known because it is an infinity, a NAN, or its absolute value fits in
3480 value
= atof (string
+ signedp
);
3482 return make_float (negative
? -value
: value
);
3487 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3491 Lisp_Object tem
, item
, vector
;
3492 struct Lisp_Cons
*otem
;
3495 tem
= read_list (1, readcharfun
);
3496 len
= Flength (tem
);
3497 vector
= Fmake_vector (len
, Qnil
);
3499 size
= ASIZE (vector
);
3500 ptr
= XVECTOR (vector
)->contents
;
3501 for (i
= 0; i
< size
; i
++)
3504 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3505 bytecode object, the docstring containing the bytecode and
3506 constants values must be treated as unibyte and passed to
3507 Fread, to get the actual bytecode string and constants vector. */
3508 if (bytecodeflag
&& load_force_doc_strings
)
3510 if (i
== COMPILED_BYTECODE
)
3512 if (!STRINGP (item
))
3513 error ("Invalid byte code");
3515 /* Delay handling the bytecode slot until we know whether
3516 it is lazily-loaded (we can tell by whether the
3517 constants slot is nil). */
3518 ASET (vector
, COMPILED_CONSTANTS
, item
);
3521 else if (i
== COMPILED_CONSTANTS
)
3523 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3527 /* Coerce string to unibyte (like string-as-unibyte,
3528 but without generating extra garbage and
3529 guaranteeing no change in the contents). */
3530 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3531 STRING_SET_UNIBYTE (bytestr
);
3533 item
= Fread (Fcons (bytestr
, readcharfun
));
3535 error ("Invalid byte code");
3537 otem
= XCONS (item
);
3538 bytestr
= XCAR (item
);
3543 /* Now handle the bytecode slot. */
3544 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3546 else if (i
== COMPILED_DOC_STRING
3548 && ! STRING_MULTIBYTE (item
))
3550 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3551 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3553 item
= Fstring_as_multibyte (item
);
3556 ASET (vector
, i
, item
);
3564 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3567 read_list (bool flag
, Lisp_Object readcharfun
)
3569 Lisp_Object val
, tail
;
3570 Lisp_Object elt
, tem
;
3571 /* 0 is the normal case.
3572 1 means this list is a doc reference; replace it with the number 0.
3573 2 means this list is a doc reference; replace it with the doc string. */
3574 int doc_reference
= 0;
3576 /* Initialize this to 1 if we are reading a list. */
3577 bool first_in_list
= flag
<= 0;
3585 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3589 /* While building, if the list starts with #$, treat it specially. */
3590 if (EQ (elt
, Vload_file_name
)
3592 && !NILP (Vpurify_flag
))
3594 if (NILP (Vdoc_file_name
))
3595 /* We have not yet called Snarf-documentation, so assume
3596 this file is described in the DOC file
3597 and Snarf-documentation will fill in the right value later.
3598 For now, replace the whole list with 0. */
3601 /* We have already called Snarf-documentation, so make a relative
3602 file name for this file, so it can be found properly
3603 in the installed Lisp directory.
3604 We don't use Fexpand_file_name because that would make
3605 the directory absolute now. */
3607 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3608 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3611 else if (EQ (elt
, Vload_file_name
)
3613 && load_force_doc_strings
)
3622 invalid_syntax (") or . in a vector");
3629 XSETCDR (tail
, read0 (readcharfun
));
3631 val
= read0 (readcharfun
);
3632 read1 (readcharfun
, &ch
, 0);
3636 if (doc_reference
== 1)
3637 return make_number (0);
3638 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3641 file_offset saved_position
;
3642 /* Get a doc string from the file we are loading.
3643 If it's in saved_doc_string, get it from there.
3645 Here, we don't know if the string is a
3646 bytecode string or a doc string. As a
3647 bytecode string must be unibyte, we always
3648 return a unibyte string. If it is actually a
3649 doc string, caller must make it
3652 /* Position is negative for user variables. */
3653 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3654 if (pos
>= saved_doc_string_position
3655 && pos
< (saved_doc_string_position
3656 + saved_doc_string_length
))
3658 saved
= saved_doc_string
;
3659 saved_position
= saved_doc_string_position
;
3661 /* Look in prev_saved_doc_string the same way. */
3662 else if (pos
>= prev_saved_doc_string_position
3663 && pos
< (prev_saved_doc_string_position
3664 + prev_saved_doc_string_length
))
3666 saved
= prev_saved_doc_string
;
3667 saved_position
= prev_saved_doc_string_position
;
3671 ptrdiff_t start
= pos
- saved_position
;
3674 /* Process quoting with ^A,
3675 and find the end of the string,
3676 which is marked with ^_ (037). */
3677 for (from
= start
, to
= start
;
3678 saved
[from
] != 037;)
3680 int c
= saved
[from
++];
3684 saved
[to
++] = (c
== 1 ? c
3693 return make_unibyte_string (saved
+ start
,
3697 return get_doc_string (val
, 1, 0);
3702 invalid_syntax (". in wrong context");
3704 invalid_syntax ("] in a list");
3708 XSETCDR (tail
, tem
);
3715 static Lisp_Object initial_obarray
;
3717 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3719 static size_t oblookup_last_bucket_number
;
3721 /* Get an error if OBARRAY is not an obarray.
3722 If it is one, return it. */
3725 check_obarray (Lisp_Object obarray
)
3727 /* We don't want to signal a wrong-type-argument error when we are
3728 shutting down due to a fatal error, and we don't want to hit
3729 assertions in VECTORP and ASIZE if the fatal error was during GC. */
3730 if (!fatal_error_in_progress
3731 && (!VECTORP (obarray
) || ASIZE (obarray
) == 0))
3733 /* If Vobarray is now invalid, force it to be valid. */
3734 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3735 wrong_type_argument (Qvectorp
, obarray
);
3740 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3743 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3747 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3748 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3751 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3753 XSYMBOL (sym
)->constant
= 1;
3754 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3755 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3758 ptr
= aref_addr (obarray
, XINT (index
));
3759 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3764 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3767 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3769 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3772 /* Intern the C string STR: return a symbol with that name,
3773 interned in the current obarray. */
3776 intern_1 (const char *str
, ptrdiff_t len
)
3778 Lisp_Object obarray
= check_obarray (Vobarray
);
3779 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3781 return (SYMBOLP (tem
) ? tem
3782 /* The above `oblookup' was done on the basis of nchars==nbytes, so
3783 the string has to be unibyte. */
3784 : intern_driver (make_unibyte_string (str
, len
),
3789 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3791 Lisp_Object obarray
= check_obarray (Vobarray
);
3792 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3796 /* Creating a non-pure string from a string literal not implemented yet.
3797 We could just use make_string here and live with the extra copy. */
3798 eassert (!NILP (Vpurify_flag
));
3799 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3805 define_symbol (Lisp_Object sym
, char const *str
)
3807 ptrdiff_t len
= strlen (str
);
3808 Lisp_Object string
= make_pure_c_string (str
, len
);
3809 init_symbol (sym
, string
);
3811 /* Qunbound is uninterned, so that it's not confused with any symbol
3812 'unbound' created by a Lisp program. */
3813 if (! EQ (sym
, Qunbound
))
3815 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3816 eassert (INTEGERP (bucket
));
3817 intern_sym (sym
, initial_obarray
, bucket
);
3821 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3822 doc
: /* Return the canonical symbol whose name is STRING.
3823 If there is none, one is created by this function and returned.
3824 A second optional argument specifies the obarray to use;
3825 it defaults to the value of `obarray'. */)
3826 (Lisp_Object string
, Lisp_Object obarray
)
3830 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3831 CHECK_STRING (string
);
3833 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3835 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3840 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3841 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3842 NAME may be a string or a symbol. If it is a symbol, that exact
3843 symbol is searched for.
3844 A second optional argument specifies the obarray to use;
3845 it defaults to the value of `obarray'. */)
3846 (Lisp_Object name
, Lisp_Object obarray
)
3848 register Lisp_Object tem
, string
;
3850 if (NILP (obarray
)) obarray
= Vobarray
;
3851 obarray
= check_obarray (obarray
);
3853 if (!SYMBOLP (name
))
3855 CHECK_STRING (name
);
3859 string
= SYMBOL_NAME (name
);
3861 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3862 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3868 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3869 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3870 The value is t if a symbol was found and deleted, nil otherwise.
3871 NAME may be a string or a symbol. If it is a symbol, that symbol
3872 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3873 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3874 usage: (unintern NAME OBARRAY) */)
3875 (Lisp_Object name
, Lisp_Object obarray
)
3877 register Lisp_Object string
, tem
;
3880 if (NILP (obarray
)) obarray
= Vobarray
;
3881 obarray
= check_obarray (obarray
);
3884 string
= SYMBOL_NAME (name
);
3887 CHECK_STRING (name
);
3891 tem
= oblookup (obarray
, SSDATA (string
),
3896 /* If arg was a symbol, don't delete anything but that symbol itself. */
3897 if (SYMBOLP (name
) && !EQ (name
, tem
))
3900 /* There are plenty of other symbols which will screw up the Emacs
3901 session if we unintern them, as well as even more ways to use
3902 `setq' or `fset' or whatnot to make the Emacs session
3903 unusable. Let's not go down this silly road. --Stef */
3904 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3905 error ("Attempt to unintern t or nil"); */
3907 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3909 hash
= oblookup_last_bucket_number
;
3911 if (EQ (AREF (obarray
, hash
), tem
))
3913 if (XSYMBOL (tem
)->next
)
3916 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3917 ASET (obarray
, hash
, sym
);
3920 ASET (obarray
, hash
, make_number (0));
3924 Lisp_Object tail
, following
;
3926 for (tail
= AREF (obarray
, hash
);
3927 XSYMBOL (tail
)->next
;
3930 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3931 if (EQ (following
, tem
))
3933 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3942 /* Return the symbol in OBARRAY whose names matches the string
3943 of SIZE characters (SIZE_BYTE bytes) at PTR.
3944 If there is no such symbol, return the integer bucket number of
3945 where the symbol would be if it were present.
3947 Also store the bucket number in oblookup_last_bucket_number. */
3950 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3954 register Lisp_Object tail
;
3955 Lisp_Object bucket
, tem
;
3957 obarray
= check_obarray (obarray
);
3958 /* This is sometimes needed in the middle of GC. */
3959 obsize
= gc_asize (obarray
);
3960 hash
= hash_string (ptr
, size_byte
) % obsize
;
3961 bucket
= AREF (obarray
, hash
);
3962 oblookup_last_bucket_number
= hash
;
3963 if (EQ (bucket
, make_number (0)))
3965 else if (!SYMBOLP (bucket
))
3966 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3968 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3970 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3971 && SCHARS (SYMBOL_NAME (tail
)) == size
3972 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3974 else if (XSYMBOL (tail
)->next
== 0)
3977 XSETINT (tem
, hash
);
3982 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3985 register Lisp_Object tail
;
3986 CHECK_VECTOR (obarray
);
3987 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3989 tail
= AREF (obarray
, i
);
3994 if (XSYMBOL (tail
)->next
== 0)
3996 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4002 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4004 call1 (function
, sym
);
4007 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4008 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4009 OBARRAY defaults to the value of `obarray'. */)
4010 (Lisp_Object function
, Lisp_Object obarray
)
4012 if (NILP (obarray
)) obarray
= Vobarray
;
4013 obarray
= check_obarray (obarray
);
4015 map_obarray (obarray
, mapatoms_1
, function
);
4019 #define OBARRAY_SIZE 1511
4024 Lisp_Object oblength
;
4025 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4027 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4029 Vobarray
= Fmake_vector (oblength
, make_number (0));
4030 initial_obarray
= Vobarray
;
4031 staticpro (&initial_obarray
);
4033 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4034 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4036 DEFSYM (Qunbound
, "unbound");
4038 DEFSYM (Qnil
, "nil");
4039 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4040 XSYMBOL (Qnil
)->constant
= 1;
4041 XSYMBOL (Qnil
)->declared_special
= true;
4044 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4045 XSYMBOL (Qt
)->constant
= 1;
4046 XSYMBOL (Qt
)->declared_special
= true;
4048 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4051 DEFSYM (Qvariable_documentation
, "variable-documentation");
4053 read_buffer
= xmalloc (size
);
4054 read_buffer_size
= size
;
4058 defsubr (struct Lisp_Subr
*sname
)
4060 Lisp_Object sym
, tem
;
4061 sym
= intern_c_string (sname
->symbol_name
);
4062 XSETPVECTYPE (sname
, PVEC_SUBR
);
4063 XSETSUBR (tem
, sname
);
4064 set_symbol_function (sym
, tem
);
4067 #ifdef NOTDEF /* Use fset in subr.el now! */
4069 defalias (struct Lisp_Subr
*sname
, char *string
)
4072 sym
= intern (string
);
4073 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4077 /* Define an "integer variable"; a symbol whose value is forwarded to a
4078 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4079 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4081 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4082 const char *namestring
, EMACS_INT
*address
)
4085 sym
= intern_c_string (namestring
);
4086 i_fwd
->type
= Lisp_Fwd_Int
;
4087 i_fwd
->intvar
= address
;
4088 XSYMBOL (sym
)->declared_special
= 1;
4089 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4090 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4093 /* Similar but define a variable whose value is t if address contains 1,
4094 nil if address contains 0. */
4096 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4097 const char *namestring
, bool *address
)
4100 sym
= intern_c_string (namestring
);
4101 b_fwd
->type
= Lisp_Fwd_Bool
;
4102 b_fwd
->boolvar
= address
;
4103 XSYMBOL (sym
)->declared_special
= 1;
4104 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4105 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4106 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4109 /* Similar but define a variable whose value is the Lisp Object stored
4110 at address. Two versions: with and without gc-marking of the C
4111 variable. The nopro version is used when that variable will be
4112 gc-marked for some other reason, since marking the same slot twice
4113 can cause trouble with strings. */
4115 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4116 const char *namestring
, Lisp_Object
*address
)
4119 sym
= intern_c_string (namestring
);
4120 o_fwd
->type
= Lisp_Fwd_Obj
;
4121 o_fwd
->objvar
= address
;
4122 XSYMBOL (sym
)->declared_special
= 1;
4123 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4124 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4128 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4129 const char *namestring
, Lisp_Object
*address
)
4131 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4132 staticpro (address
);
4135 /* Similar but define a variable whose value is the Lisp Object stored
4136 at a particular offset in the current kboard object. */
4139 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4140 const char *namestring
, int offset
)
4143 sym
= intern_c_string (namestring
);
4144 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4145 ko_fwd
->offset
= offset
;
4146 XSYMBOL (sym
)->declared_special
= 1;
4147 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4148 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4151 /* Check that the elements of lpath exist. */
4154 load_path_check (Lisp_Object lpath
)
4156 Lisp_Object path_tail
;
4158 /* The only elements that might not exist are those from
4159 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4161 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4163 Lisp_Object dirfile
;
4164 dirfile
= Fcar (path_tail
);
4165 if (STRINGP (dirfile
))
4167 dirfile
= Fdirectory_file_name (dirfile
);
4168 if (! file_accessible_directory_p (dirfile
))
4169 dir_warning ("Lisp directory", XCAR (path_tail
));
4174 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4175 This does not include the standard site-lisp directories
4176 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4177 but it does (unless no_site_lisp is set) include site-lisp
4178 directories in the source/build directories if those exist and we
4179 are running uninstalled.
4181 Uses the following logic:
4182 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4183 The remainder is what happens when dumping works:
4184 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4185 Otherwise use PATH_LOADSEARCH.
4187 If !initialized, then just return PATH_DUMPLOADSEARCH.
4189 If Vinstallation_directory is not nil (ie, running uninstalled):
4190 If installation-dir/lisp exists and not already a member,
4191 we must be running uninstalled. Reset the load-path
4192 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4193 refers to the eventual installation directories. Since we
4194 are not yet installed, we should not use them, even if they exist.)
4195 If installation-dir/lisp does not exist, just add
4196 PATH_DUMPLOADSEARCH at the end instead.
4197 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4198 and not already a member) at the front.
4199 If installation-dir != source-dir (ie running an uninstalled,
4200 out-of-tree build) AND install-dir/src/Makefile exists BUT
4201 install-dir/src/Makefile.in does NOT exist (this is a sanity
4202 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4205 load_path_default (void)
4207 Lisp_Object lpath
= Qnil
;
4212 const char *loadpath
= ns_load_path ();
4215 normal
= PATH_LOADSEARCH
;
4217 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4219 lpath
= decode_env_path (0, normal
, 0);
4222 #else /* !CANNOT_DUMP */
4224 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4229 const char *loadpath
= ns_load_path ();
4230 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4232 lpath
= decode_env_path (0, normal
, 0);
4234 if (!NILP (Vinstallation_directory
))
4236 Lisp_Object tem
, tem1
;
4238 /* Add to the path the lisp subdir of the installation
4239 dir, if it is accessible. Note: in out-of-tree builds,
4240 this directory is empty save for Makefile. */
4241 tem
= Fexpand_file_name (build_string ("lisp"),
4242 Vinstallation_directory
);
4243 tem1
= Ffile_accessible_directory_p (tem
);
4246 if (NILP (Fmember (tem
, lpath
)))
4248 /* We are running uninstalled. The default load-path
4249 points to the eventual installed lisp directories.
4250 We should not use those now, even if they exist,
4251 so start over from a clean slate. */
4252 lpath
= list1 (tem
);
4256 /* That dir doesn't exist, so add the build-time
4257 Lisp dirs instead. */
4259 Lisp_Object dump_path
=
4260 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4261 lpath
= nconc2 (lpath
, dump_path
);
4264 /* Add site-lisp under the installation dir, if it exists. */
4267 tem
= Fexpand_file_name (build_string ("site-lisp"),
4268 Vinstallation_directory
);
4269 tem1
= Ffile_accessible_directory_p (tem
);
4272 if (NILP (Fmember (tem
, lpath
)))
4273 lpath
= Fcons (tem
, lpath
);
4277 /* If Emacs was not built in the source directory,
4278 and it is run from where it was built, add to load-path
4279 the lisp and site-lisp dirs under that directory. */
4281 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4285 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4286 Vinstallation_directory
);
4287 tem1
= Ffile_exists_p (tem
);
4289 /* Don't be fooled if they moved the entire source tree
4290 AFTER dumping Emacs. If the build directory is indeed
4291 different from the source dir, src/Makefile.in and
4292 src/Makefile will not be found together. */
4293 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4294 Vinstallation_directory
);
4295 tem2
= Ffile_exists_p (tem
);
4296 if (!NILP (tem1
) && NILP (tem2
))
4298 tem
= Fexpand_file_name (build_string ("lisp"),
4301 if (NILP (Fmember (tem
, lpath
)))
4302 lpath
= Fcons (tem
, lpath
);
4306 tem
= Fexpand_file_name (build_string ("site-lisp"),
4308 tem1
= Ffile_accessible_directory_p (tem
);
4311 if (NILP (Fmember (tem
, lpath
)))
4312 lpath
= Fcons (tem
, lpath
);
4316 } /* Vinstallation_directory != Vsource_directory */
4318 } /* if Vinstallation_directory */
4320 else /* !initialized */
4322 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4323 source directory. We used to add ../lisp (ie the lisp dir in
4324 the build directory) at the front here, but that should not
4325 be necessary, since in out of tree builds lisp/ is empty, save
4327 lpath
= decode_env_path (0, normal
, 0);
4329 #endif /* !CANNOT_DUMP */
4337 /* First, set Vload_path. */
4339 /* Ignore EMACSLOADPATH when dumping. */
4341 bool use_loadpath
= true;
4343 bool use_loadpath
= NILP (Vpurify_flag
);
4346 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4348 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4350 /* Check (non-nil) user-supplied elements. */
4351 load_path_check (Vload_path
);
4353 /* If no nils in the environment variable, use as-is.
4354 Otherwise, replace any nils with the default. */
4355 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4357 Lisp_Object elem
, elpath
= Vload_path
;
4358 Lisp_Object default_lpath
= load_path_default ();
4360 /* Check defaults, before adding site-lisp. */
4361 load_path_check (default_lpath
);
4363 /* Add the site-lisp directories to the front of the default. */
4364 if (!no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4366 Lisp_Object sitelisp
;
4367 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4368 if (! NILP (sitelisp
))
4369 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4374 /* Replace nils from EMACSLOADPATH by default. */
4375 while (CONSP (elpath
))
4377 elem
= XCAR (elpath
);
4378 elpath
= XCDR (elpath
);
4379 Vload_path
= CALLN (Fappend
, Vload_path
,
4380 NILP (elem
) ? default_lpath
: list1 (elem
));
4382 } /* Fmemq (Qnil, Vload_path) */
4386 Vload_path
= load_path_default ();
4388 /* Check before adding site-lisp directories.
4389 The install should have created them, but they are not
4390 required, so no need to warn if they are absent.
4391 Or we might be running before installation. */
4392 load_path_check (Vload_path
);
4394 /* Add the site-lisp directories at the front. */
4395 if (initialized
&& !no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4397 Lisp_Object sitelisp
;
4398 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4399 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4405 load_in_progress
= 0;
4406 Vload_file_name
= Qnil
;
4407 Vstandard_input
= Qt
;
4408 Vloads_in_progress
= Qnil
;
4411 /* Print a warning that directory intended for use USE and with name
4412 DIRNAME cannot be accessed. On entry, errno should correspond to
4413 the access failure. Print the warning on stderr and put it in
4417 dir_warning (char const *use
, Lisp_Object dirname
)
4419 static char const format
[] = "Warning: %s '%s': %s\n";
4420 int access_errno
= errno
;
4421 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)),
4422 strerror (access_errno
));
4424 /* Don't log the warning before we've initialized!! */
4427 char const *diagnostic
= emacs_strerror (access_errno
);
4429 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4430 + strlen (use
) + SBYTES (dirname
)
4431 + strlen (diagnostic
));
4432 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4434 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4440 syms_of_lread (void)
4443 defsubr (&Sread_from_string
);
4445 defsubr (&Sintern_soft
);
4446 defsubr (&Sunintern
);
4447 defsubr (&Sget_load_suffixes
);
4449 defsubr (&Seval_buffer
);
4450 defsubr (&Seval_region
);
4451 defsubr (&Sread_char
);
4452 defsubr (&Sread_char_exclusive
);
4453 defsubr (&Sread_event
);
4454 defsubr (&Sget_file_char
);
4455 defsubr (&Smapatoms
);
4456 defsubr (&Slocate_file_internal
);
4458 DEFVAR_LISP ("obarray", Vobarray
,
4459 doc
: /* Symbol table for use by `intern' and `read'.
4460 It is a vector whose length ought to be prime for best results.
4461 The vector's contents don't make sense if examined from Lisp programs;
4462 to find all the symbols in an obarray, use `mapatoms'. */);
4464 DEFVAR_LISP ("values", Vvalues
,
4465 doc
: /* List of values of all expressions which were read, evaluated and printed.
4466 Order is reverse chronological. */);
4467 XSYMBOL (intern ("values"))->declared_special
= 0;
4469 DEFVAR_LISP ("standard-input", Vstandard_input
,
4470 doc
: /* Stream for read to get input from.
4471 See documentation of `read' for possible values. */);
4472 Vstandard_input
= Qt
;
4474 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4475 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4477 If this variable is a buffer, then only forms read from that buffer
4478 will be added to `read-symbol-positions-list'.
4479 If this variable is t, then all read forms will be added.
4480 The effect of all other values other than nil are not currently
4481 defined, although they may be in the future.
4483 The positions are relative to the last call to `read' or
4484 `read-from-string'. It is probably a bad idea to set this variable at
4485 the toplevel; bind it instead. */);
4486 Vread_with_symbol_positions
= Qnil
;
4488 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4489 doc
: /* A list mapping read symbols to their positions.
4490 This variable is modified during calls to `read' or
4491 `read-from-string', but only when `read-with-symbol-positions' is
4494 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4495 CHAR-POSITION is an integer giving the offset of that occurrence of the
4496 symbol from the position where `read' or `read-from-string' started.
4498 Note that a symbol will appear multiple times in this list, if it was
4499 read multiple times. The list is in the same order as the symbols
4501 Vread_symbol_positions_list
= Qnil
;
4503 DEFVAR_LISP ("read-circle", Vread_circle
,
4504 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4507 DEFVAR_LISP ("load-path", Vload_path
,
4508 doc
: /* List of directories to search for files to load.
4509 Each element is a string (directory file name) or nil (meaning
4510 `default-directory').
4511 This list is consulted by the `require' function.
4512 Initialized during startup as described in Info node `(elisp)Library Search'.
4513 Use `directory-file-name' when adding items to this path. However, Lisp
4514 programs that process this list should tolerate directories both with
4515 and without trailing slashes. */);
4517 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4518 doc
: /* List of suffixes for Emacs Lisp files and dynamic modules.
4519 This list includes suffixes for both compiled and source Emacs Lisp files.
4520 This list should not include the empty string.
4521 `load' and related functions try to append these suffixes, in order,
4522 to the specified file name if a suffix is allowed or required. */);
4524 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4525 build_pure_c_string (".el"),
4526 build_pure_c_string (MODULES_SUFFIX
));
4528 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4529 build_pure_c_string (".el"));
4531 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix
,
4532 doc
: /* Suffix of loadable module file, or nil of modules are not supported. */);
4534 Vmodule_file_suffix
= build_pure_c_string (MODULES_SUFFIX
);
4536 Vmodule_file_suffix
= Qnil
;
4538 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4539 doc
: /* List of suffixes that indicate representations of \
4541 This list should normally start with the empty string.
4543 Enabling Auto Compression mode appends the suffixes in
4544 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4545 mode removes them again. `load' and related functions use this list to
4546 determine whether they should look for compressed versions of a file
4547 and, if so, which suffixes they should try to append to the file name
4548 in order to do so. However, if you want to customize which suffixes
4549 the loading functions recognize as compression suffixes, you should
4550 customize `jka-compr-load-suffixes' rather than the present variable. */);
4551 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4553 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4554 doc
: /* Non-nil if inside of `load'. */);
4555 DEFSYM (Qload_in_progress
, "load-in-progress");
4557 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4558 doc
: /* An alist of functions to be evalled when particular files are loaded.
4559 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4561 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4562 a symbol (a feature name).
4564 When `load' is run and the file-name argument matches an element's
4565 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4566 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4568 An error in FORMS does not undo the load, but does prevent execution of
4569 the rest of the FORMS. */);
4570 Vafter_load_alist
= Qnil
;
4572 DEFVAR_LISP ("load-history", Vload_history
,
4573 doc
: /* Alist mapping loaded file names to symbols and features.
4574 Each alist element should be a list (FILE-NAME ENTRIES...), where
4575 FILE-NAME is the name of a file that has been loaded into Emacs.
4576 The file name is absolute and true (i.e. it doesn't contain symlinks).
4577 As an exception, one of the alist elements may have FILE-NAME nil,
4578 for symbols and features not associated with any file.
4580 The remaining ENTRIES in the alist element describe the functions and
4581 variables defined in that file, the features provided, and the
4582 features required. Each entry has the form `(provide . FEATURE)',
4583 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4584 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4585 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4586 autoload before this file redefined it as a function. In addition,
4587 entries may also be single symbols, which means that SYMBOL was
4588 defined by `defvar' or `defconst'.
4590 During preloading, the file name recorded is relative to the main Lisp
4591 directory. These file names are converted to absolute at startup. */);
4592 Vload_history
= Qnil
;
4594 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4595 doc
: /* Full name of file being loaded by `load'. */);
4596 Vload_file_name
= Qnil
;
4598 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4599 doc
: /* File name, including directory, of user's initialization file.
4600 If the file loaded had extension `.elc', and the corresponding source file
4601 exists, this variable contains the name of source file, suitable for use
4602 by functions like `custom-save-all' which edit the init file.
4603 While Emacs loads and evaluates the init file, value is the real name
4604 of the file, regardless of whether or not it has the `.elc' extension. */);
4605 Vuser_init_file
= Qnil
;
4607 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4608 doc
: /* Used for internal purposes by `load'. */);
4609 Vcurrent_load_list
= Qnil
;
4611 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4612 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4613 Called with a single argument (the stream from which to read).
4614 The default is to use the function `read'. */);
4615 DEFSYM (Qread
, "read");
4616 Vload_read_function
= Qread
;
4618 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4619 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4620 The value should be a function for doing code conversion before
4621 reading a source file. It can also be nil, in which case loading is
4622 done without any code conversion.
4624 If the value is a function, it is called with four arguments,
4625 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4626 the file to load, FILE is the non-absolute name (for messages etc.),
4627 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4628 `load'. The function should return t if the file was loaded. */);
4629 Vload_source_file_function
= Qnil
;
4631 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4632 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4633 This is useful when the file being loaded is a temporary copy. */);
4634 load_force_doc_strings
= 0;
4636 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4637 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4638 This is normally bound by `load' and `eval-buffer' to control `read',
4639 and is not meant for users to change. */);
4640 load_convert_to_unibyte
= 0;
4642 DEFVAR_LISP ("source-directory", Vsource_directory
,
4643 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4644 You cannot count on them to still be there! */);
4646 = Fexpand_file_name (build_string ("../"),
4647 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4649 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4650 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4651 Vpreloaded_file_list
= Qnil
;
4653 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4654 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4655 Vbyte_boolean_vars
= Qnil
;
4657 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4658 doc
: /* Non-nil means load dangerous compiled Lisp files.
4659 Some versions of XEmacs use different byte codes than Emacs. These
4660 incompatible byte codes can make Emacs crash when it tries to execute
4662 load_dangerous_libraries
= 0;
4664 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4665 doc
: /* Non-nil means force printing messages when loading Lisp files.
4666 This overrides the value of the NOMESSAGE argument to `load'. */);
4667 force_load_messages
= 0;
4669 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4670 doc
: /* Regular expression matching safe to load compiled Lisp files.
4671 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4672 from the file, and matches them against this regular expression.
4673 When the regular expression matches, the file is considered to be safe
4674 to load. See also `load-dangerous-libraries'. */);
4675 Vbytecomp_version_regexp
4676 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4678 DEFSYM (Qlexical_binding
, "lexical-binding");
4679 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4680 doc
: /* Whether to use lexical binding when evaluating code.
4681 Non-nil means that the code in the current buffer should be evaluated
4682 with lexical binding.
4683 This variable is automatically set from the file variables of an
4684 interpreted Lisp file read using `load'. Unlike other file local
4685 variables, this must be set in the first line of a file. */);
4686 Vlexical_binding
= Qnil
;
4687 Fmake_variable_buffer_local (Qlexical_binding
);
4689 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4690 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4691 Veval_buffer_list
= Qnil
;
4693 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4694 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4695 Vold_style_backquotes
= Qnil
;
4696 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4698 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4699 doc
: /* Non-nil means `load' prefers the newest version of a file.
4700 This applies when a filename suffix is not explicitly specified and
4701 `load' is trying various possible suffixes (see `load-suffixes' and
4702 `load-file-rep-suffixes'). Normally, it stops at the first file
4703 that exists unless you explicitly specify one or the other. If this
4704 option is non-nil, it checks all suffixes and uses whichever file is
4706 Note that if you customize this, obviously it will not affect files
4707 that are loaded before your customizations are read! */);
4708 load_prefer_newer
= 0;
4710 /* Vsource_directory was initialized in init_lread. */
4712 DEFSYM (Qcurrent_load_list
, "current-load-list");
4713 DEFSYM (Qstandard_input
, "standard-input");
4714 DEFSYM (Qread_char
, "read-char");
4715 DEFSYM (Qget_file_char
, "get-file-char");
4717 /* Used instead of Qget_file_char while loading *.elc files compiled
4718 by Emacs 21 or older. */
4719 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4721 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4723 DEFSYM (Qbackquote
, "`");
4724 DEFSYM (Qcomma
, ",");
4725 DEFSYM (Qcomma_at
, ",@");
4726 DEFSYM (Qcomma_dot
, ",.");
4728 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4729 DEFSYM (Qascii_character
, "ascii-character");
4730 DEFSYM (Qfunction
, "function");
4731 DEFSYM (Qload
, "load");
4732 DEFSYM (Qload_file_name
, "load-file-name");
4733 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4734 DEFSYM (Qfile_truename
, "file-truename");
4735 DEFSYM (Qdir_ok
, "dir-ok");
4736 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4738 staticpro (&read_objects
);
4739 read_objects
= Qnil
;
4740 staticpro (&seen_list
);
4743 Vloads_in_progress
= Qnil
;
4744 staticpro (&Vloads_in_progress
);
4746 DEFSYM (Qhash_table
, "hash-table");
4747 DEFSYM (Qdata
, "data");
4748 DEFSYM (Qtest
, "test");
4749 DEFSYM (Qsize
, "size");
4750 DEFSYM (Qweakness
, "weakness");
4751 DEFSYM (Qrehash_size
, "rehash-size");
4752 DEFSYM (Qrehash_threshold
, "rehash-threshold");