1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2015 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 /* Tell globals.h to define tables needed by init_obarray. */
22 #define DEFINE_SYMBOLS
26 #include <sys/types.h>
30 #include <limits.h> /* For CHAR_BIT. */
32 #include <stat-time.h>
34 #include "intervals.h"
35 #include "character.h"
43 #include "termhooks.h"
44 #include "blockinput.h"
58 #endif /* HAVE_SETLOCALE */
63 #define file_offset off_t
64 #define file_tell ftello
66 #define file_offset long
67 #define file_tell ftell
70 /* The association list of objects read with the #n=object form.
71 Each member of the list has the form (n . object), and is used to
72 look up the object for the corresponding #n# construct.
73 It must be set to nil before all top-level calls to read0. */
74 static Lisp_Object read_objects
;
76 /* File for get_file_char to read from. Use by load. */
77 static FILE *instream
;
79 /* For use within read-from-string (this reader is non-reentrant!!) */
80 static ptrdiff_t read_from_string_index
;
81 static ptrdiff_t read_from_string_index_byte
;
82 static ptrdiff_t read_from_string_limit
;
84 /* Number of characters read in the current call to Fread or
86 static EMACS_INT readchar_count
;
88 /* This contains the last string skipped with #@. */
89 static char *saved_doc_string
;
90 /* Length of buffer allocated in saved_doc_string. */
91 static ptrdiff_t saved_doc_string_size
;
92 /* Length of actual data in saved_doc_string. */
93 static ptrdiff_t saved_doc_string_length
;
94 /* This is the file position that string came from. */
95 static file_offset saved_doc_string_position
;
97 /* This contains the previous string skipped with #@.
98 We copy it from saved_doc_string when a new string
99 is put in saved_doc_string. */
100 static char *prev_saved_doc_string
;
101 /* Length of buffer allocated in prev_saved_doc_string. */
102 static ptrdiff_t prev_saved_doc_string_size
;
103 /* Length of actual data in prev_saved_doc_string. */
104 static ptrdiff_t prev_saved_doc_string_length
;
105 /* This is the file position that string came from. */
106 static file_offset prev_saved_doc_string_position
;
108 /* True means inside a new-style backquote
109 with no surrounding parentheses.
110 Fread initializes this to false, so we need not specbind it
111 or worry about what happens to it when there is an error. */
112 static bool new_backquote_flag
;
114 /* A list of file names for files being loaded in Fload. Used to
115 check for recursive loads. */
117 static Lisp_Object Vloads_in_progress
;
119 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
122 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
123 Lisp_Object
, Lisp_Object
,
124 Lisp_Object
, Lisp_Object
);
126 /* Functions that read one byte from the current source READCHARFUN
127 or unreads one byte. If the integer argument C is -1, it returns
128 one read byte, or -1 when there's no more byte in the source. If C
129 is 0 or positive, it unreads C, and the return value is not
132 static int readbyte_for_lambda (int, Lisp_Object
);
133 static int readbyte_from_file (int, Lisp_Object
);
134 static int readbyte_from_string (int, Lisp_Object
);
136 /* Handle unreading and rereading of characters.
137 Write READCHAR to read a character,
138 UNREAD(c) to unread c to be read again.
140 These macros correctly read/unread multibyte characters. */
142 #define READCHAR readchar (readcharfun, NULL)
143 #define UNREAD(c) unreadchar (readcharfun, c)
145 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
146 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
148 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
149 Qlambda, or a cons, we use this to keep an unread character because
150 a file stream can't handle multibyte-char unreading. The value -1
151 means that there's no unread character. */
152 static int unread_char
;
155 readchar (Lisp_Object readcharfun
, bool *multibyte
)
159 int (*readbyte
) (int, Lisp_Object
);
160 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
162 bool emacs_mule_encoding
= 0;
169 if (BUFFERP (readcharfun
))
171 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
173 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
175 if (! BUFFER_LIVE_P (inbuffer
))
178 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
181 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
183 /* Fetch the character code from the buffer. */
184 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
185 BUF_INC_POS (inbuffer
, pt_byte
);
192 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
193 if (! ASCII_CHAR_P (c
))
194 c
= BYTE8_TO_CHAR (c
);
197 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
201 if (MARKERP (readcharfun
))
203 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
205 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
207 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
210 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
212 /* Fetch the character code from the buffer. */
213 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
214 BUF_INC_POS (inbuffer
, bytepos
);
221 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
222 if (! ASCII_CHAR_P (c
))
223 c
= BYTE8_TO_CHAR (c
);
227 XMARKER (readcharfun
)->bytepos
= bytepos
;
228 XMARKER (readcharfun
)->charpos
++;
233 if (EQ (readcharfun
, Qlambda
))
235 readbyte
= readbyte_for_lambda
;
239 if (EQ (readcharfun
, Qget_file_char
))
241 readbyte
= readbyte_from_file
;
245 if (STRINGP (readcharfun
))
247 if (read_from_string_index
>= read_from_string_limit
)
249 else if (STRING_MULTIBYTE (readcharfun
))
253 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
254 read_from_string_index
,
255 read_from_string_index_byte
);
259 c
= SREF (readcharfun
, read_from_string_index_byte
);
260 read_from_string_index
++;
261 read_from_string_index_byte
++;
266 if (CONSP (readcharfun
))
268 /* This is the case that read_vector is reading from a unibyte
269 string that contains a byte sequence previously skipped
270 because of #@NUMBER. The car part of readcharfun is that
271 string, and the cdr part is a value of readcharfun given to
273 readbyte
= readbyte_from_string
;
274 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
275 emacs_mule_encoding
= 1;
279 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
281 readbyte
= readbyte_from_file
;
282 emacs_mule_encoding
= 1;
286 tem
= call0 (readcharfun
);
293 if (unread_char
>= 0)
299 c
= (*readbyte
) (-1, readcharfun
);
304 if (ASCII_CHAR_P (c
))
306 if (emacs_mule_encoding
)
307 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
310 len
= BYTES_BY_CHAR_HEAD (c
);
313 c
= (*readbyte
) (-1, readcharfun
);
314 if (c
< 0 || ! TRAILING_CODE_P (c
))
317 (*readbyte
) (buf
[i
], readcharfun
);
318 return BYTE8_TO_CHAR (buf
[0]);
322 return STRING_CHAR (buf
);
325 #define FROM_FILE_P(readcharfun) \
326 (EQ (readcharfun, Qget_file_char) \
327 || EQ (readcharfun, Qget_emacs_mule_file_char))
330 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
332 if (FROM_FILE_P (readcharfun
))
334 block_input (); /* FIXME: Not sure if it's needed. */
335 fseek (instream
, n
, SEEK_CUR
);
339 { /* We're not reading directly from a file. In that case, it's difficult
340 to reliably count bytes, since these are usually meant for the file's
341 encoding, whereas we're now typically in the internal encoding.
342 But luckily, skip_dyn_bytes is used to skip over a single
343 dynamic-docstring (or dynamic byte-code) which is always quoted such
344 that \037 is the final char. */
348 } while (c
>= 0 && c
!= '\037');
353 skip_dyn_eof (Lisp_Object readcharfun
)
355 if (FROM_FILE_P (readcharfun
))
357 block_input (); /* FIXME: Not sure if it's needed. */
358 fseek (instream
, 0, SEEK_END
);
362 while (READCHAR
>= 0);
365 /* Unread the character C in the way appropriate for the stream READCHARFUN.
366 If the stream is a user function, call it with the char as argument. */
369 unreadchar (Lisp_Object readcharfun
, int c
)
373 /* Don't back up the pointer if we're unreading the end-of-input mark,
374 since readchar didn't advance it when we read it. */
376 else if (BUFFERP (readcharfun
))
378 struct buffer
*b
= XBUFFER (readcharfun
);
379 ptrdiff_t charpos
= BUF_PT (b
);
380 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
382 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
383 BUF_DEC_POS (b
, bytepos
);
387 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
389 else if (MARKERP (readcharfun
))
391 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
392 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
394 XMARKER (readcharfun
)->charpos
--;
395 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
396 BUF_DEC_POS (b
, bytepos
);
400 XMARKER (readcharfun
)->bytepos
= bytepos
;
402 else if (STRINGP (readcharfun
))
404 read_from_string_index
--;
405 read_from_string_index_byte
406 = string_char_to_byte (readcharfun
, read_from_string_index
);
408 else if (CONSP (readcharfun
))
412 else if (EQ (readcharfun
, Qlambda
))
416 else if (FROM_FILE_P (readcharfun
))
421 call1 (readcharfun
, make_number (c
));
425 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
427 return read_bytecode_char (c
>= 0);
432 readbyte_from_file (int c
, Lisp_Object readcharfun
)
437 ungetc (c
, instream
);
445 /* Interrupted reads have been observed while reading over the network. */
446 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
457 return (c
== EOF
? -1 : c
);
461 readbyte_from_string (int c
, Lisp_Object readcharfun
)
463 Lisp_Object string
= XCAR (readcharfun
);
467 read_from_string_index
--;
468 read_from_string_index_byte
469 = string_char_to_byte (string
, read_from_string_index
);
472 if (read_from_string_index
>= read_from_string_limit
)
475 FETCH_STRING_CHAR_ADVANCE (c
, string
,
476 read_from_string_index
,
477 read_from_string_index_byte
);
482 /* Read one non-ASCII character from INSTREAM. The character is
483 encoded in `emacs-mule' and the first byte is already read in
487 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
489 /* Emacs-mule coding uses at most 4-byte for one character. */
490 unsigned char buf
[4];
491 int len
= emacs_mule_bytes
[c
];
492 struct charset
*charset
;
497 /* C is not a valid leading-code of `emacs-mule'. */
498 return BYTE8_TO_CHAR (c
);
504 c
= (*readbyte
) (-1, readcharfun
);
508 (*readbyte
) (buf
[i
], readcharfun
);
509 return BYTE8_TO_CHAR (buf
[0]);
516 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
517 code
= buf
[1] & 0x7F;
521 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
522 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
524 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
525 code
= buf
[2] & 0x7F;
529 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
530 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
535 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
536 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
538 c
= DECODE_CHAR (charset
, code
);
540 Fsignal (Qinvalid_read_syntax
,
541 list1 (build_string ("invalid multibyte form")));
546 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
548 static Lisp_Object
read0 (Lisp_Object
);
549 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
551 static Lisp_Object
read_list (bool, Lisp_Object
);
552 static Lisp_Object
read_vector (Lisp_Object
, bool);
554 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
556 static void substitute_object_in_subtree (Lisp_Object
,
558 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
561 /* Get a character from the tty. */
563 /* Read input events until we get one that's acceptable for our purposes.
565 If NO_SWITCH_FRAME, switch-frame events are stashed
566 until we get a character we like, and then stuffed into
569 If ASCII_REQUIRED, check function key events to see
570 if the unmodified version of the symbol has a Qascii_character
571 property, and use that character, if present.
573 If ERROR_NONASCII, signal an error if the input we
574 get isn't an ASCII character with modifiers. If it's false but
575 ASCII_REQUIRED is true, just re-read until we get an ASCII
578 If INPUT_METHOD, invoke the current input method
579 if the character warrants that.
581 If SECONDS is a number, wait that many seconds for input, and
582 return Qnil if no input arrives within that time. */
585 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
586 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
588 Lisp_Object val
, delayed_switch_frame
;
589 struct timespec end_time
;
591 #ifdef HAVE_WINDOW_SYSTEM
592 if (display_hourglass_p
)
596 delayed_switch_frame
= Qnil
;
598 /* Compute timeout. */
599 if (NUMBERP (seconds
))
601 double duration
= extract_float (seconds
);
602 struct timespec wait_time
= dtotimespec (duration
);
603 end_time
= timespec_add (current_timespec (), wait_time
);
606 /* Read until we get an acceptable event. */
609 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
610 NUMBERP (seconds
) ? &end_time
: NULL
);
611 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
616 /* `switch-frame' events are put off until after the next ASCII
617 character. This is better than signaling an error just because
618 the last characters were typed to a separate minibuffer frame,
619 for example. Eventually, some code which can deal with
620 switch-frame events will read it and process it. */
622 && EVENT_HAS_PARAMETERS (val
)
623 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
625 delayed_switch_frame
= val
;
629 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
631 /* Convert certain symbols to their ASCII equivalents. */
634 Lisp_Object tem
, tem1
;
635 tem
= Fget (val
, Qevent_symbol_element_mask
);
638 tem1
= Fget (Fcar (tem
), Qascii_character
);
639 /* Merge this symbol's modifier bits
640 with the ASCII equivalent of its basic code. */
642 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
646 /* If we don't have a character now, deal with it appropriately. */
651 Vunread_command_events
= list1 (val
);
652 error ("Non-character input-event");
659 if (! NILP (delayed_switch_frame
))
660 unread_switch_frame
= delayed_switch_frame
;
664 #ifdef HAVE_WINDOW_SYSTEM
665 if (display_hourglass_p
)
674 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
675 doc
: /* Read a character from the command input (keyboard or macro).
676 It is returned as a number.
677 If the character has modifiers, they are resolved and reflected to the
678 character code if possible (e.g. C-SPC -> 0).
680 If the user generates an event which is not a character (i.e. a mouse
681 click or function key event), `read-char' signals an error. As an
682 exception, switch-frame events are put off until non-character events
684 If you want to read non-character events, or ignore them, call
685 `read-event' or `read-char-exclusive' instead.
687 If the optional argument PROMPT is non-nil, display that as a prompt.
688 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
689 input method is turned on in the current buffer, that input method
690 is used for reading a character.
691 If the optional argument SECONDS is non-nil, it should be a number
692 specifying the maximum number of seconds to wait for input. If no
693 input arrives in that time, return nil. SECONDS may be a
694 floating-point value. */)
695 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
700 message_with_string ("%s", prompt
, 0);
701 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
703 return (NILP (val
) ? Qnil
704 : make_number (char_resolve_modifier_mask (XINT (val
))));
707 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
708 doc
: /* Read an event object from the input stream.
709 If the optional argument PROMPT is non-nil, display that as a prompt.
710 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
711 input method is turned on in the current buffer, that input method
712 is used for reading a character.
713 If the optional argument SECONDS is non-nil, it should be a number
714 specifying the maximum number of seconds to wait for input. If no
715 input arrives in that time, return nil. SECONDS may be a
716 floating-point value. */)
717 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
720 message_with_string ("%s", prompt
, 0);
721 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
724 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
725 doc
: /* Read a character from the command input (keyboard or macro).
726 It is returned as a number. Non-character events are ignored.
727 If the character has modifiers, they are resolved and reflected to the
728 character code if possible (e.g. C-SPC -> 0).
730 If the optional argument PROMPT is non-nil, display that as a prompt.
731 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
732 input method is turned on in the current buffer, that input method
733 is used for reading a character.
734 If the optional argument SECONDS is non-nil, it should be a number
735 specifying the maximum number of seconds to wait for input. If no
736 input arrives in that time, return nil. SECONDS may be a
737 floating-point value. */)
738 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
743 message_with_string ("%s", prompt
, 0);
745 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
747 return (NILP (val
) ? Qnil
748 : make_number (char_resolve_modifier_mask (XINT (val
))));
751 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
752 doc
: /* Don't use this yourself. */)
755 register Lisp_Object val
;
757 XSETINT (val
, getc (instream
));
765 /* Return true if the lisp code read using READCHARFUN defines a non-nil
766 `lexical-binding' file variable. After returning, the stream is
767 positioned following the first line, if it is a comment or #! line,
768 otherwise nothing is read. */
771 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
784 while (ch
!= '\n' && ch
!= EOF
)
786 if (ch
== '\n') ch
= READCHAR
;
787 /* It is OK to leave the position after a #! line, since
788 that is what read1 does. */
792 /* The first line isn't a comment, just give up. */
798 /* Look for an appropriate file-variable in the first line. */
802 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
803 } beg_end_state
= NOMINAL
;
804 bool in_file_vars
= 0;
806 #define UPDATE_BEG_END_STATE(ch) \
807 if (beg_end_state == NOMINAL) \
808 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
809 else if (beg_end_state == AFTER_FIRST_DASH) \
810 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
811 else if (beg_end_state == AFTER_ASTERIX) \
814 in_file_vars = !in_file_vars; \
815 beg_end_state = NOMINAL; \
818 /* Skip until we get to the file vars, if any. */
822 UPDATE_BEG_END_STATE (ch
);
824 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
828 char var
[100], val
[100];
833 /* Read a variable name. */
834 while (ch
== ' ' || ch
== '\t')
838 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
840 if (i
< sizeof var
- 1)
842 UPDATE_BEG_END_STATE (ch
);
846 /* Stop scanning if no colon was found before end marker. */
847 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
850 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
856 /* Read a variable value. */
859 while (ch
== ' ' || ch
== '\t')
863 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
865 if (i
< sizeof val
- 1)
867 UPDATE_BEG_END_STATE (ch
);
871 /* The value was terminated by an end-marker, which remove. */
873 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
877 if (strcmp (var
, "lexical-binding") == 0)
880 rv
= (strcmp (val
, "nil") != 0);
886 while (ch
!= '\n' && ch
!= EOF
)
893 /* Value is a version number of byte compiled code if the file
894 associated with file descriptor FD is a compiled Lisp file that's
895 safe to load. Only files compiled with Emacs are safe to load.
896 Files compiled with XEmacs can lead to a crash in Fbyte_code
897 because of an incompatible change in the byte compiler. */
900 safe_to_load_version (int fd
)
906 /* Read the first few bytes from the file, and look for a line
907 specifying the byte compiler version used. */
908 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
911 /* Skip to the next newline, skipping over the initial `ELC'
912 with NUL bytes following it, but note the version. */
913 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
918 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
919 buf
+ i
, nbytes
- i
) < 0)
923 lseek (fd
, 0, SEEK_SET
);
928 /* Callback for record_unwind_protect. Restore the old load list OLD,
929 after loading a file successfully. */
932 record_load_unwind (Lisp_Object old
)
934 Vloads_in_progress
= old
;
937 /* This handler function is used via internal_condition_case_1. */
940 load_error_handler (Lisp_Object data
)
946 load_warn_old_style_backquotes (Lisp_Object file
)
948 if (!NILP (Vold_style_backquotes
))
950 Lisp_Object format
= build_string ("Loading "uLSQM
"%s"uRSQM
951 ": old-style backquotes detected!");
952 CALLN (Fmessage
, format
, file
);
956 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
957 doc
: /* Return the suffixes that `load' should try if a suffix is \
959 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
962 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
963 while (CONSP (suffixes
))
965 Lisp_Object exts
= Vload_file_rep_suffixes
;
966 suffix
= XCAR (suffixes
);
967 suffixes
= XCDR (suffixes
);
972 lst
= Fcons (concat2 (suffix
, ext
), lst
);
975 return Fnreverse (lst
);
978 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
979 doc
: /* Execute a file of Lisp code named FILE.
980 First try FILE with `.elc' appended, then try with `.el',
981 then try FILE unmodified (the exact suffixes in the exact order are
982 determined by `load-suffixes'). Environment variable references in
983 FILE are replaced with their values by calling `substitute-in-file-name'.
984 This function searches the directories in `load-path'.
986 If optional second arg NOERROR is non-nil,
987 report no error if FILE doesn't exist.
988 Print messages at start and end of loading unless
989 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
991 If optional fourth arg NOSUFFIX is non-nil, don't try adding
992 suffixes `.elc' or `.el' to the specified name FILE.
993 If optional fifth arg MUST-SUFFIX is non-nil, insist on
994 the suffix `.elc' or `.el'; don't accept just FILE unless
995 it ends in one of those suffixes or includes a directory name.
997 If NOSUFFIX is nil, then if a file could not be found, try looking for
998 a different representation of the file by adding non-empty suffixes to
999 its name, before trying another file. Emacs uses this feature to find
1000 compressed versions of files when Auto Compression mode is enabled.
1001 If NOSUFFIX is non-nil, disable this feature.
1003 The suffixes that this function tries out, when NOSUFFIX is nil, are
1004 given by the return value of `get-load-suffixes' and the values listed
1005 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1006 return value of `get-load-suffixes' is used, i.e. the file name is
1007 required to have a non-empty suffix.
1009 When searching suffixes, this function normally stops at the first
1010 one that exists. If the option `load-prefer-newer' is non-nil,
1011 however, it tries all suffixes, and uses whichever file is the newest.
1013 Loading a file records its definitions, and its `provide' and
1014 `require' calls, in an element of `load-history' whose
1015 car is the file name loaded. See `load-history'.
1017 While the file is in the process of being loaded, the variable
1018 `load-in-progress' is non-nil and the variable `load-file-name'
1019 is bound to the file's name.
1021 Return t if the file exists and loads successfully. */)
1022 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1023 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1028 ptrdiff_t count
= SPECPDL_INDEX ();
1029 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1030 Lisp_Object found
, efound
, hist_file_name
;
1031 /* True means we printed the ".el is newer" message. */
1033 /* True means we are loading a compiled file. */
1035 Lisp_Object handler
;
1037 const char *fmode
= "r" FOPEN_TEXT
;
1040 CHECK_STRING (file
);
1042 /* If file name is magic, call the handler. */
1043 /* This shouldn't be necessary any more now that `openp' handles it right.
1044 handler = Ffind_file_name_handler (file, Qload);
1045 if (!NILP (handler))
1046 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1048 /* Do this after the handler to avoid
1049 the need to gcpro noerror, nomessage and nosuffix.
1050 (Below here, we care only whether they are nil or not.)
1051 The presence of this call is the result of a historical accident:
1052 it used to be in every file-operation and when it got removed
1053 everywhere, it accidentally stayed here. Since then, enough people
1054 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1055 that it seemed risky to remove. */
1056 if (! NILP (noerror
))
1058 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1059 Qt
, load_error_handler
);
1064 file
= Fsubstitute_in_file_name (file
);
1066 /* Avoid weird lossage with null string as arg,
1067 since it would try to load a directory as a Lisp file. */
1068 if (SCHARS (file
) == 0)
1075 Lisp_Object suffixes
;
1077 GCPRO2 (file
, found
);
1079 if (! NILP (must_suffix
))
1081 /* Don't insist on adding a suffix if FILE already ends with one. */
1082 ptrdiff_t size
= SBYTES (file
);
1084 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1087 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1089 /* Don't insist on adding a suffix
1090 if the argument includes a directory name. */
1091 else if (! NILP (Ffile_name_directory (file
)))
1095 if (!NILP (nosuffix
))
1099 suffixes
= Fget_load_suffixes ();
1100 if (NILP (must_suffix
))
1101 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1104 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1111 report_file_error ("Cannot open load file", file
);
1115 /* Tell startup.el whether or not we found the user's init file. */
1116 if (EQ (Qt
, Vuser_init_file
))
1117 Vuser_init_file
= found
;
1119 /* If FD is -2, that means openp found a magic file. */
1122 if (NILP (Fequal (found
, file
)))
1123 /* If FOUND is a different file name from FILE,
1124 find its handler even if we have already inhibited
1125 the `load' operation on FILE. */
1126 handler
= Ffind_file_name_handler (found
, Qt
);
1128 handler
= Ffind_file_name_handler (found
, Qload
);
1129 if (! NILP (handler
))
1130 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1132 /* Tramp has to deal with semi-broken packages that prepend
1133 drive letters to remote files. For that reason, Tramp
1134 catches file operations that test for file existence, which
1135 makes openp think X:/foo.elc files are remote. However,
1136 Tramp does not catch `load' operations for such files, so we
1137 end up with a nil as the `load' handler above. If we would
1138 continue with fd = -2, we will behave wrongly, and in
1139 particular try reading a .elc file in the "rt" mode instead
1140 of "rb". See bug #9311 for the results. To work around
1141 this, we try to open the file locally, and go with that if it
1143 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1151 /* Pacify older GCC with --enable-gcc-warnings. */
1152 IF_LINT (fd_index
= 0);
1156 fd_index
= SPECPDL_INDEX ();
1157 record_unwind_protect_int (close_file_unwind
, fd
);
1160 /* Check if we're stuck in a recursive load cycle.
1162 2000-09-21: It's not possible to just check for the file loaded
1163 being a member of Vloads_in_progress. This fails because of the
1164 way the byte compiler currently works; `provide's are not
1165 evaluated, see font-lock.el/jit-lock.el as an example. This
1166 leads to a certain amount of ``normal'' recursion.
1168 Also, just loading a file recursively is not always an error in
1169 the general case; the second load may do something different. */
1173 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1174 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1175 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1176 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1177 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1180 /* All loads are by default dynamic, unless the file itself specifies
1181 otherwise using a file-variable in the first line. This is bound here
1182 so that it takes effect whether or not we use
1183 Vload_source_file_function. */
1184 specbind (Qlexical_binding
, Qnil
);
1186 /* Get the name for load-history. */
1187 hist_file_name
= (! NILP (Vpurify_flag
)
1188 ? concat2 (Ffile_name_directory (file
),
1189 Ffile_name_nondirectory (found
))
1194 /* Check for the presence of old-style quotes and warn about them. */
1195 specbind (Qold_style_backquotes
, Qnil
);
1196 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1198 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1199 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1200 /* Load .elc files directly, but not when they are
1201 remote and have no handler! */
1208 GCPRO3 (file
, found
, hist_file_name
);
1211 && ! (version
= safe_to_load_version (fd
)))
1214 if (!load_dangerous_libraries
)
1215 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1216 else if (!NILP (nomessage
) && !force_load_messages
)
1217 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1222 efound
= ENCODE_FILE (found
);
1223 fmode
= "r" FOPEN_BINARY
;
1225 /* openp already checked for newness, no point doing it again.
1226 FIXME would be nice to get a message when openp
1227 ignores suffix order due to load_prefer_newer. */
1228 if (!load_prefer_newer
)
1230 result
= stat (SSDATA (efound
), &s1
);
1233 SSET (efound
, SBYTES (efound
) - 1, 0);
1234 result
= stat (SSDATA (efound
), &s2
);
1235 SSET (efound
, SBYTES (efound
) - 1, 'c');
1239 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1241 /* Make the progress messages mention that source is newer. */
1244 /* If we won't print another message, mention this anyway. */
1245 if (!NILP (nomessage
) && !force_load_messages
)
1247 Lisp_Object msg_file
;
1248 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1249 message_with_string ("Source file `%s' newer than byte-compiled file",
1253 } /* !load_prefer_newer */
1259 /* We are loading a source file (*.el). */
1260 if (!NILP (Vload_source_file_function
))
1267 clear_unwind_protect (fd_index
);
1269 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1270 NILP (noerror
) ? Qnil
: Qt
,
1271 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1272 return unbind_to (count
, val
);
1276 GCPRO3 (file
, found
, hist_file_name
);
1280 /* We somehow got here with fd == -2, meaning the file is deemed
1281 to be remote. Don't even try to reopen the file locally;
1282 just force a failure. */
1290 clear_unwind_protect (fd_index
);
1291 efound
= ENCODE_FILE (found
);
1292 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1294 stream
= fdopen (fd
, fmode
);
1298 report_file_error ("Opening stdio stream", file
);
1299 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1301 if (! NILP (Vpurify_flag
))
1302 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1304 if (NILP (nomessage
) || force_load_messages
)
1307 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1310 message_with_string ("Loading %s (source)...", file
, 1);
1312 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1314 else /* The typical case; compiled file newer than source file. */
1315 message_with_string ("Loading %s...", file
, 1);
1318 specbind (Qload_file_name
, found
);
1319 specbind (Qinhibit_file_name_operation
, Qnil
);
1320 specbind (Qload_in_progress
, Qt
);
1323 if (lisp_file_lexically_bound_p (Qget_file_char
))
1324 Fset (Qlexical_binding
, Qt
);
1326 if (! version
|| version
>= 22)
1327 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1328 0, Qnil
, Qnil
, Qnil
, Qnil
);
1331 /* We can't handle a file which was compiled with
1332 byte-compile-dynamic by older version of Emacs. */
1333 specbind (Qload_force_doc_strings
, Qt
);
1334 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1335 0, Qnil
, Qnil
, Qnil
, Qnil
);
1337 unbind_to (count
, Qnil
);
1339 /* Run any eval-after-load forms for this file. */
1340 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1341 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1345 xfree (saved_doc_string
);
1346 saved_doc_string
= 0;
1347 saved_doc_string_size
= 0;
1349 xfree (prev_saved_doc_string
);
1350 prev_saved_doc_string
= 0;
1351 prev_saved_doc_string_size
= 0;
1353 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1356 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1359 message_with_string ("Loading %s (source)...done", file
, 1);
1361 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1363 else /* The typical case; compiled file newer than source file. */
1364 message_with_string ("Loading %s...done", file
, 1);
1371 complete_filename_p (Lisp_Object pathname
)
1373 const unsigned char *s
= SDATA (pathname
);
1374 return (IS_DIRECTORY_SEP (s
[0])
1375 || (SCHARS (pathname
) > 2
1376 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1379 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1380 doc
: /* Search for FILENAME through PATH.
1381 Returns the file's name in absolute form, or nil if not found.
1382 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1383 file name when searching.
1384 If non-nil, PREDICATE is used instead of `file-readable-p'.
1385 PREDICATE can also be an integer to pass to the faccessat(2) function,
1386 in which case file-name-handlers are ignored.
1387 This function will normally skip directories, so if you want it to find
1388 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1389 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1392 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1393 if (NILP (predicate
) && fd
>= 0)
1398 /* Search for a file whose name is STR, looking in directories
1399 in the Lisp list PATH, and trying suffixes from SUFFIX.
1400 On success, return a file descriptor (or 1 or -2 as described below).
1401 On failure, return -1 and set errno.
1403 SUFFIXES is a list of strings containing possible suffixes.
1404 The empty suffix is automatically added if the list is empty.
1406 PREDICATE non-nil means don't open the files,
1407 just look for one that satisfies the predicate. In this case,
1408 return 1 on success. The predicate can be a lisp function or
1409 an integer to pass to `access' (in which case file-name-handlers
1412 If STOREPTR is nonzero, it points to a slot where the name of
1413 the file actually found should be stored as a Lisp string.
1414 nil is stored there on failure.
1416 If the file we find is remote, return -2
1417 but store the found remote file name in *STOREPTR.
1419 If NEWER is true, try all SUFFIXes and return the result for the
1420 newest file that exists. Does not apply to remote files,
1421 or if PREDICATE is specified. */
1424 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1425 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1427 ptrdiff_t fn_size
= 100;
1431 ptrdiff_t want_length
;
1432 Lisp_Object filename
;
1433 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
, gcpro7
;
1434 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1435 ptrdiff_t max_suffix_len
= 0;
1436 int last_errno
= ENOENT
;
1440 /* The last-modified time of the newest matching file found.
1441 Initialize it to something less than all valid timestamps. */
1442 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1446 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1448 CHECK_STRING_CAR (tail
);
1449 max_suffix_len
= max (max_suffix_len
,
1450 SBYTES (XCAR (tail
)));
1453 string
= filename
= encoded_fn
= save_string
= Qnil
;
1454 GCPRO7 (str
, string
, save_string
, filename
, path
, suffixes
, encoded_fn
);
1459 absolute
= complete_filename_p (str
);
1461 for (; CONSP (path
); path
= XCDR (path
))
1463 filename
= Fexpand_file_name (str
, XCAR (path
));
1464 if (!complete_filename_p (filename
))
1465 /* If there are non-absolute elts in PATH (eg "."). */
1466 /* Of course, this could conceivably lose if luser sets
1467 default-directory to be something non-absolute... */
1469 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1470 if (!complete_filename_p (filename
))
1471 /* Give up on this path element! */
1475 /* Calculate maximum length of any filename made from
1476 this path element/specified file name and any possible suffix. */
1477 want_length
= max_suffix_len
+ SBYTES (filename
);
1478 if (fn_size
<= want_length
)
1480 fn_size
= 100 + want_length
;
1481 fn
= SAFE_ALLOCA (fn_size
);
1484 /* Loop over suffixes. */
1485 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1486 CONSP (tail
); tail
= XCDR (tail
))
1488 Lisp_Object suffix
= XCAR (tail
);
1489 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1490 Lisp_Object handler
;
1492 /* Concatenate path element/specified name with the suffix.
1493 If the directory starts with /:, remove that. */
1494 int prefixlen
= ((SCHARS (filename
) > 2
1495 && SREF (filename
, 0) == '/'
1496 && SREF (filename
, 1) == ':')
1498 fnlen
= SBYTES (filename
) - prefixlen
;
1499 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1500 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1502 /* Check that the file exists and is not a directory. */
1503 /* We used to only check for handlers on non-absolute file names:
1507 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1508 It's not clear why that was the case and it breaks things like
1509 (load "/bar.el") where the file is actually "/bar.el.gz". */
1510 /* make_string has its own ideas on when to return a unibyte
1511 string and when a multibyte string, but we know better.
1512 We must have a unibyte string when dumping, since
1513 file-name encoding is shaky at best at that time, and in
1514 particular default-file-name-coding-system is reset
1515 several times during loadup. We therefore don't want to
1516 encode the file before passing it to file I/O library
1518 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1519 string
= make_unibyte_string (fn
, fnlen
);
1521 string
= make_string (fn
, fnlen
);
1522 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1523 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1526 if (NILP (predicate
))
1527 exists
= !NILP (Ffile_readable_p (string
));
1530 Lisp_Object tmp
= call1 (predicate
, string
);
1533 else if (EQ (tmp
, Qdir_ok
)
1534 || NILP (Ffile_directory_p (string
)))
1539 last_errno
= EISDIR
;
1545 /* We succeeded; return this descriptor and filename. */
1559 encoded_fn
= ENCODE_FILE (string
);
1560 pfn
= SSDATA (encoded_fn
);
1562 /* Check that we can access or open it. */
1563 if (NATNUMP (predicate
))
1566 if (INT_MAX
< XFASTINT (predicate
))
1567 last_errno
= EINVAL
;
1568 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1572 if (file_directory_p (pfn
))
1573 last_errno
= EISDIR
;
1580 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1583 if (errno
!= ENOENT
)
1588 int err
= (fstat (fd
, &st
) != 0 ? errno
1589 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1601 if (newer
&& !NATNUMP (predicate
))
1603 struct timespec mtime
= get_stat_mtime (&st
);
1605 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1610 emacs_close (save_fd
);
1613 save_string
= string
;
1618 /* We succeeded; return this descriptor and filename. */
1627 /* No more suffixes. Return the newest. */
1628 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1631 *storeptr
= save_string
;
1649 /* Merge the list we've accumulated of globals from the current input source
1650 into the load_history variable. The details depend on whether
1651 the source has an associated file name or not.
1653 FILENAME is the file name that we are loading from.
1655 ENTIRE is true if loading that entire file, false if evaluating
1659 build_load_history (Lisp_Object filename
, bool entire
)
1661 Lisp_Object tail
, prev
, newelt
;
1662 Lisp_Object tem
, tem2
;
1665 tail
= Vload_history
;
1668 while (CONSP (tail
))
1672 /* Find the feature's previous assoc list... */
1673 if (!NILP (Fequal (filename
, Fcar (tem
))))
1677 /* If we're loading the entire file, remove old data. */
1681 Vload_history
= XCDR (tail
);
1683 Fsetcdr (prev
, XCDR (tail
));
1686 /* Otherwise, cons on new symbols that are not already members. */
1689 tem2
= Vcurrent_load_list
;
1691 while (CONSP (tem2
))
1693 newelt
= XCAR (tem2
);
1695 if (NILP (Fmember (newelt
, tem
)))
1696 Fsetcar (tail
, Fcons (XCAR (tem
),
1697 Fcons (newelt
, XCDR (tem
))));
1710 /* If we're loading an entire file, cons the new assoc onto the
1711 front of load-history, the most-recently-loaded position. Also
1712 do this if we didn't find an existing member for the file. */
1713 if (entire
|| !foundit
)
1714 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1719 readevalloop_1 (int old
)
1721 load_convert_to_unibyte
= old
;
1724 /* Signal an `end-of-file' error, if possible with file name
1727 static _Noreturn
void
1728 end_of_file_error (void)
1730 if (STRINGP (Vload_file_name
))
1731 xsignal1 (Qend_of_file
, Vload_file_name
);
1733 xsignal0 (Qend_of_file
);
1737 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1739 /* If we macroexpand the toplevel form non-recursively and it ends
1740 up being a `progn' (or if it was a progn to start), treat each
1741 form in the progn as a top-level form. This way, if one form in
1742 the progn defines a macro, that macro is in effect when we expand
1743 the remaining forms. See similar code in bytecomp.el. */
1744 val
= call2 (macroexpand
, val
, Qnil
);
1745 if (EQ (CAR_SAFE (val
), Qprogn
))
1747 struct gcpro gcpro1
;
1748 Lisp_Object subforms
= XCDR (val
);
1751 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1752 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
)
1777 register Lisp_Object val
;
1778 ptrdiff_t count
= SPECPDL_INDEX ();
1779 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1780 struct buffer
*b
= 0;
1781 bool continue_reading_p
;
1782 Lisp_Object lex_bound
;
1783 /* True if reading an entire buffer. */
1784 bool whole_buffer
= 0;
1785 /* True on the first time around. */
1786 bool first_sexp
= 1;
1787 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1789 if (NILP (Ffboundp (macroexpand
))
1790 /* Don't macroexpand in .elc files, since it should have been done
1791 already. We actually don't know whether we're in a .elc file or not,
1792 so we use circumstantial evidence: .el files normally go through
1793 Vload_source_file_function -> load-with-code-conversion
1795 || EQ (readcharfun
, Qget_file_char
)
1796 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1799 if (MARKERP (readcharfun
))
1802 start
= readcharfun
;
1805 if (BUFFERP (readcharfun
))
1806 b
= XBUFFER (readcharfun
);
1807 else if (MARKERP (readcharfun
))
1808 b
= XMARKER (readcharfun
)->buffer
;
1810 /* We assume START is nil when input is not from a buffer. */
1811 if (! NILP (start
) && !b
)
1814 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1815 specbind (Qcurrent_load_list
, Qnil
);
1816 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1817 load_convert_to_unibyte
= !NILP (unibyte
);
1819 /* If lexical binding is active (either because it was specified in
1820 the file's header, or via a buffer-local variable), create an empty
1821 lexical environment, otherwise, turn off lexical binding. */
1822 lex_bound
= find_symbol_value (Qlexical_binding
);
1823 specbind (Qinternal_interpreter_environment
,
1824 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1825 ? Qnil
: list1 (Qt
)));
1827 GCPRO4 (sourcename
, readfun
, start
, end
);
1829 /* Try to ensure sourcename is a truename, except whilst preloading. */
1830 if (NILP (Vpurify_flag
)
1831 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1832 && !NILP (Ffboundp (Qfile_truename
)))
1833 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1835 LOADHIST_ATTACH (sourcename
);
1837 continue_reading_p
= 1;
1838 while (continue_reading_p
)
1840 ptrdiff_t count1
= SPECPDL_INDEX ();
1842 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1843 error ("Reading from killed buffer");
1847 /* Switch to the buffer we are reading from. */
1848 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1849 set_buffer_internal (b
);
1851 /* Save point in it. */
1852 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1853 /* Save ZV in it. */
1854 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1855 /* Those get unbound after we read one expression. */
1857 /* Set point and ZV around stuff to be read. */
1860 Fnarrow_to_region (make_number (BEGV
), end
);
1862 /* Just for cleanliness, convert END to a marker
1863 if it is an integer. */
1865 end
= Fpoint_max_marker ();
1868 /* On the first cycle, we can easily test here
1869 whether we are reading the whole buffer. */
1870 if (b
&& first_sexp
)
1871 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1878 while ((c
= READCHAR
) != '\n' && c
!= -1);
1883 unbind_to (count1
, Qnil
);
1887 /* Ignore whitespace here, so we can detect eof. */
1888 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1889 || c
== NO_BREAK_SPACE
)
1892 if (!NILP (Vpurify_flag
) && c
== '(')
1894 val
= read_list (0, readcharfun
);
1899 read_objects
= Qnil
;
1900 if (!NILP (readfun
))
1902 val
= call1 (readfun
, readcharfun
);
1904 /* If READCHARFUN has set point to ZV, we should
1905 stop reading, even if the form read sets point
1906 to a different value when evaluated. */
1907 if (BUFFERP (readcharfun
))
1909 struct buffer
*buf
= XBUFFER (readcharfun
);
1910 if (BUF_PT (buf
) == BUF_ZV (buf
))
1911 continue_reading_p
= 0;
1914 else if (! NILP (Vload_read_function
))
1915 val
= call1 (Vload_read_function
, readcharfun
);
1917 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1920 if (!NILP (start
) && continue_reading_p
)
1921 start
= Fpoint_marker ();
1923 /* Restore saved point and BEGV. */
1924 unbind_to (count1
, Qnil
);
1926 /* Now eval what we just read. */
1927 if (!NILP (macroexpand
))
1928 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1930 val
= eval_sub (val
);
1934 Vvalues
= Fcons (val
, Vvalues
);
1935 if (EQ (Vstandard_output
, Qt
))
1944 build_load_history (sourcename
,
1945 stream
|| whole_buffer
);
1949 unbind_to (count
, Qnil
);
1952 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1953 doc
: /* Execute the current buffer as Lisp code.
1954 When called from a Lisp program (i.e., not interactively), this
1955 function accepts up to five optional arguments:
1956 BUFFER is the buffer to evaluate (nil means use current buffer).
1957 PRINTFLAG controls printing of output:
1958 A value of nil means discard it; anything else is stream for print.
1959 FILENAME specifies the file name to use for `load-history'.
1960 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1962 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1963 functions should work normally even if PRINTFLAG is nil.
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 Also the fourth argument READ-FUNCTION, if non-nil, is used
2006 instead of `read' to read each expression. It gets one argument
2007 which is the input stream for reading characters.
2009 This function does not move point. */)
2010 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2012 /* FIXME: Do the eval-sexp-add-defvars dance! */
2013 ptrdiff_t count
= SPECPDL_INDEX ();
2014 Lisp_Object tem
, cbuf
;
2016 cbuf
= Fcurrent_buffer ();
2018 if (NILP (printflag
))
2022 specbind (Qstandard_output
, tem
);
2023 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2025 /* `readevalloop' calls functions which check the type of start and end. */
2026 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2027 !NILP (printflag
), Qnil
, read_function
,
2030 return unbind_to (count
, Qnil
);
2034 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2035 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2036 If STREAM is nil, use the value of `standard-input' (which see).
2037 STREAM or the value of `standard-input' may be:
2038 a buffer (read from point and advance it)
2039 a marker (read from where it points and advance it)
2040 a function (call it with no arguments for each character,
2041 call it with a char as argument to push a char back)
2042 a string (takes text from string, starting at the beginning)
2043 t (read text line using minibuffer and use it, or read from
2044 standard input in batch mode). */)
2045 (Lisp_Object stream
)
2048 stream
= Vstandard_input
;
2049 if (EQ (stream
, Qt
))
2050 stream
= Qread_char
;
2051 if (EQ (stream
, Qread_char
))
2052 /* FIXME: ?! When is this used !? */
2053 return call1 (intern ("read-minibuffer"),
2054 build_string ("Lisp expression: "));
2056 return read_internal_start (stream
, Qnil
, Qnil
);
2059 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2060 doc
: /* Read one Lisp expression which is represented as text by STRING.
2061 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2062 FINAL-STRING-INDEX is an integer giving the position of the next
2063 remaining character in STRING. START and END optionally delimit
2064 a substring of STRING from which to read; they default to 0 and
2065 (length STRING) respectively. Negative values are counted from
2066 the end of STRING. */)
2067 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2070 CHECK_STRING (string
);
2071 /* `read_internal_start' sets `read_from_string_index'. */
2072 ret
= read_internal_start (string
, start
, end
);
2073 return Fcons (ret
, make_number (read_from_string_index
));
2076 /* Function to set up the global context we need in toplevel read
2077 calls. START and END only used when STREAM is a string. */
2079 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2084 new_backquote_flag
= 0;
2085 read_objects
= Qnil
;
2086 if (EQ (Vread_with_symbol_positions
, Qt
)
2087 || EQ (Vread_with_symbol_positions
, stream
))
2088 Vread_symbol_positions_list
= Qnil
;
2090 if (STRINGP (stream
)
2091 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2093 ptrdiff_t startval
, endval
;
2096 if (STRINGP (stream
))
2099 string
= XCAR (stream
);
2101 validate_subarray (string
, start
, end
, SCHARS (string
),
2102 &startval
, &endval
);
2104 read_from_string_index
= startval
;
2105 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2106 read_from_string_limit
= endval
;
2109 retval
= read0 (stream
);
2110 if (EQ (Vread_with_symbol_positions
, Qt
)
2111 || EQ (Vread_with_symbol_positions
, stream
))
2112 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2117 /* Signal Qinvalid_read_syntax error.
2118 S is error string of length N (if > 0) */
2120 static _Noreturn
void
2121 invalid_syntax (const char *s
)
2123 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2127 /* Use this for recursive reads, in contexts where internal tokens
2131 read0 (Lisp_Object readcharfun
)
2133 register Lisp_Object val
;
2136 val
= read1 (readcharfun
, &c
, 0);
2140 xsignal1 (Qinvalid_read_syntax
,
2141 Fmake_string (make_number (1), make_number (c
)));
2144 static ptrdiff_t read_buffer_size
;
2145 static char *read_buffer
;
2147 /* Read a \-escape sequence, assuming we already read the `\'.
2148 If the escape sequence forces unibyte, return eight-bit char. */
2151 read_escape (Lisp_Object readcharfun
, bool stringp
)
2154 /* \u allows up to four hex digits, \U up to eight. Default to the
2155 behavior for \u, and change this value in the case that \U is seen. */
2156 int unicode_hex_count
= 4;
2161 end_of_file_error ();
2191 error ("Invalid escape character syntax");
2194 c
= read_escape (readcharfun
, 0);
2195 return c
| meta_modifier
;
2200 error ("Invalid escape character syntax");
2203 c
= read_escape (readcharfun
, 0);
2204 return c
| shift_modifier
;
2209 error ("Invalid escape character syntax");
2212 c
= read_escape (readcharfun
, 0);
2213 return c
| hyper_modifier
;
2218 error ("Invalid escape character syntax");
2221 c
= read_escape (readcharfun
, 0);
2222 return c
| alt_modifier
;
2226 if (stringp
|| c
!= '-')
2233 c
= read_escape (readcharfun
, 0);
2234 return c
| super_modifier
;
2239 error ("Invalid escape character syntax");
2243 c
= read_escape (readcharfun
, 0);
2244 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2245 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2246 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2247 return c
| ctrl_modifier
;
2248 /* ASCII control chars are made from letters (both cases),
2249 as well as the non-letters within 0100...0137. */
2250 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2251 return (c
& (037 | ~0177));
2252 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2253 return (c
& (037 | ~0177));
2255 return c
| ctrl_modifier
;
2265 /* An octal escape, as in ANSI C. */
2267 register int i
= c
- '0';
2268 register int count
= 0;
2271 if ((c
= READCHAR
) >= '0' && c
<= '7')
2283 if (i
>= 0x80 && i
< 0x100)
2284 i
= BYTE8_TO_CHAR (i
);
2289 /* A hex escape, as in ANSI C. */
2296 if (c
>= '0' && c
<= '9')
2301 else if ((c
>= 'a' && c
<= 'f')
2302 || (c
>= 'A' && c
<= 'F'))
2305 if (c
>= 'a' && c
<= 'f')
2315 /* Allow hex escapes as large as ?\xfffffff, because some
2316 packages use them to denote characters with modifiers. */
2317 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2318 error ("Hex character out of range: \\x%x...", i
);
2322 if (count
< 3 && i
>= 0x80)
2323 return BYTE8_TO_CHAR (i
);
2328 /* Post-Unicode-2.0: Up to eight hex chars. */
2329 unicode_hex_count
= 8;
2332 /* A Unicode escape. We only permit them in strings and characters,
2333 not arbitrarily in the source code, as in some other languages. */
2338 while (++count
<= unicode_hex_count
)
2341 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2343 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2344 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2345 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2347 error ("Non-hex digit used for Unicode escape");
2350 error ("Non-Unicode character: 0x%x", i
);
2359 /* Return the digit that CHARACTER stands for in the given BASE.
2360 Return -1 if CHARACTER is out of range for BASE,
2361 and -2 if CHARACTER is not valid for any supported BASE. */
2363 digit_to_number (int character
, int base
)
2367 if ('0' <= character
&& character
<= '9')
2368 digit
= character
- '0';
2369 else if ('a' <= character
&& character
<= 'z')
2370 digit
= character
- 'a' + 10;
2371 else if ('A' <= character
&& character
<= 'Z')
2372 digit
= character
- 'A' + 10;
2376 return digit
< base
? digit
: -1;
2379 /* Read an integer in radix RADIX using READCHARFUN to read
2380 characters. RADIX must be in the interval [2..36]; if it isn't, a
2381 read error is signaled . Value is the integer read. Signals an
2382 error if encountering invalid read syntax or if RADIX is out of
2386 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2388 /* Room for sign, leading 0, other digits, trailing null byte.
2389 Also, room for invalid syntax diagnostic. */
2390 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2391 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2393 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2395 if (radix
< 2 || radix
> 36)
2403 if (c
== '-' || c
== '+')
2414 /* Ignore redundant leading zeros, so the buffer doesn't
2415 fill up with them. */
2421 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2428 if (p
< buf
+ sizeof buf
- 1)
2442 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2443 invalid_syntax (buf
);
2446 return string_to_number (buf
, radix
, 0);
2450 /* If the next token is ')' or ']' or '.', we store that character
2451 in *PCH and the return value is not interesting. Else, we store
2452 zero in *PCH and we read and return one lisp object.
2454 FIRST_IN_LIST is true if this is the first element of a list. */
2457 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2460 bool uninterned_symbol
= 0;
2467 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2469 end_of_file_error ();
2474 return read_list (0, readcharfun
);
2477 return read_vector (readcharfun
, 0);
2493 /* Accept extended format for hashtables (extensible to
2495 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2496 Lisp_Object tmp
= read_list (0, readcharfun
);
2497 Lisp_Object head
= CAR_SAFE (tmp
);
2498 Lisp_Object data
= Qnil
;
2499 Lisp_Object val
= Qnil
;
2500 /* The size is 2 * number of allowed keywords to
2502 Lisp_Object params
[10];
2504 Lisp_Object key
= Qnil
;
2505 int param_count
= 0;
2507 if (!EQ (head
, Qhash_table
))
2508 error ("Invalid extended read marker at head of #s list "
2509 "(only hash-table allowed)");
2511 tmp
= CDR_SAFE (tmp
);
2513 /* This is repetitive but fast and simple. */
2514 params
[param_count
] = QCsize
;
2515 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2516 if (!NILP (params
[param_count
+ 1]))
2519 params
[param_count
] = QCtest
;
2520 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2521 if (!NILP (params
[param_count
+ 1]))
2524 params
[param_count
] = QCweakness
;
2525 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2526 if (!NILP (params
[param_count
+ 1]))
2529 params
[param_count
] = QCrehash_size
;
2530 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2531 if (!NILP (params
[param_count
+ 1]))
2534 params
[param_count
] = QCrehash_threshold
;
2535 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2536 if (!NILP (params
[param_count
+ 1]))
2539 /* This is the hashtable data. */
2540 data
= Fplist_get (tmp
, Qdata
);
2542 /* Now use params to make a new hashtable and fill it. */
2543 ht
= Fmake_hash_table (param_count
, params
);
2545 while (CONSP (data
))
2550 error ("Odd number of elements in hashtable data");
2553 Fputhash (key
, val
, ht
);
2559 invalid_syntax ("#");
2567 tmp
= read_vector (readcharfun
, 0);
2568 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2569 error ("Invalid size char-table");
2570 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2578 /* Sub char-table can't be read as a regular
2579 vector because of a two C integer fields. */
2580 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2581 ptrdiff_t size
= XINT (Flength (tmp
));
2582 int i
, depth
, min_char
;
2583 struct Lisp_Cons
*cell
;
2586 error ("Zero-sized sub char-table");
2588 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2589 error ("Invalid depth in sub char-table");
2590 depth
= XINT (XCAR (tmp
));
2591 if (chartab_size
[depth
] != size
- 2)
2592 error ("Invalid size in sub char-table");
2593 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2596 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2597 error ("Invalid minimum character in sub-char-table");
2598 min_char
= XINT (XCAR (tmp
));
2599 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2602 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2603 for (i
= 0; i
< size
; i
++)
2605 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2606 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2611 invalid_syntax ("#^^");
2613 invalid_syntax ("#^");
2618 length
= read1 (readcharfun
, pch
, first_in_list
);
2622 Lisp_Object tmp
, val
;
2623 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2624 unsigned char *data
;
2627 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2628 if (STRING_MULTIBYTE (tmp
)
2629 || (size_in_chars
!= SCHARS (tmp
)
2630 /* We used to print 1 char too many
2631 when the number of bits was a multiple of 8.
2632 Accept such input in case it came from an old
2634 && ! (XFASTINT (length
)
2635 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2636 invalid_syntax ("#&...");
2638 val
= make_uninit_bool_vector (XFASTINT (length
));
2639 data
= bool_vector_uchar_data (val
);
2640 memcpy (data
, SDATA (tmp
), size_in_chars
);
2641 /* Clear the extraneous bits in the last byte. */
2642 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2643 data
[size_in_chars
- 1]
2644 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2647 invalid_syntax ("#&...");
2651 /* Accept compiled functions at read-time so that we don't have to
2652 build them using function calls. */
2654 struct Lisp_Vector
*vec
;
2655 tmp
= read_vector (readcharfun
, 1);
2656 vec
= XVECTOR (tmp
);
2657 if (vec
->header
.size
== 0)
2658 invalid_syntax ("Empty byte-code object");
2659 make_byte_code (vec
);
2665 struct gcpro gcpro1
;
2668 /* Read the string itself. */
2669 tmp
= read1 (readcharfun
, &ch
, 0);
2670 if (ch
!= 0 || !STRINGP (tmp
))
2671 invalid_syntax ("#");
2673 /* Read the intervals and their properties. */
2676 Lisp_Object beg
, end
, plist
;
2678 beg
= read1 (readcharfun
, &ch
, 0);
2683 end
= read1 (readcharfun
, &ch
, 0);
2685 plist
= read1 (readcharfun
, &ch
, 0);
2687 invalid_syntax ("Invalid string property list");
2688 Fset_text_properties (beg
, end
, plist
, tmp
);
2694 /* #@NUMBER is used to skip NUMBER following bytes.
2695 That's used in .elc files to skip over doc strings
2696 and function definitions. */
2699 enum { extra
= 100 };
2700 ptrdiff_t i
, nskip
= 0, digits
= 0;
2702 /* Read a decimal integer. */
2703 while ((c
= READCHAR
) >= 0
2704 && c
>= '0' && c
<= '9')
2706 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2711 if (digits
== 2 && nskip
== 0)
2712 { /* We've just seen #@00, which means "skip to end". */
2713 skip_dyn_eof (readcharfun
);
2718 /* We can't use UNREAD here, because in the code below we side-step
2719 READCHAR. Instead, assume the first char after #@NNN occupies
2720 a single byte, which is the case normally since it's just
2726 if (load_force_doc_strings
2727 && (FROM_FILE_P (readcharfun
)))
2729 /* If we are supposed to force doc strings into core right now,
2730 record the last string that we skipped,
2731 and record where in the file it comes from. */
2733 /* But first exchange saved_doc_string
2734 with prev_saved_doc_string, so we save two strings. */
2736 char *temp
= saved_doc_string
;
2737 ptrdiff_t temp_size
= saved_doc_string_size
;
2738 file_offset temp_pos
= saved_doc_string_position
;
2739 ptrdiff_t temp_len
= saved_doc_string_length
;
2741 saved_doc_string
= prev_saved_doc_string
;
2742 saved_doc_string_size
= prev_saved_doc_string_size
;
2743 saved_doc_string_position
= prev_saved_doc_string_position
;
2744 saved_doc_string_length
= prev_saved_doc_string_length
;
2746 prev_saved_doc_string
= temp
;
2747 prev_saved_doc_string_size
= temp_size
;
2748 prev_saved_doc_string_position
= temp_pos
;
2749 prev_saved_doc_string_length
= temp_len
;
2752 if (saved_doc_string_size
== 0)
2754 saved_doc_string
= xmalloc (nskip
+ extra
);
2755 saved_doc_string_size
= nskip
+ extra
;
2757 if (nskip
> saved_doc_string_size
)
2759 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2760 saved_doc_string_size
= nskip
+ extra
;
2763 saved_doc_string_position
= file_tell (instream
);
2765 /* Copy that many characters into saved_doc_string. */
2767 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2768 saved_doc_string
[i
] = c
= getc (instream
);
2771 saved_doc_string_length
= i
;
2774 /* Skip that many bytes. */
2775 skip_dyn_bytes (readcharfun
, nskip
);
2781 /* #! appears at the beginning of an executable file.
2782 Skip the first line. */
2783 while (c
!= '\n' && c
>= 0)
2788 return Vload_file_name
;
2790 return list2 (Qfunction
, read0 (readcharfun
));
2791 /* #:foo is the uninterned symbol named foo. */
2794 uninterned_symbol
= 1;
2797 && c
!= NO_BREAK_SPACE
2799 || strchr ("\"';()[]#`,", c
) == NULL
)))
2801 /* No symbol character follows, this is the empty
2804 return Fmake_symbol (empty_unibyte_string
);
2808 /* ## is the empty symbol. */
2810 return Fintern (empty_unibyte_string
, Qnil
);
2811 /* Reader forms that can reuse previously read objects. */
2812 if (c
>= '0' && c
<= '9')
2817 /* Read a non-negative integer. */
2818 while (c
>= '0' && c
<= '9')
2820 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2821 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2822 n
= MOST_POSITIVE_FIXNUM
+ 1;
2824 n
= n
* 10 + c
- '0';
2828 if (n
<= MOST_POSITIVE_FIXNUM
)
2830 if (c
== 'r' || c
== 'R')
2831 return read_integer (readcharfun
, n
);
2833 if (! NILP (Vread_circle
))
2835 /* #n=object returns object, but associates it with
2839 /* Make a placeholder for #n# to use temporarily. */
2840 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2841 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2842 read_objects
= Fcons (cell
, read_objects
);
2844 /* Read the object itself. */
2845 tem
= read0 (readcharfun
);
2847 /* Now put it everywhere the placeholder was... */
2848 substitute_object_in_subtree (tem
, placeholder
);
2850 /* ...and #n# will use the real value from now on. */
2851 Fsetcdr (cell
, tem
);
2856 /* #n# returns a previously read object. */
2859 tem
= Fassq (make_number (n
), read_objects
);
2865 /* Fall through to error message. */
2867 else if (c
== 'x' || c
== 'X')
2868 return read_integer (readcharfun
, 16);
2869 else if (c
== 'o' || c
== 'O')
2870 return read_integer (readcharfun
, 8);
2871 else if (c
== 'b' || c
== 'B')
2872 return read_integer (readcharfun
, 2);
2875 invalid_syntax ("#");
2878 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2882 return list2 (Qquote
, read0 (readcharfun
));
2886 int next_char
= READCHAR
;
2888 /* Transition from old-style to new-style:
2889 If we see "(`" it used to mean old-style, which usually works
2890 fine because ` should almost never appear in such a position
2891 for new-style. But occasionally we need "(`" to mean new
2892 style, so we try to distinguish the two by the fact that we
2893 can either write "( `foo" or "(` foo", where the first
2894 intends to use new-style whereas the second intends to use
2895 old-style. For Emacs-25, we should completely remove this
2896 first_in_list exception (old-style can still be obtained via
2898 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2900 Vold_style_backquotes
= Qt
;
2906 bool saved_new_backquote_flag
= new_backquote_flag
;
2908 new_backquote_flag
= 1;
2909 value
= read0 (readcharfun
);
2910 new_backquote_flag
= saved_new_backquote_flag
;
2912 return list2 (Qbackquote
, value
);
2917 int next_char
= READCHAR
;
2919 /* Transition from old-style to new-style:
2920 It used to be impossible to have a new-style , other than within
2921 a new-style `. This is sufficient when ` and , are used in the
2922 normal way, but ` and , can also appear in args to macros that
2923 will not interpret them in the usual way, in which case , may be
2924 used without any ` anywhere near.
2925 So we now use the same heuristic as for backquote: old-style
2926 unquotes are only recognized when first on a list, and when
2927 followed by a space.
2928 Because it's more difficult to peek 2 chars ahead, a new-style
2929 ,@ can still not be used outside of a `, unless it's in the middle
2931 if (new_backquote_flag
2933 || (next_char
!= ' ' && next_char
!= '@'))
2935 Lisp_Object comma_type
= Qnil
;
2940 comma_type
= Qcomma_at
;
2942 comma_type
= Qcomma_dot
;
2945 if (ch
>= 0) UNREAD (ch
);
2946 comma_type
= Qcomma
;
2949 value
= read0 (readcharfun
);
2950 return list2 (comma_type
, value
);
2954 Vold_style_backquotes
= Qt
;
2966 end_of_file_error ();
2968 /* Accept `single space' syntax like (list ? x) where the
2969 whitespace character is SPC or TAB.
2970 Other literal whitespace like NL, CR, and FF are not accepted,
2971 as there are well-established escape sequences for these. */
2972 if (c
== ' ' || c
== '\t')
2973 return make_number (c
);
2976 c
= read_escape (readcharfun
, 0);
2977 modifiers
= c
& CHAR_MODIFIER_MASK
;
2978 c
&= ~CHAR_MODIFIER_MASK
;
2979 if (CHAR_BYTE8_P (c
))
2980 c
= CHAR_TO_BYTE8 (c
);
2983 next_char
= READCHAR
;
2984 ok
= (next_char
<= 040
2985 || (next_char
< 0200
2986 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2989 return make_number (c
);
2991 invalid_syntax ("?");
2996 char *p
= read_buffer
;
2997 char *end
= read_buffer
+ read_buffer_size
;
2999 /* True if we saw an escape sequence specifying
3000 a multibyte character. */
3001 bool force_multibyte
= 0;
3002 /* True if we saw an escape sequence specifying
3003 a single-byte character. */
3004 bool force_singlebyte
= 0;
3006 ptrdiff_t nchars
= 0;
3008 while ((ch
= READCHAR
) >= 0
3011 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3013 ptrdiff_t offset
= p
- read_buffer
;
3014 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3015 memory_full (SIZE_MAX
);
3016 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3017 read_buffer_size
*= 2;
3018 p
= read_buffer
+ offset
;
3019 end
= read_buffer
+ read_buffer_size
;
3026 ch
= read_escape (readcharfun
, 1);
3028 /* CH is -1 if \ newline or \ space has just been seen. */
3031 if (p
== read_buffer
)
3036 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3037 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3039 if (CHAR_BYTE8_P (ch
))
3040 force_singlebyte
= 1;
3041 else if (! ASCII_CHAR_P (ch
))
3042 force_multibyte
= 1;
3043 else /* I.e. ASCII_CHAR_P (ch). */
3045 /* Allow `\C- ' and `\C-?'. */
3046 if (modifiers
== CHAR_CTL
)
3049 ch
= 0, modifiers
= 0;
3051 ch
= 127, modifiers
= 0;
3053 if (modifiers
& CHAR_SHIFT
)
3055 /* Shift modifier is valid only with [A-Za-z]. */
3056 if (ch
>= 'A' && ch
<= 'Z')
3057 modifiers
&= ~CHAR_SHIFT
;
3058 else if (ch
>= 'a' && ch
<= 'z')
3059 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3062 if (modifiers
& CHAR_META
)
3064 /* Move the meta bit to the right place for a
3066 modifiers
&= ~CHAR_META
;
3067 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3068 force_singlebyte
= 1;
3072 /* Any modifiers remaining are invalid. */
3074 error ("Invalid modifier in string");
3075 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3079 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3080 if (CHAR_BYTE8_P (ch
))
3081 force_singlebyte
= 1;
3082 else if (! ASCII_CHAR_P (ch
))
3083 force_multibyte
= 1;
3089 end_of_file_error ();
3091 /* If purifying, and string starts with \ newline,
3092 return zero instead. This is for doc strings
3093 that we are really going to find in etc/DOC.nn.nn. */
3094 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3095 return make_number (0);
3097 if (! force_multibyte
&& force_singlebyte
)
3099 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3100 forms. Convert it to unibyte. */
3101 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3103 p
= read_buffer
+ nchars
;
3106 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3108 || (p
- read_buffer
!= nchars
)));
3113 int next_char
= READCHAR
;
3116 if (next_char
<= 040
3117 || (next_char
< 0200
3118 && strchr ("\"';([#?`,", next_char
) != NULL
))
3124 /* Otherwise, we fall through! Note that the atom-reading loop
3125 below will now loop at least once, assuring that we will not
3126 try to UNREAD two characters in a row. */
3130 if (c
<= 040) goto retry
;
3131 if (c
== NO_BREAK_SPACE
)
3136 char *p
= read_buffer
;
3138 EMACS_INT start_position
= readchar_count
- 1;
3141 char *end
= read_buffer
+ read_buffer_size
;
3145 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3147 ptrdiff_t offset
= p
- read_buffer
;
3148 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3149 memory_full (SIZE_MAX
);
3150 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3151 read_buffer_size
*= 2;
3152 p
= read_buffer
+ offset
;
3153 end
= read_buffer
+ read_buffer_size
;
3160 end_of_file_error ();
3165 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3171 && c
!= NO_BREAK_SPACE
3173 || strchr ("\"';()[]#`,", c
) == NULL
));
3177 ptrdiff_t offset
= p
- read_buffer
;
3178 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3179 memory_full (SIZE_MAX
);
3180 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3181 read_buffer_size
*= 2;
3182 p
= read_buffer
+ offset
;
3183 end
= read_buffer
+ read_buffer_size
;
3189 if (!quoted
&& !uninterned_symbol
)
3191 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3192 if (! NILP (result
))
3196 Lisp_Object name
, result
;
3197 ptrdiff_t nbytes
= p
- read_buffer
;
3200 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3204 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3205 ? make_pure_string
: make_specified_string
)
3206 (read_buffer
, nchars
, nbytes
, multibyte
));
3207 result
= (uninterned_symbol
? Fmake_symbol (name
)
3208 : Fintern (name
, Qnil
));
3210 if (EQ (Vread_with_symbol_positions
, Qt
)
3211 || EQ (Vread_with_symbol_positions
, readcharfun
))
3212 Vread_symbol_positions_list
3213 = Fcons (Fcons (result
, make_number (start_position
)),
3214 Vread_symbol_positions_list
);
3222 /* List of nodes we've seen during substitute_object_in_subtree. */
3223 static Lisp_Object seen_list
;
3226 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3228 Lisp_Object check_object
;
3230 /* We haven't seen any objects when we start. */
3233 /* Make all the substitutions. */
3235 = substitute_object_recurse (object
, placeholder
, object
);
3237 /* Clear seen_list because we're done with it. */
3240 /* The returned object here is expected to always eq the
3242 if (!EQ (check_object
, object
))
3243 error ("Unexpected mutation error in reader");
3246 /* Feval doesn't get called from here, so no gc protection is needed. */
3247 #define SUBSTITUTE(get_val, set_val) \
3249 Lisp_Object old_value = get_val; \
3250 Lisp_Object true_value \
3251 = substitute_object_recurse (object, placeholder, \
3254 if (!EQ (old_value, true_value)) \
3261 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3263 /* If we find the placeholder, return the target object. */
3264 if (EQ (placeholder
, subtree
))
3267 /* If we've been to this node before, don't explore it again. */
3268 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3271 /* If this node can be the entry point to a cycle, remember that
3272 we've seen it. It can only be such an entry point if it was made
3273 by #n=, which means that we can find it as a value in
3275 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3276 seen_list
= Fcons (subtree
, seen_list
);
3278 /* Recurse according to subtree's type.
3279 Every branch must return a Lisp_Object. */
3280 switch (XTYPE (subtree
))
3282 case Lisp_Vectorlike
:
3284 ptrdiff_t i
= 0, length
= 0;
3285 if (BOOL_VECTOR_P (subtree
))
3286 return subtree
; /* No sub-objects anyway. */
3287 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3288 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3289 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3290 else if (VECTORP (subtree
))
3291 length
= ASIZE (subtree
);
3293 /* An unknown pseudovector may contain non-Lisp fields, so we
3294 can't just blindly traverse all its fields. We used to call
3295 `Flength' which signaled `sequencep', so I just preserved this
3297 wrong_type_argument (Qsequencep
, subtree
);
3299 if (SUB_CHAR_TABLE_P (subtree
))
3301 for ( ; i
< length
; i
++)
3302 SUBSTITUTE (AREF (subtree
, i
),
3303 ASET (subtree
, i
, true_value
));
3309 SUBSTITUTE (XCAR (subtree
),
3310 XSETCAR (subtree
, true_value
));
3311 SUBSTITUTE (XCDR (subtree
),
3312 XSETCDR (subtree
, true_value
));
3318 /* Check for text properties in each interval.
3319 substitute_in_interval contains part of the logic. */
3321 INTERVAL root_interval
= string_intervals (subtree
);
3322 AUTO_CONS (arg
, object
, placeholder
);
3324 traverse_intervals_noorder (root_interval
,
3325 &substitute_in_interval
, arg
);
3330 /* Other types don't recurse any further. */
3336 /* Helper function for substitute_object_recurse. */
3338 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3340 Lisp_Object object
= Fcar (arg
);
3341 Lisp_Object placeholder
= Fcdr (arg
);
3343 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3353 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3354 integer syntax and fits in a fixnum, else return the nearest float if CP has
3355 either floating point or integer syntax and BASE is 10, else return nil. If
3356 IGNORE_TRAILING, consider just the longest prefix of CP that has
3357 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3358 number has integer syntax but does not fit. */
3361 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3364 char const *cp
= string
;
3366 bool float_syntax
= 0;
3369 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3370 IEEE floating point hosts, and works around a formerly-common bug where
3371 atof ("-0.0") drops the sign. */
3372 bool negative
= *cp
== '-';
3374 bool signedp
= negative
|| *cp
== '+';
3379 leading_digit
= digit_to_number (*cp
, base
);
3380 if (leading_digit
>= 0)
3385 while (digit_to_number (*cp
, base
) >= 0);
3395 if ('0' <= *cp
&& *cp
<= '9')
3400 while ('0' <= *cp
&& *cp
<= '9');
3402 if (*cp
== 'e' || *cp
== 'E')
3404 char const *ecp
= cp
;
3406 if (*cp
== '+' || *cp
== '-')
3408 if ('0' <= *cp
&& *cp
<= '9')
3413 while ('0' <= *cp
&& *cp
<= '9');
3415 else if (cp
[-1] == '+'
3416 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3422 else if (cp
[-1] == '+'
3423 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3427 /* NAN is a "positive" NaN on all known Emacs hosts. */
3434 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3435 || state
== (LEAD_INT
|E_EXP
));
3438 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3439 any prefix that matches. Otherwise, the entire string must match. */
3440 if (! (ignore_trailing
3441 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3442 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3445 /* If the number uses integer and not float syntax, and is in C-language
3446 range, use its value, preferably as a fixnum. */
3447 if (leading_digit
>= 0 && ! float_syntax
)
3451 /* Fast special case for single-digit integers. This also avoids a
3452 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3453 case some versions of strtoumax accept numbers like "0x1" that Emacs
3455 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3456 return make_number (negative
? -leading_digit
: leading_digit
);
3459 n
= strtoumax (string
+ signedp
, NULL
, base
);
3460 if (errno
== ERANGE
)
3462 /* Unfortunately there's no simple and accurate way to convert
3463 non-base-10 numbers that are out of C-language range. */
3465 xsignal1 (Qoverflow_error
, build_string (string
));
3467 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3469 EMACS_INT signed_n
= n
;
3470 return make_number (negative
? -signed_n
: signed_n
);
3476 /* Either the number uses float syntax, or it does not fit into a fixnum.
3477 Convert it from string to floating point, unless the value is already
3478 known because it is an infinity, a NAN, or its absolute value fits in
3481 value
= atof (string
+ signedp
);
3483 return make_float (negative
? -value
: value
);
3488 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3492 Lisp_Object tem
, item
, vector
;
3493 struct Lisp_Cons
*otem
;
3496 tem
= read_list (1, readcharfun
);
3497 len
= Flength (tem
);
3498 vector
= Fmake_vector (len
, Qnil
);
3500 size
= ASIZE (vector
);
3501 ptr
= XVECTOR (vector
)->contents
;
3502 for (i
= 0; i
< size
; i
++)
3505 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3506 bytecode object, the docstring containing the bytecode and
3507 constants values must be treated as unibyte and passed to
3508 Fread, to get the actual bytecode string and constants vector. */
3509 if (bytecodeflag
&& load_force_doc_strings
)
3511 if (i
== COMPILED_BYTECODE
)
3513 if (!STRINGP (item
))
3514 error ("Invalid byte code");
3516 /* Delay handling the bytecode slot until we know whether
3517 it is lazily-loaded (we can tell by whether the
3518 constants slot is nil). */
3519 ASET (vector
, COMPILED_CONSTANTS
, item
);
3522 else if (i
== COMPILED_CONSTANTS
)
3524 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3528 /* Coerce string to unibyte (like string-as-unibyte,
3529 but without generating extra garbage and
3530 guaranteeing no change in the contents). */
3531 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3532 STRING_SET_UNIBYTE (bytestr
);
3534 item
= Fread (Fcons (bytestr
, readcharfun
));
3536 error ("Invalid byte code");
3538 otem
= XCONS (item
);
3539 bytestr
= XCAR (item
);
3544 /* Now handle the bytecode slot. */
3545 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3547 else if (i
== COMPILED_DOC_STRING
3549 && ! STRING_MULTIBYTE (item
))
3551 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3552 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3554 item
= Fstring_as_multibyte (item
);
3557 ASET (vector
, i
, item
);
3565 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3568 read_list (bool flag
, Lisp_Object readcharfun
)
3570 Lisp_Object val
, tail
;
3571 Lisp_Object elt
, tem
;
3572 struct gcpro gcpro1
, gcpro2
;
3573 /* 0 is the normal case.
3574 1 means this list is a doc reference; replace it with the number 0.
3575 2 means this list is a doc reference; replace it with the doc string. */
3576 int doc_reference
= 0;
3578 /* Initialize this to 1 if we are reading a list. */
3579 bool first_in_list
= flag
<= 0;
3588 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3593 /* While building, if the list starts with #$, treat it specially. */
3594 if (EQ (elt
, Vload_file_name
)
3596 && !NILP (Vpurify_flag
))
3598 if (NILP (Vdoc_file_name
))
3599 /* We have not yet called Snarf-documentation, so assume
3600 this file is described in the DOC file
3601 and Snarf-documentation will fill in the right value later.
3602 For now, replace the whole list with 0. */
3605 /* We have already called Snarf-documentation, so make a relative
3606 file name for this file, so it can be found properly
3607 in the installed Lisp directory.
3608 We don't use Fexpand_file_name because that would make
3609 the directory absolute now. */
3611 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3612 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3615 else if (EQ (elt
, Vload_file_name
)
3617 && load_force_doc_strings
)
3626 invalid_syntax (") or . in a vector");
3634 XSETCDR (tail
, read0 (readcharfun
));
3636 val
= read0 (readcharfun
);
3637 read1 (readcharfun
, &ch
, 0);
3641 if (doc_reference
== 1)
3642 return make_number (0);
3643 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3646 file_offset saved_position
;
3647 /* Get a doc string from the file we are loading.
3648 If it's in saved_doc_string, get it from there.
3650 Here, we don't know if the string is a
3651 bytecode string or a doc string. As a
3652 bytecode string must be unibyte, we always
3653 return a unibyte string. If it is actually a
3654 doc string, caller must make it
3657 /* Position is negative for user variables. */
3658 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3659 if (pos
>= saved_doc_string_position
3660 && pos
< (saved_doc_string_position
3661 + saved_doc_string_length
))
3663 saved
= saved_doc_string
;
3664 saved_position
= saved_doc_string_position
;
3666 /* Look in prev_saved_doc_string the same way. */
3667 else if (pos
>= prev_saved_doc_string_position
3668 && pos
< (prev_saved_doc_string_position
3669 + prev_saved_doc_string_length
))
3671 saved
= prev_saved_doc_string
;
3672 saved_position
= prev_saved_doc_string_position
;
3676 ptrdiff_t start
= pos
- saved_position
;
3679 /* Process quoting with ^A,
3680 and find the end of the string,
3681 which is marked with ^_ (037). */
3682 for (from
= start
, to
= start
;
3683 saved
[from
] != 037;)
3685 int c
= saved
[from
++];
3689 saved
[to
++] = (c
== 1 ? c
3698 return make_unibyte_string (saved
+ start
,
3702 return get_doc_string (val
, 1, 0);
3707 invalid_syntax (". in wrong context");
3709 invalid_syntax ("] in a list");
3713 XSETCDR (tail
, tem
);
3720 static Lisp_Object initial_obarray
;
3722 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3724 static size_t oblookup_last_bucket_number
;
3726 /* Get an error if OBARRAY is not an obarray.
3727 If it is one, return it. */
3730 check_obarray (Lisp_Object obarray
)
3732 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3734 /* If Vobarray is now invalid, force it to be valid. */
3735 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3736 wrong_type_argument (Qvectorp
, obarray
);
3741 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3744 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3748 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3749 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3752 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3754 XSYMBOL (sym
)->constant
= 1;
3755 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3756 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3759 ptr
= aref_addr (obarray
, XINT (index
));
3760 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3765 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3768 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3770 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3773 /* Intern the C string STR: return a symbol with that name,
3774 interned in the current obarray. */
3777 intern_1 (const char *str
, ptrdiff_t len
)
3779 Lisp_Object obarray
= check_obarray (Vobarray
);
3780 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3782 return (SYMBOLP (tem
) ? tem
3783 /* The above `oblookup' was done on the basis of nchars==nbytes, so
3784 the string has to be unibyte. */
3785 : intern_driver (make_unibyte_string (str
, len
),
3790 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3792 Lisp_Object obarray
= check_obarray (Vobarray
);
3793 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3797 /* Creating a non-pure string from a string literal not implemented yet.
3798 We could just use make_string here and live with the extra copy. */
3799 eassert (!NILP (Vpurify_flag
));
3800 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3806 define_symbol (Lisp_Object sym
, char const *str
)
3808 ptrdiff_t len
= strlen (str
);
3809 Lisp_Object string
= make_pure_c_string (str
, len
);
3810 init_symbol (sym
, string
);
3812 /* Qunbound is uninterned, so that it's not confused with any symbol
3813 'unbound' created by a Lisp program. */
3814 if (! EQ (sym
, Qunbound
))
3816 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3817 eassert (INTEGERP (bucket
));
3818 intern_sym (sym
, initial_obarray
, bucket
);
3822 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3823 doc
: /* Return the canonical symbol whose name is STRING.
3824 If there is none, one is created by this function and returned.
3825 A second optional argument specifies the obarray to use;
3826 it defaults to the value of `obarray'. */)
3827 (Lisp_Object string
, Lisp_Object obarray
)
3831 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3832 CHECK_STRING (string
);
3834 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3836 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3841 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3842 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3843 NAME may be a string or a symbol. If it is a symbol, that exact
3844 symbol is searched for.
3845 A second optional argument specifies the obarray to use;
3846 it defaults to the value of `obarray'. */)
3847 (Lisp_Object name
, Lisp_Object obarray
)
3849 register Lisp_Object tem
, string
;
3851 if (NILP (obarray
)) obarray
= Vobarray
;
3852 obarray
= check_obarray (obarray
);
3854 if (!SYMBOLP (name
))
3856 CHECK_STRING (name
);
3860 string
= SYMBOL_NAME (name
);
3862 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3863 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3869 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3870 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3871 The value is t if a symbol was found and deleted, nil otherwise.
3872 NAME may be a string or a symbol. If it is a symbol, that symbol
3873 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3874 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3875 usage: (unintern NAME OBARRAY) */)
3876 (Lisp_Object name
, Lisp_Object obarray
)
3878 register Lisp_Object string
, tem
;
3881 if (NILP (obarray
)) obarray
= Vobarray
;
3882 obarray
= check_obarray (obarray
);
3885 string
= SYMBOL_NAME (name
);
3888 CHECK_STRING (name
);
3892 tem
= oblookup (obarray
, SSDATA (string
),
3897 /* If arg was a symbol, don't delete anything but that symbol itself. */
3898 if (SYMBOLP (name
) && !EQ (name
, tem
))
3901 /* There are plenty of other symbols which will screw up the Emacs
3902 session if we unintern them, as well as even more ways to use
3903 `setq' or `fset' or whatnot to make the Emacs session
3904 unusable. Let's not go down this silly road. --Stef */
3905 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3906 error ("Attempt to unintern t or nil"); */
3908 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3910 hash
= oblookup_last_bucket_number
;
3912 if (EQ (AREF (obarray
, hash
), tem
))
3914 if (XSYMBOL (tem
)->next
)
3917 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3918 ASET (obarray
, hash
, sym
);
3921 ASET (obarray
, hash
, make_number (0));
3925 Lisp_Object tail
, following
;
3927 for (tail
= AREF (obarray
, hash
);
3928 XSYMBOL (tail
)->next
;
3931 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3932 if (EQ (following
, tem
))
3934 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3943 /* Return the symbol in OBARRAY whose names matches the string
3944 of SIZE characters (SIZE_BYTE bytes) at PTR.
3945 If there is no such symbol, return the integer bucket number of
3946 where the symbol would be if it were present.
3948 Also store the bucket number in oblookup_last_bucket_number. */
3951 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3955 register Lisp_Object tail
;
3956 Lisp_Object bucket
, tem
;
3958 obarray
= check_obarray (obarray
);
3959 obsize
= ASIZE (obarray
);
3961 /* This is sometimes needed in the middle of GC. */
3962 obsize
&= ~ARRAY_MARK_FLAG
;
3963 hash
= hash_string (ptr
, size_byte
) % obsize
;
3964 bucket
= AREF (obarray
, hash
);
3965 oblookup_last_bucket_number
= hash
;
3966 if (EQ (bucket
, make_number (0)))
3968 else if (!SYMBOLP (bucket
))
3969 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3971 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3973 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3974 && SCHARS (SYMBOL_NAME (tail
)) == size
3975 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3977 else if (XSYMBOL (tail
)->next
== 0)
3980 XSETINT (tem
, hash
);
3985 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3988 register Lisp_Object tail
;
3989 CHECK_VECTOR (obarray
);
3990 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3992 tail
= AREF (obarray
, i
);
3997 if (XSYMBOL (tail
)->next
== 0)
3999 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4005 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4007 call1 (function
, sym
);
4010 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4011 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4012 OBARRAY defaults to the value of `obarray'. */)
4013 (Lisp_Object function
, Lisp_Object obarray
)
4015 if (NILP (obarray
)) obarray
= Vobarray
;
4016 obarray
= check_obarray (obarray
);
4018 map_obarray (obarray
, mapatoms_1
, function
);
4022 #define OBARRAY_SIZE 1511
4027 Lisp_Object oblength
;
4028 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4030 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4032 Vobarray
= Fmake_vector (oblength
, make_number (0));
4033 initial_obarray
= Vobarray
;
4034 staticpro (&initial_obarray
);
4036 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4037 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4039 DEFSYM (Qunbound
, "unbound");
4041 DEFSYM (Qnil
, "nil");
4042 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4043 XSYMBOL (Qnil
)->constant
= 1;
4044 XSYMBOL (Qnil
)->declared_special
= true;
4047 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4048 XSYMBOL (Qt
)->constant
= 1;
4049 XSYMBOL (Qt
)->declared_special
= true;
4051 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4054 DEFSYM (Qvariable_documentation
, "variable-documentation");
4056 read_buffer
= xmalloc (size
);
4057 read_buffer_size
= size
;
4061 defsubr (struct Lisp_Subr
*sname
)
4063 Lisp_Object sym
, tem
;
4064 sym
= intern_c_string (sname
->symbol_name
);
4065 XSETPVECTYPE (sname
, PVEC_SUBR
);
4066 XSETSUBR (tem
, sname
);
4067 set_symbol_function (sym
, tem
);
4070 #ifdef NOTDEF /* Use fset in subr.el now! */
4072 defalias (struct Lisp_Subr
*sname
, char *string
)
4075 sym
= intern (string
);
4076 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4080 /* Define an "integer variable"; a symbol whose value is forwarded to a
4081 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4082 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4084 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4085 const char *namestring
, EMACS_INT
*address
)
4088 sym
= intern_c_string (namestring
);
4089 i_fwd
->type
= Lisp_Fwd_Int
;
4090 i_fwd
->intvar
= address
;
4091 XSYMBOL (sym
)->declared_special
= 1;
4092 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4093 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4096 /* Similar but define a variable whose value is t if address contains 1,
4097 nil if address contains 0. */
4099 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4100 const char *namestring
, bool *address
)
4103 sym
= intern_c_string (namestring
);
4104 b_fwd
->type
= Lisp_Fwd_Bool
;
4105 b_fwd
->boolvar
= address
;
4106 XSYMBOL (sym
)->declared_special
= 1;
4107 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4108 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4109 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4112 /* Similar but define a variable whose value is the Lisp Object stored
4113 at address. Two versions: with and without gc-marking of the C
4114 variable. The nopro version is used when that variable will be
4115 gc-marked for some other reason, since marking the same slot twice
4116 can cause trouble with strings. */
4118 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4119 const char *namestring
, Lisp_Object
*address
)
4122 sym
= intern_c_string (namestring
);
4123 o_fwd
->type
= Lisp_Fwd_Obj
;
4124 o_fwd
->objvar
= address
;
4125 XSYMBOL (sym
)->declared_special
= 1;
4126 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4127 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4131 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4132 const char *namestring
, Lisp_Object
*address
)
4134 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4135 staticpro (address
);
4138 /* Similar but define a variable whose value is the Lisp Object stored
4139 at a particular offset in the current kboard object. */
4142 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4143 const char *namestring
, int offset
)
4146 sym
= intern_c_string (namestring
);
4147 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4148 ko_fwd
->offset
= offset
;
4149 XSYMBOL (sym
)->declared_special
= 1;
4150 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4151 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4154 /* Check that the elements of lpath exist. */
4157 load_path_check (Lisp_Object lpath
)
4159 Lisp_Object path_tail
;
4161 /* The only elements that might not exist are those from
4162 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4164 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4166 Lisp_Object dirfile
;
4167 dirfile
= Fcar (path_tail
);
4168 if (STRINGP (dirfile
))
4170 dirfile
= Fdirectory_file_name (dirfile
);
4171 if (! file_accessible_directory_p (dirfile
))
4172 dir_warning ("Lisp directory", XCAR (path_tail
));
4177 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4178 This does not include the standard site-lisp directories
4179 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4180 but it does (unless no_site_lisp is set) include site-lisp
4181 directories in the source/build directories if those exist and we
4182 are running uninstalled.
4184 Uses the following logic:
4185 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4186 The remainder is what happens when dumping works:
4187 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4188 Otherwise use PATH_LOADSEARCH.
4190 If !initialized, then just return PATH_DUMPLOADSEARCH.
4192 If Vinstallation_directory is not nil (ie, running uninstalled):
4193 If installation-dir/lisp exists and not already a member,
4194 we must be running uninstalled. Reset the load-path
4195 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4196 refers to the eventual installation directories. Since we
4197 are not yet installed, we should not use them, even if they exist.)
4198 If installation-dir/lisp does not exist, just add
4199 PATH_DUMPLOADSEARCH at the end instead.
4200 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4201 and not already a member) at the front.
4202 If installation-dir != source-dir (ie running an uninstalled,
4203 out-of-tree build) AND install-dir/src/Makefile exists BUT
4204 install-dir/src/Makefile.in does NOT exist (this is a sanity
4205 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4208 load_path_default (void)
4210 Lisp_Object lpath
= Qnil
;
4215 const char *loadpath
= ns_load_path ();
4218 normal
= PATH_LOADSEARCH
;
4220 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4222 lpath
= decode_env_path (0, normal
, 0);
4225 #else /* !CANNOT_DUMP */
4227 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4232 const char *loadpath
= ns_load_path ();
4233 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4235 lpath
= decode_env_path (0, normal
, 0);
4237 if (!NILP (Vinstallation_directory
))
4239 Lisp_Object tem
, tem1
;
4241 /* Add to the path the lisp subdir of the installation
4242 dir, if it is accessible. Note: in out-of-tree builds,
4243 this directory is empty save for Makefile. */
4244 tem
= Fexpand_file_name (build_string ("lisp"),
4245 Vinstallation_directory
);
4246 tem1
= Ffile_accessible_directory_p (tem
);
4249 if (NILP (Fmember (tem
, lpath
)))
4251 /* We are running uninstalled. The default load-path
4252 points to the eventual installed lisp directories.
4253 We should not use those now, even if they exist,
4254 so start over from a clean slate. */
4255 lpath
= list1 (tem
);
4259 /* That dir doesn't exist, so add the build-time
4260 Lisp dirs instead. */
4262 Lisp_Object dump_path
=
4263 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4264 lpath
= nconc2 (lpath
, dump_path
);
4267 /* Add site-lisp under the installation dir, if it exists. */
4270 tem
= Fexpand_file_name (build_string ("site-lisp"),
4271 Vinstallation_directory
);
4272 tem1
= Ffile_accessible_directory_p (tem
);
4275 if (NILP (Fmember (tem
, lpath
)))
4276 lpath
= Fcons (tem
, lpath
);
4280 /* If Emacs was not built in the source directory,
4281 and it is run from where it was built, add to load-path
4282 the lisp and site-lisp dirs under that directory. */
4284 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4288 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4289 Vinstallation_directory
);
4290 tem1
= Ffile_exists_p (tem
);
4292 /* Don't be fooled if they moved the entire source tree
4293 AFTER dumping Emacs. If the build directory is indeed
4294 different from the source dir, src/Makefile.in and
4295 src/Makefile will not be found together. */
4296 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4297 Vinstallation_directory
);
4298 tem2
= Ffile_exists_p (tem
);
4299 if (!NILP (tem1
) && NILP (tem2
))
4301 tem
= Fexpand_file_name (build_string ("lisp"),
4304 if (NILP (Fmember (tem
, lpath
)))
4305 lpath
= Fcons (tem
, lpath
);
4309 tem
= Fexpand_file_name (build_string ("site-lisp"),
4311 tem1
= Ffile_accessible_directory_p (tem
);
4314 if (NILP (Fmember (tem
, lpath
)))
4315 lpath
= Fcons (tem
, lpath
);
4319 } /* Vinstallation_directory != Vsource_directory */
4321 } /* if Vinstallation_directory */
4323 else /* !initialized */
4325 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4326 source directory. We used to add ../lisp (ie the lisp dir in
4327 the build directory) at the front here, but that should not
4328 be necessary, since in out of tree builds lisp/ is empty, save
4330 lpath
= decode_env_path (0, normal
, 0);
4332 #endif /* !CANNOT_DUMP */
4340 /* First, set Vload_path. */
4342 /* Ignore EMACSLOADPATH when dumping. */
4344 bool use_loadpath
= true;
4346 bool use_loadpath
= NILP (Vpurify_flag
);
4349 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4351 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4353 /* Check (non-nil) user-supplied elements. */
4354 load_path_check (Vload_path
);
4356 /* If no nils in the environment variable, use as-is.
4357 Otherwise, replace any nils with the default. */
4358 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4360 Lisp_Object elem
, elpath
= Vload_path
;
4361 Lisp_Object default_lpath
= load_path_default ();
4363 /* Check defaults, before adding site-lisp. */
4364 load_path_check (default_lpath
);
4366 /* Add the site-lisp directories to the front of the default. */
4369 Lisp_Object sitelisp
;
4370 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4371 if (! NILP (sitelisp
))
4372 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4377 /* Replace nils from EMACSLOADPATH by default. */
4378 while (CONSP (elpath
))
4380 elem
= XCAR (elpath
);
4381 elpath
= XCDR (elpath
);
4382 Vload_path
= CALLN (Fappend
, Vload_path
,
4383 NILP (elem
) ? default_lpath
: list1 (elem
));
4385 } /* Fmemq (Qnil, Vload_path) */
4389 Vload_path
= load_path_default ();
4391 /* Check before adding site-lisp directories.
4392 The install should have created them, but they are not
4393 required, so no need to warn if they are absent.
4394 Or we might be running before installation. */
4395 load_path_check (Vload_path
);
4397 /* Add the site-lisp directories at the front. */
4398 if (initialized
&& !no_site_lisp
)
4400 Lisp_Object sitelisp
;
4401 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4402 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4408 load_in_progress
= 0;
4409 Vload_file_name
= Qnil
;
4410 Vstandard_input
= Qt
;
4411 Vloads_in_progress
= Qnil
;
4414 /* Print a warning that directory intended for use USE and with name
4415 DIRNAME cannot be accessed. On entry, errno should correspond to
4416 the access failure. Print the warning on stderr and put it in
4420 dir_warning (char const *use
, Lisp_Object dirname
)
4422 static char const format
[] = "Warning: %s '%s': %s\n";
4423 int access_errno
= errno
;
4424 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)),
4425 strerror (access_errno
));
4427 /* Don't log the warning before we've initialized!! */
4430 char const *diagnostic
= emacs_strerror (access_errno
);
4432 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4433 + strlen (use
) + SBYTES (dirname
)
4434 + strlen (diagnostic
));
4435 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4437 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4443 syms_of_lread (void)
4446 defsubr (&Sread_from_string
);
4448 defsubr (&Sintern_soft
);
4449 defsubr (&Sunintern
);
4450 defsubr (&Sget_load_suffixes
);
4452 defsubr (&Seval_buffer
);
4453 defsubr (&Seval_region
);
4454 defsubr (&Sread_char
);
4455 defsubr (&Sread_char_exclusive
);
4456 defsubr (&Sread_event
);
4457 defsubr (&Sget_file_char
);
4458 defsubr (&Smapatoms
);
4459 defsubr (&Slocate_file_internal
);
4461 DEFVAR_LISP ("obarray", Vobarray
,
4462 doc
: /* Symbol table for use by `intern' and `read'.
4463 It is a vector whose length ought to be prime for best results.
4464 The vector's contents don't make sense if examined from Lisp programs;
4465 to find all the symbols in an obarray, use `mapatoms'. */);
4467 DEFVAR_LISP ("values", Vvalues
,
4468 doc
: /* List of values of all expressions which were read, evaluated and printed.
4469 Order is reverse chronological. */);
4470 XSYMBOL (intern ("values"))->declared_special
= 0;
4472 DEFVAR_LISP ("standard-input", Vstandard_input
,
4473 doc
: /* Stream for read to get input from.
4474 See documentation of `read' for possible values. */);
4475 Vstandard_input
= Qt
;
4477 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4478 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4480 If this variable is a buffer, then only forms read from that buffer
4481 will be added to `read-symbol-positions-list'.
4482 If this variable is t, then all read forms will be added.
4483 The effect of all other values other than nil are not currently
4484 defined, although they may be in the future.
4486 The positions are relative to the last call to `read' or
4487 `read-from-string'. It is probably a bad idea to set this variable at
4488 the toplevel; bind it instead. */);
4489 Vread_with_symbol_positions
= Qnil
;
4491 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4492 doc
: /* A list mapping read symbols to their positions.
4493 This variable is modified during calls to `read' or
4494 `read-from-string', but only when `read-with-symbol-positions' is
4497 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4498 CHAR-POSITION is an integer giving the offset of that occurrence of the
4499 symbol from the position where `read' or `read-from-string' started.
4501 Note that a symbol will appear multiple times in this list, if it was
4502 read multiple times. The list is in the same order as the symbols
4504 Vread_symbol_positions_list
= Qnil
;
4506 DEFVAR_LISP ("read-circle", Vread_circle
,
4507 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4510 DEFVAR_LISP ("load-path", Vload_path
,
4511 doc
: /* List of directories to search for files to load.
4512 Each element is a string (directory name) or nil (meaning `default-directory').
4513 Initialized during startup as described in Info node `(elisp)Library Search'. */);
4515 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4516 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4517 This list should not include the empty string.
4518 `load' and related functions try to append these suffixes, in order,
4519 to the specified file name if a Lisp suffix is allowed or required. */);
4520 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4521 build_pure_c_string (".el"));
4522 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4523 doc
: /* List of suffixes that indicate representations of \
4525 This list should normally start with the empty string.
4527 Enabling Auto Compression mode appends the suffixes in
4528 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4529 mode removes them again. `load' and related functions use this list to
4530 determine whether they should look for compressed versions of a file
4531 and, if so, which suffixes they should try to append to the file name
4532 in order to do so. However, if you want to customize which suffixes
4533 the loading functions recognize as compression suffixes, you should
4534 customize `jka-compr-load-suffixes' rather than the present variable. */);
4535 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4537 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4538 doc
: /* Non-nil if inside of `load'. */);
4539 DEFSYM (Qload_in_progress
, "load-in-progress");
4541 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4542 doc
: /* An alist of functions to be evalled when particular files are loaded.
4543 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4545 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4546 a symbol \(a feature name).
4548 When `load' is run and the file-name argument matches an element's
4549 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4550 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4552 An error in FORMS does not undo the load, but does prevent execution of
4553 the rest of the FORMS. */);
4554 Vafter_load_alist
= Qnil
;
4556 DEFVAR_LISP ("load-history", Vload_history
,
4557 doc
: /* Alist mapping loaded file names to symbols and features.
4558 Each alist element should be a list (FILE-NAME ENTRIES...), where
4559 FILE-NAME is the name of a file that has been loaded into Emacs.
4560 The file name is absolute and true (i.e. it doesn't contain symlinks).
4561 As an exception, one of the alist elements may have FILE-NAME nil,
4562 for symbols and features not associated with any file.
4564 The remaining ENTRIES in the alist element describe the functions and
4565 variables defined in that file, the features provided, and the
4566 features required. Each entry has the form `(provide . FEATURE)',
4567 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4568 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4569 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4570 autoload before this file redefined it as a function. In addition,
4571 entries may also be single symbols, which means that SYMBOL was
4572 defined by `defvar' or `defconst'.
4574 During preloading, the file name recorded is relative to the main Lisp
4575 directory. These file names are converted to absolute at startup. */);
4576 Vload_history
= Qnil
;
4578 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4579 doc
: /* Full name of file being loaded by `load'. */);
4580 Vload_file_name
= Qnil
;
4582 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4583 doc
: /* File name, including directory, of user's initialization file.
4584 If the file loaded had extension `.elc', and the corresponding source file
4585 exists, this variable contains the name of source file, suitable for use
4586 by functions like `custom-save-all' which edit the init file.
4587 While Emacs loads and evaluates the init file, value is the real name
4588 of the file, regardless of whether or not it has the `.elc' extension. */);
4589 Vuser_init_file
= Qnil
;
4591 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4592 doc
: /* Used for internal purposes by `load'. */);
4593 Vcurrent_load_list
= Qnil
;
4595 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4596 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4597 Called with a single argument (the stream from which to read).
4598 The default is to use the function `read'. */);
4599 DEFSYM (Qread
, "read");
4600 Vload_read_function
= Qread
;
4602 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4603 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4604 The value should be a function for doing code conversion before
4605 reading a source file. It can also be nil, in which case loading is
4606 done without any code conversion.
4608 If the value is a function, it is called with four arguments,
4609 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4610 the file to load, FILE is the non-absolute name (for messages etc.),
4611 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4612 `load'. The function should return t if the file was loaded. */);
4613 Vload_source_file_function
= Qnil
;
4615 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4616 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4617 This is useful when the file being loaded is a temporary copy. */);
4618 load_force_doc_strings
= 0;
4620 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4621 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4622 This is normally bound by `load' and `eval-buffer' to control `read',
4623 and is not meant for users to change. */);
4624 load_convert_to_unibyte
= 0;
4626 DEFVAR_LISP ("source-directory", Vsource_directory
,
4627 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4628 You cannot count on them to still be there! */);
4630 = Fexpand_file_name (build_string ("../"),
4631 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4633 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4634 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4635 Vpreloaded_file_list
= Qnil
;
4637 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4638 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4639 Vbyte_boolean_vars
= Qnil
;
4641 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4642 doc
: /* Non-nil means load dangerous compiled Lisp files.
4643 Some versions of XEmacs use different byte codes than Emacs. These
4644 incompatible byte codes can make Emacs crash when it tries to execute
4646 load_dangerous_libraries
= 0;
4648 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4649 doc
: /* Non-nil means force printing messages when loading Lisp files.
4650 This overrides the value of the NOMESSAGE argument to `load'. */);
4651 force_load_messages
= 0;
4653 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4654 doc
: /* Regular expression matching safe to load compiled Lisp files.
4655 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4656 from the file, and matches them against this regular expression.
4657 When the regular expression matches, the file is considered to be safe
4658 to load. See also `load-dangerous-libraries'. */);
4659 Vbytecomp_version_regexp
4660 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4662 DEFSYM (Qlexical_binding
, "lexical-binding");
4663 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4664 doc
: /* Whether to use lexical binding when evaluating code.
4665 Non-nil means that the code in the current buffer should be evaluated
4666 with lexical binding.
4667 This variable is automatically set from the file variables of an
4668 interpreted Lisp file read using `load'. Unlike other file local
4669 variables, this must be set in the first line of a file. */);
4670 Vlexical_binding
= Qnil
;
4671 Fmake_variable_buffer_local (Qlexical_binding
);
4673 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4674 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4675 Veval_buffer_list
= Qnil
;
4677 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4678 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4679 Vold_style_backquotes
= Qnil
;
4680 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4682 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4683 doc
: /* Non-nil means `load' prefers the newest version of a file.
4684 This applies when a filename suffix is not explicitly specified and
4685 `load' is trying various possible suffixes (see `load-suffixes' and
4686 `load-file-rep-suffixes'). Normally, it stops at the first file
4687 that exists unless you explicitly specify one or the other. If this
4688 option is non-nil, it checks all suffixes and uses whichever file is
4690 Note that if you customize this, obviously it will not affect files
4691 that are loaded before your customizations are read! */);
4692 load_prefer_newer
= 0;
4694 /* Vsource_directory was initialized in init_lread. */
4696 DEFSYM (Qcurrent_load_list
, "current-load-list");
4697 DEFSYM (Qstandard_input
, "standard-input");
4698 DEFSYM (Qread_char
, "read-char");
4699 DEFSYM (Qget_file_char
, "get-file-char");
4701 /* Used instead of Qget_file_char while loading *.elc files compiled
4702 by Emacs 21 or older. */
4703 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4705 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4707 DEFSYM (Qbackquote
, "`");
4708 DEFSYM (Qcomma
, ",");
4709 DEFSYM (Qcomma_at
, ",@");
4710 DEFSYM (Qcomma_dot
, ",.");
4712 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4713 DEFSYM (Qascii_character
, "ascii-character");
4714 DEFSYM (Qfunction
, "function");
4715 DEFSYM (Qload
, "load");
4716 DEFSYM (Qload_file_name
, "load-file-name");
4717 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4718 DEFSYM (Qfile_truename
, "file-truename");
4719 DEFSYM (Qdir_ok
, "dir-ok");
4720 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4722 staticpro (&read_objects
);
4723 read_objects
= Qnil
;
4724 staticpro (&seen_list
);
4727 Vloads_in_progress
= Qnil
;
4728 staticpro (&Vloads_in_progress
);
4730 DEFSYM (Qhash_table
, "hash-table");
4731 DEFSYM (Qdata
, "data");
4732 DEFSYM (Qtest
, "test");
4733 DEFSYM (Qsize
, "size");
4734 DEFSYM (Qweakness
, "weakness");
4735 DEFSYM (Qrehash_size
, "rehash-size");
4736 DEFSYM (Qrehash_threshold
, "rehash-threshold");