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 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
979 doc
: /* Execute a file of Lisp code named FILE.
980 First try FILE with `.elc' appended, then try with `.el',
981 then try FILE unmodified (the exact suffixes in the exact order are
982 determined by `load-suffixes'). Environment variable references in
983 FILE are replaced with their values by calling `substitute-in-file-name'.
984 This function searches the directories in `load-path'.
986 If optional second arg NOERROR is non-nil,
987 report no error if FILE doesn't exist.
988 Print messages at start and end of loading unless
989 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
991 If optional fourth arg NOSUFFIX is non-nil, don't try adding
992 suffixes `.elc' or `.el' to the specified name FILE.
993 If optional fifth arg MUST-SUFFIX is non-nil, insist on
994 the suffix `.elc' or `.el'; don't accept just FILE unless
995 it ends in one of those suffixes or includes a directory name.
997 If NOSUFFIX is nil, then if a file could not be found, try looking for
998 a different representation of the file by adding non-empty suffixes to
999 its name, before trying another file. Emacs uses this feature to find
1000 compressed versions of files when Auto Compression mode is enabled.
1001 If NOSUFFIX is non-nil, disable this feature.
1003 The suffixes that this function tries out, when NOSUFFIX is nil, are
1004 given by the return value of `get-load-suffixes' and the values listed
1005 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1006 return value of `get-load-suffixes' is used, i.e. the file name is
1007 required to have a non-empty suffix.
1009 When searching suffixes, this function normally stops at the first
1010 one that exists. If the option `load-prefer-newer' is non-nil,
1011 however, it tries all suffixes, and uses whichever file is the newest.
1013 Loading a file records its definitions, and its `provide' and
1014 `require' calls, in an element of `load-history' whose
1015 car is the file name loaded. See `load-history'.
1017 While the file is in the process of being loaded, the variable
1018 `load-in-progress' is non-nil and the variable `load-file-name'
1019 is bound to the file's name.
1021 Return t if the file exists and loads successfully. */)
1022 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1023 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1028 ptrdiff_t count
= SPECPDL_INDEX ();
1029 Lisp_Object found
, efound
, hist_file_name
;
1030 /* True means we printed the ".el is newer" message. */
1032 /* True means we are loading a compiled file. */
1034 Lisp_Object handler
;
1036 const char *fmode
= "r" FOPEN_TEXT
;
1039 CHECK_STRING (file
);
1041 /* If file name is magic, call the handler. */
1042 /* This shouldn't be necessary any more now that `openp' handles it right.
1043 handler = Ffind_file_name_handler (file, Qload);
1044 if (!NILP (handler))
1045 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1047 /* The presence of this call is the result of a historical accident:
1048 it used to be in every file-operation and when it got removed
1049 everywhere, it accidentally stayed here. Since then, enough people
1050 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1051 that it seemed risky to remove. */
1052 if (! NILP (noerror
))
1054 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1055 Qt
, load_error_handler
);
1060 file
= Fsubstitute_in_file_name (file
);
1062 /* Avoid weird lossage with null string as arg,
1063 since it would try to load a directory as a Lisp file. */
1064 if (SCHARS (file
) == 0)
1071 Lisp_Object suffixes
;
1074 if (! NILP (must_suffix
))
1076 /* Don't insist on adding a suffix if FILE already ends with one. */
1077 ptrdiff_t size
= SBYTES (file
);
1079 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1082 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1084 /* Don't insist on adding a suffix
1085 if the argument includes a directory name. */
1086 else if (! NILP (Ffile_name_directory (file
)))
1090 if (!NILP (nosuffix
))
1094 suffixes
= Fget_load_suffixes ();
1095 if (NILP (must_suffix
))
1096 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1099 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1105 report_file_error ("Cannot open load file", file
);
1109 /* Tell startup.el whether or not we found the user's init file. */
1110 if (EQ (Qt
, Vuser_init_file
))
1111 Vuser_init_file
= found
;
1113 /* If FD is -2, that means openp found a magic file. */
1116 if (NILP (Fequal (found
, file
)))
1117 /* If FOUND is a different file name from FILE,
1118 find its handler even if we have already inhibited
1119 the `load' operation on FILE. */
1120 handler
= Ffind_file_name_handler (found
, Qt
);
1122 handler
= Ffind_file_name_handler (found
, Qload
);
1123 if (! NILP (handler
))
1124 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1126 /* Tramp has to deal with semi-broken packages that prepend
1127 drive letters to remote files. For that reason, Tramp
1128 catches file operations that test for file existence, which
1129 makes openp think X:/foo.elc files are remote. However,
1130 Tramp does not catch `load' operations for such files, so we
1131 end up with a nil as the `load' handler above. If we would
1132 continue with fd = -2, we will behave wrongly, and in
1133 particular try reading a .elc file in the "rt" mode instead
1134 of "rb". See bug #9311 for the results. To work around
1135 this, we try to open the file locally, and go with that if it
1137 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1145 /* Pacify older GCC with --enable-gcc-warnings. */
1146 IF_LINT (fd_index
= 0);
1150 fd_index
= SPECPDL_INDEX ();
1151 record_unwind_protect_int (close_file_unwind
, fd
);
1154 /* Check if we're stuck in a recursive load cycle.
1156 2000-09-21: It's not possible to just check for the file loaded
1157 being a member of Vloads_in_progress. This fails because of the
1158 way the byte compiler currently works; `provide's are not
1159 evaluated, see font-lock.el/jit-lock.el as an example. This
1160 leads to a certain amount of ``normal'' recursion.
1162 Also, just loading a file recursively is not always an error in
1163 the general case; the second load may do something different. */
1167 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1168 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1169 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1170 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1171 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1174 /* All loads are by default dynamic, unless the file itself specifies
1175 otherwise using a file-variable in the first line. This is bound here
1176 so that it takes effect whether or not we use
1177 Vload_source_file_function. */
1178 specbind (Qlexical_binding
, Qnil
);
1180 /* Get the name for load-history. */
1181 hist_file_name
= (! NILP (Vpurify_flag
)
1182 ? concat2 (Ffile_name_directory (file
),
1183 Ffile_name_nondirectory (found
))
1188 /* Check for the presence of old-style quotes and warn about them. */
1189 specbind (Qold_style_backquotes
, Qnil
);
1190 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1192 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1193 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1194 /* Load .elc files directly, but not when they are
1195 remote and have no handler! */
1203 && ! (version
= safe_to_load_version (fd
)))
1206 if (!load_dangerous_libraries
)
1207 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1208 else if (!NILP (nomessage
) && !force_load_messages
)
1209 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1214 efound
= ENCODE_FILE (found
);
1215 fmode
= "r" FOPEN_BINARY
;
1217 /* openp already checked for newness, no point doing it again.
1218 FIXME would be nice to get a message when openp
1219 ignores suffix order due to load_prefer_newer. */
1220 if (!load_prefer_newer
)
1222 result
= stat (SSDATA (efound
), &s1
);
1225 SSET (efound
, SBYTES (efound
) - 1, 0);
1226 result
= stat (SSDATA (efound
), &s2
);
1227 SSET (efound
, SBYTES (efound
) - 1, 'c');
1231 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1233 /* Make the progress messages mention that source is newer. */
1236 /* If we won't print another message, mention this anyway. */
1237 if (!NILP (nomessage
) && !force_load_messages
)
1239 Lisp_Object msg_file
;
1240 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1241 message_with_string ("Source file `%s' newer than byte-compiled file",
1245 } /* !load_prefer_newer */
1250 /* We are loading a source file (*.el). */
1251 if (!NILP (Vload_source_file_function
))
1258 clear_unwind_protect (fd_index
);
1260 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1261 NILP (noerror
) ? Qnil
: Qt
,
1262 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1263 return unbind_to (count
, val
);
1269 /* We somehow got here with fd == -2, meaning the file is deemed
1270 to be remote. Don't even try to reopen the file locally;
1271 just force a failure. */
1279 clear_unwind_protect (fd_index
);
1280 efound
= ENCODE_FILE (found
);
1281 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1283 stream
= fdopen (fd
, fmode
);
1287 report_file_error ("Opening stdio stream", file
);
1288 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1290 if (! NILP (Vpurify_flag
))
1291 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1293 if (NILP (nomessage
) || force_load_messages
)
1296 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1299 message_with_string ("Loading %s (source)...", file
, 1);
1301 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1303 else /* The typical case; compiled file newer than source file. */
1304 message_with_string ("Loading %s...", file
, 1);
1307 specbind (Qload_file_name
, found
);
1308 specbind (Qinhibit_file_name_operation
, Qnil
);
1309 specbind (Qload_in_progress
, Qt
);
1312 if (lisp_file_lexically_bound_p (Qget_file_char
))
1313 Fset (Qlexical_binding
, Qt
);
1315 if (! version
|| version
>= 22)
1316 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1317 0, Qnil
, Qnil
, Qnil
, Qnil
);
1320 /* We can't handle a file which was compiled with
1321 byte-compile-dynamic by older version of Emacs. */
1322 specbind (Qload_force_doc_strings
, Qt
);
1323 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1324 0, Qnil
, Qnil
, Qnil
, Qnil
);
1326 unbind_to (count
, Qnil
);
1328 /* Run any eval-after-load forms for this file. */
1329 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1330 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1332 xfree (saved_doc_string
);
1333 saved_doc_string
= 0;
1334 saved_doc_string_size
= 0;
1336 xfree (prev_saved_doc_string
);
1337 prev_saved_doc_string
= 0;
1338 prev_saved_doc_string_size
= 0;
1340 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1343 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1346 message_with_string ("Loading %s (source)...done", file
, 1);
1348 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1350 else /* The typical case; compiled file newer than source file. */
1351 message_with_string ("Loading %s...done", file
, 1);
1358 complete_filename_p (Lisp_Object pathname
)
1360 const unsigned char *s
= SDATA (pathname
);
1361 return (IS_DIRECTORY_SEP (s
[0])
1362 || (SCHARS (pathname
) > 2
1363 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1366 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1367 doc
: /* Search for FILENAME through PATH.
1368 Returns the file's name in absolute form, or nil if not found.
1369 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1370 file name when searching.
1371 If non-nil, PREDICATE is used instead of `file-readable-p'.
1372 PREDICATE can also be an integer to pass to the faccessat(2) function,
1373 in which case file-name-handlers are ignored.
1374 This function will normally skip directories, so if you want it to find
1375 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1376 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1379 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1380 if (NILP (predicate
) && fd
>= 0)
1385 /* Search for a file whose name is STR, looking in directories
1386 in the Lisp list PATH, and trying suffixes from SUFFIX.
1387 On success, return a file descriptor (or 1 or -2 as described below).
1388 On failure, return -1 and set errno.
1390 SUFFIXES is a list of strings containing possible suffixes.
1391 The empty suffix is automatically added if the list is empty.
1393 PREDICATE t means the files are binary.
1394 PREDICATE non-nil and non-t means don't open the files,
1395 just look for one that satisfies the predicate. In this case,
1396 return 1 on success. The predicate can be a lisp function or
1397 an integer to pass to `access' (in which case file-name-handlers
1400 If STOREPTR is nonzero, it points to a slot where the name of
1401 the file actually found should be stored as a Lisp string.
1402 nil is stored there on failure.
1404 If the file we find is remote, return -2
1405 but store the found remote file name in *STOREPTR.
1407 If NEWER is true, try all SUFFIXes and return the result for the
1408 newest file that exists. Does not apply to remote files,
1409 or if a non-nil and non-t PREDICATE is specified. */
1412 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1413 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1415 ptrdiff_t fn_size
= 100;
1419 ptrdiff_t want_length
;
1420 Lisp_Object filename
;
1421 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1422 ptrdiff_t max_suffix_len
= 0;
1423 int last_errno
= ENOENT
;
1427 /* The last-modified time of the newest matching file found.
1428 Initialize it to something less than all valid timestamps. */
1429 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1433 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1435 CHECK_STRING_CAR (tail
);
1436 max_suffix_len
= max (max_suffix_len
,
1437 SBYTES (XCAR (tail
)));
1440 string
= filename
= encoded_fn
= save_string
= Qnil
;
1445 absolute
= complete_filename_p (str
);
1447 for (; CONSP (path
); path
= XCDR (path
))
1449 filename
= Fexpand_file_name (str
, XCAR (path
));
1450 if (!complete_filename_p (filename
))
1451 /* If there are non-absolute elts in PATH (eg "."). */
1452 /* Of course, this could conceivably lose if luser sets
1453 default-directory to be something non-absolute... */
1455 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1456 if (!complete_filename_p (filename
))
1457 /* Give up on this path element! */
1461 /* Calculate maximum length of any filename made from
1462 this path element/specified file name and any possible suffix. */
1463 want_length
= max_suffix_len
+ SBYTES (filename
);
1464 if (fn_size
<= want_length
)
1466 fn_size
= 100 + want_length
;
1467 fn
= SAFE_ALLOCA (fn_size
);
1470 /* Loop over suffixes. */
1471 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1472 CONSP (tail
); tail
= XCDR (tail
))
1474 Lisp_Object suffix
= XCAR (tail
);
1475 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1476 Lisp_Object handler
;
1478 /* Concatenate path element/specified name with the suffix.
1479 If the directory starts with /:, remove that. */
1480 int prefixlen
= ((SCHARS (filename
) > 2
1481 && SREF (filename
, 0) == '/'
1482 && SREF (filename
, 1) == ':')
1484 fnlen
= SBYTES (filename
) - prefixlen
;
1485 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1486 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1488 /* Check that the file exists and is not a directory. */
1489 /* We used to only check for handlers on non-absolute file names:
1493 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1494 It's not clear why that was the case and it breaks things like
1495 (load "/bar.el") where the file is actually "/bar.el.gz". */
1496 /* make_string has its own ideas on when to return a unibyte
1497 string and when a multibyte string, but we know better.
1498 We must have a unibyte string when dumping, since
1499 file-name encoding is shaky at best at that time, and in
1500 particular default-file-name-coding-system is reset
1501 several times during loadup. We therefore don't want to
1502 encode the file before passing it to file I/O library
1504 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1505 string
= make_unibyte_string (fn
, fnlen
);
1507 string
= make_string (fn
, fnlen
);
1508 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1509 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1510 && !NATNUMP (predicate
))
1513 if (NILP (predicate
) || EQ (predicate
, Qt
))
1514 exists
= !NILP (Ffile_readable_p (string
));
1517 Lisp_Object tmp
= call1 (predicate
, string
);
1520 else if (EQ (tmp
, Qdir_ok
)
1521 || NILP (Ffile_directory_p (string
)))
1526 last_errno
= EISDIR
;
1532 /* We succeeded; return this descriptor and filename. */
1545 encoded_fn
= ENCODE_FILE (string
);
1546 pfn
= SSDATA (encoded_fn
);
1548 /* Check that we can access or open it. */
1549 if (NATNUMP (predicate
))
1552 if (INT_MAX
< XFASTINT (predicate
))
1553 last_errno
= EINVAL
;
1554 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1558 if (file_directory_p (pfn
))
1559 last_errno
= EISDIR
;
1566 int oflags
= O_RDONLY
+ (NILP (predicate
) ? 0 : O_BINARY
);
1567 fd
= emacs_open (pfn
, oflags
, 0);
1570 if (errno
!= ENOENT
)
1575 int err
= (fstat (fd
, &st
) != 0 ? errno
1576 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1588 if (newer
&& !NATNUMP (predicate
))
1590 struct timespec mtime
= get_stat_mtime (&st
);
1592 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1597 emacs_close (save_fd
);
1600 save_string
= string
;
1605 /* We succeeded; return this descriptor and filename. */
1613 /* No more suffixes. Return the newest. */
1614 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1617 *storeptr
= save_string
;
1633 /* Merge the list we've accumulated of globals from the current input source
1634 into the load_history variable. The details depend on whether
1635 the source has an associated file name or not.
1637 FILENAME is the file name that we are loading from.
1639 ENTIRE is true if loading that entire file, false if evaluating
1643 build_load_history (Lisp_Object filename
, bool entire
)
1645 Lisp_Object tail
, prev
, newelt
;
1646 Lisp_Object tem
, tem2
;
1649 tail
= Vload_history
;
1652 while (CONSP (tail
))
1656 /* Find the feature's previous assoc list... */
1657 if (!NILP (Fequal (filename
, Fcar (tem
))))
1661 /* If we're loading the entire file, remove old data. */
1665 Vload_history
= XCDR (tail
);
1667 Fsetcdr (prev
, XCDR (tail
));
1670 /* Otherwise, cons on new symbols that are not already members. */
1673 tem2
= Vcurrent_load_list
;
1675 while (CONSP (tem2
))
1677 newelt
= XCAR (tem2
);
1679 if (NILP (Fmember (newelt
, tem
)))
1680 Fsetcar (tail
, Fcons (XCAR (tem
),
1681 Fcons (newelt
, XCDR (tem
))));
1694 /* If we're loading an entire file, cons the new assoc onto the
1695 front of load-history, the most-recently-loaded position. Also
1696 do this if we didn't find an existing member for the file. */
1697 if (entire
|| !foundit
)
1698 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1703 readevalloop_1 (int old
)
1705 load_convert_to_unibyte
= old
;
1708 /* Signal an `end-of-file' error, if possible with file name
1711 static _Noreturn
void
1712 end_of_file_error (void)
1714 if (STRINGP (Vload_file_name
))
1715 xsignal1 (Qend_of_file
, Vload_file_name
);
1717 xsignal0 (Qend_of_file
);
1721 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1723 /* If we macroexpand the toplevel form non-recursively and it ends
1724 up being a `progn' (or if it was a progn to start), treat each
1725 form in the progn as a top-level form. This way, if one form in
1726 the progn defines a macro, that macro is in effect when we expand
1727 the remaining forms. See similar code in bytecomp.el. */
1728 val
= call2 (macroexpand
, val
, Qnil
);
1729 if (EQ (CAR_SAFE (val
), Qprogn
))
1731 Lisp_Object subforms
= XCDR (val
);
1733 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1734 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1738 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1742 /* UNIBYTE specifies how to set load_convert_to_unibyte
1743 for this invocation.
1744 READFUN, if non-nil, is used instead of `read'.
1746 START, END specify region to read in current buffer (from eval-region).
1747 If the input is not from a buffer, they must be nil. */
1750 readevalloop (Lisp_Object readcharfun
,
1752 Lisp_Object sourcename
,
1754 Lisp_Object unibyte
, Lisp_Object readfun
,
1755 Lisp_Object start
, Lisp_Object end
)
1759 ptrdiff_t count
= SPECPDL_INDEX ();
1760 struct buffer
*b
= 0;
1761 bool continue_reading_p
;
1762 Lisp_Object lex_bound
;
1763 /* True if reading an entire buffer. */
1764 bool whole_buffer
= 0;
1765 /* True on the first time around. */
1766 bool first_sexp
= 1;
1767 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1769 if (NILP (Ffboundp (macroexpand
))
1770 /* Don't macroexpand in .elc files, since it should have been done
1771 already. We actually don't know whether we're in a .elc file or not,
1772 so we use circumstantial evidence: .el files normally go through
1773 Vload_source_file_function -> load-with-code-conversion
1775 || EQ (readcharfun
, Qget_file_char
)
1776 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1779 if (MARKERP (readcharfun
))
1782 start
= readcharfun
;
1785 if (BUFFERP (readcharfun
))
1786 b
= XBUFFER (readcharfun
);
1787 else if (MARKERP (readcharfun
))
1788 b
= XMARKER (readcharfun
)->buffer
;
1790 /* We assume START is nil when input is not from a buffer. */
1791 if (! NILP (start
) && !b
)
1794 specbind (Qstandard_input
, readcharfun
);
1795 specbind (Qcurrent_load_list
, Qnil
);
1796 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1797 load_convert_to_unibyte
= !NILP (unibyte
);
1799 /* If lexical binding is active (either because it was specified in
1800 the file's header, or via a buffer-local variable), create an empty
1801 lexical environment, otherwise, turn off lexical binding. */
1802 lex_bound
= find_symbol_value (Qlexical_binding
);
1803 specbind (Qinternal_interpreter_environment
,
1804 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1805 ? Qnil
: list1 (Qt
)));
1807 /* Try to ensure sourcename is a truename, except whilst preloading. */
1808 if (NILP (Vpurify_flag
)
1809 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1810 && !NILP (Ffboundp (Qfile_truename
)))
1811 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1813 LOADHIST_ATTACH (sourcename
);
1815 continue_reading_p
= 1;
1816 while (continue_reading_p
)
1818 ptrdiff_t count1
= SPECPDL_INDEX ();
1820 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1821 error ("Reading from killed buffer");
1825 /* Switch to the buffer we are reading from. */
1826 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1827 set_buffer_internal (b
);
1829 /* Save point in it. */
1830 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1831 /* Save ZV in it. */
1832 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1833 /* Those get unbound after we read one expression. */
1835 /* Set point and ZV around stuff to be read. */
1838 Fnarrow_to_region (make_number (BEGV
), end
);
1840 /* Just for cleanliness, convert END to a marker
1841 if it is an integer. */
1843 end
= Fpoint_max_marker ();
1846 /* On the first cycle, we can easily test here
1847 whether we are reading the whole buffer. */
1848 if (b
&& first_sexp
)
1849 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1856 while ((c
= READCHAR
) != '\n' && c
!= -1);
1861 unbind_to (count1
, Qnil
);
1865 /* Ignore whitespace here, so we can detect eof. */
1866 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1867 || c
== NO_BREAK_SPACE
)
1870 if (!NILP (Vpurify_flag
) && c
== '(')
1872 val
= read_list (0, readcharfun
);
1877 read_objects
= Qnil
;
1878 if (!NILP (readfun
))
1880 val
= call1 (readfun
, readcharfun
);
1882 /* If READCHARFUN has set point to ZV, we should
1883 stop reading, even if the form read sets point
1884 to a different value when evaluated. */
1885 if (BUFFERP (readcharfun
))
1887 struct buffer
*buf
= XBUFFER (readcharfun
);
1888 if (BUF_PT (buf
) == BUF_ZV (buf
))
1889 continue_reading_p
= 0;
1892 else if (! NILP (Vload_read_function
))
1893 val
= call1 (Vload_read_function
, readcharfun
);
1895 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1898 if (!NILP (start
) && continue_reading_p
)
1899 start
= Fpoint_marker ();
1901 /* Restore saved point and BEGV. */
1902 unbind_to (count1
, Qnil
);
1904 /* Now eval what we just read. */
1905 if (!NILP (macroexpand
))
1906 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1908 val
= eval_sub (val
);
1912 Vvalues
= Fcons (val
, Vvalues
);
1913 if (EQ (Vstandard_output
, Qt
))
1922 build_load_history (sourcename
,
1923 stream
|| whole_buffer
);
1925 unbind_to (count
, Qnil
);
1928 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1929 doc
: /* Execute the current buffer as Lisp code.
1930 When called from a Lisp program (i.e., not interactively), this
1931 function accepts up to five optional arguments:
1932 BUFFER is the buffer to evaluate (nil means use current buffer).
1933 PRINTFLAG controls printing of output:
1934 A value of nil means discard it; anything else is stream for print.
1935 FILENAME specifies the file name to use for `load-history'.
1936 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1938 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1939 functions should work normally even if PRINTFLAG is nil.
1941 This function preserves the position of point. */)
1942 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1944 ptrdiff_t count
= SPECPDL_INDEX ();
1945 Lisp_Object tem
, buf
;
1948 buf
= Fcurrent_buffer ();
1950 buf
= Fget_buffer (buffer
);
1952 error ("No such buffer");
1954 if (NILP (printflag
) && NILP (do_allow_print
))
1959 if (NILP (filename
))
1960 filename
= BVAR (XBUFFER (buf
), filename
);
1962 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1963 specbind (Qstandard_output
, tem
);
1964 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1965 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1966 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1967 readevalloop (buf
, 0, filename
,
1968 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1969 unbind_to (count
, Qnil
);
1974 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1975 doc
: /* Execute the region as Lisp code.
1976 When called from programs, expects two arguments,
1977 giving starting and ending indices in the current buffer
1978 of the text to be executed.
1979 Programs can pass third argument PRINTFLAG which controls output:
1980 A value of nil means discard it; anything else is stream for printing it.
1981 Also the fourth argument READ-FUNCTION, if non-nil, is used
1982 instead of `read' to read each expression. It gets one argument
1983 which is the input stream for reading characters.
1985 This function does not move point. */)
1986 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1988 /* FIXME: Do the eval-sexp-add-defvars dance! */
1989 ptrdiff_t count
= SPECPDL_INDEX ();
1990 Lisp_Object tem
, cbuf
;
1992 cbuf
= Fcurrent_buffer ();
1994 if (NILP (printflag
))
1998 specbind (Qstandard_output
, tem
);
1999 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2001 /* `readevalloop' calls functions which check the type of start and end. */
2002 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2003 !NILP (printflag
), Qnil
, read_function
,
2006 return unbind_to (count
, Qnil
);
2010 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2011 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2012 If STREAM is nil, use the value of `standard-input' (which see).
2013 STREAM or the value of `standard-input' may be:
2014 a buffer (read from point and advance it)
2015 a marker (read from where it points and advance it)
2016 a function (call it with no arguments for each character,
2017 call it with a char as argument to push a char back)
2018 a string (takes text from string, starting at the beginning)
2019 t (read text line using minibuffer and use it, or read from
2020 standard input in batch mode). */)
2021 (Lisp_Object stream
)
2024 stream
= Vstandard_input
;
2025 if (EQ (stream
, Qt
))
2026 stream
= Qread_char
;
2027 if (EQ (stream
, Qread_char
))
2028 /* FIXME: ?! When is this used !? */
2029 return call1 (intern ("read-minibuffer"),
2030 build_string ("Lisp expression: "));
2032 return read_internal_start (stream
, Qnil
, Qnil
);
2035 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2036 doc
: /* Read one Lisp expression which is represented as text by STRING.
2037 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2038 FINAL-STRING-INDEX is an integer giving the position of the next
2039 remaining character in STRING. START and END optionally delimit
2040 a substring of STRING from which to read; they default to 0 and
2041 (length STRING) respectively. Negative values are counted from
2042 the end of STRING. */)
2043 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2046 CHECK_STRING (string
);
2047 /* `read_internal_start' sets `read_from_string_index'. */
2048 ret
= read_internal_start (string
, start
, end
);
2049 return Fcons (ret
, make_number (read_from_string_index
));
2052 /* Function to set up the global context we need in toplevel read
2053 calls. START and END only used when STREAM is a string. */
2055 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2060 new_backquote_flag
= 0;
2061 read_objects
= Qnil
;
2062 if (EQ (Vread_with_symbol_positions
, Qt
)
2063 || EQ (Vread_with_symbol_positions
, stream
))
2064 Vread_symbol_positions_list
= Qnil
;
2066 if (STRINGP (stream
)
2067 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2069 ptrdiff_t startval
, endval
;
2072 if (STRINGP (stream
))
2075 string
= XCAR (stream
);
2077 validate_subarray (string
, start
, end
, SCHARS (string
),
2078 &startval
, &endval
);
2080 read_from_string_index
= startval
;
2081 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2082 read_from_string_limit
= endval
;
2085 retval
= read0 (stream
);
2086 if (EQ (Vread_with_symbol_positions
, Qt
)
2087 || EQ (Vread_with_symbol_positions
, stream
))
2088 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2093 /* Signal Qinvalid_read_syntax error.
2094 S is error string of length N (if > 0) */
2096 static _Noreturn
void
2097 invalid_syntax (const char *s
)
2099 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2103 /* Use this for recursive reads, in contexts where internal tokens
2107 read0 (Lisp_Object readcharfun
)
2109 register Lisp_Object val
;
2112 val
= read1 (readcharfun
, &c
, 0);
2116 xsignal1 (Qinvalid_read_syntax
,
2117 Fmake_string (make_number (1), make_number (c
)));
2120 static ptrdiff_t read_buffer_size
;
2121 static char *read_buffer
;
2123 /* Read a \-escape sequence, assuming we already read the `\'.
2124 If the escape sequence forces unibyte, return eight-bit char. */
2127 read_escape (Lisp_Object readcharfun
, bool stringp
)
2130 /* \u allows up to four hex digits, \U up to eight. Default to the
2131 behavior for \u, and change this value in the case that \U is seen. */
2132 int unicode_hex_count
= 4;
2137 end_of_file_error ();
2167 error ("Invalid escape character syntax");
2170 c
= read_escape (readcharfun
, 0);
2171 return c
| meta_modifier
;
2176 error ("Invalid escape character syntax");
2179 c
= read_escape (readcharfun
, 0);
2180 return c
| shift_modifier
;
2185 error ("Invalid escape character syntax");
2188 c
= read_escape (readcharfun
, 0);
2189 return c
| hyper_modifier
;
2194 error ("Invalid escape character syntax");
2197 c
= read_escape (readcharfun
, 0);
2198 return c
| alt_modifier
;
2202 if (stringp
|| c
!= '-')
2209 c
= read_escape (readcharfun
, 0);
2210 return c
| super_modifier
;
2215 error ("Invalid escape character syntax");
2219 c
= read_escape (readcharfun
, 0);
2220 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2221 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2222 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2223 return c
| ctrl_modifier
;
2224 /* ASCII control chars are made from letters (both cases),
2225 as well as the non-letters within 0100...0137. */
2226 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2227 return (c
& (037 | ~0177));
2228 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2229 return (c
& (037 | ~0177));
2231 return c
| ctrl_modifier
;
2241 /* An octal escape, as in ANSI C. */
2243 register int i
= c
- '0';
2244 register int count
= 0;
2247 if ((c
= READCHAR
) >= '0' && c
<= '7')
2259 if (i
>= 0x80 && i
< 0x100)
2260 i
= BYTE8_TO_CHAR (i
);
2265 /* A hex escape, as in ANSI C. */
2272 if (c
>= '0' && c
<= '9')
2277 else if ((c
>= 'a' && c
<= 'f')
2278 || (c
>= 'A' && c
<= 'F'))
2281 if (c
>= 'a' && c
<= 'f')
2291 /* Allow hex escapes as large as ?\xfffffff, because some
2292 packages use them to denote characters with modifiers. */
2293 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2294 error ("Hex character out of range: \\x%x...", i
);
2298 if (count
< 3 && i
>= 0x80)
2299 return BYTE8_TO_CHAR (i
);
2304 /* Post-Unicode-2.0: Up to eight hex chars. */
2305 unicode_hex_count
= 8;
2308 /* A Unicode escape. We only permit them in strings and characters,
2309 not arbitrarily in the source code, as in some other languages. */
2314 while (++count
<= unicode_hex_count
)
2317 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2319 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2320 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2321 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2323 error ("Non-hex digit used for Unicode escape");
2326 error ("Non-Unicode character: 0x%x", i
);
2335 /* Return the digit that CHARACTER stands for in the given BASE.
2336 Return -1 if CHARACTER is out of range for BASE,
2337 and -2 if CHARACTER is not valid for any supported BASE. */
2339 digit_to_number (int character
, int base
)
2343 if ('0' <= character
&& character
<= '9')
2344 digit
= character
- '0';
2345 else if ('a' <= character
&& character
<= 'z')
2346 digit
= character
- 'a' + 10;
2347 else if ('A' <= character
&& character
<= 'Z')
2348 digit
= character
- 'A' + 10;
2352 return digit
< base
? digit
: -1;
2355 /* Read an integer in radix RADIX using READCHARFUN to read
2356 characters. RADIX must be in the interval [2..36]; if it isn't, a
2357 read error is signaled . Value is the integer read. Signals an
2358 error if encountering invalid read syntax or if RADIX is out of
2362 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2364 /* Room for sign, leading 0, other digits, trailing null byte.
2365 Also, room for invalid syntax diagnostic. */
2366 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2367 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2369 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2371 if (radix
< 2 || radix
> 36)
2379 if (c
== '-' || c
== '+')
2390 /* Ignore redundant leading zeros, so the buffer doesn't
2391 fill up with them. */
2397 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2404 if (p
< buf
+ sizeof buf
- 1)
2418 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2419 invalid_syntax (buf
);
2422 return string_to_number (buf
, radix
, 0);
2426 /* If the next token is ')' or ']' or '.', we store that character
2427 in *PCH and the return value is not interesting. Else, we store
2428 zero in *PCH and we read and return one lisp object.
2430 FIRST_IN_LIST is true if this is the first element of a list. */
2433 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2436 bool uninterned_symbol
= 0;
2443 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2445 end_of_file_error ();
2450 return read_list (0, readcharfun
);
2453 return read_vector (readcharfun
, 0);
2469 /* Accept extended format for hashtables (extensible to
2471 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2472 Lisp_Object tmp
= read_list (0, readcharfun
);
2473 Lisp_Object head
= CAR_SAFE (tmp
);
2474 Lisp_Object data
= Qnil
;
2475 Lisp_Object val
= Qnil
;
2476 /* The size is 2 * number of allowed keywords to
2478 Lisp_Object params
[10];
2480 Lisp_Object key
= Qnil
;
2481 int param_count
= 0;
2483 if (!EQ (head
, Qhash_table
))
2484 error ("Invalid extended read marker at head of #s list "
2485 "(only hash-table allowed)");
2487 tmp
= CDR_SAFE (tmp
);
2489 /* This is repetitive but fast and simple. */
2490 params
[param_count
] = QCsize
;
2491 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2492 if (!NILP (params
[param_count
+ 1]))
2495 params
[param_count
] = QCtest
;
2496 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2497 if (!NILP (params
[param_count
+ 1]))
2500 params
[param_count
] = QCweakness
;
2501 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2502 if (!NILP (params
[param_count
+ 1]))
2505 params
[param_count
] = QCrehash_size
;
2506 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2507 if (!NILP (params
[param_count
+ 1]))
2510 params
[param_count
] = QCrehash_threshold
;
2511 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2512 if (!NILP (params
[param_count
+ 1]))
2515 /* This is the hashtable data. */
2516 data
= Fplist_get (tmp
, Qdata
);
2518 /* Now use params to make a new hashtable and fill it. */
2519 ht
= Fmake_hash_table (param_count
, params
);
2521 while (CONSP (data
))
2526 error ("Odd number of elements in hashtable data");
2529 Fputhash (key
, val
, ht
);
2535 invalid_syntax ("#");
2543 tmp
= read_vector (readcharfun
, 0);
2544 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2545 error ("Invalid size char-table");
2546 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2554 /* Sub char-table can't be read as a regular
2555 vector because of a two C integer fields. */
2556 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2557 ptrdiff_t size
= XINT (Flength (tmp
));
2558 int i
, depth
, min_char
;
2559 struct Lisp_Cons
*cell
;
2562 error ("Zero-sized sub char-table");
2564 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2565 error ("Invalid depth in sub char-table");
2566 depth
= XINT (XCAR (tmp
));
2567 if (chartab_size
[depth
] != size
- 2)
2568 error ("Invalid size in sub char-table");
2569 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2572 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2573 error ("Invalid minimum character in sub-char-table");
2574 min_char
= XINT (XCAR (tmp
));
2575 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2578 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2579 for (i
= 0; i
< size
; i
++)
2581 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2582 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2587 invalid_syntax ("#^^");
2589 invalid_syntax ("#^");
2594 length
= read1 (readcharfun
, pch
, first_in_list
);
2598 Lisp_Object tmp
, val
;
2599 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2600 unsigned char *data
;
2603 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2604 if (STRING_MULTIBYTE (tmp
)
2605 || (size_in_chars
!= SCHARS (tmp
)
2606 /* We used to print 1 char too many
2607 when the number of bits was a multiple of 8.
2608 Accept such input in case it came from an old
2610 && ! (XFASTINT (length
)
2611 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2612 invalid_syntax ("#&...");
2614 val
= make_uninit_bool_vector (XFASTINT (length
));
2615 data
= bool_vector_uchar_data (val
);
2616 memcpy (data
, SDATA (tmp
), size_in_chars
);
2617 /* Clear the extraneous bits in the last byte. */
2618 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2619 data
[size_in_chars
- 1]
2620 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2623 invalid_syntax ("#&...");
2627 /* Accept compiled functions at read-time so that we don't have to
2628 build them using function calls. */
2630 struct Lisp_Vector
*vec
;
2631 tmp
= read_vector (readcharfun
, 1);
2632 vec
= XVECTOR (tmp
);
2633 if (vec
->header
.size
== 0)
2634 invalid_syntax ("Empty byte-code object");
2635 make_byte_code (vec
);
2643 /* Read the string itself. */
2644 tmp
= read1 (readcharfun
, &ch
, 0);
2645 if (ch
!= 0 || !STRINGP (tmp
))
2646 invalid_syntax ("#");
2647 /* Read the intervals and their properties. */
2650 Lisp_Object beg
, end
, plist
;
2652 beg
= read1 (readcharfun
, &ch
, 0);
2657 end
= read1 (readcharfun
, &ch
, 0);
2659 plist
= read1 (readcharfun
, &ch
, 0);
2661 invalid_syntax ("Invalid string property list");
2662 Fset_text_properties (beg
, end
, plist
, tmp
);
2668 /* #@NUMBER is used to skip NUMBER following bytes.
2669 That's used in .elc files to skip over doc strings
2670 and function definitions. */
2673 enum { extra
= 100 };
2674 ptrdiff_t i
, nskip
= 0, digits
= 0;
2676 /* Read a decimal integer. */
2677 while ((c
= READCHAR
) >= 0
2678 && c
>= '0' && c
<= '9')
2680 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2685 if (digits
== 2 && nskip
== 0)
2686 { /* We've just seen #@00, which means "skip to end". */
2687 skip_dyn_eof (readcharfun
);
2692 /* We can't use UNREAD here, because in the code below we side-step
2693 READCHAR. Instead, assume the first char after #@NNN occupies
2694 a single byte, which is the case normally since it's just
2700 if (load_force_doc_strings
2701 && (FROM_FILE_P (readcharfun
)))
2703 /* If we are supposed to force doc strings into core right now,
2704 record the last string that we skipped,
2705 and record where in the file it comes from. */
2707 /* But first exchange saved_doc_string
2708 with prev_saved_doc_string, so we save two strings. */
2710 char *temp
= saved_doc_string
;
2711 ptrdiff_t temp_size
= saved_doc_string_size
;
2712 file_offset temp_pos
= saved_doc_string_position
;
2713 ptrdiff_t temp_len
= saved_doc_string_length
;
2715 saved_doc_string
= prev_saved_doc_string
;
2716 saved_doc_string_size
= prev_saved_doc_string_size
;
2717 saved_doc_string_position
= prev_saved_doc_string_position
;
2718 saved_doc_string_length
= prev_saved_doc_string_length
;
2720 prev_saved_doc_string
= temp
;
2721 prev_saved_doc_string_size
= temp_size
;
2722 prev_saved_doc_string_position
= temp_pos
;
2723 prev_saved_doc_string_length
= temp_len
;
2726 if (saved_doc_string_size
== 0)
2728 saved_doc_string
= xmalloc (nskip
+ extra
);
2729 saved_doc_string_size
= nskip
+ extra
;
2731 if (nskip
> saved_doc_string_size
)
2733 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2734 saved_doc_string_size
= nskip
+ extra
;
2737 saved_doc_string_position
= file_tell (instream
);
2739 /* Copy that many characters into saved_doc_string. */
2741 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2742 saved_doc_string
[i
] = c
= getc (instream
);
2745 saved_doc_string_length
= i
;
2748 /* Skip that many bytes. */
2749 skip_dyn_bytes (readcharfun
, nskip
);
2755 /* #! appears at the beginning of an executable file.
2756 Skip the first line. */
2757 while (c
!= '\n' && c
>= 0)
2762 return Vload_file_name
;
2764 return list2 (Qfunction
, read0 (readcharfun
));
2765 /* #:foo is the uninterned symbol named foo. */
2768 uninterned_symbol
= 1;
2771 && c
!= NO_BREAK_SPACE
2773 || strchr ("\"';()[]#`,", c
) == NULL
)))
2775 /* No symbol character follows, this is the empty
2778 return Fmake_symbol (empty_unibyte_string
);
2782 /* ## is the empty symbol. */
2784 return Fintern (empty_unibyte_string
, Qnil
);
2785 /* Reader forms that can reuse previously read objects. */
2786 if (c
>= '0' && c
<= '9')
2791 /* Read a non-negative integer. */
2792 while (c
>= '0' && c
<= '9')
2794 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2795 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2796 n
= MOST_POSITIVE_FIXNUM
+ 1;
2798 n
= n
* 10 + c
- '0';
2802 if (n
<= MOST_POSITIVE_FIXNUM
)
2804 if (c
== 'r' || c
== 'R')
2805 return read_integer (readcharfun
, n
);
2807 if (! NILP (Vread_circle
))
2809 /* #n=object returns object, but associates it with
2813 /* Make a placeholder for #n# to use temporarily. */
2814 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2815 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2816 read_objects
= Fcons (cell
, read_objects
);
2818 /* Read the object itself. */
2819 tem
= read0 (readcharfun
);
2821 /* Now put it everywhere the placeholder was... */
2822 substitute_object_in_subtree (tem
, placeholder
);
2824 /* ...and #n# will use the real value from now on. */
2825 Fsetcdr (cell
, tem
);
2830 /* #n# returns a previously read object. */
2833 tem
= Fassq (make_number (n
), read_objects
);
2839 /* Fall through to error message. */
2841 else if (c
== 'x' || c
== 'X')
2842 return read_integer (readcharfun
, 16);
2843 else if (c
== 'o' || c
== 'O')
2844 return read_integer (readcharfun
, 8);
2845 else if (c
== 'b' || c
== 'B')
2846 return read_integer (readcharfun
, 2);
2849 invalid_syntax ("#");
2852 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2856 return list2 (Qquote
, read0 (readcharfun
));
2860 int next_char
= READCHAR
;
2862 /* Transition from old-style to new-style:
2863 If we see "(`" it used to mean old-style, which usually works
2864 fine because ` should almost never appear in such a position
2865 for new-style. But occasionally we need "(`" to mean new
2866 style, so we try to distinguish the two by the fact that we
2867 can either write "( `foo" or "(` foo", where the first
2868 intends to use new-style whereas the second intends to use
2869 old-style. For Emacs-25, we should completely remove this
2870 first_in_list exception (old-style can still be obtained via
2872 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2874 Vold_style_backquotes
= Qt
;
2880 bool saved_new_backquote_flag
= new_backquote_flag
;
2882 new_backquote_flag
= 1;
2883 value
= read0 (readcharfun
);
2884 new_backquote_flag
= saved_new_backquote_flag
;
2886 return list2 (Qbackquote
, value
);
2891 int next_char
= READCHAR
;
2893 /* Transition from old-style to new-style:
2894 It used to be impossible to have a new-style , other than within
2895 a new-style `. This is sufficient when ` and , are used in the
2896 normal way, but ` and , can also appear in args to macros that
2897 will not interpret them in the usual way, in which case , may be
2898 used without any ` anywhere near.
2899 So we now use the same heuristic as for backquote: old-style
2900 unquotes are only recognized when first on a list, and when
2901 followed by a space.
2902 Because it's more difficult to peek 2 chars ahead, a new-style
2903 ,@ can still not be used outside of a `, unless it's in the middle
2905 if (new_backquote_flag
2907 || (next_char
!= ' ' && next_char
!= '@'))
2909 Lisp_Object comma_type
= Qnil
;
2914 comma_type
= Qcomma_at
;
2916 comma_type
= Qcomma_dot
;
2919 if (ch
>= 0) UNREAD (ch
);
2920 comma_type
= Qcomma
;
2923 value
= read0 (readcharfun
);
2924 return list2 (comma_type
, value
);
2928 Vold_style_backquotes
= Qt
;
2940 end_of_file_error ();
2942 /* Accept `single space' syntax like (list ? x) where the
2943 whitespace character is SPC or TAB.
2944 Other literal whitespace like NL, CR, and FF are not accepted,
2945 as there are well-established escape sequences for these. */
2946 if (c
== ' ' || c
== '\t')
2947 return make_number (c
);
2950 c
= read_escape (readcharfun
, 0);
2951 modifiers
= c
& CHAR_MODIFIER_MASK
;
2952 c
&= ~CHAR_MODIFIER_MASK
;
2953 if (CHAR_BYTE8_P (c
))
2954 c
= CHAR_TO_BYTE8 (c
);
2957 next_char
= READCHAR
;
2958 ok
= (next_char
<= 040
2959 || (next_char
< 0200
2960 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2963 return make_number (c
);
2965 invalid_syntax ("?");
2970 char *p
= read_buffer
;
2971 char *end
= read_buffer
+ read_buffer_size
;
2973 /* True if we saw an escape sequence specifying
2974 a multibyte character. */
2975 bool force_multibyte
= 0;
2976 /* True if we saw an escape sequence specifying
2977 a single-byte character. */
2978 bool force_singlebyte
= 0;
2980 ptrdiff_t nchars
= 0;
2982 while ((ch
= READCHAR
) >= 0
2985 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2987 ptrdiff_t offset
= p
- read_buffer
;
2988 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2989 memory_full (SIZE_MAX
);
2990 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
2991 read_buffer_size
*= 2;
2992 p
= read_buffer
+ offset
;
2993 end
= read_buffer
+ read_buffer_size
;
3000 ch
= read_escape (readcharfun
, 1);
3002 /* CH is -1 if \ newline or \ space has just been seen. */
3005 if (p
== read_buffer
)
3010 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3011 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3013 if (CHAR_BYTE8_P (ch
))
3014 force_singlebyte
= 1;
3015 else if (! ASCII_CHAR_P (ch
))
3016 force_multibyte
= 1;
3017 else /* I.e. ASCII_CHAR_P (ch). */
3019 /* Allow `\C- ' and `\C-?'. */
3020 if (modifiers
== CHAR_CTL
)
3023 ch
= 0, modifiers
= 0;
3025 ch
= 127, modifiers
= 0;
3027 if (modifiers
& CHAR_SHIFT
)
3029 /* Shift modifier is valid only with [A-Za-z]. */
3030 if (ch
>= 'A' && ch
<= 'Z')
3031 modifiers
&= ~CHAR_SHIFT
;
3032 else if (ch
>= 'a' && ch
<= 'z')
3033 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3036 if (modifiers
& CHAR_META
)
3038 /* Move the meta bit to the right place for a
3040 modifiers
&= ~CHAR_META
;
3041 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3042 force_singlebyte
= 1;
3046 /* Any modifiers remaining are invalid. */
3048 error ("Invalid modifier in string");
3049 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3053 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3054 if (CHAR_BYTE8_P (ch
))
3055 force_singlebyte
= 1;
3056 else if (! ASCII_CHAR_P (ch
))
3057 force_multibyte
= 1;
3063 end_of_file_error ();
3065 /* If purifying, and string starts with \ newline,
3066 return zero instead. This is for doc strings
3067 that we are really going to find in etc/DOC.nn.nn. */
3068 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3069 return make_number (0);
3071 if (! force_multibyte
&& force_singlebyte
)
3073 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3074 forms. Convert it to unibyte. */
3075 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3077 p
= read_buffer
+ nchars
;
3080 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3082 || (p
- read_buffer
!= nchars
)));
3087 int next_char
= READCHAR
;
3090 if (next_char
<= 040
3091 || (next_char
< 0200
3092 && strchr ("\"';([#?`,", next_char
) != NULL
))
3098 /* Otherwise, we fall through! Note that the atom-reading loop
3099 below will now loop at least once, assuring that we will not
3100 try to UNREAD two characters in a row. */
3104 if (c
<= 040) goto retry
;
3105 if (c
== NO_BREAK_SPACE
)
3110 char *p
= read_buffer
;
3112 EMACS_INT start_position
= readchar_count
- 1;
3115 char *end
= read_buffer
+ read_buffer_size
;
3119 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3121 ptrdiff_t offset
= p
- read_buffer
;
3122 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3123 memory_full (SIZE_MAX
);
3124 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3125 read_buffer_size
*= 2;
3126 p
= read_buffer
+ offset
;
3127 end
= read_buffer
+ read_buffer_size
;
3134 end_of_file_error ();
3139 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3145 && c
!= NO_BREAK_SPACE
3147 || strchr ("\"';()[]#`,", c
) == NULL
));
3151 ptrdiff_t offset
= p
- read_buffer
;
3152 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3153 memory_full (SIZE_MAX
);
3154 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3155 read_buffer_size
*= 2;
3156 p
= read_buffer
+ offset
;
3157 end
= read_buffer
+ read_buffer_size
;
3163 if (!quoted
&& !uninterned_symbol
)
3165 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3166 if (! NILP (result
))
3170 Lisp_Object name
, result
;
3171 ptrdiff_t nbytes
= p
- read_buffer
;
3174 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3178 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3179 ? make_pure_string
: make_specified_string
)
3180 (read_buffer
, nchars
, nbytes
, multibyte
));
3181 result
= (uninterned_symbol
? Fmake_symbol (name
)
3182 : Fintern (name
, Qnil
));
3184 if (EQ (Vread_with_symbol_positions
, Qt
)
3185 || EQ (Vread_with_symbol_positions
, readcharfun
))
3186 Vread_symbol_positions_list
3187 = Fcons (Fcons (result
, make_number (start_position
)),
3188 Vread_symbol_positions_list
);
3196 /* List of nodes we've seen during substitute_object_in_subtree. */
3197 static Lisp_Object seen_list
;
3200 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3202 Lisp_Object check_object
;
3204 /* We haven't seen any objects when we start. */
3207 /* Make all the substitutions. */
3209 = substitute_object_recurse (object
, placeholder
, object
);
3211 /* Clear seen_list because we're done with it. */
3214 /* The returned object here is expected to always eq the
3216 if (!EQ (check_object
, object
))
3217 error ("Unexpected mutation error in reader");
3220 /* Feval doesn't get called from here, so no gc protection is needed. */
3221 #define SUBSTITUTE(get_val, set_val) \
3223 Lisp_Object old_value = get_val; \
3224 Lisp_Object true_value \
3225 = substitute_object_recurse (object, placeholder, \
3228 if (!EQ (old_value, true_value)) \
3235 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3237 /* If we find the placeholder, return the target object. */
3238 if (EQ (placeholder
, subtree
))
3241 /* If we've been to this node before, don't explore it again. */
3242 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3245 /* If this node can be the entry point to a cycle, remember that
3246 we've seen it. It can only be such an entry point if it was made
3247 by #n=, which means that we can find it as a value in
3249 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3250 seen_list
= Fcons (subtree
, seen_list
);
3252 /* Recurse according to subtree's type.
3253 Every branch must return a Lisp_Object. */
3254 switch (XTYPE (subtree
))
3256 case Lisp_Vectorlike
:
3258 ptrdiff_t i
= 0, length
= 0;
3259 if (BOOL_VECTOR_P (subtree
))
3260 return subtree
; /* No sub-objects anyway. */
3261 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3262 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3263 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3264 else if (VECTORP (subtree
))
3265 length
= ASIZE (subtree
);
3267 /* An unknown pseudovector may contain non-Lisp fields, so we
3268 can't just blindly traverse all its fields. We used to call
3269 `Flength' which signaled `sequencep', so I just preserved this
3271 wrong_type_argument (Qsequencep
, subtree
);
3273 if (SUB_CHAR_TABLE_P (subtree
))
3275 for ( ; i
< length
; i
++)
3276 SUBSTITUTE (AREF (subtree
, i
),
3277 ASET (subtree
, i
, true_value
));
3283 SUBSTITUTE (XCAR (subtree
),
3284 XSETCAR (subtree
, true_value
));
3285 SUBSTITUTE (XCDR (subtree
),
3286 XSETCDR (subtree
, true_value
));
3292 /* Check for text properties in each interval.
3293 substitute_in_interval contains part of the logic. */
3295 INTERVAL root_interval
= string_intervals (subtree
);
3296 AUTO_CONS (arg
, object
, placeholder
);
3298 traverse_intervals_noorder (root_interval
,
3299 &substitute_in_interval
, arg
);
3304 /* Other types don't recurse any further. */
3310 /* Helper function for substitute_object_recurse. */
3312 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3314 Lisp_Object object
= Fcar (arg
);
3315 Lisp_Object placeholder
= Fcdr (arg
);
3317 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3327 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3328 integer syntax and fits in a fixnum, else return the nearest float if CP has
3329 either floating point or integer syntax and BASE is 10, else return nil. If
3330 IGNORE_TRAILING, consider just the longest prefix of CP that has
3331 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3332 number has integer syntax but does not fit. */
3335 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3338 char const *cp
= string
;
3340 bool float_syntax
= 0;
3343 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3344 IEEE floating point hosts, and works around a formerly-common bug where
3345 atof ("-0.0") drops the sign. */
3346 bool negative
= *cp
== '-';
3348 bool signedp
= negative
|| *cp
== '+';
3353 leading_digit
= digit_to_number (*cp
, base
);
3354 if (leading_digit
>= 0)
3359 while (digit_to_number (*cp
, base
) >= 0);
3369 if ('0' <= *cp
&& *cp
<= '9')
3374 while ('0' <= *cp
&& *cp
<= '9');
3376 if (*cp
== 'e' || *cp
== 'E')
3378 char const *ecp
= cp
;
3380 if (*cp
== '+' || *cp
== '-')
3382 if ('0' <= *cp
&& *cp
<= '9')
3387 while ('0' <= *cp
&& *cp
<= '9');
3389 else if (cp
[-1] == '+'
3390 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3396 else if (cp
[-1] == '+'
3397 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3401 /* NAN is a "positive" NaN on all known Emacs hosts. */
3408 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3409 || state
== (LEAD_INT
|E_EXP
));
3412 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3413 any prefix that matches. Otherwise, the entire string must match. */
3414 if (! (ignore_trailing
3415 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3416 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3419 /* If the number uses integer and not float syntax, and is in C-language
3420 range, use its value, preferably as a fixnum. */
3421 if (leading_digit
>= 0 && ! float_syntax
)
3425 /* Fast special case for single-digit integers. This also avoids a
3426 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3427 case some versions of strtoumax accept numbers like "0x1" that Emacs
3429 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3430 return make_number (negative
? -leading_digit
: leading_digit
);
3433 n
= strtoumax (string
+ signedp
, NULL
, base
);
3434 if (errno
== ERANGE
)
3436 /* Unfortunately there's no simple and accurate way to convert
3437 non-base-10 numbers that are out of C-language range. */
3439 xsignal1 (Qoverflow_error
, build_string (string
));
3441 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3443 EMACS_INT signed_n
= n
;
3444 return make_number (negative
? -signed_n
: signed_n
);
3450 /* Either the number uses float syntax, or it does not fit into a fixnum.
3451 Convert it from string to floating point, unless the value is already
3452 known because it is an infinity, a NAN, or its absolute value fits in
3455 value
= atof (string
+ signedp
);
3457 return make_float (negative
? -value
: value
);
3462 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3466 Lisp_Object tem
, item
, vector
;
3467 struct Lisp_Cons
*otem
;
3470 tem
= read_list (1, readcharfun
);
3471 len
= Flength (tem
);
3472 vector
= Fmake_vector (len
, Qnil
);
3474 size
= ASIZE (vector
);
3475 ptr
= XVECTOR (vector
)->contents
;
3476 for (i
= 0; i
< size
; i
++)
3479 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3480 bytecode object, the docstring containing the bytecode and
3481 constants values must be treated as unibyte and passed to
3482 Fread, to get the actual bytecode string and constants vector. */
3483 if (bytecodeflag
&& load_force_doc_strings
)
3485 if (i
== COMPILED_BYTECODE
)
3487 if (!STRINGP (item
))
3488 error ("Invalid byte code");
3490 /* Delay handling the bytecode slot until we know whether
3491 it is lazily-loaded (we can tell by whether the
3492 constants slot is nil). */
3493 ASET (vector
, COMPILED_CONSTANTS
, item
);
3496 else if (i
== COMPILED_CONSTANTS
)
3498 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3502 /* Coerce string to unibyte (like string-as-unibyte,
3503 but without generating extra garbage and
3504 guaranteeing no change in the contents). */
3505 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3506 STRING_SET_UNIBYTE (bytestr
);
3508 item
= Fread (Fcons (bytestr
, readcharfun
));
3510 error ("Invalid byte code");
3512 otem
= XCONS (item
);
3513 bytestr
= XCAR (item
);
3518 /* Now handle the bytecode slot. */
3519 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3521 else if (i
== COMPILED_DOC_STRING
3523 && ! STRING_MULTIBYTE (item
))
3525 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3526 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3528 item
= Fstring_as_multibyte (item
);
3531 ASET (vector
, i
, item
);
3539 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3542 read_list (bool flag
, Lisp_Object readcharfun
)
3544 Lisp_Object val
, tail
;
3545 Lisp_Object elt
, tem
;
3546 /* 0 is the normal case.
3547 1 means this list is a doc reference; replace it with the number 0.
3548 2 means this list is a doc reference; replace it with the doc string. */
3549 int doc_reference
= 0;
3551 /* Initialize this to 1 if we are reading a list. */
3552 bool first_in_list
= flag
<= 0;
3560 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3564 /* While building, if the list starts with #$, treat it specially. */
3565 if (EQ (elt
, Vload_file_name
)
3567 && !NILP (Vpurify_flag
))
3569 if (NILP (Vdoc_file_name
))
3570 /* We have not yet called Snarf-documentation, so assume
3571 this file is described in the DOC file
3572 and Snarf-documentation will fill in the right value later.
3573 For now, replace the whole list with 0. */
3576 /* We have already called Snarf-documentation, so make a relative
3577 file name for this file, so it can be found properly
3578 in the installed Lisp directory.
3579 We don't use Fexpand_file_name because that would make
3580 the directory absolute now. */
3582 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3583 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3586 else if (EQ (elt
, Vload_file_name
)
3588 && load_force_doc_strings
)
3597 invalid_syntax (") or . in a vector");
3604 XSETCDR (tail
, read0 (readcharfun
));
3606 val
= read0 (readcharfun
);
3607 read1 (readcharfun
, &ch
, 0);
3611 if (doc_reference
== 1)
3612 return make_number (0);
3613 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3616 file_offset saved_position
;
3617 /* Get a doc string from the file we are loading.
3618 If it's in saved_doc_string, get it from there.
3620 Here, we don't know if the string is a
3621 bytecode string or a doc string. As a
3622 bytecode string must be unibyte, we always
3623 return a unibyte string. If it is actually a
3624 doc string, caller must make it
3627 /* Position is negative for user variables. */
3628 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3629 if (pos
>= saved_doc_string_position
3630 && pos
< (saved_doc_string_position
3631 + saved_doc_string_length
))
3633 saved
= saved_doc_string
;
3634 saved_position
= saved_doc_string_position
;
3636 /* Look in prev_saved_doc_string the same way. */
3637 else if (pos
>= prev_saved_doc_string_position
3638 && pos
< (prev_saved_doc_string_position
3639 + prev_saved_doc_string_length
))
3641 saved
= prev_saved_doc_string
;
3642 saved_position
= prev_saved_doc_string_position
;
3646 ptrdiff_t start
= pos
- saved_position
;
3649 /* Process quoting with ^A,
3650 and find the end of the string,
3651 which is marked with ^_ (037). */
3652 for (from
= start
, to
= start
;
3653 saved
[from
] != 037;)
3655 int c
= saved
[from
++];
3659 saved
[to
++] = (c
== 1 ? c
3668 return make_unibyte_string (saved
+ start
,
3672 return get_doc_string (val
, 1, 0);
3677 invalid_syntax (". in wrong context");
3679 invalid_syntax ("] in a list");
3683 XSETCDR (tail
, tem
);
3690 static Lisp_Object initial_obarray
;
3692 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3694 static size_t oblookup_last_bucket_number
;
3696 /* Get an error if OBARRAY is not an obarray.
3697 If it is one, return it. */
3700 check_obarray (Lisp_Object obarray
)
3702 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3704 /* If Vobarray is now invalid, force it to be valid. */
3705 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3706 wrong_type_argument (Qvectorp
, obarray
);
3711 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3714 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3718 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3719 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3722 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3724 XSYMBOL (sym
)->constant
= 1;
3725 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3726 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3729 ptr
= aref_addr (obarray
, XINT (index
));
3730 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3735 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3738 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3740 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3743 /* Intern the C string STR: return a symbol with that name,
3744 interned in the current obarray. */
3747 intern_1 (const char *str
, ptrdiff_t len
)
3749 Lisp_Object obarray
= check_obarray (Vobarray
);
3750 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3752 return (SYMBOLP (tem
) ? tem
3753 /* The above `oblookup' was done on the basis of nchars==nbytes, so
3754 the string has to be unibyte. */
3755 : intern_driver (make_unibyte_string (str
, len
),
3760 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3762 Lisp_Object obarray
= check_obarray (Vobarray
);
3763 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3767 /* Creating a non-pure string from a string literal not implemented yet.
3768 We could just use make_string here and live with the extra copy. */
3769 eassert (!NILP (Vpurify_flag
));
3770 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3776 define_symbol (Lisp_Object sym
, char const *str
)
3778 ptrdiff_t len
= strlen (str
);
3779 Lisp_Object string
= make_pure_c_string (str
, len
);
3780 init_symbol (sym
, string
);
3782 /* Qunbound is uninterned, so that it's not confused with any symbol
3783 'unbound' created by a Lisp program. */
3784 if (! EQ (sym
, Qunbound
))
3786 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3787 eassert (INTEGERP (bucket
));
3788 intern_sym (sym
, initial_obarray
, bucket
);
3792 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3793 doc
: /* Return the canonical symbol whose name is STRING.
3794 If there is none, one is created by this function and returned.
3795 A second optional argument specifies the obarray to use;
3796 it defaults to the value of `obarray'. */)
3797 (Lisp_Object string
, Lisp_Object obarray
)
3801 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3802 CHECK_STRING (string
);
3804 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3806 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3811 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3812 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3813 NAME may be a string or a symbol. If it is a symbol, that exact
3814 symbol is searched for.
3815 A second optional argument specifies the obarray to use;
3816 it defaults to the value of `obarray'. */)
3817 (Lisp_Object name
, Lisp_Object obarray
)
3819 register Lisp_Object tem
, string
;
3821 if (NILP (obarray
)) obarray
= Vobarray
;
3822 obarray
= check_obarray (obarray
);
3824 if (!SYMBOLP (name
))
3826 CHECK_STRING (name
);
3830 string
= SYMBOL_NAME (name
);
3832 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3833 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3839 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3840 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3841 The value is t if a symbol was found and deleted, nil otherwise.
3842 NAME may be a string or a symbol. If it is a symbol, that symbol
3843 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3844 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3845 usage: (unintern NAME OBARRAY) */)
3846 (Lisp_Object name
, Lisp_Object obarray
)
3848 register Lisp_Object string
, tem
;
3851 if (NILP (obarray
)) obarray
= Vobarray
;
3852 obarray
= check_obarray (obarray
);
3855 string
= SYMBOL_NAME (name
);
3858 CHECK_STRING (name
);
3862 tem
= oblookup (obarray
, SSDATA (string
),
3867 /* If arg was a symbol, don't delete anything but that symbol itself. */
3868 if (SYMBOLP (name
) && !EQ (name
, tem
))
3871 /* There are plenty of other symbols which will screw up the Emacs
3872 session if we unintern them, as well as even more ways to use
3873 `setq' or `fset' or whatnot to make the Emacs session
3874 unusable. Let's not go down this silly road. --Stef */
3875 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3876 error ("Attempt to unintern t or nil"); */
3878 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3880 hash
= oblookup_last_bucket_number
;
3882 if (EQ (AREF (obarray
, hash
), tem
))
3884 if (XSYMBOL (tem
)->next
)
3887 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3888 ASET (obarray
, hash
, sym
);
3891 ASET (obarray
, hash
, make_number (0));
3895 Lisp_Object tail
, following
;
3897 for (tail
= AREF (obarray
, hash
);
3898 XSYMBOL (tail
)->next
;
3901 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3902 if (EQ (following
, tem
))
3904 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3913 /* Return the symbol in OBARRAY whose names matches the string
3914 of SIZE characters (SIZE_BYTE bytes) at PTR.
3915 If there is no such symbol, return the integer bucket number of
3916 where the symbol would be if it were present.
3918 Also store the bucket number in oblookup_last_bucket_number. */
3921 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3925 register Lisp_Object tail
;
3926 Lisp_Object bucket
, tem
;
3928 obarray
= check_obarray (obarray
);
3929 obsize
= ASIZE (obarray
);
3931 /* This is sometimes needed in the middle of GC. */
3932 obsize
&= ~ARRAY_MARK_FLAG
;
3933 hash
= hash_string (ptr
, size_byte
) % obsize
;
3934 bucket
= AREF (obarray
, hash
);
3935 oblookup_last_bucket_number
= hash
;
3936 if (EQ (bucket
, make_number (0)))
3938 else if (!SYMBOLP (bucket
))
3939 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3941 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3943 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3944 && SCHARS (SYMBOL_NAME (tail
)) == size
3945 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3947 else if (XSYMBOL (tail
)->next
== 0)
3950 XSETINT (tem
, hash
);
3955 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3958 register Lisp_Object tail
;
3959 CHECK_VECTOR (obarray
);
3960 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3962 tail
= AREF (obarray
, i
);
3967 if (XSYMBOL (tail
)->next
== 0)
3969 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3975 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3977 call1 (function
, sym
);
3980 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3981 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3982 OBARRAY defaults to the value of `obarray'. */)
3983 (Lisp_Object function
, Lisp_Object obarray
)
3985 if (NILP (obarray
)) obarray
= Vobarray
;
3986 obarray
= check_obarray (obarray
);
3988 map_obarray (obarray
, mapatoms_1
, function
);
3992 #define OBARRAY_SIZE 1511
3997 Lisp_Object oblength
;
3998 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4000 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4002 Vobarray
= Fmake_vector (oblength
, make_number (0));
4003 initial_obarray
= Vobarray
;
4004 staticpro (&initial_obarray
);
4006 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4007 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4009 DEFSYM (Qunbound
, "unbound");
4011 DEFSYM (Qnil
, "nil");
4012 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4013 XSYMBOL (Qnil
)->constant
= 1;
4014 XSYMBOL (Qnil
)->declared_special
= true;
4017 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4018 XSYMBOL (Qt
)->constant
= 1;
4019 XSYMBOL (Qt
)->declared_special
= true;
4021 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4024 DEFSYM (Qvariable_documentation
, "variable-documentation");
4026 read_buffer
= xmalloc (size
);
4027 read_buffer_size
= size
;
4031 defsubr (struct Lisp_Subr
*sname
)
4033 Lisp_Object sym
, tem
;
4034 sym
= intern_c_string (sname
->symbol_name
);
4035 XSETPVECTYPE (sname
, PVEC_SUBR
);
4036 XSETSUBR (tem
, sname
);
4037 set_symbol_function (sym
, tem
);
4040 #ifdef NOTDEF /* Use fset in subr.el now! */
4042 defalias (struct Lisp_Subr
*sname
, char *string
)
4045 sym
= intern (string
);
4046 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4050 /* Define an "integer variable"; a symbol whose value is forwarded to a
4051 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4052 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4054 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4055 const char *namestring
, EMACS_INT
*address
)
4058 sym
= intern_c_string (namestring
);
4059 i_fwd
->type
= Lisp_Fwd_Int
;
4060 i_fwd
->intvar
= address
;
4061 XSYMBOL (sym
)->declared_special
= 1;
4062 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4063 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4066 /* Similar but define a variable whose value is t if address contains 1,
4067 nil if address contains 0. */
4069 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4070 const char *namestring
, bool *address
)
4073 sym
= intern_c_string (namestring
);
4074 b_fwd
->type
= Lisp_Fwd_Bool
;
4075 b_fwd
->boolvar
= address
;
4076 XSYMBOL (sym
)->declared_special
= 1;
4077 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4078 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4079 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4082 /* Similar but define a variable whose value is the Lisp Object stored
4083 at address. Two versions: with and without gc-marking of the C
4084 variable. The nopro version is used when that variable will be
4085 gc-marked for some other reason, since marking the same slot twice
4086 can cause trouble with strings. */
4088 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4089 const char *namestring
, Lisp_Object
*address
)
4092 sym
= intern_c_string (namestring
);
4093 o_fwd
->type
= Lisp_Fwd_Obj
;
4094 o_fwd
->objvar
= address
;
4095 XSYMBOL (sym
)->declared_special
= 1;
4096 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4097 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4101 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4102 const char *namestring
, Lisp_Object
*address
)
4104 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4105 staticpro (address
);
4108 /* Similar but define a variable whose value is the Lisp Object stored
4109 at a particular offset in the current kboard object. */
4112 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4113 const char *namestring
, int offset
)
4116 sym
= intern_c_string (namestring
);
4117 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4118 ko_fwd
->offset
= offset
;
4119 XSYMBOL (sym
)->declared_special
= 1;
4120 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4121 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4124 /* Check that the elements of lpath exist. */
4127 load_path_check (Lisp_Object lpath
)
4129 Lisp_Object path_tail
;
4131 /* The only elements that might not exist are those from
4132 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4134 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4136 Lisp_Object dirfile
;
4137 dirfile
= Fcar (path_tail
);
4138 if (STRINGP (dirfile
))
4140 dirfile
= Fdirectory_file_name (dirfile
);
4141 if (! file_accessible_directory_p (dirfile
))
4142 dir_warning ("Lisp directory", XCAR (path_tail
));
4147 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4148 This does not include the standard site-lisp directories
4149 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4150 but it does (unless no_site_lisp is set) include site-lisp
4151 directories in the source/build directories if those exist and we
4152 are running uninstalled.
4154 Uses the following logic:
4155 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4156 The remainder is what happens when dumping works:
4157 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4158 Otherwise use PATH_LOADSEARCH.
4160 If !initialized, then just return PATH_DUMPLOADSEARCH.
4162 If Vinstallation_directory is not nil (ie, running uninstalled):
4163 If installation-dir/lisp exists and not already a member,
4164 we must be running uninstalled. Reset the load-path
4165 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4166 refers to the eventual installation directories. Since we
4167 are not yet installed, we should not use them, even if they exist.)
4168 If installation-dir/lisp does not exist, just add
4169 PATH_DUMPLOADSEARCH at the end instead.
4170 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4171 and not already a member) at the front.
4172 If installation-dir != source-dir (ie running an uninstalled,
4173 out-of-tree build) AND install-dir/src/Makefile exists BUT
4174 install-dir/src/Makefile.in does NOT exist (this is a sanity
4175 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4178 load_path_default (void)
4180 Lisp_Object lpath
= Qnil
;
4185 const char *loadpath
= ns_load_path ();
4188 normal
= PATH_LOADSEARCH
;
4190 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4192 lpath
= decode_env_path (0, normal
, 0);
4195 #else /* !CANNOT_DUMP */
4197 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4202 const char *loadpath
= ns_load_path ();
4203 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4205 lpath
= decode_env_path (0, normal
, 0);
4207 if (!NILP (Vinstallation_directory
))
4209 Lisp_Object tem
, tem1
;
4211 /* Add to the path the lisp subdir of the installation
4212 dir, if it is accessible. Note: in out-of-tree builds,
4213 this directory is empty save for Makefile. */
4214 tem
= Fexpand_file_name (build_string ("lisp"),
4215 Vinstallation_directory
);
4216 tem1
= Ffile_accessible_directory_p (tem
);
4219 if (NILP (Fmember (tem
, lpath
)))
4221 /* We are running uninstalled. The default load-path
4222 points to the eventual installed lisp directories.
4223 We should not use those now, even if they exist,
4224 so start over from a clean slate. */
4225 lpath
= list1 (tem
);
4229 /* That dir doesn't exist, so add the build-time
4230 Lisp dirs instead. */
4232 Lisp_Object dump_path
=
4233 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4234 lpath
= nconc2 (lpath
, dump_path
);
4237 /* Add site-lisp under the installation dir, if it exists. */
4240 tem
= Fexpand_file_name (build_string ("site-lisp"),
4241 Vinstallation_directory
);
4242 tem1
= Ffile_accessible_directory_p (tem
);
4245 if (NILP (Fmember (tem
, lpath
)))
4246 lpath
= Fcons (tem
, lpath
);
4250 /* If Emacs was not built in the source directory,
4251 and it is run from where it was built, add to load-path
4252 the lisp and site-lisp dirs under that directory. */
4254 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4258 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4259 Vinstallation_directory
);
4260 tem1
= Ffile_exists_p (tem
);
4262 /* Don't be fooled if they moved the entire source tree
4263 AFTER dumping Emacs. If the build directory is indeed
4264 different from the source dir, src/Makefile.in and
4265 src/Makefile will not be found together. */
4266 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4267 Vinstallation_directory
);
4268 tem2
= Ffile_exists_p (tem
);
4269 if (!NILP (tem1
) && NILP (tem2
))
4271 tem
= Fexpand_file_name (build_string ("lisp"),
4274 if (NILP (Fmember (tem
, lpath
)))
4275 lpath
= Fcons (tem
, lpath
);
4279 tem
= Fexpand_file_name (build_string ("site-lisp"),
4281 tem1
= Ffile_accessible_directory_p (tem
);
4284 if (NILP (Fmember (tem
, lpath
)))
4285 lpath
= Fcons (tem
, lpath
);
4289 } /* Vinstallation_directory != Vsource_directory */
4291 } /* if Vinstallation_directory */
4293 else /* !initialized */
4295 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4296 source directory. We used to add ../lisp (ie the lisp dir in
4297 the build directory) at the front here, but that should not
4298 be necessary, since in out of tree builds lisp/ is empty, save
4300 lpath
= decode_env_path (0, normal
, 0);
4302 #endif /* !CANNOT_DUMP */
4310 /* First, set Vload_path. */
4312 /* Ignore EMACSLOADPATH when dumping. */
4314 bool use_loadpath
= true;
4316 bool use_loadpath
= NILP (Vpurify_flag
);
4319 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4321 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4323 /* Check (non-nil) user-supplied elements. */
4324 load_path_check (Vload_path
);
4326 /* If no nils in the environment variable, use as-is.
4327 Otherwise, replace any nils with the default. */
4328 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4330 Lisp_Object elem
, elpath
= Vload_path
;
4331 Lisp_Object default_lpath
= load_path_default ();
4333 /* Check defaults, before adding site-lisp. */
4334 load_path_check (default_lpath
);
4336 /* Add the site-lisp directories to the front of the default. */
4339 Lisp_Object sitelisp
;
4340 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4341 if (! NILP (sitelisp
))
4342 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4347 /* Replace nils from EMACSLOADPATH by default. */
4348 while (CONSP (elpath
))
4350 elem
= XCAR (elpath
);
4351 elpath
= XCDR (elpath
);
4352 Vload_path
= CALLN (Fappend
, Vload_path
,
4353 NILP (elem
) ? default_lpath
: list1 (elem
));
4355 } /* Fmemq (Qnil, Vload_path) */
4359 Vload_path
= load_path_default ();
4361 /* Check before adding site-lisp directories.
4362 The install should have created them, but they are not
4363 required, so no need to warn if they are absent.
4364 Or we might be running before installation. */
4365 load_path_check (Vload_path
);
4367 /* Add the site-lisp directories at the front. */
4368 if (initialized
&& !no_site_lisp
)
4370 Lisp_Object sitelisp
;
4371 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4372 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4378 load_in_progress
= 0;
4379 Vload_file_name
= Qnil
;
4380 Vstandard_input
= Qt
;
4381 Vloads_in_progress
= Qnil
;
4384 /* Print a warning that directory intended for use USE and with name
4385 DIRNAME cannot be accessed. On entry, errno should correspond to
4386 the access failure. Print the warning on stderr and put it in
4390 dir_warning (char const *use
, Lisp_Object dirname
)
4392 static char const format
[] = "Warning: %s '%s': %s\n";
4393 int access_errno
= errno
;
4394 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)),
4395 strerror (access_errno
));
4397 /* Don't log the warning before we've initialized!! */
4400 char const *diagnostic
= emacs_strerror (access_errno
);
4402 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4403 + strlen (use
) + SBYTES (dirname
)
4404 + strlen (diagnostic
));
4405 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4407 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4413 syms_of_lread (void)
4416 defsubr (&Sread_from_string
);
4418 defsubr (&Sintern_soft
);
4419 defsubr (&Sunintern
);
4420 defsubr (&Sget_load_suffixes
);
4422 defsubr (&Seval_buffer
);
4423 defsubr (&Seval_region
);
4424 defsubr (&Sread_char
);
4425 defsubr (&Sread_char_exclusive
);
4426 defsubr (&Sread_event
);
4427 defsubr (&Sget_file_char
);
4428 defsubr (&Smapatoms
);
4429 defsubr (&Slocate_file_internal
);
4431 DEFVAR_LISP ("obarray", Vobarray
,
4432 doc
: /* Symbol table for use by `intern' and `read'.
4433 It is a vector whose length ought to be prime for best results.
4434 The vector's contents don't make sense if examined from Lisp programs;
4435 to find all the symbols in an obarray, use `mapatoms'. */);
4437 DEFVAR_LISP ("values", Vvalues
,
4438 doc
: /* List of values of all expressions which were read, evaluated and printed.
4439 Order is reverse chronological. */);
4440 XSYMBOL (intern ("values"))->declared_special
= 0;
4442 DEFVAR_LISP ("standard-input", Vstandard_input
,
4443 doc
: /* Stream for read to get input from.
4444 See documentation of `read' for possible values. */);
4445 Vstandard_input
= Qt
;
4447 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4448 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4450 If this variable is a buffer, then only forms read from that buffer
4451 will be added to `read-symbol-positions-list'.
4452 If this variable is t, then all read forms will be added.
4453 The effect of all other values other than nil are not currently
4454 defined, although they may be in the future.
4456 The positions are relative to the last call to `read' or
4457 `read-from-string'. It is probably a bad idea to set this variable at
4458 the toplevel; bind it instead. */);
4459 Vread_with_symbol_positions
= Qnil
;
4461 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4462 doc
: /* A list mapping read symbols to their positions.
4463 This variable is modified during calls to `read' or
4464 `read-from-string', but only when `read-with-symbol-positions' is
4467 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4468 CHAR-POSITION is an integer giving the offset of that occurrence of the
4469 symbol from the position where `read' or `read-from-string' started.
4471 Note that a symbol will appear multiple times in this list, if it was
4472 read multiple times. The list is in the same order as the symbols
4474 Vread_symbol_positions_list
= Qnil
;
4476 DEFVAR_LISP ("read-circle", Vread_circle
,
4477 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4480 DEFVAR_LISP ("load-path", Vload_path
,
4481 doc
: /* List of directories to search for files to load.
4482 Each element is a string (directory file name) or nil (meaning
4483 `default-directory').
4484 Initialized during startup as described in Info node `(elisp)Library Search'.
4485 Use `directory-file-name' when adding items to this path. However, Lisp
4486 programs that process this list should tolerate directories both with
4487 and without trailing slashes. */);
4489 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4490 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4491 This list should not include the empty string.
4492 `load' and related functions try to append these suffixes, in order,
4493 to the specified file name if a Lisp suffix is allowed or required. */);
4494 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4495 build_pure_c_string (".el"));
4496 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4497 doc
: /* List of suffixes that indicate representations of \
4499 This list should normally start with the empty string.
4501 Enabling Auto Compression mode appends the suffixes in
4502 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4503 mode removes them again. `load' and related functions use this list to
4504 determine whether they should look for compressed versions of a file
4505 and, if so, which suffixes they should try to append to the file name
4506 in order to do so. However, if you want to customize which suffixes
4507 the loading functions recognize as compression suffixes, you should
4508 customize `jka-compr-load-suffixes' rather than the present variable. */);
4509 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4511 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4512 doc
: /* Non-nil if inside of `load'. */);
4513 DEFSYM (Qload_in_progress
, "load-in-progress");
4515 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4516 doc
: /* An alist of functions to be evalled when particular files are loaded.
4517 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4519 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4520 a symbol (a feature name).
4522 When `load' is run and the file-name argument matches an element's
4523 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4524 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4526 An error in FORMS does not undo the load, but does prevent execution of
4527 the rest of the FORMS. */);
4528 Vafter_load_alist
= Qnil
;
4530 DEFVAR_LISP ("load-history", Vload_history
,
4531 doc
: /* Alist mapping loaded file names to symbols and features.
4532 Each alist element should be a list (FILE-NAME ENTRIES...), where
4533 FILE-NAME is the name of a file that has been loaded into Emacs.
4534 The file name is absolute and true (i.e. it doesn't contain symlinks).
4535 As an exception, one of the alist elements may have FILE-NAME nil,
4536 for symbols and features not associated with any file.
4538 The remaining ENTRIES in the alist element describe the functions and
4539 variables defined in that file, the features provided, and the
4540 features required. Each entry has the form `(provide . FEATURE)',
4541 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4542 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4543 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4544 autoload before this file redefined it as a function. In addition,
4545 entries may also be single symbols, which means that SYMBOL was
4546 defined by `defvar' or `defconst'.
4548 During preloading, the file name recorded is relative to the main Lisp
4549 directory. These file names are converted to absolute at startup. */);
4550 Vload_history
= Qnil
;
4552 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4553 doc
: /* Full name of file being loaded by `load'. */);
4554 Vload_file_name
= Qnil
;
4556 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4557 doc
: /* File name, including directory, of user's initialization file.
4558 If the file loaded had extension `.elc', and the corresponding source file
4559 exists, this variable contains the name of source file, suitable for use
4560 by functions like `custom-save-all' which edit the init file.
4561 While Emacs loads and evaluates the init file, value is the real name
4562 of the file, regardless of whether or not it has the `.elc' extension. */);
4563 Vuser_init_file
= Qnil
;
4565 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4566 doc
: /* Used for internal purposes by `load'. */);
4567 Vcurrent_load_list
= Qnil
;
4569 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4570 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4571 Called with a single argument (the stream from which to read).
4572 The default is to use the function `read'. */);
4573 DEFSYM (Qread
, "read");
4574 Vload_read_function
= Qread
;
4576 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4577 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4578 The value should be a function for doing code conversion before
4579 reading a source file. It can also be nil, in which case loading is
4580 done without any code conversion.
4582 If the value is a function, it is called with four arguments,
4583 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4584 the file to load, FILE is the non-absolute name (for messages etc.),
4585 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4586 `load'. The function should return t if the file was loaded. */);
4587 Vload_source_file_function
= Qnil
;
4589 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4590 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4591 This is useful when the file being loaded is a temporary copy. */);
4592 load_force_doc_strings
= 0;
4594 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4595 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4596 This is normally bound by `load' and `eval-buffer' to control `read',
4597 and is not meant for users to change. */);
4598 load_convert_to_unibyte
= 0;
4600 DEFVAR_LISP ("source-directory", Vsource_directory
,
4601 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4602 You cannot count on them to still be there! */);
4604 = Fexpand_file_name (build_string ("../"),
4605 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4607 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4608 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4609 Vpreloaded_file_list
= Qnil
;
4611 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4612 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4613 Vbyte_boolean_vars
= Qnil
;
4615 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4616 doc
: /* Non-nil means load dangerous compiled Lisp files.
4617 Some versions of XEmacs use different byte codes than Emacs. These
4618 incompatible byte codes can make Emacs crash when it tries to execute
4620 load_dangerous_libraries
= 0;
4622 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4623 doc
: /* Non-nil means force printing messages when loading Lisp files.
4624 This overrides the value of the NOMESSAGE argument to `load'. */);
4625 force_load_messages
= 0;
4627 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4628 doc
: /* Regular expression matching safe to load compiled Lisp files.
4629 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4630 from the file, and matches them against this regular expression.
4631 When the regular expression matches, the file is considered to be safe
4632 to load. See also `load-dangerous-libraries'. */);
4633 Vbytecomp_version_regexp
4634 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4636 DEFSYM (Qlexical_binding
, "lexical-binding");
4637 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4638 doc
: /* Whether to use lexical binding when evaluating code.
4639 Non-nil means that the code in the current buffer should be evaluated
4640 with lexical binding.
4641 This variable is automatically set from the file variables of an
4642 interpreted Lisp file read using `load'. Unlike other file local
4643 variables, this must be set in the first line of a file. */);
4644 Vlexical_binding
= Qnil
;
4645 Fmake_variable_buffer_local (Qlexical_binding
);
4647 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4648 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4649 Veval_buffer_list
= Qnil
;
4651 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4652 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4653 Vold_style_backquotes
= Qnil
;
4654 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4656 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4657 doc
: /* Non-nil means `load' prefers the newest version of a file.
4658 This applies when a filename suffix is not explicitly specified and
4659 `load' is trying various possible suffixes (see `load-suffixes' and
4660 `load-file-rep-suffixes'). Normally, it stops at the first file
4661 that exists unless you explicitly specify one or the other. If this
4662 option is non-nil, it checks all suffixes and uses whichever file is
4664 Note that if you customize this, obviously it will not affect files
4665 that are loaded before your customizations are read! */);
4666 load_prefer_newer
= 0;
4668 /* Vsource_directory was initialized in init_lread. */
4670 DEFSYM (Qcurrent_load_list
, "current-load-list");
4671 DEFSYM (Qstandard_input
, "standard-input");
4672 DEFSYM (Qread_char
, "read-char");
4673 DEFSYM (Qget_file_char
, "get-file-char");
4675 /* Used instead of Qget_file_char while loading *.elc files compiled
4676 by Emacs 21 or older. */
4677 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4679 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4681 DEFSYM (Qbackquote
, "`");
4682 DEFSYM (Qcomma
, ",");
4683 DEFSYM (Qcomma_at
, ",@");
4684 DEFSYM (Qcomma_dot
, ",.");
4686 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4687 DEFSYM (Qascii_character
, "ascii-character");
4688 DEFSYM (Qfunction
, "function");
4689 DEFSYM (Qload
, "load");
4690 DEFSYM (Qload_file_name
, "load-file-name");
4691 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4692 DEFSYM (Qfile_truename
, "file-truename");
4693 DEFSYM (Qdir_ok
, "dir-ok");
4694 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4696 staticpro (&read_objects
);
4697 read_objects
= Qnil
;
4698 staticpro (&seen_list
);
4701 Vloads_in_progress
= Qnil
;
4702 staticpro (&Vloads_in_progress
);
4704 DEFSYM (Qhash_table
, "hash-table");
4705 DEFSYM (Qdata
, "data");
4706 DEFSYM (Qtest
, "test");
4707 DEFSYM (Qsize
, "size");
4708 DEFSYM (Qweakness
, "weakness");
4709 DEFSYM (Qrehash_size
, "rehash-size");
4710 DEFSYM (Qrehash_threshold
, "rehash-threshold");