1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2015 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 /* Tell globals.h to define tables needed by init_obarray. */
22 #define DEFINE_SYMBOLS
26 #include <sys/types.h>
30 #include <limits.h> /* For CHAR_BIT. */
32 #include <stat-time.h>
34 #include "dispextern.h"
35 #include "intervals.h"
36 #include "character.h"
44 #include "termhooks.h"
45 #include "blockinput.h"
59 #endif /* HAVE_SETLOCALE */
64 #define file_offset off_t
65 #define file_tell ftello
67 #define file_offset long
68 #define file_tell ftell
71 /* The association list of objects read with the #n=object form.
72 Each member of the list has the form (n . object), and is used to
73 look up the object for the corresponding #n# construct.
74 It must be set to nil before all top-level calls to read0. */
75 static Lisp_Object read_objects
;
77 /* File for get_file_char to read from. Use by load. */
78 static FILE *instream
;
80 /* For use within read-from-string (this reader is non-reentrant!!) */
81 static ptrdiff_t read_from_string_index
;
82 static ptrdiff_t read_from_string_index_byte
;
83 static ptrdiff_t read_from_string_limit
;
85 /* Number of characters read in the current call to Fread or
87 static EMACS_INT readchar_count
;
89 /* This contains the last string skipped with #@. */
90 static char *saved_doc_string
;
91 /* Length of buffer allocated in saved_doc_string. */
92 static ptrdiff_t saved_doc_string_size
;
93 /* Length of actual data in saved_doc_string. */
94 static ptrdiff_t saved_doc_string_length
;
95 /* This is the file position that string came from. */
96 static file_offset saved_doc_string_position
;
98 /* This contains the previous string skipped with #@.
99 We copy it from saved_doc_string when a new string
100 is put in saved_doc_string. */
101 static char *prev_saved_doc_string
;
102 /* Length of buffer allocated in prev_saved_doc_string. */
103 static ptrdiff_t prev_saved_doc_string_size
;
104 /* Length of actual data in prev_saved_doc_string. */
105 static ptrdiff_t prev_saved_doc_string_length
;
106 /* This is the file position that string came from. */
107 static file_offset prev_saved_doc_string_position
;
109 /* True means inside a new-style backquote
110 with no surrounding parentheses.
111 Fread initializes this to false, so we need not specbind it
112 or worry about what happens to it when there is an error. */
113 static bool new_backquote_flag
;
115 /* A list of file names for files being loaded in Fload. Used to
116 check for recursive loads. */
118 static Lisp_Object Vloads_in_progress
;
120 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
123 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
124 Lisp_Object
, Lisp_Object
,
125 Lisp_Object
, Lisp_Object
);
127 /* Functions that read one byte from the current source READCHARFUN
128 or unreads one byte. If the integer argument C is -1, it returns
129 one read byte, or -1 when there's no more byte in the source. If C
130 is 0 or positive, it unreads C, and the return value is not
133 static int readbyte_for_lambda (int, Lisp_Object
);
134 static int readbyte_from_file (int, Lisp_Object
);
135 static int readbyte_from_string (int, Lisp_Object
);
137 /* Handle unreading and rereading of characters.
138 Write READCHAR to read a character,
139 UNREAD(c) to unread c to be read again.
141 These macros correctly read/unread multibyte characters. */
143 #define READCHAR readchar (readcharfun, NULL)
144 #define UNREAD(c) unreadchar (readcharfun, c)
146 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
147 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
149 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
150 Qlambda, or a cons, we use this to keep an unread character because
151 a file stream can't handle multibyte-char unreading. The value -1
152 means that there's no unread character. */
153 static int unread_char
;
156 readchar (Lisp_Object readcharfun
, bool *multibyte
)
160 int (*readbyte
) (int, Lisp_Object
);
161 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
163 bool emacs_mule_encoding
= 0;
170 if (BUFFERP (readcharfun
))
172 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
174 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
176 if (! BUFFER_LIVE_P (inbuffer
))
179 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
182 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
184 /* Fetch the character code from the buffer. */
185 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
186 BUF_INC_POS (inbuffer
, pt_byte
);
193 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
194 if (! ASCII_CHAR_P (c
))
195 c
= BYTE8_TO_CHAR (c
);
198 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
202 if (MARKERP (readcharfun
))
204 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
206 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
208 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
211 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
213 /* Fetch the character code from the buffer. */
214 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
215 BUF_INC_POS (inbuffer
, bytepos
);
222 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
223 if (! ASCII_CHAR_P (c
))
224 c
= BYTE8_TO_CHAR (c
);
228 XMARKER (readcharfun
)->bytepos
= bytepos
;
229 XMARKER (readcharfun
)->charpos
++;
234 if (EQ (readcharfun
, Qlambda
))
236 readbyte
= readbyte_for_lambda
;
240 if (EQ (readcharfun
, Qget_file_char
))
242 readbyte
= readbyte_from_file
;
246 if (STRINGP (readcharfun
))
248 if (read_from_string_index
>= read_from_string_limit
)
250 else if (STRING_MULTIBYTE (readcharfun
))
254 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
255 read_from_string_index
,
256 read_from_string_index_byte
);
260 c
= SREF (readcharfun
, read_from_string_index_byte
);
261 read_from_string_index
++;
262 read_from_string_index_byte
++;
267 if (CONSP (readcharfun
))
269 /* This is the case that read_vector is reading from a unibyte
270 string that contains a byte sequence previously skipped
271 because of #@NUMBER. The car part of readcharfun is that
272 string, and the cdr part is a value of readcharfun given to
274 readbyte
= readbyte_from_string
;
275 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
276 emacs_mule_encoding
= 1;
280 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
282 readbyte
= readbyte_from_file
;
283 emacs_mule_encoding
= 1;
287 tem
= call0 (readcharfun
);
294 if (unread_char
>= 0)
300 c
= (*readbyte
) (-1, readcharfun
);
305 if (ASCII_CHAR_P (c
))
307 if (emacs_mule_encoding
)
308 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
311 len
= BYTES_BY_CHAR_HEAD (c
);
314 c
= (*readbyte
) (-1, readcharfun
);
315 if (c
< 0 || ! TRAILING_CODE_P (c
))
318 (*readbyte
) (buf
[i
], readcharfun
);
319 return BYTE8_TO_CHAR (buf
[0]);
323 return STRING_CHAR (buf
);
326 #define FROM_FILE_P(readcharfun) \
327 (EQ (readcharfun, Qget_file_char) \
328 || EQ (readcharfun, Qget_emacs_mule_file_char))
331 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
333 if (FROM_FILE_P (readcharfun
))
335 block_input (); /* FIXME: Not sure if it's needed. */
336 fseek (instream
, n
, SEEK_CUR
);
340 { /* We're not reading directly from a file. In that case, it's difficult
341 to reliably count bytes, since these are usually meant for the file's
342 encoding, whereas we're now typically in the internal encoding.
343 But luckily, skip_dyn_bytes is used to skip over a single
344 dynamic-docstring (or dynamic byte-code) which is always quoted such
345 that \037 is the final char. */
349 } while (c
>= 0 && c
!= '\037');
354 skip_dyn_eof (Lisp_Object readcharfun
)
356 if (FROM_FILE_P (readcharfun
))
358 block_input (); /* FIXME: Not sure if it's needed. */
359 fseek (instream
, 0, SEEK_END
);
363 while (READCHAR
>= 0);
366 /* Unread the character C in the way appropriate for the stream READCHARFUN.
367 If the stream is a user function, call it with the char as argument. */
370 unreadchar (Lisp_Object readcharfun
, int c
)
374 /* Don't back up the pointer if we're unreading the end-of-input mark,
375 since readchar didn't advance it when we read it. */
377 else if (BUFFERP (readcharfun
))
379 struct buffer
*b
= XBUFFER (readcharfun
);
380 ptrdiff_t charpos
= BUF_PT (b
);
381 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
383 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
384 BUF_DEC_POS (b
, bytepos
);
388 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
390 else if (MARKERP (readcharfun
))
392 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
393 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
395 XMARKER (readcharfun
)->charpos
--;
396 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
397 BUF_DEC_POS (b
, bytepos
);
401 XMARKER (readcharfun
)->bytepos
= bytepos
;
403 else if (STRINGP (readcharfun
))
405 read_from_string_index
--;
406 read_from_string_index_byte
407 = string_char_to_byte (readcharfun
, read_from_string_index
);
409 else if (CONSP (readcharfun
))
413 else if (EQ (readcharfun
, Qlambda
))
417 else if (FROM_FILE_P (readcharfun
))
422 call1 (readcharfun
, make_number (c
));
426 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
428 return read_bytecode_char (c
>= 0);
433 readbyte_from_file (int c
, Lisp_Object readcharfun
)
438 ungetc (c
, instream
);
446 /* Interrupted reads have been observed while reading over the network. */
447 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
458 return (c
== EOF
? -1 : c
);
462 readbyte_from_string (int c
, Lisp_Object readcharfun
)
464 Lisp_Object string
= XCAR (readcharfun
);
468 read_from_string_index
--;
469 read_from_string_index_byte
470 = string_char_to_byte (string
, read_from_string_index
);
473 if (read_from_string_index
>= read_from_string_limit
)
476 FETCH_STRING_CHAR_ADVANCE (c
, string
,
477 read_from_string_index
,
478 read_from_string_index_byte
);
483 /* Read one non-ASCII character from INSTREAM. The character is
484 encoded in `emacs-mule' and the first byte is already read in
488 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
490 /* Emacs-mule coding uses at most 4-byte for one character. */
491 unsigned char buf
[4];
492 int len
= emacs_mule_bytes
[c
];
493 struct charset
*charset
;
498 /* C is not a valid leading-code of `emacs-mule'. */
499 return BYTE8_TO_CHAR (c
);
505 c
= (*readbyte
) (-1, readcharfun
);
509 (*readbyte
) (buf
[i
], readcharfun
);
510 return BYTE8_TO_CHAR (buf
[0]);
517 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
518 code
= buf
[1] & 0x7F;
522 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
523 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
525 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
526 code
= buf
[2] & 0x7F;
530 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
531 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
536 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
537 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
539 c
= DECODE_CHAR (charset
, code
);
541 Fsignal (Qinvalid_read_syntax
,
542 list1 (build_string ("invalid multibyte form")));
547 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
549 static Lisp_Object
read0 (Lisp_Object
);
550 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
552 static Lisp_Object
read_list (bool, Lisp_Object
);
553 static Lisp_Object
read_vector (Lisp_Object
, bool);
555 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
557 static void substitute_object_in_subtree (Lisp_Object
,
559 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
562 /* Get a character from the tty. */
564 /* Read input events until we get one that's acceptable for our purposes.
566 If NO_SWITCH_FRAME, switch-frame events are stashed
567 until we get a character we like, and then stuffed into
570 If ASCII_REQUIRED, check function key events to see
571 if the unmodified version of the symbol has a Qascii_character
572 property, and use that character, if present.
574 If ERROR_NONASCII, signal an error if the input we
575 get isn't an ASCII character with modifiers. If it's false but
576 ASCII_REQUIRED is true, just re-read until we get an ASCII
579 If INPUT_METHOD, invoke the current input method
580 if the character warrants that.
582 If SECONDS is a number, wait that many seconds for input, and
583 return Qnil if no input arrives within that time. */
586 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
587 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
589 Lisp_Object val
, delayed_switch_frame
;
590 struct timespec end_time
;
592 #ifdef HAVE_WINDOW_SYSTEM
593 if (display_hourglass_p
)
597 delayed_switch_frame
= Qnil
;
599 /* Compute timeout. */
600 if (NUMBERP (seconds
))
602 double duration
= extract_float (seconds
);
603 struct timespec wait_time
= dtotimespec (duration
);
604 end_time
= timespec_add (current_timespec (), wait_time
);
607 /* Read until we get an acceptable event. */
610 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
611 NUMBERP (seconds
) ? &end_time
: NULL
);
612 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
617 /* `switch-frame' events are put off until after the next ASCII
618 character. This is better than signaling an error just because
619 the last characters were typed to a separate minibuffer frame,
620 for example. Eventually, some code which can deal with
621 switch-frame events will read it and process it. */
623 && EVENT_HAS_PARAMETERS (val
)
624 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
626 delayed_switch_frame
= val
;
630 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
632 /* Convert certain symbols to their ASCII equivalents. */
635 Lisp_Object tem
, tem1
;
636 tem
= Fget (val
, Qevent_symbol_element_mask
);
639 tem1
= Fget (Fcar (tem
), Qascii_character
);
640 /* Merge this symbol's modifier bits
641 with the ASCII equivalent of its basic code. */
643 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
647 /* If we don't have a character now, deal with it appropriately. */
652 Vunread_command_events
= list1 (val
);
653 error ("Non-character input-event");
660 if (! NILP (delayed_switch_frame
))
661 unread_switch_frame
= delayed_switch_frame
;
665 #ifdef HAVE_WINDOW_SYSTEM
666 if (display_hourglass_p
)
675 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
676 doc
: /* Read a character from the command input (keyboard or macro).
677 It is returned as a number.
678 If the character has modifiers, they are resolved and reflected to the
679 character code if possible (e.g. C-SPC -> 0).
681 If the user generates an event which is not a character (i.e. a mouse
682 click or function key event), `read-char' signals an error. As an
683 exception, switch-frame events are put off until non-character events
685 If you want to read non-character events, or ignore them, call
686 `read-event' or `read-char-exclusive' instead.
688 If the optional argument PROMPT is non-nil, display that as a prompt.
689 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
690 input method is turned on in the current buffer, that input method
691 is used for reading a character.
692 If the optional argument SECONDS is non-nil, it should be a number
693 specifying the maximum number of seconds to wait for input. If no
694 input arrives in that time, return nil. SECONDS may be a
695 floating-point value. */)
696 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
701 message_with_string ("%s", prompt
, 0);
702 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
704 return (NILP (val
) ? Qnil
705 : make_number (char_resolve_modifier_mask (XINT (val
))));
708 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
709 doc
: /* Read an event object from the input stream.
710 If the optional argument PROMPT is non-nil, display that as a prompt.
711 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
712 input method is turned on in the current buffer, that input method
713 is used for reading a character.
714 If the optional argument SECONDS is non-nil, it should be a number
715 specifying the maximum number of seconds to wait for input. If no
716 input arrives in that time, return nil. SECONDS may be a
717 floating-point value. */)
718 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
721 message_with_string ("%s", prompt
, 0);
722 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
725 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
726 doc
: /* Read a character from the command input (keyboard or macro).
727 It is returned as a number. Non-character events are ignored.
728 If the character has modifiers, they are resolved and reflected to the
729 character code if possible (e.g. C-SPC -> 0).
731 If the optional argument PROMPT is non-nil, display that as a prompt.
732 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
733 input method is turned on in the current buffer, that input method
734 is used for reading a character.
735 If the optional argument SECONDS is non-nil, it should be a number
736 specifying the maximum number of seconds to wait for input. If no
737 input arrives in that time, return nil. SECONDS may be a
738 floating-point value. */)
739 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
744 message_with_string ("%s", prompt
, 0);
746 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
748 return (NILP (val
) ? Qnil
749 : make_number (char_resolve_modifier_mask (XINT (val
))));
752 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
753 doc
: /* Don't use this yourself. */)
756 register Lisp_Object val
;
758 XSETINT (val
, getc (instream
));
766 /* Return true if the lisp code read using READCHARFUN defines a non-nil
767 `lexical-binding' file variable. After returning, the stream is
768 positioned following the first line, if it is a comment or #! line,
769 otherwise nothing is read. */
772 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
785 while (ch
!= '\n' && ch
!= EOF
)
787 if (ch
== '\n') ch
= READCHAR
;
788 /* It is OK to leave the position after a #! line, since
789 that is what read1 does. */
793 /* The first line isn't a comment, just give up. */
799 /* Look for an appropriate file-variable in the first line. */
803 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
804 } beg_end_state
= NOMINAL
;
805 bool in_file_vars
= 0;
807 #define UPDATE_BEG_END_STATE(ch) \
808 if (beg_end_state == NOMINAL) \
809 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
810 else if (beg_end_state == AFTER_FIRST_DASH) \
811 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
812 else if (beg_end_state == AFTER_ASTERIX) \
815 in_file_vars = !in_file_vars; \
816 beg_end_state = NOMINAL; \
819 /* Skip until we get to the file vars, if any. */
823 UPDATE_BEG_END_STATE (ch
);
825 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
829 char var
[100], val
[100];
834 /* Read a variable name. */
835 while (ch
== ' ' || ch
== '\t')
839 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
841 if (i
< sizeof var
- 1)
843 UPDATE_BEG_END_STATE (ch
);
847 /* Stop scanning if no colon was found before end marker. */
848 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
851 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
857 /* Read a variable value. */
860 while (ch
== ' ' || ch
== '\t')
864 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
866 if (i
< sizeof val
- 1)
868 UPDATE_BEG_END_STATE (ch
);
872 /* The value was terminated by an end-marker, which remove. */
874 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
878 if (strcmp (var
, "lexical-binding") == 0)
881 rv
= (strcmp (val
, "nil") != 0);
887 while (ch
!= '\n' && ch
!= EOF
)
894 /* Value is a version number of byte compiled code if the file
895 associated with file descriptor FD is a compiled Lisp file that's
896 safe to load. Only files compiled with Emacs are safe to load.
897 Files compiled with XEmacs can lead to a crash in Fbyte_code
898 because of an incompatible change in the byte compiler. */
901 safe_to_load_version (int fd
)
907 /* Read the first few bytes from the file, and look for a line
908 specifying the byte compiler version used. */
909 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
912 /* Skip to the next newline, skipping over the initial `ELC'
913 with NUL bytes following it, but note the version. */
914 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
919 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
920 buf
+ i
, nbytes
- i
) < 0)
924 lseek (fd
, 0, SEEK_SET
);
929 /* Callback for record_unwind_protect. Restore the old load list OLD,
930 after loading a file successfully. */
933 record_load_unwind (Lisp_Object old
)
935 Vloads_in_progress
= old
;
938 /* This handler function is used via internal_condition_case_1. */
941 load_error_handler (Lisp_Object data
)
947 load_warn_old_style_backquotes (Lisp_Object file
)
949 if (!NILP (Vold_style_backquotes
))
951 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
952 CALLN (Fmessage
, format
, file
);
956 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
957 doc
: /* Return the suffixes that `load' should try if a suffix is \
959 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
962 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
963 while (CONSP (suffixes
))
965 Lisp_Object exts
= Vload_file_rep_suffixes
;
966 suffix
= XCAR (suffixes
);
967 suffixes
= XCDR (suffixes
);
972 lst
= Fcons (concat2 (suffix
, ext
), lst
);
975 return Fnreverse (lst
);
978 /* Returns true if STRING ends with SUFFIX */
980 suffix_p (Lisp_Object string
, const char *suffix
)
982 const size_t suffix_len
= strlen (suffix
);
983 const size_t string_len
= SBYTES (string
);
985 return string_len
>= suffix_len
&& !strcmp (SSDATA (string
) + string_len
- suffix_len
, suffix
);
988 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
989 doc
: /* Execute a file of Lisp code named FILE.
990 First try FILE with `.elc' appended, then try with `.el',
991 then try FILE unmodified (the exact suffixes in the exact order are
992 determined by `load-suffixes'). Environment variable references in
993 FILE are replaced with their values by calling `substitute-in-file-name'.
994 This function searches the directories in `load-path'.
996 If optional second arg NOERROR is non-nil,
997 report no error if FILE doesn't exist.
998 Print messages at start and end of loading unless
999 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1001 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1002 suffixes `.elc' or `.el' to the specified name FILE.
1003 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1004 the suffix `.elc' or `.el'; don't accept just FILE unless
1005 it ends in one of those suffixes or includes a directory name.
1007 If NOSUFFIX is nil, then if a file could not be found, try looking for
1008 a different representation of the file by adding non-empty suffixes to
1009 its name, before trying another file. Emacs uses this feature to find
1010 compressed versions of files when Auto Compression mode is enabled.
1011 If NOSUFFIX is non-nil, disable this feature.
1013 The suffixes that this function tries out, when NOSUFFIX is nil, are
1014 given by the return value of `get-load-suffixes' and the values listed
1015 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1016 return value of `get-load-suffixes' is used, i.e. the file name is
1017 required to have a non-empty suffix.
1019 When searching suffixes, this function normally stops at the first
1020 one that exists. If the option `load-prefer-newer' is non-nil,
1021 however, it tries all suffixes, and uses whichever file is the newest.
1023 Loading a file records its definitions, and its `provide' and
1024 `require' calls, in an element of `load-history' whose
1025 car is the file name loaded. See `load-history'.
1027 While the file is in the process of being loaded, the variable
1028 `load-in-progress' is non-nil and the variable `load-file-name'
1029 is bound to the file's name.
1031 Return t if the file exists and loads successfully. */)
1032 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1033 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1038 ptrdiff_t count
= SPECPDL_INDEX ();
1039 Lisp_Object found
, efound
, hist_file_name
;
1040 /* True means we printed the ".el is newer" message. */
1042 /* True means we are loading a compiled file. */
1044 Lisp_Object handler
;
1046 const char *fmode
= "r" FOPEN_TEXT
;
1049 CHECK_STRING (file
);
1051 /* If file name is magic, call the handler. */
1052 /* This shouldn't be necessary any more now that `openp' handles it right.
1053 handler = Ffind_file_name_handler (file, Qload);
1054 if (!NILP (handler))
1055 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1057 /* The presence of this call is the result of a historical accident:
1058 it used to be in every file-operation and when it got removed
1059 everywhere, it accidentally stayed here. Since then, enough people
1060 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1061 that it seemed risky to remove. */
1062 if (! NILP (noerror
))
1064 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1065 Qt
, load_error_handler
);
1070 file
= Fsubstitute_in_file_name (file
);
1072 /* Avoid weird lossage with null string as arg,
1073 since it would try to load a directory as a Lisp file. */
1074 if (SCHARS (file
) == 0)
1081 Lisp_Object suffixes
;
1084 if (! NILP (must_suffix
))
1086 /* Don't insist on adding a suffix if FILE already ends with one. */
1087 ptrdiff_t size
= SBYTES (file
);
1088 if (suffix_p (file
, ".el") || suffix_p (file
, ".elc"))
1090 /* Don't insist on adding a suffix
1091 if the argument includes a directory name. */
1092 else if (! NILP (Ffile_name_directory (file
)))
1096 if (!NILP (nosuffix
))
1100 suffixes
= Fget_load_suffixes ();
1101 if (NILP (must_suffix
))
1102 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1105 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
);
1161 if (suffix_p (found
, MODULES_SUFFIX
))
1163 return Fmodule_load (found
);
1167 /* Check if we're stuck in a recursive load cycle.
1169 2000-09-21: It's not possible to just check for the file loaded
1170 being a member of Vloads_in_progress. This fails because of the
1171 way the byte compiler currently works; `provide's are not
1172 evaluated, see font-lock.el/jit-lock.el as an example. This
1173 leads to a certain amount of ``normal'' recursion.
1175 Also, just loading a file recursively is not always an error in
1176 the general case; the second load may do something different. */
1180 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1181 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1182 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1183 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1184 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1187 /* All loads are by default dynamic, unless the file itself specifies
1188 otherwise using a file-variable in the first line. This is bound here
1189 so that it takes effect whether or not we use
1190 Vload_source_file_function. */
1191 specbind (Qlexical_binding
, Qnil
);
1193 /* Get the name for load-history. */
1194 hist_file_name
= (! NILP (Vpurify_flag
)
1195 ? concat2 (Ffile_name_directory (file
),
1196 Ffile_name_nondirectory (found
))
1201 /* Check for the presence of old-style quotes and warn about them. */
1202 specbind (Qold_style_backquotes
, Qnil
);
1203 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1205 if (suffix_p (found
, ".elc") || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1206 /* Load .elc files directly, but not when they are
1207 remote and have no handler! */
1215 && ! (version
= safe_to_load_version (fd
)))
1218 if (!load_dangerous_libraries
)
1219 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1220 else if (!NILP (nomessage
) && !force_load_messages
)
1221 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1226 efound
= ENCODE_FILE (found
);
1227 fmode
= "r" FOPEN_BINARY
;
1229 /* openp already checked for newness, no point doing it again.
1230 FIXME would be nice to get a message when openp
1231 ignores suffix order due to load_prefer_newer. */
1232 if (!load_prefer_newer
)
1234 result
= stat (SSDATA (efound
), &s1
);
1237 SSET (efound
, SBYTES (efound
) - 1, 0);
1238 result
= stat (SSDATA (efound
), &s2
);
1239 SSET (efound
, SBYTES (efound
) - 1, 'c');
1243 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1245 /* Make the progress messages mention that source is newer. */
1248 /* If we won't print another message, mention this anyway. */
1249 if (!NILP (nomessage
) && !force_load_messages
)
1251 Lisp_Object msg_file
;
1252 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1253 message_with_string ("Source file `%s' newer than byte-compiled file",
1257 } /* !load_prefer_newer */
1262 /* We are loading a source file (*.el). */
1263 if (!NILP (Vload_source_file_function
))
1270 clear_unwind_protect (fd_index
);
1272 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1273 NILP (noerror
) ? Qnil
: Qt
,
1274 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1275 return unbind_to (count
, val
);
1281 /* We somehow got here with fd == -2, meaning the file is deemed
1282 to be remote. Don't even try to reopen the file locally;
1283 just force a failure. */
1291 clear_unwind_protect (fd_index
);
1292 efound
= ENCODE_FILE (found
);
1293 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1295 stream
= fdopen (fd
, fmode
);
1299 report_file_error ("Opening stdio stream", file
);
1300 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1302 if (! NILP (Vpurify_flag
))
1303 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1305 if (NILP (nomessage
) || force_load_messages
)
1308 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1311 message_with_string ("Loading %s (source)...", file
, 1);
1313 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1315 else /* The typical case; compiled file newer than source file. */
1316 message_with_string ("Loading %s...", file
, 1);
1319 specbind (Qload_file_name
, found
);
1320 specbind (Qinhibit_file_name_operation
, Qnil
);
1321 specbind (Qload_in_progress
, Qt
);
1324 if (lisp_file_lexically_bound_p (Qget_file_char
))
1325 Fset (Qlexical_binding
, Qt
);
1327 if (! version
|| version
>= 22)
1328 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1329 0, Qnil
, Qnil
, Qnil
, Qnil
);
1332 /* We can't handle a file which was compiled with
1333 byte-compile-dynamic by older version of Emacs. */
1334 specbind (Qload_force_doc_strings
, Qt
);
1335 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1336 0, Qnil
, Qnil
, Qnil
, Qnil
);
1338 unbind_to (count
, Qnil
);
1340 /* Run any eval-after-load forms for this file. */
1341 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1342 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1344 xfree (saved_doc_string
);
1345 saved_doc_string
= 0;
1346 saved_doc_string_size
= 0;
1348 xfree (prev_saved_doc_string
);
1349 prev_saved_doc_string
= 0;
1350 prev_saved_doc_string_size
= 0;
1352 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1355 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1358 message_with_string ("Loading %s (source)...done", file
, 1);
1360 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1362 else /* The typical case; compiled file newer than source file. */
1363 message_with_string ("Loading %s...done", file
, 1);
1370 complete_filename_p (Lisp_Object pathname
)
1372 const unsigned char *s
= SDATA (pathname
);
1373 return (IS_DIRECTORY_SEP (s
[0])
1374 || (SCHARS (pathname
) > 2
1375 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1378 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1379 doc
: /* Search for FILENAME through PATH.
1380 Returns the file's name in absolute form, or nil if not found.
1381 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1382 file name when searching.
1383 If non-nil, PREDICATE is used instead of `file-readable-p'.
1384 PREDICATE can also be an integer to pass to the faccessat(2) function,
1385 in which case file-name-handlers are ignored.
1386 This function will normally skip directories, so if you want it to find
1387 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1388 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1391 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1392 if (NILP (predicate
) && fd
>= 0)
1397 /* Search for a file whose name is STR, looking in directories
1398 in the Lisp list PATH, and trying suffixes from SUFFIX.
1399 On success, return a file descriptor (or 1 or -2 as described below).
1400 On failure, return -1 and set errno.
1402 SUFFIXES is a list of strings containing possible suffixes.
1403 The empty suffix is automatically added if the list is empty.
1405 PREDICATE t means the files are binary.
1406 PREDICATE non-nil and non-t 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 a non-nil and non-t 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 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1434 ptrdiff_t max_suffix_len
= 0;
1435 int last_errno
= ENOENT
;
1439 /* The last-modified time of the newest matching file found.
1440 Initialize it to something less than all valid timestamps. */
1441 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1445 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1447 CHECK_STRING_CAR (tail
);
1448 max_suffix_len
= max (max_suffix_len
,
1449 SBYTES (XCAR (tail
)));
1452 string
= filename
= encoded_fn
= save_string
= Qnil
;
1457 absolute
= complete_filename_p (str
);
1459 for (; CONSP (path
); path
= XCDR (path
))
1461 filename
= Fexpand_file_name (str
, XCAR (path
));
1462 if (!complete_filename_p (filename
))
1463 /* If there are non-absolute elts in PATH (eg "."). */
1464 /* Of course, this could conceivably lose if luser sets
1465 default-directory to be something non-absolute... */
1467 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1468 if (!complete_filename_p (filename
))
1469 /* Give up on this path element! */
1473 /* Calculate maximum length of any filename made from
1474 this path element/specified file name and any possible suffix. */
1475 want_length
= max_suffix_len
+ SBYTES (filename
);
1476 if (fn_size
<= want_length
)
1478 fn_size
= 100 + want_length
;
1479 fn
= SAFE_ALLOCA (fn_size
);
1482 /* Loop over suffixes. */
1483 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1484 CONSP (tail
); tail
= XCDR (tail
))
1486 Lisp_Object suffix
= XCAR (tail
);
1487 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1488 Lisp_Object handler
;
1490 /* Concatenate path element/specified name with the suffix.
1491 If the directory starts with /:, remove that. */
1492 int prefixlen
= ((SCHARS (filename
) > 2
1493 && SREF (filename
, 0) == '/'
1494 && SREF (filename
, 1) == ':')
1496 fnlen
= SBYTES (filename
) - prefixlen
;
1497 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1498 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1500 /* Check that the file exists and is not a directory. */
1501 /* We used to only check for handlers on non-absolute file names:
1505 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1506 It's not clear why that was the case and it breaks things like
1507 (load "/bar.el") where the file is actually "/bar.el.gz". */
1508 /* make_string has its own ideas on when to return a unibyte
1509 string and when a multibyte string, but we know better.
1510 We must have a unibyte string when dumping, since
1511 file-name encoding is shaky at best at that time, and in
1512 particular default-file-name-coding-system is reset
1513 several times during loadup. We therefore don't want to
1514 encode the file before passing it to file I/O library
1516 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1517 string
= make_unibyte_string (fn
, fnlen
);
1519 string
= make_string (fn
, fnlen
);
1520 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1521 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1522 && !NATNUMP (predicate
))
1525 if (NILP (predicate
) || EQ (predicate
, Qt
))
1526 exists
= !NILP (Ffile_readable_p (string
));
1529 Lisp_Object tmp
= call1 (predicate
, string
);
1532 else if (EQ (tmp
, Qdir_ok
)
1533 || NILP (Ffile_directory_p (string
)))
1538 last_errno
= EISDIR
;
1544 /* We succeeded; return this descriptor and filename. */
1557 encoded_fn
= ENCODE_FILE (string
);
1558 pfn
= SSDATA (encoded_fn
);
1560 /* Check that we can access or open it. */
1561 if (NATNUMP (predicate
))
1564 if (INT_MAX
< XFASTINT (predicate
))
1565 last_errno
= EINVAL
;
1566 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1570 if (file_directory_p (pfn
))
1571 last_errno
= EISDIR
;
1578 int oflags
= O_RDONLY
+ (NILP (predicate
) ? 0 : O_BINARY
);
1579 fd
= emacs_open (pfn
, oflags
, 0);
1582 if (errno
!= ENOENT
)
1587 int err
= (fstat (fd
, &st
) != 0 ? errno
1588 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1600 if (newer
&& !NATNUMP (predicate
))
1602 struct timespec mtime
= get_stat_mtime (&st
);
1604 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1609 emacs_close (save_fd
);
1612 save_string
= string
;
1617 /* We succeeded; return this descriptor and filename. */
1625 /* No more suffixes. Return the newest. */
1626 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1629 *storeptr
= save_string
;
1645 /* Merge the list we've accumulated of globals from the current input source
1646 into the load_history variable. The details depend on whether
1647 the source has an associated file name or not.
1649 FILENAME is the file name that we are loading from.
1651 ENTIRE is true if loading that entire file, false if evaluating
1655 build_load_history (Lisp_Object filename
, bool entire
)
1657 Lisp_Object tail
, prev
, newelt
;
1658 Lisp_Object tem
, tem2
;
1661 tail
= Vload_history
;
1664 while (CONSP (tail
))
1668 /* Find the feature's previous assoc list... */
1669 if (!NILP (Fequal (filename
, Fcar (tem
))))
1673 /* If we're loading the entire file, remove old data. */
1677 Vload_history
= XCDR (tail
);
1679 Fsetcdr (prev
, XCDR (tail
));
1682 /* Otherwise, cons on new symbols that are not already members. */
1685 tem2
= Vcurrent_load_list
;
1687 while (CONSP (tem2
))
1689 newelt
= XCAR (tem2
);
1691 if (NILP (Fmember (newelt
, tem
)))
1692 Fsetcar (tail
, Fcons (XCAR (tem
),
1693 Fcons (newelt
, XCDR (tem
))));
1706 /* If we're loading an entire file, cons the new assoc onto the
1707 front of load-history, the most-recently-loaded position. Also
1708 do this if we didn't find an existing member for the file. */
1709 if (entire
|| !foundit
)
1710 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1715 readevalloop_1 (int old
)
1717 load_convert_to_unibyte
= old
;
1720 /* Signal an `end-of-file' error, if possible with file name
1723 static _Noreturn
void
1724 end_of_file_error (void)
1726 if (STRINGP (Vload_file_name
))
1727 xsignal1 (Qend_of_file
, Vload_file_name
);
1729 xsignal0 (Qend_of_file
);
1733 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1735 /* If we macroexpand the toplevel form non-recursively and it ends
1736 up being a `progn' (or if it was a progn to start), treat each
1737 form in the progn as a top-level form. This way, if one form in
1738 the progn defines a macro, that macro is in effect when we expand
1739 the remaining forms. See similar code in bytecomp.el. */
1740 val
= call2 (macroexpand
, val
, Qnil
);
1741 if (EQ (CAR_SAFE (val
), Qprogn
))
1743 Lisp_Object subforms
= XCDR (val
);
1745 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1746 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1750 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1754 /* UNIBYTE specifies how to set load_convert_to_unibyte
1755 for this invocation.
1756 READFUN, if non-nil, is used instead of `read'.
1758 START, END specify region to read in current buffer (from eval-region).
1759 If the input is not from a buffer, they must be nil. */
1762 readevalloop (Lisp_Object readcharfun
,
1764 Lisp_Object sourcename
,
1766 Lisp_Object unibyte
, Lisp_Object readfun
,
1767 Lisp_Object start
, Lisp_Object end
)
1771 ptrdiff_t count
= SPECPDL_INDEX ();
1772 struct buffer
*b
= 0;
1773 bool continue_reading_p
;
1774 Lisp_Object lex_bound
;
1775 /* True if reading an entire buffer. */
1776 bool whole_buffer
= 0;
1777 /* True on the first time around. */
1778 bool first_sexp
= 1;
1779 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1781 if (NILP (Ffboundp (macroexpand
))
1782 /* Don't macroexpand in .elc files, since it should have been done
1783 already. We actually don't know whether we're in a .elc file or not,
1784 so we use circumstantial evidence: .el files normally go through
1785 Vload_source_file_function -> load-with-code-conversion
1787 || EQ (readcharfun
, Qget_file_char
)
1788 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1791 if (MARKERP (readcharfun
))
1794 start
= readcharfun
;
1797 if (BUFFERP (readcharfun
))
1798 b
= XBUFFER (readcharfun
);
1799 else if (MARKERP (readcharfun
))
1800 b
= XMARKER (readcharfun
)->buffer
;
1802 /* We assume START is nil when input is not from a buffer. */
1803 if (! NILP (start
) && !b
)
1806 specbind (Qstandard_input
, readcharfun
);
1807 specbind (Qcurrent_load_list
, Qnil
);
1808 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1809 load_convert_to_unibyte
= !NILP (unibyte
);
1811 /* If lexical binding is active (either because it was specified in
1812 the file's header, or via a buffer-local variable), create an empty
1813 lexical environment, otherwise, turn off lexical binding. */
1814 lex_bound
= find_symbol_value (Qlexical_binding
);
1815 specbind (Qinternal_interpreter_environment
,
1816 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1817 ? Qnil
: list1 (Qt
)));
1819 /* Try to ensure sourcename is a truename, except whilst preloading. */
1820 if (NILP (Vpurify_flag
)
1821 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1822 && !NILP (Ffboundp (Qfile_truename
)))
1823 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1825 LOADHIST_ATTACH (sourcename
);
1827 continue_reading_p
= 1;
1828 while (continue_reading_p
)
1830 ptrdiff_t count1
= SPECPDL_INDEX ();
1832 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1833 error ("Reading from killed buffer");
1837 /* Switch to the buffer we are reading from. */
1838 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1839 set_buffer_internal (b
);
1841 /* Save point in it. */
1842 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1843 /* Save ZV in it. */
1844 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1845 /* Those get unbound after we read one expression. */
1847 /* Set point and ZV around stuff to be read. */
1850 Fnarrow_to_region (make_number (BEGV
), end
);
1852 /* Just for cleanliness, convert END to a marker
1853 if it is an integer. */
1855 end
= Fpoint_max_marker ();
1858 /* On the first cycle, we can easily test here
1859 whether we are reading the whole buffer. */
1860 if (b
&& first_sexp
)
1861 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1868 while ((c
= READCHAR
) != '\n' && c
!= -1);
1873 unbind_to (count1
, Qnil
);
1877 /* Ignore whitespace here, so we can detect eof. */
1878 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1879 || c
== NO_BREAK_SPACE
)
1882 if (!NILP (Vpurify_flag
) && c
== '(')
1884 val
= read_list (0, readcharfun
);
1889 read_objects
= Qnil
;
1890 if (!NILP (readfun
))
1892 val
= call1 (readfun
, readcharfun
);
1894 /* If READCHARFUN has set point to ZV, we should
1895 stop reading, even if the form read sets point
1896 to a different value when evaluated. */
1897 if (BUFFERP (readcharfun
))
1899 struct buffer
*buf
= XBUFFER (readcharfun
);
1900 if (BUF_PT (buf
) == BUF_ZV (buf
))
1901 continue_reading_p
= 0;
1904 else if (! NILP (Vload_read_function
))
1905 val
= call1 (Vload_read_function
, readcharfun
);
1907 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1910 if (!NILP (start
) && continue_reading_p
)
1911 start
= Fpoint_marker ();
1913 /* Restore saved point and BEGV. */
1914 unbind_to (count1
, Qnil
);
1916 /* Now eval what we just read. */
1917 if (!NILP (macroexpand
))
1918 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1920 val
= eval_sub (val
);
1924 Vvalues
= Fcons (val
, Vvalues
);
1925 if (EQ (Vstandard_output
, Qt
))
1934 build_load_history (sourcename
,
1935 stream
|| whole_buffer
);
1937 unbind_to (count
, Qnil
);
1940 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1941 doc
: /* Execute the current buffer as Lisp code.
1942 When called from a Lisp program (i.e., not interactively), this
1943 function accepts up to five optional arguments:
1944 BUFFER is the buffer to evaluate (nil means use current buffer).
1945 PRINTFLAG controls printing of output:
1946 A value of nil means discard it; anything else is stream for print.
1947 FILENAME specifies the file name to use for `load-history'.
1948 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1950 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1951 functions should work normally even if PRINTFLAG is nil.
1953 This function preserves the position of point. */)
1954 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1956 ptrdiff_t count
= SPECPDL_INDEX ();
1957 Lisp_Object tem
, buf
;
1960 buf
= Fcurrent_buffer ();
1962 buf
= Fget_buffer (buffer
);
1964 error ("No such buffer");
1966 if (NILP (printflag
) && NILP (do_allow_print
))
1971 if (NILP (filename
))
1972 filename
= BVAR (XBUFFER (buf
), filename
);
1974 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1975 specbind (Qstandard_output
, tem
);
1976 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1977 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1978 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1979 readevalloop (buf
, 0, filename
,
1980 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1981 unbind_to (count
, Qnil
);
1986 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1987 doc
: /* Execute the region as Lisp code.
1988 When called from programs, expects two arguments,
1989 giving starting and ending indices in the current buffer
1990 of the text to be executed.
1991 Programs can pass third argument PRINTFLAG which controls output:
1992 A value of nil means discard it; anything else is stream for printing it.
1993 Also the fourth argument READ-FUNCTION, if non-nil, is used
1994 instead of `read' to read each expression. It gets one argument
1995 which is the input stream for reading characters.
1997 This function does not move point. */)
1998 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2000 /* FIXME: Do the eval-sexp-add-defvars dance! */
2001 ptrdiff_t count
= SPECPDL_INDEX ();
2002 Lisp_Object tem
, cbuf
;
2004 cbuf
= Fcurrent_buffer ();
2006 if (NILP (printflag
))
2010 specbind (Qstandard_output
, tem
);
2011 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2013 /* `readevalloop' calls functions which check the type of start and end. */
2014 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2015 !NILP (printflag
), Qnil
, read_function
,
2018 return unbind_to (count
, Qnil
);
2022 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2023 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2024 If STREAM is nil, use the value of `standard-input' (which see).
2025 STREAM or the value of `standard-input' may be:
2026 a buffer (read from point and advance it)
2027 a marker (read from where it points and advance it)
2028 a function (call it with no arguments for each character,
2029 call it with a char as argument to push a char back)
2030 a string (takes text from string, starting at the beginning)
2031 t (read text line using minibuffer and use it, or read from
2032 standard input in batch mode). */)
2033 (Lisp_Object stream
)
2036 stream
= Vstandard_input
;
2037 if (EQ (stream
, Qt
))
2038 stream
= Qread_char
;
2039 if (EQ (stream
, Qread_char
))
2040 /* FIXME: ?! When is this used !? */
2041 return call1 (intern ("read-minibuffer"),
2042 build_string ("Lisp expression: "));
2044 return read_internal_start (stream
, Qnil
, Qnil
);
2047 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2048 doc
: /* Read one Lisp expression which is represented as text by STRING.
2049 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2050 FINAL-STRING-INDEX is an integer giving the position of the next
2051 remaining character in STRING. START and END optionally delimit
2052 a substring of STRING from which to read; they default to 0 and
2053 (length STRING) respectively. Negative values are counted from
2054 the end of STRING. */)
2055 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2058 CHECK_STRING (string
);
2059 /* `read_internal_start' sets `read_from_string_index'. */
2060 ret
= read_internal_start (string
, start
, end
);
2061 return Fcons (ret
, make_number (read_from_string_index
));
2064 /* Function to set up the global context we need in toplevel read
2065 calls. START and END only used when STREAM is a string. */
2067 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2072 new_backquote_flag
= 0;
2073 read_objects
= Qnil
;
2074 if (EQ (Vread_with_symbol_positions
, Qt
)
2075 || EQ (Vread_with_symbol_positions
, stream
))
2076 Vread_symbol_positions_list
= Qnil
;
2078 if (STRINGP (stream
)
2079 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2081 ptrdiff_t startval
, endval
;
2084 if (STRINGP (stream
))
2087 string
= XCAR (stream
);
2089 validate_subarray (string
, start
, end
, SCHARS (string
),
2090 &startval
, &endval
);
2092 read_from_string_index
= startval
;
2093 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2094 read_from_string_limit
= endval
;
2097 retval
= read0 (stream
);
2098 if (EQ (Vread_with_symbol_positions
, Qt
)
2099 || EQ (Vread_with_symbol_positions
, stream
))
2100 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2105 /* Signal Qinvalid_read_syntax error.
2106 S is error string of length N (if > 0) */
2108 static _Noreturn
void
2109 invalid_syntax (const char *s
)
2111 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2115 /* Use this for recursive reads, in contexts where internal tokens
2119 read0 (Lisp_Object readcharfun
)
2121 register Lisp_Object val
;
2124 val
= read1 (readcharfun
, &c
, 0);
2128 xsignal1 (Qinvalid_read_syntax
,
2129 Fmake_string (make_number (1), make_number (c
)));
2132 static ptrdiff_t read_buffer_size
;
2133 static char *read_buffer
;
2135 /* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes. */
2138 grow_read_buffer (void)
2140 read_buffer
= xpalloc (read_buffer
, &read_buffer_size
,
2141 MAX_MULTIBYTE_LENGTH
, -1, 1);
2144 /* Read a \-escape sequence, assuming we already read the `\'.
2145 If the escape sequence forces unibyte, return eight-bit char. */
2148 read_escape (Lisp_Object readcharfun
, bool stringp
)
2151 /* \u allows up to four hex digits, \U up to eight. Default to the
2152 behavior for \u, and change this value in the case that \U is seen. */
2153 int unicode_hex_count
= 4;
2158 end_of_file_error ();
2188 error ("Invalid escape character syntax");
2191 c
= read_escape (readcharfun
, 0);
2192 return c
| meta_modifier
;
2197 error ("Invalid escape character syntax");
2200 c
= read_escape (readcharfun
, 0);
2201 return c
| shift_modifier
;
2206 error ("Invalid escape character syntax");
2209 c
= read_escape (readcharfun
, 0);
2210 return c
| hyper_modifier
;
2215 error ("Invalid escape character syntax");
2218 c
= read_escape (readcharfun
, 0);
2219 return c
| alt_modifier
;
2223 if (stringp
|| c
!= '-')
2230 c
= read_escape (readcharfun
, 0);
2231 return c
| super_modifier
;
2236 error ("Invalid escape character syntax");
2240 c
= read_escape (readcharfun
, 0);
2241 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2242 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2243 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2244 return c
| ctrl_modifier
;
2245 /* ASCII control chars are made from letters (both cases),
2246 as well as the non-letters within 0100...0137. */
2247 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2248 return (c
& (037 | ~0177));
2249 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2250 return (c
& (037 | ~0177));
2252 return c
| ctrl_modifier
;
2262 /* An octal escape, as in ANSI C. */
2264 register int i
= c
- '0';
2265 register int count
= 0;
2268 if ((c
= READCHAR
) >= '0' && c
<= '7')
2280 if (i
>= 0x80 && i
< 0x100)
2281 i
= BYTE8_TO_CHAR (i
);
2286 /* A hex escape, as in ANSI C. */
2293 if (c
>= '0' && c
<= '9')
2298 else if ((c
>= 'a' && c
<= 'f')
2299 || (c
>= 'A' && c
<= 'F'))
2302 if (c
>= 'a' && c
<= 'f')
2312 /* Allow hex escapes as large as ?\xfffffff, because some
2313 packages use them to denote characters with modifiers. */
2314 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2315 error ("Hex character out of range: \\x%x...", i
);
2319 if (count
< 3 && i
>= 0x80)
2320 return BYTE8_TO_CHAR (i
);
2325 /* Post-Unicode-2.0: Up to eight hex chars. */
2326 unicode_hex_count
= 8;
2329 /* A Unicode escape. We only permit them in strings and characters,
2330 not arbitrarily in the source code, as in some other languages. */
2335 while (++count
<= unicode_hex_count
)
2338 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2340 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2341 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2342 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2344 error ("Non-hex digit used for Unicode escape");
2347 error ("Non-Unicode character: 0x%x", i
);
2356 /* Return the digit that CHARACTER stands for in the given BASE.
2357 Return -1 if CHARACTER is out of range for BASE,
2358 and -2 if CHARACTER is not valid for any supported BASE. */
2360 digit_to_number (int character
, int base
)
2364 if ('0' <= character
&& character
<= '9')
2365 digit
= character
- '0';
2366 else if ('a' <= character
&& character
<= 'z')
2367 digit
= character
- 'a' + 10;
2368 else if ('A' <= character
&& character
<= 'Z')
2369 digit
= character
- 'A' + 10;
2373 return digit
< base
? digit
: -1;
2376 /* Read an integer in radix RADIX using READCHARFUN to read
2377 characters. RADIX must be in the interval [2..36]; if it isn't, a
2378 read error is signaled . Value is the integer read. Signals an
2379 error if encountering invalid read syntax or if RADIX is out of
2383 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2385 /* Room for sign, leading 0, other digits, trailing null byte.
2386 Also, room for invalid syntax diagnostic. */
2387 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2388 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2390 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2392 if (radix
< 2 || radix
> 36)
2400 if (c
== '-' || c
== '+')
2411 /* Ignore redundant leading zeros, so the buffer doesn't
2412 fill up with them. */
2418 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2425 if (p
< buf
+ sizeof buf
- 1)
2439 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2440 invalid_syntax (buf
);
2443 return string_to_number (buf
, radix
, 0);
2447 /* If the next token is ')' or ']' or '.', we store that character
2448 in *PCH and the return value is not interesting. Else, we store
2449 zero in *PCH and we read and return one lisp object.
2451 FIRST_IN_LIST is true if this is the first element of a list. */
2454 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2457 bool uninterned_symbol
= 0;
2464 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2466 end_of_file_error ();
2471 return read_list (0, readcharfun
);
2474 return read_vector (readcharfun
, 0);
2490 /* Accept extended format for hashtables (extensible to
2492 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2493 Lisp_Object tmp
= read_list (0, readcharfun
);
2494 Lisp_Object head
= CAR_SAFE (tmp
);
2495 Lisp_Object data
= Qnil
;
2496 Lisp_Object val
= Qnil
;
2497 /* The size is 2 * number of allowed keywords to
2499 Lisp_Object params
[10];
2501 Lisp_Object key
= Qnil
;
2502 int param_count
= 0;
2504 if (!EQ (head
, Qhash_table
))
2505 error ("Invalid extended read marker at head of #s list "
2506 "(only hash-table allowed)");
2508 tmp
= CDR_SAFE (tmp
);
2510 /* This is repetitive but fast and simple. */
2511 params
[param_count
] = QCsize
;
2512 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2513 if (!NILP (params
[param_count
+ 1]))
2516 params
[param_count
] = QCtest
;
2517 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2518 if (!NILP (params
[param_count
+ 1]))
2521 params
[param_count
] = QCweakness
;
2522 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2523 if (!NILP (params
[param_count
+ 1]))
2526 params
[param_count
] = QCrehash_size
;
2527 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2528 if (!NILP (params
[param_count
+ 1]))
2531 params
[param_count
] = QCrehash_threshold
;
2532 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2533 if (!NILP (params
[param_count
+ 1]))
2536 /* This is the hashtable data. */
2537 data
= Fplist_get (tmp
, Qdata
);
2539 /* Now use params to make a new hashtable and fill it. */
2540 ht
= Fmake_hash_table (param_count
, params
);
2542 while (CONSP (data
))
2547 error ("Odd number of elements in hashtable data");
2550 Fputhash (key
, val
, ht
);
2556 invalid_syntax ("#");
2564 tmp
= read_vector (readcharfun
, 0);
2565 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2566 error ("Invalid size char-table");
2567 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2575 /* Sub char-table can't be read as a regular
2576 vector because of a two C integer fields. */
2577 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2578 ptrdiff_t size
= XINT (Flength (tmp
));
2579 int i
, depth
, min_char
;
2580 struct Lisp_Cons
*cell
;
2583 error ("Zero-sized sub char-table");
2585 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2586 error ("Invalid depth in sub char-table");
2587 depth
= XINT (XCAR (tmp
));
2588 if (chartab_size
[depth
] != size
- 2)
2589 error ("Invalid size in sub char-table");
2590 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2593 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2594 error ("Invalid minimum character in sub-char-table");
2595 min_char
= XINT (XCAR (tmp
));
2596 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2599 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2600 for (i
= 0; i
< size
; i
++)
2602 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2603 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2608 invalid_syntax ("#^^");
2610 invalid_syntax ("#^");
2615 length
= read1 (readcharfun
, pch
, first_in_list
);
2619 Lisp_Object tmp
, val
;
2620 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2621 unsigned char *data
;
2624 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2625 if (STRING_MULTIBYTE (tmp
)
2626 || (size_in_chars
!= SCHARS (tmp
)
2627 /* We used to print 1 char too many
2628 when the number of bits was a multiple of 8.
2629 Accept such input in case it came from an old
2631 && ! (XFASTINT (length
)
2632 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2633 invalid_syntax ("#&...");
2635 val
= make_uninit_bool_vector (XFASTINT (length
));
2636 data
= bool_vector_uchar_data (val
);
2637 memcpy (data
, SDATA (tmp
), size_in_chars
);
2638 /* Clear the extraneous bits in the last byte. */
2639 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2640 data
[size_in_chars
- 1]
2641 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2644 invalid_syntax ("#&...");
2648 /* Accept compiled functions at read-time so that we don't have to
2649 build them using function calls. */
2651 struct Lisp_Vector
*vec
;
2652 tmp
= read_vector (readcharfun
, 1);
2653 vec
= XVECTOR (tmp
);
2654 if (vec
->header
.size
== 0)
2655 invalid_syntax ("Empty byte-code object");
2656 make_byte_code (vec
);
2664 /* Read the string itself. */
2665 tmp
= read1 (readcharfun
, &ch
, 0);
2666 if (ch
!= 0 || !STRINGP (tmp
))
2667 invalid_syntax ("#");
2668 /* Read the intervals and their properties. */
2671 Lisp_Object beg
, end
, plist
;
2673 beg
= read1 (readcharfun
, &ch
, 0);
2678 end
= read1 (readcharfun
, &ch
, 0);
2680 plist
= read1 (readcharfun
, &ch
, 0);
2682 invalid_syntax ("Invalid string property list");
2683 Fset_text_properties (beg
, end
, plist
, tmp
);
2689 /* #@NUMBER is used to skip NUMBER following bytes.
2690 That's used in .elc files to skip over doc strings
2691 and function definitions. */
2694 enum { extra
= 100 };
2695 ptrdiff_t i
, nskip
= 0, digits
= 0;
2697 /* Read a decimal integer. */
2698 while ((c
= READCHAR
) >= 0
2699 && c
>= '0' && c
<= '9')
2701 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2706 if (digits
== 2 && nskip
== 0)
2707 { /* We've just seen #@00, which means "skip to end". */
2708 skip_dyn_eof (readcharfun
);
2713 /* We can't use UNREAD here, because in the code below we side-step
2714 READCHAR. Instead, assume the first char after #@NNN occupies
2715 a single byte, which is the case normally since it's just
2721 if (load_force_doc_strings
2722 && (FROM_FILE_P (readcharfun
)))
2724 /* If we are supposed to force doc strings into core right now,
2725 record the last string that we skipped,
2726 and record where in the file it comes from. */
2728 /* But first exchange saved_doc_string
2729 with prev_saved_doc_string, so we save two strings. */
2731 char *temp
= saved_doc_string
;
2732 ptrdiff_t temp_size
= saved_doc_string_size
;
2733 file_offset temp_pos
= saved_doc_string_position
;
2734 ptrdiff_t temp_len
= saved_doc_string_length
;
2736 saved_doc_string
= prev_saved_doc_string
;
2737 saved_doc_string_size
= prev_saved_doc_string_size
;
2738 saved_doc_string_position
= prev_saved_doc_string_position
;
2739 saved_doc_string_length
= prev_saved_doc_string_length
;
2741 prev_saved_doc_string
= temp
;
2742 prev_saved_doc_string_size
= temp_size
;
2743 prev_saved_doc_string_position
= temp_pos
;
2744 prev_saved_doc_string_length
= temp_len
;
2747 if (saved_doc_string_size
== 0)
2749 saved_doc_string
= xmalloc (nskip
+ extra
);
2750 saved_doc_string_size
= nskip
+ extra
;
2752 if (nskip
> saved_doc_string_size
)
2754 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2755 saved_doc_string_size
= nskip
+ extra
;
2758 saved_doc_string_position
= file_tell (instream
);
2760 /* Copy that many characters into saved_doc_string. */
2762 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2763 saved_doc_string
[i
] = c
= getc (instream
);
2766 saved_doc_string_length
= i
;
2769 /* Skip that many bytes. */
2770 skip_dyn_bytes (readcharfun
, nskip
);
2776 /* #! appears at the beginning of an executable file.
2777 Skip the first line. */
2778 while (c
!= '\n' && c
>= 0)
2783 return Vload_file_name
;
2785 return list2 (Qfunction
, read0 (readcharfun
));
2786 /* #:foo is the uninterned symbol named foo. */
2789 uninterned_symbol
= 1;
2792 && c
!= NO_BREAK_SPACE
2794 || strchr ("\"';()[]#`,", c
) == NULL
)))
2796 /* No symbol character follows, this is the empty
2799 return Fmake_symbol (empty_unibyte_string
);
2803 /* ## is the empty symbol. */
2805 return Fintern (empty_unibyte_string
, Qnil
);
2806 /* Reader forms that can reuse previously read objects. */
2807 if (c
>= '0' && c
<= '9')
2812 /* Read a non-negative integer. */
2813 while (c
>= '0' && c
<= '9')
2815 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2816 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2817 n
= MOST_POSITIVE_FIXNUM
+ 1;
2819 n
= n
* 10 + c
- '0';
2823 if (n
<= MOST_POSITIVE_FIXNUM
)
2825 if (c
== 'r' || c
== 'R')
2826 return read_integer (readcharfun
, n
);
2828 if (! NILP (Vread_circle
))
2830 /* #n=object returns object, but associates it with
2834 /* Make a placeholder for #n# to use temporarily. */
2835 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2836 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2837 read_objects
= Fcons (cell
, read_objects
);
2839 /* Read the object itself. */
2840 tem
= read0 (readcharfun
);
2842 /* Now put it everywhere the placeholder was... */
2843 substitute_object_in_subtree (tem
, placeholder
);
2845 /* ...and #n# will use the real value from now on. */
2846 Fsetcdr (cell
, tem
);
2851 /* #n# returns a previously read object. */
2854 tem
= Fassq (make_number (n
), read_objects
);
2860 /* Fall through to error message. */
2862 else if (c
== 'x' || c
== 'X')
2863 return read_integer (readcharfun
, 16);
2864 else if (c
== 'o' || c
== 'O')
2865 return read_integer (readcharfun
, 8);
2866 else if (c
== 'b' || c
== 'B')
2867 return read_integer (readcharfun
, 2);
2870 invalid_syntax ("#");
2873 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2877 return list2 (Qquote
, read0 (readcharfun
));
2881 int next_char
= READCHAR
;
2883 /* Transition from old-style to new-style:
2884 If we see "(`" it used to mean old-style, which usually works
2885 fine because ` should almost never appear in such a position
2886 for new-style. But occasionally we need "(`" to mean new
2887 style, so we try to distinguish the two by the fact that we
2888 can either write "( `foo" or "(` foo", where the first
2889 intends to use new-style whereas the second intends to use
2890 old-style. For Emacs-25, we should completely remove this
2891 first_in_list exception (old-style can still be obtained via
2893 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2895 Vold_style_backquotes
= Qt
;
2901 bool saved_new_backquote_flag
= new_backquote_flag
;
2903 new_backquote_flag
= 1;
2904 value
= read0 (readcharfun
);
2905 new_backquote_flag
= saved_new_backquote_flag
;
2907 return list2 (Qbackquote
, value
);
2912 int next_char
= READCHAR
;
2914 /* Transition from old-style to new-style:
2915 It used to be impossible to have a new-style , other than within
2916 a new-style `. This is sufficient when ` and , are used in the
2917 normal way, but ` and , can also appear in args to macros that
2918 will not interpret them in the usual way, in which case , may be
2919 used without any ` anywhere near.
2920 So we now use the same heuristic as for backquote: old-style
2921 unquotes are only recognized when first on a list, and when
2922 followed by a space.
2923 Because it's more difficult to peek 2 chars ahead, a new-style
2924 ,@ can still not be used outside of a `, unless it's in the middle
2926 if (new_backquote_flag
2928 || (next_char
!= ' ' && next_char
!= '@'))
2930 Lisp_Object comma_type
= Qnil
;
2935 comma_type
= Qcomma_at
;
2937 comma_type
= Qcomma_dot
;
2940 if (ch
>= 0) UNREAD (ch
);
2941 comma_type
= Qcomma
;
2944 value
= read0 (readcharfun
);
2945 return list2 (comma_type
, value
);
2949 Vold_style_backquotes
= Qt
;
2961 end_of_file_error ();
2963 /* Accept `single space' syntax like (list ? x) where the
2964 whitespace character is SPC or TAB.
2965 Other literal whitespace like NL, CR, and FF are not accepted,
2966 as there are well-established escape sequences for these. */
2967 if (c
== ' ' || c
== '\t')
2968 return make_number (c
);
2971 c
= read_escape (readcharfun
, 0);
2972 modifiers
= c
& CHAR_MODIFIER_MASK
;
2973 c
&= ~CHAR_MODIFIER_MASK
;
2974 if (CHAR_BYTE8_P (c
))
2975 c
= CHAR_TO_BYTE8 (c
);
2978 next_char
= READCHAR
;
2979 ok
= (next_char
<= 040
2980 || (next_char
< 0200
2981 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2984 return make_number (c
);
2986 invalid_syntax ("?");
2991 char *p
= read_buffer
;
2992 char *end
= read_buffer
+ read_buffer_size
;
2994 /* True if we saw an escape sequence specifying
2995 a multibyte character. */
2996 bool force_multibyte
= 0;
2997 /* True if we saw an escape sequence specifying
2998 a single-byte character. */
2999 bool force_singlebyte
= 0;
3001 ptrdiff_t nchars
= 0;
3003 while ((ch
= READCHAR
) >= 0
3006 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3008 ptrdiff_t offset
= p
- read_buffer
;
3009 grow_read_buffer ();
3010 p
= read_buffer
+ offset
;
3011 end
= read_buffer
+ read_buffer_size
;
3018 ch
= read_escape (readcharfun
, 1);
3020 /* CH is -1 if \ newline or \ space has just been seen. */
3023 if (p
== read_buffer
)
3028 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3029 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3031 if (CHAR_BYTE8_P (ch
))
3032 force_singlebyte
= 1;
3033 else if (! ASCII_CHAR_P (ch
))
3034 force_multibyte
= 1;
3035 else /* I.e. ASCII_CHAR_P (ch). */
3037 /* Allow `\C- ' and `\C-?'. */
3038 if (modifiers
== CHAR_CTL
)
3041 ch
= 0, modifiers
= 0;
3043 ch
= 127, modifiers
= 0;
3045 if (modifiers
& CHAR_SHIFT
)
3047 /* Shift modifier is valid only with [A-Za-z]. */
3048 if (ch
>= 'A' && ch
<= 'Z')
3049 modifiers
&= ~CHAR_SHIFT
;
3050 else if (ch
>= 'a' && ch
<= 'z')
3051 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3054 if (modifiers
& CHAR_META
)
3056 /* Move the meta bit to the right place for a
3058 modifiers
&= ~CHAR_META
;
3059 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3060 force_singlebyte
= 1;
3064 /* Any modifiers remaining are invalid. */
3066 error ("Invalid modifier in string");
3067 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3071 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3072 if (CHAR_BYTE8_P (ch
))
3073 force_singlebyte
= 1;
3074 else if (! ASCII_CHAR_P (ch
))
3075 force_multibyte
= 1;
3081 end_of_file_error ();
3083 /* If purifying, and string starts with \ newline,
3084 return zero instead. This is for doc strings
3085 that we are really going to find in etc/DOC.nn.nn. */
3086 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3087 return make_number (0);
3089 if (! force_multibyte
&& force_singlebyte
)
3091 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3092 forms. Convert it to unibyte. */
3093 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3095 p
= read_buffer
+ nchars
;
3098 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3100 || (p
- read_buffer
!= nchars
)));
3105 int next_char
= READCHAR
;
3108 if (next_char
<= 040
3109 || (next_char
< 0200
3110 && strchr ("\"';([#?`,", next_char
) != NULL
))
3116 /* Otherwise, we fall through! Note that the atom-reading loop
3117 below will now loop at least once, assuring that we will not
3118 try to UNREAD two characters in a row. */
3122 if (c
<= 040) goto retry
;
3123 if (c
== NO_BREAK_SPACE
)
3128 char *p
= read_buffer
;
3130 EMACS_INT start_position
= readchar_count
- 1;
3133 char *end
= read_buffer
+ read_buffer_size
;
3137 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3139 ptrdiff_t offset
= p
- read_buffer
;
3140 grow_read_buffer ();
3141 p
= read_buffer
+ offset
;
3142 end
= read_buffer
+ read_buffer_size
;
3149 end_of_file_error ();
3154 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3160 && c
!= NO_BREAK_SPACE
3162 || strchr ("\"';()[]#`,", c
) == NULL
));
3166 ptrdiff_t offset
= p
- read_buffer
;
3167 grow_read_buffer ();
3168 p
= read_buffer
+ offset
;
3169 end
= read_buffer
+ read_buffer_size
;
3175 if (!quoted
&& !uninterned_symbol
)
3177 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3178 if (! NILP (result
))
3182 Lisp_Object name
, result
;
3183 ptrdiff_t nbytes
= p
- read_buffer
;
3186 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3190 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3191 ? make_pure_string
: make_specified_string
)
3192 (read_buffer
, nchars
, nbytes
, multibyte
));
3193 result
= (uninterned_symbol
? Fmake_symbol (name
)
3194 : Fintern (name
, Qnil
));
3196 if (EQ (Vread_with_symbol_positions
, Qt
)
3197 || EQ (Vread_with_symbol_positions
, readcharfun
))
3198 Vread_symbol_positions_list
3199 = Fcons (Fcons (result
, make_number (start_position
)),
3200 Vread_symbol_positions_list
);
3208 /* List of nodes we've seen during substitute_object_in_subtree. */
3209 static Lisp_Object seen_list
;
3212 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3214 Lisp_Object check_object
;
3216 /* We haven't seen any objects when we start. */
3219 /* Make all the substitutions. */
3221 = substitute_object_recurse (object
, placeholder
, object
);
3223 /* Clear seen_list because we're done with it. */
3226 /* The returned object here is expected to always eq the
3228 if (!EQ (check_object
, object
))
3229 error ("Unexpected mutation error in reader");
3232 /* Feval doesn't get called from here, so no gc protection is needed. */
3233 #define SUBSTITUTE(get_val, set_val) \
3235 Lisp_Object old_value = get_val; \
3236 Lisp_Object true_value \
3237 = substitute_object_recurse (object, placeholder, \
3240 if (!EQ (old_value, true_value)) \
3247 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3249 /* If we find the placeholder, return the target object. */
3250 if (EQ (placeholder
, subtree
))
3253 /* If we've been to this node before, don't explore it again. */
3254 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3257 /* If this node can be the entry point to a cycle, remember that
3258 we've seen it. It can only be such an entry point if it was made
3259 by #n=, which means that we can find it as a value in
3261 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3262 seen_list
= Fcons (subtree
, seen_list
);
3264 /* Recurse according to subtree's type.
3265 Every branch must return a Lisp_Object. */
3266 switch (XTYPE (subtree
))
3268 case Lisp_Vectorlike
:
3270 ptrdiff_t i
= 0, length
= 0;
3271 if (BOOL_VECTOR_P (subtree
))
3272 return subtree
; /* No sub-objects anyway. */
3273 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3274 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3275 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3276 else if (VECTORP (subtree
))
3277 length
= ASIZE (subtree
);
3279 /* An unknown pseudovector may contain non-Lisp fields, so we
3280 can't just blindly traverse all its fields. We used to call
3281 `Flength' which signaled `sequencep', so I just preserved this
3283 wrong_type_argument (Qsequencep
, subtree
);
3285 if (SUB_CHAR_TABLE_P (subtree
))
3287 for ( ; i
< length
; i
++)
3288 SUBSTITUTE (AREF (subtree
, i
),
3289 ASET (subtree
, i
, true_value
));
3295 SUBSTITUTE (XCAR (subtree
),
3296 XSETCAR (subtree
, true_value
));
3297 SUBSTITUTE (XCDR (subtree
),
3298 XSETCDR (subtree
, true_value
));
3304 /* Check for text properties in each interval.
3305 substitute_in_interval contains part of the logic. */
3307 INTERVAL root_interval
= string_intervals (subtree
);
3308 AUTO_CONS (arg
, object
, placeholder
);
3310 traverse_intervals_noorder (root_interval
,
3311 &substitute_in_interval
, arg
);
3316 /* Other types don't recurse any further. */
3322 /* Helper function for substitute_object_recurse. */
3324 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3326 Lisp_Object object
= Fcar (arg
);
3327 Lisp_Object placeholder
= Fcdr (arg
);
3329 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3339 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3340 integer syntax and fits in a fixnum, else return the nearest float if CP has
3341 either floating point or integer syntax and BASE is 10, else return nil. If
3342 IGNORE_TRAILING, consider just the longest prefix of CP that has
3343 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3344 number has integer syntax but does not fit. */
3347 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3350 char const *cp
= string
;
3352 bool float_syntax
= 0;
3355 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3356 IEEE floating point hosts, and works around a formerly-common bug where
3357 atof ("-0.0") drops the sign. */
3358 bool negative
= *cp
== '-';
3360 bool signedp
= negative
|| *cp
== '+';
3365 leading_digit
= digit_to_number (*cp
, base
);
3366 if (leading_digit
>= 0)
3371 while (digit_to_number (*cp
, base
) >= 0);
3381 if ('0' <= *cp
&& *cp
<= '9')
3386 while ('0' <= *cp
&& *cp
<= '9');
3388 if (*cp
== 'e' || *cp
== 'E')
3390 char const *ecp
= cp
;
3392 if (*cp
== '+' || *cp
== '-')
3394 if ('0' <= *cp
&& *cp
<= '9')
3399 while ('0' <= *cp
&& *cp
<= '9');
3401 else if (cp
[-1] == '+'
3402 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3408 else if (cp
[-1] == '+'
3409 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3413 /* NAN is a "positive" NaN on all known Emacs hosts. */
3420 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3421 || state
== (LEAD_INT
|E_EXP
));
3424 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3425 any prefix that matches. Otherwise, the entire string must match. */
3426 if (! (ignore_trailing
3427 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3428 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3431 /* If the number uses integer and not float syntax, and is in C-language
3432 range, use its value, preferably as a fixnum. */
3433 if (leading_digit
>= 0 && ! float_syntax
)
3437 /* Fast special case for single-digit integers. This also avoids a
3438 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3439 case some versions of strtoumax accept numbers like "0x1" that Emacs
3441 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3442 return make_number (negative
? -leading_digit
: leading_digit
);
3445 n
= strtoumax (string
+ signedp
, NULL
, base
);
3446 if (errno
== ERANGE
)
3448 /* Unfortunately there's no simple and accurate way to convert
3449 non-base-10 numbers that are out of C-language range. */
3451 xsignal1 (Qoverflow_error
, build_string (string
));
3453 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3455 EMACS_INT signed_n
= n
;
3456 return make_number (negative
? -signed_n
: signed_n
);
3462 /* Either the number uses float syntax, or it does not fit into a fixnum.
3463 Convert it from string to floating point, unless the value is already
3464 known because it is an infinity, a NAN, or its absolute value fits in
3467 value
= atof (string
+ signedp
);
3469 return make_float (negative
? -value
: value
);
3474 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3478 Lisp_Object tem
, item
, vector
;
3479 struct Lisp_Cons
*otem
;
3482 tem
= read_list (1, readcharfun
);
3483 len
= Flength (tem
);
3484 vector
= Fmake_vector (len
, Qnil
);
3486 size
= ASIZE (vector
);
3487 ptr
= XVECTOR (vector
)->contents
;
3488 for (i
= 0; i
< size
; i
++)
3491 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3492 bytecode object, the docstring containing the bytecode and
3493 constants values must be treated as unibyte and passed to
3494 Fread, to get the actual bytecode string and constants vector. */
3495 if (bytecodeflag
&& load_force_doc_strings
)
3497 if (i
== COMPILED_BYTECODE
)
3499 if (!STRINGP (item
))
3500 error ("Invalid byte code");
3502 /* Delay handling the bytecode slot until we know whether
3503 it is lazily-loaded (we can tell by whether the
3504 constants slot is nil). */
3505 ASET (vector
, COMPILED_CONSTANTS
, item
);
3508 else if (i
== COMPILED_CONSTANTS
)
3510 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3514 /* Coerce string to unibyte (like string-as-unibyte,
3515 but without generating extra garbage and
3516 guaranteeing no change in the contents). */
3517 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3518 STRING_SET_UNIBYTE (bytestr
);
3520 item
= Fread (Fcons (bytestr
, readcharfun
));
3522 error ("Invalid byte code");
3524 otem
= XCONS (item
);
3525 bytestr
= XCAR (item
);
3530 /* Now handle the bytecode slot. */
3531 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3533 else if (i
== COMPILED_DOC_STRING
3535 && ! STRING_MULTIBYTE (item
))
3537 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3538 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3540 item
= Fstring_as_multibyte (item
);
3543 ASET (vector
, i
, item
);
3551 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3554 read_list (bool flag
, Lisp_Object readcharfun
)
3556 Lisp_Object val
, tail
;
3557 Lisp_Object elt
, tem
;
3558 /* 0 is the normal case.
3559 1 means this list is a doc reference; replace it with the number 0.
3560 2 means this list is a doc reference; replace it with the doc string. */
3561 int doc_reference
= 0;
3563 /* Initialize this to 1 if we are reading a list. */
3564 bool first_in_list
= flag
<= 0;
3572 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3576 /* While building, if the list starts with #$, treat it specially. */
3577 if (EQ (elt
, Vload_file_name
)
3579 && !NILP (Vpurify_flag
))
3581 if (NILP (Vdoc_file_name
))
3582 /* We have not yet called Snarf-documentation, so assume
3583 this file is described in the DOC file
3584 and Snarf-documentation will fill in the right value later.
3585 For now, replace the whole list with 0. */
3588 /* We have already called Snarf-documentation, so make a relative
3589 file name for this file, so it can be found properly
3590 in the installed Lisp directory.
3591 We don't use Fexpand_file_name because that would make
3592 the directory absolute now. */
3594 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3595 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3598 else if (EQ (elt
, Vload_file_name
)
3600 && load_force_doc_strings
)
3609 invalid_syntax (") or . in a vector");
3616 XSETCDR (tail
, read0 (readcharfun
));
3618 val
= read0 (readcharfun
);
3619 read1 (readcharfun
, &ch
, 0);
3623 if (doc_reference
== 1)
3624 return make_number (0);
3625 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3628 file_offset saved_position
;
3629 /* Get a doc string from the file we are loading.
3630 If it's in saved_doc_string, get it from there.
3632 Here, we don't know if the string is a
3633 bytecode string or a doc string. As a
3634 bytecode string must be unibyte, we always
3635 return a unibyte string. If it is actually a
3636 doc string, caller must make it
3639 /* Position is negative for user variables. */
3640 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3641 if (pos
>= saved_doc_string_position
3642 && pos
< (saved_doc_string_position
3643 + saved_doc_string_length
))
3645 saved
= saved_doc_string
;
3646 saved_position
= saved_doc_string_position
;
3648 /* Look in prev_saved_doc_string the same way. */
3649 else if (pos
>= prev_saved_doc_string_position
3650 && pos
< (prev_saved_doc_string_position
3651 + prev_saved_doc_string_length
))
3653 saved
= prev_saved_doc_string
;
3654 saved_position
= prev_saved_doc_string_position
;
3658 ptrdiff_t start
= pos
- saved_position
;
3661 /* Process quoting with ^A,
3662 and find the end of the string,
3663 which is marked with ^_ (037). */
3664 for (from
= start
, to
= start
;
3665 saved
[from
] != 037;)
3667 int c
= saved
[from
++];
3671 saved
[to
++] = (c
== 1 ? c
3680 return make_unibyte_string (saved
+ start
,
3684 return get_doc_string (val
, 1, 0);
3689 invalid_syntax (". in wrong context");
3691 invalid_syntax ("] in a list");
3695 XSETCDR (tail
, tem
);
3702 static Lisp_Object initial_obarray
;
3704 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3706 static size_t oblookup_last_bucket_number
;
3708 /* Get an error if OBARRAY is not an obarray.
3709 If it is one, return it. */
3712 check_obarray (Lisp_Object obarray
)
3714 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3716 /* If Vobarray is now invalid, force it to be valid. */
3717 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3718 wrong_type_argument (Qvectorp
, obarray
);
3723 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3726 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3730 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3731 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3734 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3736 XSYMBOL (sym
)->constant
= 1;
3737 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3738 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3741 ptr
= aref_addr (obarray
, XINT (index
));
3742 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3747 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3750 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3752 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3755 /* Intern the C string STR: return a symbol with that name,
3756 interned in the current obarray. */
3759 intern_1 (const char *str
, ptrdiff_t len
)
3761 Lisp_Object obarray
= check_obarray (Vobarray
);
3762 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3764 return (SYMBOLP (tem
) ? tem
3765 /* The above `oblookup' was done on the basis of nchars==nbytes, so
3766 the string has to be unibyte. */
3767 : intern_driver (make_unibyte_string (str
, len
),
3772 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3774 Lisp_Object obarray
= check_obarray (Vobarray
);
3775 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3779 /* Creating a non-pure string from a string literal not implemented yet.
3780 We could just use make_string here and live with the extra copy. */
3781 eassert (!NILP (Vpurify_flag
));
3782 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3788 define_symbol (Lisp_Object sym
, char const *str
)
3790 ptrdiff_t len
= strlen (str
);
3791 Lisp_Object string
= make_pure_c_string (str
, len
);
3792 init_symbol (sym
, string
);
3794 /* Qunbound is uninterned, so that it's not confused with any symbol
3795 'unbound' created by a Lisp program. */
3796 if (! EQ (sym
, Qunbound
))
3798 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3799 eassert (INTEGERP (bucket
));
3800 intern_sym (sym
, initial_obarray
, bucket
);
3804 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3805 doc
: /* Return the canonical symbol whose name is STRING.
3806 If there is none, one is created by this function and returned.
3807 A second optional argument specifies the obarray to use;
3808 it defaults to the value of `obarray'. */)
3809 (Lisp_Object string
, Lisp_Object obarray
)
3813 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3814 CHECK_STRING (string
);
3816 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3818 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3823 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3824 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3825 NAME may be a string or a symbol. If it is a symbol, that exact
3826 symbol is searched for.
3827 A second optional argument specifies the obarray to use;
3828 it defaults to the value of `obarray'. */)
3829 (Lisp_Object name
, Lisp_Object obarray
)
3831 register Lisp_Object tem
, string
;
3833 if (NILP (obarray
)) obarray
= Vobarray
;
3834 obarray
= check_obarray (obarray
);
3836 if (!SYMBOLP (name
))
3838 CHECK_STRING (name
);
3842 string
= SYMBOL_NAME (name
);
3844 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3845 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3851 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3852 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3853 The value is t if a symbol was found and deleted, nil otherwise.
3854 NAME may be a string or a symbol. If it is a symbol, that symbol
3855 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3856 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3857 usage: (unintern NAME OBARRAY) */)
3858 (Lisp_Object name
, Lisp_Object obarray
)
3860 register Lisp_Object string
, tem
;
3863 if (NILP (obarray
)) obarray
= Vobarray
;
3864 obarray
= check_obarray (obarray
);
3867 string
= SYMBOL_NAME (name
);
3870 CHECK_STRING (name
);
3874 tem
= oblookup (obarray
, SSDATA (string
),
3879 /* If arg was a symbol, don't delete anything but that symbol itself. */
3880 if (SYMBOLP (name
) && !EQ (name
, tem
))
3883 /* There are plenty of other symbols which will screw up the Emacs
3884 session if we unintern them, as well as even more ways to use
3885 `setq' or `fset' or whatnot to make the Emacs session
3886 unusable. Let's not go down this silly road. --Stef */
3887 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3888 error ("Attempt to unintern t or nil"); */
3890 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3892 hash
= oblookup_last_bucket_number
;
3894 if (EQ (AREF (obarray
, hash
), tem
))
3896 if (XSYMBOL (tem
)->next
)
3899 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3900 ASET (obarray
, hash
, sym
);
3903 ASET (obarray
, hash
, make_number (0));
3907 Lisp_Object tail
, following
;
3909 for (tail
= AREF (obarray
, hash
);
3910 XSYMBOL (tail
)->next
;
3913 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3914 if (EQ (following
, tem
))
3916 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3925 /* Return the symbol in OBARRAY whose names matches the string
3926 of SIZE characters (SIZE_BYTE bytes) at PTR.
3927 If there is no such symbol, return the integer bucket number of
3928 where the symbol would be if it were present.
3930 Also store the bucket number in oblookup_last_bucket_number. */
3933 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3937 register Lisp_Object tail
;
3938 Lisp_Object bucket
, tem
;
3940 obarray
= check_obarray (obarray
);
3941 obsize
= ASIZE (obarray
);
3943 /* This is sometimes needed in the middle of GC. */
3944 obsize
&= ~ARRAY_MARK_FLAG
;
3945 hash
= hash_string (ptr
, size_byte
) % obsize
;
3946 bucket
= AREF (obarray
, hash
);
3947 oblookup_last_bucket_number
= hash
;
3948 if (EQ (bucket
, make_number (0)))
3950 else if (!SYMBOLP (bucket
))
3951 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3953 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3955 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3956 && SCHARS (SYMBOL_NAME (tail
)) == size
3957 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3959 else if (XSYMBOL (tail
)->next
== 0)
3962 XSETINT (tem
, hash
);
3967 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3970 register Lisp_Object tail
;
3971 CHECK_VECTOR (obarray
);
3972 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3974 tail
= AREF (obarray
, i
);
3979 if (XSYMBOL (tail
)->next
== 0)
3981 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3987 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3989 call1 (function
, sym
);
3992 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3993 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3994 OBARRAY defaults to the value of `obarray'. */)
3995 (Lisp_Object function
, Lisp_Object obarray
)
3997 if (NILP (obarray
)) obarray
= Vobarray
;
3998 obarray
= check_obarray (obarray
);
4000 map_obarray (obarray
, mapatoms_1
, function
);
4004 #define OBARRAY_SIZE 1511
4009 Lisp_Object oblength
;
4010 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4012 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4014 Vobarray
= Fmake_vector (oblength
, make_number (0));
4015 initial_obarray
= Vobarray
;
4016 staticpro (&initial_obarray
);
4018 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4019 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4021 DEFSYM (Qunbound
, "unbound");
4023 DEFSYM (Qnil
, "nil");
4024 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4025 XSYMBOL (Qnil
)->constant
= 1;
4026 XSYMBOL (Qnil
)->declared_special
= true;
4029 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4030 XSYMBOL (Qt
)->constant
= 1;
4031 XSYMBOL (Qt
)->declared_special
= true;
4033 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4036 DEFSYM (Qvariable_documentation
, "variable-documentation");
4038 read_buffer
= xmalloc (size
);
4039 read_buffer_size
= size
;
4043 defsubr (struct Lisp_Subr
*sname
)
4045 Lisp_Object sym
, tem
;
4046 sym
= intern_c_string (sname
->symbol_name
);
4047 XSETPVECTYPE (sname
, PVEC_SUBR
);
4048 XSETSUBR (tem
, sname
);
4049 set_symbol_function (sym
, tem
);
4052 #ifdef NOTDEF /* Use fset in subr.el now! */
4054 defalias (struct Lisp_Subr
*sname
, char *string
)
4057 sym
= intern (string
);
4058 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4062 /* Define an "integer variable"; a symbol whose value is forwarded to a
4063 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4064 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4066 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4067 const char *namestring
, EMACS_INT
*address
)
4070 sym
= intern_c_string (namestring
);
4071 i_fwd
->type
= Lisp_Fwd_Int
;
4072 i_fwd
->intvar
= address
;
4073 XSYMBOL (sym
)->declared_special
= 1;
4074 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4075 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4078 /* Similar but define a variable whose value is t if address contains 1,
4079 nil if address contains 0. */
4081 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4082 const char *namestring
, bool *address
)
4085 sym
= intern_c_string (namestring
);
4086 b_fwd
->type
= Lisp_Fwd_Bool
;
4087 b_fwd
->boolvar
= address
;
4088 XSYMBOL (sym
)->declared_special
= 1;
4089 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4090 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4091 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4094 /* Similar but define a variable whose value is the Lisp Object stored
4095 at address. Two versions: with and without gc-marking of the C
4096 variable. The nopro version is used when that variable will be
4097 gc-marked for some other reason, since marking the same slot twice
4098 can cause trouble with strings. */
4100 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4101 const char *namestring
, Lisp_Object
*address
)
4104 sym
= intern_c_string (namestring
);
4105 o_fwd
->type
= Lisp_Fwd_Obj
;
4106 o_fwd
->objvar
= address
;
4107 XSYMBOL (sym
)->declared_special
= 1;
4108 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4109 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4113 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4114 const char *namestring
, Lisp_Object
*address
)
4116 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4117 staticpro (address
);
4120 /* Similar but define a variable whose value is the Lisp Object stored
4121 at a particular offset in the current kboard object. */
4124 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4125 const char *namestring
, int offset
)
4128 sym
= intern_c_string (namestring
);
4129 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4130 ko_fwd
->offset
= offset
;
4131 XSYMBOL (sym
)->declared_special
= 1;
4132 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4133 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4136 /* Check that the elements of lpath exist. */
4139 load_path_check (Lisp_Object lpath
)
4141 Lisp_Object path_tail
;
4143 /* The only elements that might not exist are those from
4144 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4146 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4148 Lisp_Object dirfile
;
4149 dirfile
= Fcar (path_tail
);
4150 if (STRINGP (dirfile
))
4152 dirfile
= Fdirectory_file_name (dirfile
);
4153 if (! file_accessible_directory_p (dirfile
))
4154 dir_warning ("Lisp directory", XCAR (path_tail
));
4159 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4160 This does not include the standard site-lisp directories
4161 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4162 but it does (unless no_site_lisp is set) include site-lisp
4163 directories in the source/build directories if those exist and we
4164 are running uninstalled.
4166 Uses the following logic:
4167 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4168 The remainder is what happens when dumping works:
4169 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4170 Otherwise use PATH_LOADSEARCH.
4172 If !initialized, then just return PATH_DUMPLOADSEARCH.
4174 If Vinstallation_directory is not nil (ie, running uninstalled):
4175 If installation-dir/lisp exists and not already a member,
4176 we must be running uninstalled. Reset the load-path
4177 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4178 refers to the eventual installation directories. Since we
4179 are not yet installed, we should not use them, even if they exist.)
4180 If installation-dir/lisp does not exist, just add
4181 PATH_DUMPLOADSEARCH at the end instead.
4182 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4183 and not already a member) at the front.
4184 If installation-dir != source-dir (ie running an uninstalled,
4185 out-of-tree build) AND install-dir/src/Makefile exists BUT
4186 install-dir/src/Makefile.in does NOT exist (this is a sanity
4187 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4190 load_path_default (void)
4192 Lisp_Object lpath
= Qnil
;
4197 const char *loadpath
= ns_load_path ();
4200 normal
= PATH_LOADSEARCH
;
4202 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4204 lpath
= decode_env_path (0, normal
, 0);
4207 #else /* !CANNOT_DUMP */
4209 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4214 const char *loadpath
= ns_load_path ();
4215 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4217 lpath
= decode_env_path (0, normal
, 0);
4219 if (!NILP (Vinstallation_directory
))
4221 Lisp_Object tem
, tem1
;
4223 /* Add to the path the lisp subdir of the installation
4224 dir, if it is accessible. Note: in out-of-tree builds,
4225 this directory is empty save for Makefile. */
4226 tem
= Fexpand_file_name (build_string ("lisp"),
4227 Vinstallation_directory
);
4228 tem1
= Ffile_accessible_directory_p (tem
);
4231 if (NILP (Fmember (tem
, lpath
)))
4233 /* We are running uninstalled. The default load-path
4234 points to the eventual installed lisp directories.
4235 We should not use those now, even if they exist,
4236 so start over from a clean slate. */
4237 lpath
= list1 (tem
);
4241 /* That dir doesn't exist, so add the build-time
4242 Lisp dirs instead. */
4244 Lisp_Object dump_path
=
4245 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4246 lpath
= nconc2 (lpath
, dump_path
);
4249 /* Add site-lisp under the installation dir, if it exists. */
4252 tem
= Fexpand_file_name (build_string ("site-lisp"),
4253 Vinstallation_directory
);
4254 tem1
= Ffile_accessible_directory_p (tem
);
4257 if (NILP (Fmember (tem
, lpath
)))
4258 lpath
= Fcons (tem
, lpath
);
4262 /* If Emacs was not built in the source directory,
4263 and it is run from where it was built, add to load-path
4264 the lisp and site-lisp dirs under that directory. */
4266 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4270 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4271 Vinstallation_directory
);
4272 tem1
= Ffile_exists_p (tem
);
4274 /* Don't be fooled if they moved the entire source tree
4275 AFTER dumping Emacs. If the build directory is indeed
4276 different from the source dir, src/Makefile.in and
4277 src/Makefile will not be found together. */
4278 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4279 Vinstallation_directory
);
4280 tem2
= Ffile_exists_p (tem
);
4281 if (!NILP (tem1
) && NILP (tem2
))
4283 tem
= Fexpand_file_name (build_string ("lisp"),
4286 if (NILP (Fmember (tem
, lpath
)))
4287 lpath
= Fcons (tem
, lpath
);
4291 tem
= Fexpand_file_name (build_string ("site-lisp"),
4293 tem1
= Ffile_accessible_directory_p (tem
);
4296 if (NILP (Fmember (tem
, lpath
)))
4297 lpath
= Fcons (tem
, lpath
);
4301 } /* Vinstallation_directory != Vsource_directory */
4303 } /* if Vinstallation_directory */
4305 else /* !initialized */
4307 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4308 source directory. We used to add ../lisp (ie the lisp dir in
4309 the build directory) at the front here, but that should not
4310 be necessary, since in out of tree builds lisp/ is empty, save
4312 lpath
= decode_env_path (0, normal
, 0);
4314 #endif /* !CANNOT_DUMP */
4322 /* First, set Vload_path. */
4324 /* Ignore EMACSLOADPATH when dumping. */
4326 bool use_loadpath
= true;
4328 bool use_loadpath
= NILP (Vpurify_flag
);
4331 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4333 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4335 /* Check (non-nil) user-supplied elements. */
4336 load_path_check (Vload_path
);
4338 /* If no nils in the environment variable, use as-is.
4339 Otherwise, replace any nils with the default. */
4340 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4342 Lisp_Object elem
, elpath
= Vload_path
;
4343 Lisp_Object default_lpath
= load_path_default ();
4345 /* Check defaults, before adding site-lisp. */
4346 load_path_check (default_lpath
);
4348 /* Add the site-lisp directories to the front of the default. */
4351 Lisp_Object sitelisp
;
4352 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4353 if (! NILP (sitelisp
))
4354 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4359 /* Replace nils from EMACSLOADPATH by default. */
4360 while (CONSP (elpath
))
4362 elem
= XCAR (elpath
);
4363 elpath
= XCDR (elpath
);
4364 Vload_path
= CALLN (Fappend
, Vload_path
,
4365 NILP (elem
) ? default_lpath
: list1 (elem
));
4367 } /* Fmemq (Qnil, Vload_path) */
4371 Vload_path
= load_path_default ();
4373 /* Check before adding site-lisp directories.
4374 The install should have created them, but they are not
4375 required, so no need to warn if they are absent.
4376 Or we might be running before installation. */
4377 load_path_check (Vload_path
);
4379 /* Add the site-lisp directories at the front. */
4380 if (initialized
&& !no_site_lisp
)
4382 Lisp_Object sitelisp
;
4383 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4384 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4390 load_in_progress
= 0;
4391 Vload_file_name
= Qnil
;
4392 Vstandard_input
= Qt
;
4393 Vloads_in_progress
= Qnil
;
4396 /* Print a warning that directory intended for use USE and with name
4397 DIRNAME cannot be accessed. On entry, errno should correspond to
4398 the access failure. Print the warning on stderr and put it in
4402 dir_warning (char const *use
, Lisp_Object dirname
)
4404 static char const format
[] = "Warning: %s '%s': %s\n";
4405 int access_errno
= errno
;
4406 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)),
4407 strerror (access_errno
));
4409 /* Don't log the warning before we've initialized!! */
4412 char const *diagnostic
= emacs_strerror (access_errno
);
4414 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4415 + strlen (use
) + SBYTES (dirname
)
4416 + strlen (diagnostic
));
4417 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4419 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4425 syms_of_lread (void)
4428 defsubr (&Sread_from_string
);
4430 defsubr (&Sintern_soft
);
4431 defsubr (&Sunintern
);
4432 defsubr (&Sget_load_suffixes
);
4434 defsubr (&Seval_buffer
);
4435 defsubr (&Seval_region
);
4436 defsubr (&Sread_char
);
4437 defsubr (&Sread_char_exclusive
);
4438 defsubr (&Sread_event
);
4439 defsubr (&Sget_file_char
);
4440 defsubr (&Smapatoms
);
4441 defsubr (&Slocate_file_internal
);
4443 DEFVAR_LISP ("obarray", Vobarray
,
4444 doc
: /* Symbol table for use by `intern' and `read'.
4445 It is a vector whose length ought to be prime for best results.
4446 The vector's contents don't make sense if examined from Lisp programs;
4447 to find all the symbols in an obarray, use `mapatoms'. */);
4449 DEFVAR_LISP ("values", Vvalues
,
4450 doc
: /* List of values of all expressions which were read, evaluated and printed.
4451 Order is reverse chronological. */);
4452 XSYMBOL (intern ("values"))->declared_special
= 0;
4454 DEFVAR_LISP ("standard-input", Vstandard_input
,
4455 doc
: /* Stream for read to get input from.
4456 See documentation of `read' for possible values. */);
4457 Vstandard_input
= Qt
;
4459 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4460 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4462 If this variable is a buffer, then only forms read from that buffer
4463 will be added to `read-symbol-positions-list'.
4464 If this variable is t, then all read forms will be added.
4465 The effect of all other values other than nil are not currently
4466 defined, although they may be in the future.
4468 The positions are relative to the last call to `read' or
4469 `read-from-string'. It is probably a bad idea to set this variable at
4470 the toplevel; bind it instead. */);
4471 Vread_with_symbol_positions
= Qnil
;
4473 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4474 doc
: /* A list mapping read symbols to their positions.
4475 This variable is modified during calls to `read' or
4476 `read-from-string', but only when `read-with-symbol-positions' is
4479 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4480 CHAR-POSITION is an integer giving the offset of that occurrence of the
4481 symbol from the position where `read' or `read-from-string' started.
4483 Note that a symbol will appear multiple times in this list, if it was
4484 read multiple times. The list is in the same order as the symbols
4486 Vread_symbol_positions_list
= Qnil
;
4488 DEFVAR_LISP ("read-circle", Vread_circle
,
4489 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4492 DEFVAR_LISP ("load-path", Vload_path
,
4493 doc
: /* List of directories to search for files to load.
4494 Each element is a string (directory file name) or nil (meaning
4495 `default-directory').
4496 Initialized during startup as described in Info node `(elisp)Library Search'.
4497 Use `directory-file-name' when adding items to this path. However, Lisp
4498 programs that process this list should tolerate directories both with
4499 and without trailing slashes. */);
4501 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4502 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4503 This list should not include the empty string.
4504 `load' and related functions try to append these suffixes, in order,
4505 to the specified file name if a Lisp suffix is allowed or required. */);
4507 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4508 build_pure_c_string (".el"),
4509 build_pure_c_string (MODULES_SUFFIX
));
4511 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4512 build_pure_c_string (".el"));
4514 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4515 doc
: /* List of suffixes that indicate representations of \
4517 This list should normally start with the empty string.
4519 Enabling Auto Compression mode appends the suffixes in
4520 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4521 mode removes them again. `load' and related functions use this list to
4522 determine whether they should look for compressed versions of a file
4523 and, if so, which suffixes they should try to append to the file name
4524 in order to do so. However, if you want to customize which suffixes
4525 the loading functions recognize as compression suffixes, you should
4526 customize `jka-compr-load-suffixes' rather than the present variable. */);
4527 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4529 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4530 doc
: /* Non-nil if inside of `load'. */);
4531 DEFSYM (Qload_in_progress
, "load-in-progress");
4533 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4534 doc
: /* An alist of functions to be evalled when particular files are loaded.
4535 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4537 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4538 a symbol (a feature name).
4540 When `load' is run and the file-name argument matches an element's
4541 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4542 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4544 An error in FORMS does not undo the load, but does prevent execution of
4545 the rest of the FORMS. */);
4546 Vafter_load_alist
= Qnil
;
4548 DEFVAR_LISP ("load-history", Vload_history
,
4549 doc
: /* Alist mapping loaded file names to symbols and features.
4550 Each alist element should be a list (FILE-NAME ENTRIES...), where
4551 FILE-NAME is the name of a file that has been loaded into Emacs.
4552 The file name is absolute and true (i.e. it doesn't contain symlinks).
4553 As an exception, one of the alist elements may have FILE-NAME nil,
4554 for symbols and features not associated with any file.
4556 The remaining ENTRIES in the alist element describe the functions and
4557 variables defined in that file, the features provided, and the
4558 features required. Each entry has the form `(provide . FEATURE)',
4559 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4560 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4561 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4562 autoload before this file redefined it as a function. In addition,
4563 entries may also be single symbols, which means that SYMBOL was
4564 defined by `defvar' or `defconst'.
4566 During preloading, the file name recorded is relative to the main Lisp
4567 directory. These file names are converted to absolute at startup. */);
4568 Vload_history
= Qnil
;
4570 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4571 doc
: /* Full name of file being loaded by `load'. */);
4572 Vload_file_name
= Qnil
;
4574 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4575 doc
: /* File name, including directory, of user's initialization file.
4576 If the file loaded had extension `.elc', and the corresponding source file
4577 exists, this variable contains the name of source file, suitable for use
4578 by functions like `custom-save-all' which edit the init file.
4579 While Emacs loads and evaluates the init file, value is the real name
4580 of the file, regardless of whether or not it has the `.elc' extension. */);
4581 Vuser_init_file
= Qnil
;
4583 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4584 doc
: /* Used for internal purposes by `load'. */);
4585 Vcurrent_load_list
= Qnil
;
4587 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4588 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4589 Called with a single argument (the stream from which to read).
4590 The default is to use the function `read'. */);
4591 DEFSYM (Qread
, "read");
4592 Vload_read_function
= Qread
;
4594 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4595 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4596 The value should be a function for doing code conversion before
4597 reading a source file. It can also be nil, in which case loading is
4598 done without any code conversion.
4600 If the value is a function, it is called with four arguments,
4601 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4602 the file to load, FILE is the non-absolute name (for messages etc.),
4603 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4604 `load'. The function should return t if the file was loaded. */);
4605 Vload_source_file_function
= Qnil
;
4607 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4608 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4609 This is useful when the file being loaded is a temporary copy. */);
4610 load_force_doc_strings
= 0;
4612 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4613 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4614 This is normally bound by `load' and `eval-buffer' to control `read',
4615 and is not meant for users to change. */);
4616 load_convert_to_unibyte
= 0;
4618 DEFVAR_LISP ("source-directory", Vsource_directory
,
4619 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4620 You cannot count on them to still be there! */);
4622 = Fexpand_file_name (build_string ("../"),
4623 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4625 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4626 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4627 Vpreloaded_file_list
= Qnil
;
4629 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4630 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4631 Vbyte_boolean_vars
= Qnil
;
4633 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4634 doc
: /* Non-nil means load dangerous compiled Lisp files.
4635 Some versions of XEmacs use different byte codes than Emacs. These
4636 incompatible byte codes can make Emacs crash when it tries to execute
4638 load_dangerous_libraries
= 0;
4640 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4641 doc
: /* Non-nil means force printing messages when loading Lisp files.
4642 This overrides the value of the NOMESSAGE argument to `load'. */);
4643 force_load_messages
= 0;
4645 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4646 doc
: /* Regular expression matching safe to load compiled Lisp files.
4647 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4648 from the file, and matches them against this regular expression.
4649 When the regular expression matches, the file is considered to be safe
4650 to load. See also `load-dangerous-libraries'. */);
4651 Vbytecomp_version_regexp
4652 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4654 DEFSYM (Qlexical_binding
, "lexical-binding");
4655 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4656 doc
: /* Whether to use lexical binding when evaluating code.
4657 Non-nil means that the code in the current buffer should be evaluated
4658 with lexical binding.
4659 This variable is automatically set from the file variables of an
4660 interpreted Lisp file read using `load'. Unlike other file local
4661 variables, this must be set in the first line of a file. */);
4662 Vlexical_binding
= Qnil
;
4663 Fmake_variable_buffer_local (Qlexical_binding
);
4665 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4666 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4667 Veval_buffer_list
= Qnil
;
4669 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4670 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4671 Vold_style_backquotes
= Qnil
;
4672 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4674 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4675 doc
: /* Non-nil means `load' prefers the newest version of a file.
4676 This applies when a filename suffix is not explicitly specified and
4677 `load' is trying various possible suffixes (see `load-suffixes' and
4678 `load-file-rep-suffixes'). Normally, it stops at the first file
4679 that exists unless you explicitly specify one or the other. If this
4680 option is non-nil, it checks all suffixes and uses whichever file is
4682 Note that if you customize this, obviously it will not affect files
4683 that are loaded before your customizations are read! */);
4684 load_prefer_newer
= 0;
4686 /* Vsource_directory was initialized in init_lread. */
4688 DEFSYM (Qcurrent_load_list
, "current-load-list");
4689 DEFSYM (Qstandard_input
, "standard-input");
4690 DEFSYM (Qread_char
, "read-char");
4691 DEFSYM (Qget_file_char
, "get-file-char");
4693 /* Used instead of Qget_file_char while loading *.elc files compiled
4694 by Emacs 21 or older. */
4695 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4697 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4699 DEFSYM (Qbackquote
, "`");
4700 DEFSYM (Qcomma
, ",");
4701 DEFSYM (Qcomma_at
, ",@");
4702 DEFSYM (Qcomma_dot
, ",.");
4704 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4705 DEFSYM (Qascii_character
, "ascii-character");
4706 DEFSYM (Qfunction
, "function");
4707 DEFSYM (Qload
, "load");
4708 DEFSYM (Qload_file_name
, "load-file-name");
4709 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4710 DEFSYM (Qfile_truename
, "file-truename");
4711 DEFSYM (Qdir_ok
, "dir-ok");
4712 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4714 staticpro (&read_objects
);
4715 read_objects
= Qnil
;
4716 staticpro (&seen_list
);
4719 Vloads_in_progress
= Qnil
;
4720 staticpro (&Vloads_in_progress
);
4722 DEFSYM (Qhash_table
, "hash-table");
4723 DEFSYM (Qdata
, "data");
4724 DEFSYM (Qtest
, "test");
4725 DEFSYM (Qsize
, "size");
4726 DEFSYM (Qweakness
, "weakness");
4727 DEFSYM (Qrehash_size
, "rehash-size");
4728 DEFSYM (Qrehash_threshold
, "rehash-threshold");