1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2015 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 /* Tell globals.h to define tables needed by init_obarray. */
22 #define DEFINE_SYMBOLS
26 #include <sys/types.h>
30 #include <limits.h> /* For CHAR_BIT. */
32 #include <stat-time.h>
34 #include "dispextern.h"
35 #include "intervals.h"
36 #include "character.h"
44 #include "termhooks.h"
45 #include "blockinput.h"
59 #endif /* HAVE_SETLOCALE */
64 #define file_offset off_t
65 #define file_tell ftello
67 #define file_offset long
68 #define file_tell ftell
71 /* The association list of objects read with the #n=object form.
72 Each member of the list has the form (n . object), and is used to
73 look up the object for the corresponding #n# construct.
74 It must be set to nil before all top-level calls to read0. */
75 static Lisp_Object read_objects
;
77 /* File for get_file_char to read from. Use by load. */
78 static FILE *instream
;
80 /* For use within read-from-string (this reader is non-reentrant!!) */
81 static ptrdiff_t read_from_string_index
;
82 static ptrdiff_t read_from_string_index_byte
;
83 static ptrdiff_t read_from_string_limit
;
85 /* Number of characters read in the current call to Fread or
87 static EMACS_INT readchar_count
;
89 /* This contains the last string skipped with #@. */
90 static char *saved_doc_string
;
91 /* Length of buffer allocated in saved_doc_string. */
92 static ptrdiff_t saved_doc_string_size
;
93 /* Length of actual data in saved_doc_string. */
94 static ptrdiff_t saved_doc_string_length
;
95 /* This is the file position that string came from. */
96 static file_offset saved_doc_string_position
;
98 /* This contains the previous string skipped with #@.
99 We copy it from saved_doc_string when a new string
100 is put in saved_doc_string. */
101 static char *prev_saved_doc_string
;
102 /* Length of buffer allocated in prev_saved_doc_string. */
103 static ptrdiff_t prev_saved_doc_string_size
;
104 /* Length of actual data in prev_saved_doc_string. */
105 static ptrdiff_t prev_saved_doc_string_length
;
106 /* This is the file position that string came from. */
107 static file_offset prev_saved_doc_string_position
;
109 /* True means inside a new-style backquote
110 with no surrounding parentheses.
111 Fread initializes this to false, so we need not specbind it
112 or worry about what happens to it when there is an error. */
113 static bool new_backquote_flag
;
115 /* A list of file names for files being loaded in Fload. Used to
116 check for recursive loads. */
118 static Lisp_Object Vloads_in_progress
;
120 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
123 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
124 Lisp_Object
, Lisp_Object
,
125 Lisp_Object
, Lisp_Object
);
127 /* Functions that read one byte from the current source READCHARFUN
128 or unreads one byte. If the integer argument C is -1, it returns
129 one read byte, or -1 when there's no more byte in the source. If C
130 is 0 or positive, it unreads C, and the return value is not
133 static int readbyte_for_lambda (int, Lisp_Object
);
134 static int readbyte_from_file (int, Lisp_Object
);
135 static int readbyte_from_string (int, Lisp_Object
);
137 /* Handle unreading and rereading of characters.
138 Write READCHAR to read a character,
139 UNREAD(c) to unread c to be read again.
141 These macros correctly read/unread multibyte characters. */
143 #define READCHAR readchar (readcharfun, NULL)
144 #define UNREAD(c) unreadchar (readcharfun, c)
146 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
147 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
149 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
150 Qlambda, or a cons, we use this to keep an unread character because
151 a file stream can't handle multibyte-char unreading. The value -1
152 means that there's no unread character. */
153 static int unread_char
;
156 readchar (Lisp_Object readcharfun
, bool *multibyte
)
160 int (*readbyte
) (int, Lisp_Object
);
161 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
163 bool emacs_mule_encoding
= 0;
170 if (BUFFERP (readcharfun
))
172 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
174 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
176 if (! BUFFER_LIVE_P (inbuffer
))
179 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
182 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
184 /* Fetch the character code from the buffer. */
185 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
186 BUF_INC_POS (inbuffer
, pt_byte
);
193 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
194 if (! ASCII_CHAR_P (c
))
195 c
= BYTE8_TO_CHAR (c
);
198 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
202 if (MARKERP (readcharfun
))
204 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
206 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
208 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
211 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
213 /* Fetch the character code from the buffer. */
214 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
215 BUF_INC_POS (inbuffer
, bytepos
);
222 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
223 if (! ASCII_CHAR_P (c
))
224 c
= BYTE8_TO_CHAR (c
);
228 XMARKER (readcharfun
)->bytepos
= bytepos
;
229 XMARKER (readcharfun
)->charpos
++;
234 if (EQ (readcharfun
, Qlambda
))
236 readbyte
= readbyte_for_lambda
;
240 if (EQ (readcharfun
, Qget_file_char
))
242 readbyte
= readbyte_from_file
;
246 if (STRINGP (readcharfun
))
248 if (read_from_string_index
>= read_from_string_limit
)
250 else if (STRING_MULTIBYTE (readcharfun
))
254 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
255 read_from_string_index
,
256 read_from_string_index_byte
);
260 c
= SREF (readcharfun
, read_from_string_index_byte
);
261 read_from_string_index
++;
262 read_from_string_index_byte
++;
267 if (CONSP (readcharfun
))
269 /* This is the case that read_vector is reading from a unibyte
270 string that contains a byte sequence previously skipped
271 because of #@NUMBER. The car part of readcharfun is that
272 string, and the cdr part is a value of readcharfun given to
274 readbyte
= readbyte_from_string
;
275 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
276 emacs_mule_encoding
= 1;
280 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
282 readbyte
= readbyte_from_file
;
283 emacs_mule_encoding
= 1;
287 tem
= call0 (readcharfun
);
294 if (unread_char
>= 0)
300 c
= (*readbyte
) (-1, readcharfun
);
305 if (ASCII_CHAR_P (c
))
307 if (emacs_mule_encoding
)
308 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
311 len
= BYTES_BY_CHAR_HEAD (c
);
314 c
= (*readbyte
) (-1, readcharfun
);
315 if (c
< 0 || ! TRAILING_CODE_P (c
))
318 (*readbyte
) (buf
[i
], readcharfun
);
319 return BYTE8_TO_CHAR (buf
[0]);
323 return STRING_CHAR (buf
);
326 #define FROM_FILE_P(readcharfun) \
327 (EQ (readcharfun, Qget_file_char) \
328 || EQ (readcharfun, Qget_emacs_mule_file_char))
331 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
333 if (FROM_FILE_P (readcharfun
))
335 block_input (); /* FIXME: Not sure if it's needed. */
336 fseek (instream
, n
, SEEK_CUR
);
340 { /* We're not reading directly from a file. In that case, it's difficult
341 to reliably count bytes, since these are usually meant for the file's
342 encoding, whereas we're now typically in the internal encoding.
343 But luckily, skip_dyn_bytes is used to skip over a single
344 dynamic-docstring (or dynamic byte-code) which is always quoted such
345 that \037 is the final char. */
349 } while (c
>= 0 && c
!= '\037');
354 skip_dyn_eof (Lisp_Object readcharfun
)
356 if (FROM_FILE_P (readcharfun
))
358 block_input (); /* FIXME: Not sure if it's needed. */
359 fseek (instream
, 0, SEEK_END
);
363 while (READCHAR
>= 0);
366 /* Unread the character C in the way appropriate for the stream READCHARFUN.
367 If the stream is a user function, call it with the char as argument. */
370 unreadchar (Lisp_Object readcharfun
, int c
)
374 /* Don't back up the pointer if we're unreading the end-of-input mark,
375 since readchar didn't advance it when we read it. */
377 else if (BUFFERP (readcharfun
))
379 struct buffer
*b
= XBUFFER (readcharfun
);
380 ptrdiff_t charpos
= BUF_PT (b
);
381 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
383 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
384 BUF_DEC_POS (b
, bytepos
);
388 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
390 else if (MARKERP (readcharfun
))
392 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
393 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
395 XMARKER (readcharfun
)->charpos
--;
396 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
397 BUF_DEC_POS (b
, bytepos
);
401 XMARKER (readcharfun
)->bytepos
= bytepos
;
403 else if (STRINGP (readcharfun
))
405 read_from_string_index
--;
406 read_from_string_index_byte
407 = string_char_to_byte (readcharfun
, read_from_string_index
);
409 else if (CONSP (readcharfun
))
413 else if (EQ (readcharfun
, Qlambda
))
417 else if (FROM_FILE_P (readcharfun
))
422 call1 (readcharfun
, make_number (c
));
426 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
428 return read_bytecode_char (c
>= 0);
433 readbyte_from_file (int c
, Lisp_Object readcharfun
)
438 ungetc (c
, instream
);
446 /* Interrupted reads have been observed while reading over the network. */
447 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
458 return (c
== EOF
? -1 : c
);
462 readbyte_from_string (int c
, Lisp_Object readcharfun
)
464 Lisp_Object string
= XCAR (readcharfun
);
468 read_from_string_index
--;
469 read_from_string_index_byte
470 = string_char_to_byte (string
, read_from_string_index
);
473 if (read_from_string_index
>= read_from_string_limit
)
476 FETCH_STRING_CHAR_ADVANCE (c
, string
,
477 read_from_string_index
,
478 read_from_string_index_byte
);
483 /* Read one non-ASCII character from INSTREAM. The character is
484 encoded in `emacs-mule' and the first byte is already read in
488 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
490 /* Emacs-mule coding uses at most 4-byte for one character. */
491 unsigned char buf
[4];
492 int len
= emacs_mule_bytes
[c
];
493 struct charset
*charset
;
498 /* C is not a valid leading-code of `emacs-mule'. */
499 return BYTE8_TO_CHAR (c
);
505 c
= (*readbyte
) (-1, readcharfun
);
509 (*readbyte
) (buf
[i
], readcharfun
);
510 return BYTE8_TO_CHAR (buf
[0]);
517 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
518 code
= buf
[1] & 0x7F;
522 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
523 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
525 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
526 code
= buf
[2] & 0x7F;
530 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
531 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
536 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
537 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
539 c
= DECODE_CHAR (charset
, code
);
541 Fsignal (Qinvalid_read_syntax
,
542 list1 (build_string ("invalid multibyte form")));
547 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
549 static Lisp_Object
read0 (Lisp_Object
);
550 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
552 static Lisp_Object
read_list (bool, Lisp_Object
);
553 static Lisp_Object
read_vector (Lisp_Object
, bool);
555 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
557 static void substitute_object_in_subtree (Lisp_Object
,
559 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
562 /* Get a character from the tty. */
564 /* Read input events until we get one that's acceptable for our purposes.
566 If NO_SWITCH_FRAME, switch-frame events are stashed
567 until we get a character we like, and then stuffed into
570 If ASCII_REQUIRED, check function key events to see
571 if the unmodified version of the symbol has a Qascii_character
572 property, and use that character, if present.
574 If ERROR_NONASCII, signal an error if the input we
575 get isn't an ASCII character with modifiers. If it's false but
576 ASCII_REQUIRED is true, just re-read until we get an ASCII
579 If INPUT_METHOD, invoke the current input method
580 if the character warrants that.
582 If SECONDS is a number, wait that many seconds for input, and
583 return Qnil if no input arrives within that time. */
586 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
587 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
589 Lisp_Object val
, delayed_switch_frame
;
590 struct timespec end_time
;
592 #ifdef HAVE_WINDOW_SYSTEM
593 if (display_hourglass_p
)
597 delayed_switch_frame
= Qnil
;
599 /* Compute timeout. */
600 if (NUMBERP (seconds
))
602 double duration
= extract_float (seconds
);
603 struct timespec wait_time
= dtotimespec (duration
);
604 end_time
= timespec_add (current_timespec (), wait_time
);
607 /* Read until we get an acceptable event. */
610 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
611 NUMBERP (seconds
) ? &end_time
: NULL
);
612 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
617 /* `switch-frame' events are put off until after the next ASCII
618 character. This is better than signaling an error just because
619 the last characters were typed to a separate minibuffer frame,
620 for example. Eventually, some code which can deal with
621 switch-frame events will read it and process it. */
623 && EVENT_HAS_PARAMETERS (val
)
624 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
626 delayed_switch_frame
= val
;
630 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
632 /* Convert certain symbols to their ASCII equivalents. */
635 Lisp_Object tem
, tem1
;
636 tem
= Fget (val
, Qevent_symbol_element_mask
);
639 tem1
= Fget (Fcar (tem
), Qascii_character
);
640 /* Merge this symbol's modifier bits
641 with the ASCII equivalent of its basic code. */
643 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
647 /* If we don't have a character now, deal with it appropriately. */
652 Vunread_command_events
= list1 (val
);
653 error ("Non-character input-event");
660 if (! NILP (delayed_switch_frame
))
661 unread_switch_frame
= delayed_switch_frame
;
665 #ifdef HAVE_WINDOW_SYSTEM
666 if (display_hourglass_p
)
675 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
676 doc
: /* Read a character from the command input (keyboard or macro).
677 It is returned as a number.
678 If the character has modifiers, they are resolved and reflected to the
679 character code if possible (e.g. C-SPC -> 0).
681 If the user generates an event which is not a character (i.e. a mouse
682 click or function key event), `read-char' signals an error. As an
683 exception, switch-frame events are put off until non-character events
685 If you want to read non-character events, or ignore them, call
686 `read-event' or `read-char-exclusive' instead.
688 If the optional argument PROMPT is non-nil, display that as a prompt.
689 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
690 input method is turned on in the current buffer, that input method
691 is used for reading a character.
692 If the optional argument SECONDS is non-nil, it should be a number
693 specifying the maximum number of seconds to wait for input. If no
694 input arrives in that time, return nil. SECONDS may be a
695 floating-point value. */)
696 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
701 message_with_string ("%s", prompt
, 0);
702 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
704 return (NILP (val
) ? Qnil
705 : make_number (char_resolve_modifier_mask (XINT (val
))));
708 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
709 doc
: /* Read an event object from the input stream.
710 If the optional argument PROMPT is non-nil, display that as a prompt.
711 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
712 input method is turned on in the current buffer, that input method
713 is used for reading a character.
714 If the optional argument SECONDS is non-nil, it should be a number
715 specifying the maximum number of seconds to wait for input. If no
716 input arrives in that time, return nil. SECONDS may be a
717 floating-point value. */)
718 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
721 message_with_string ("%s", prompt
, 0);
722 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
725 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
726 doc
: /* Read a character from the command input (keyboard or macro).
727 It is returned as a number. Non-character events are ignored.
728 If the character has modifiers, they are resolved and reflected to the
729 character code if possible (e.g. C-SPC -> 0).
731 If the optional argument PROMPT is non-nil, display that as a prompt.
732 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
733 input method is turned on in the current buffer, that input method
734 is used for reading a character.
735 If the optional argument SECONDS is non-nil, it should be a number
736 specifying the maximum number of seconds to wait for input. If no
737 input arrives in that time, return nil. SECONDS may be a
738 floating-point value. */)
739 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
744 message_with_string ("%s", prompt
, 0);
746 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
748 return (NILP (val
) ? Qnil
749 : make_number (char_resolve_modifier_mask (XINT (val
))));
752 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
753 doc
: /* Don't use this yourself. */)
756 register Lisp_Object val
;
758 XSETINT (val
, getc (instream
));
766 /* Return true if the lisp code read using READCHARFUN defines a non-nil
767 `lexical-binding' file variable. After returning, the stream is
768 positioned following the first line, if it is a comment or #! line,
769 otherwise nothing is read. */
772 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
785 while (ch
!= '\n' && ch
!= EOF
)
787 if (ch
== '\n') ch
= READCHAR
;
788 /* It is OK to leave the position after a #! line, since
789 that is what read1 does. */
793 /* The first line isn't a comment, just give up. */
799 /* Look for an appropriate file-variable in the first line. */
803 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
804 } beg_end_state
= NOMINAL
;
805 bool in_file_vars
= 0;
807 #define UPDATE_BEG_END_STATE(ch) \
808 if (beg_end_state == NOMINAL) \
809 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
810 else if (beg_end_state == AFTER_FIRST_DASH) \
811 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
812 else if (beg_end_state == AFTER_ASTERIX) \
815 in_file_vars = !in_file_vars; \
816 beg_end_state = NOMINAL; \
819 /* Skip until we get to the file vars, if any. */
823 UPDATE_BEG_END_STATE (ch
);
825 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
829 char var
[100], val
[100];
834 /* Read a variable name. */
835 while (ch
== ' ' || ch
== '\t')
839 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
841 if (i
< sizeof var
- 1)
843 UPDATE_BEG_END_STATE (ch
);
847 /* Stop scanning if no colon was found before end marker. */
848 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
851 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
857 /* Read a variable value. */
860 while (ch
== ' ' || ch
== '\t')
864 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
866 if (i
< sizeof val
- 1)
868 UPDATE_BEG_END_STATE (ch
);
872 /* The value was terminated by an end-marker, which remove. */
874 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
878 if (strcmp (var
, "lexical-binding") == 0)
881 rv
= (strcmp (val
, "nil") != 0);
887 while (ch
!= '\n' && ch
!= EOF
)
894 /* Value is a version number of byte compiled code if the file
895 associated with file descriptor FD is a compiled Lisp file that's
896 safe to load. Only files compiled with Emacs are safe to load.
897 Files compiled with XEmacs can lead to a crash in Fbyte_code
898 because of an incompatible change in the byte compiler. */
901 safe_to_load_version (int fd
)
907 /* Read the first few bytes from the file, and look for a line
908 specifying the byte compiler version used. */
909 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
912 /* Skip to the next newline, skipping over the initial `ELC'
913 with NUL bytes following it, but note the version. */
914 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
919 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
920 buf
+ i
, nbytes
- i
) < 0)
924 lseek (fd
, 0, SEEK_SET
);
929 /* Callback for record_unwind_protect. Restore the old load list OLD,
930 after loading a file successfully. */
933 record_load_unwind (Lisp_Object old
)
935 Vloads_in_progress
= old
;
938 /* This handler function is used via internal_condition_case_1. */
941 load_error_handler (Lisp_Object data
)
947 load_warn_old_style_backquotes (Lisp_Object file
)
949 if (!NILP (Vold_style_backquotes
))
951 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
952 CALLN (Fmessage
, format
, file
);
956 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
957 doc
: /* Return the suffixes that `load' should try if a suffix is \
959 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
962 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
963 while (CONSP (suffixes
))
965 Lisp_Object exts
= Vload_file_rep_suffixes
;
966 suffix
= XCAR (suffixes
);
967 suffixes
= XCDR (suffixes
);
972 lst
= Fcons (concat2 (suffix
, ext
), lst
);
975 return Fnreverse (lst
);
978 /* Returns true if STRING ends with SUFFIX */
980 suffix_p (Lisp_Object string
, const char *suffix
)
982 ptrdiff_t suffix_len
= strlen (suffix
);
983 ptrdiff_t string_len
= SBYTES (string
);
985 return string_len
>= suffix_len
&& !strcmp (SSDATA (string
) + string_len
- suffix_len
, suffix
);
988 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
989 doc
: /* Execute a file of Lisp code named FILE.
990 First try FILE with `.elc' appended, then try with `.el',
991 then try FILE unmodified (the exact suffixes in the exact order are
992 determined by `load-suffixes'). Environment variable references in
993 FILE are replaced with their values by calling `substitute-in-file-name'.
994 This function searches the directories in `load-path'.
996 If optional second arg NOERROR is non-nil,
997 report no error if FILE doesn't exist.
998 Print messages at start and end of loading unless
999 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1001 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1002 suffixes `.elc' or `.el' to the specified name FILE.
1003 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1004 the suffix `.elc' or `.el'; don't accept just FILE unless
1005 it ends in one of those suffixes or includes a directory name.
1007 If NOSUFFIX is nil, then if a file could not be found, try looking for
1008 a different representation of the file by adding non-empty suffixes to
1009 its name, before trying another file. Emacs uses this feature to find
1010 compressed versions of files when Auto Compression mode is enabled.
1011 If NOSUFFIX is non-nil, disable this feature.
1013 The suffixes that this function tries out, when NOSUFFIX is nil, are
1014 given by the return value of `get-load-suffixes' and the values listed
1015 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1016 return value of `get-load-suffixes' is used, i.e. the file name is
1017 required to have a non-empty suffix.
1019 When searching suffixes, this function normally stops at the first
1020 one that exists. If the option `load-prefer-newer' is non-nil,
1021 however, it tries all suffixes, and uses whichever file is the newest.
1023 Loading a file records its definitions, and its `provide' and
1024 `require' calls, in an element of `load-history' whose
1025 car is the file name loaded. See `load-history'.
1027 While the file is in the process of being loaded, the variable
1028 `load-in-progress' is non-nil and the variable `load-file-name'
1029 is bound to the file's name.
1031 Return t if the file exists and loads successfully. */)
1032 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1033 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1038 ptrdiff_t count
= SPECPDL_INDEX ();
1039 Lisp_Object found
, efound
, hist_file_name
;
1040 /* True means we printed the ".el is newer" message. */
1042 /* True means we are loading a compiled file. */
1044 Lisp_Object handler
;
1046 const char *fmode
= "r" FOPEN_TEXT
;
1049 CHECK_STRING (file
);
1051 /* If file name is magic, call the handler. */
1052 /* This shouldn't be necessary any more now that `openp' handles it right.
1053 handler = Ffind_file_name_handler (file, Qload);
1054 if (!NILP (handler))
1055 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1057 /* The presence of this call is the result of a historical accident:
1058 it used to be in every file-operation and when it got removed
1059 everywhere, it accidentally stayed here. Since then, enough people
1060 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1061 that it seemed risky to remove. */
1062 if (! NILP (noerror
))
1064 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1065 Qt
, load_error_handler
);
1070 file
= Fsubstitute_in_file_name (file
);
1072 /* Avoid weird lossage with null string as arg,
1073 since it would try to load a directory as a Lisp file. */
1074 if (SCHARS (file
) == 0)
1081 Lisp_Object suffixes
;
1084 if (! NILP (must_suffix
))
1086 /* Don't insist on adding a suffix if FILE already ends with one. */
1087 if (suffix_p (file
, ".el") || suffix_p (file
, ".elc"))
1089 /* Don't insist on adding a suffix
1090 if the argument includes a directory name. */
1091 else if (! NILP (Ffile_name_directory (file
)))
1095 if (!NILP (nosuffix
))
1099 suffixes
= Fget_load_suffixes ();
1100 if (NILP (must_suffix
))
1101 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1104 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1110 report_file_error ("Cannot open load file", file
);
1114 /* Tell startup.el whether or not we found the user's init file. */
1115 if (EQ (Qt
, Vuser_init_file
))
1116 Vuser_init_file
= found
;
1118 /* If FD is -2, that means openp found a magic file. */
1121 if (NILP (Fequal (found
, file
)))
1122 /* If FOUND is a different file name from FILE,
1123 find its handler even if we have already inhibited
1124 the `load' operation on FILE. */
1125 handler
= Ffind_file_name_handler (found
, Qt
);
1127 handler
= Ffind_file_name_handler (found
, Qload
);
1128 if (! NILP (handler
))
1129 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1131 /* Tramp has to deal with semi-broken packages that prepend
1132 drive letters to remote files. For that reason, Tramp
1133 catches file operations that test for file existence, which
1134 makes openp think X:/foo.elc files are remote. However,
1135 Tramp does not catch `load' operations for such files, so we
1136 end up with a nil as the `load' handler above. If we would
1137 continue with fd = -2, we will behave wrongly, and in
1138 particular try reading a .elc file in the "rt" mode instead
1139 of "rb". See bug #9311 for the results. To work around
1140 this, we try to open the file locally, and go with that if it
1142 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1150 /* Pacify older GCC with --enable-gcc-warnings. */
1151 IF_LINT (fd_index
= 0);
1155 fd_index
= SPECPDL_INDEX ();
1156 record_unwind_protect_int (close_file_unwind
, fd
);
1160 if (suffix_p (found
, MODULES_SUFFIX
))
1162 return Fmodule_load (found
);
1166 /* Check if we're stuck in a recursive load cycle.
1168 2000-09-21: It's not possible to just check for the file loaded
1169 being a member of Vloads_in_progress. This fails because of the
1170 way the byte compiler currently works; `provide's are not
1171 evaluated, see font-lock.el/jit-lock.el as an example. This
1172 leads to a certain amount of ``normal'' recursion.
1174 Also, just loading a file recursively is not always an error in
1175 the general case; the second load may do something different. */
1179 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1180 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1181 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1182 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1183 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1186 /* All loads are by default dynamic, unless the file itself specifies
1187 otherwise using a file-variable in the first line. This is bound here
1188 so that it takes effect whether or not we use
1189 Vload_source_file_function. */
1190 specbind (Qlexical_binding
, Qnil
);
1192 /* Get the name for load-history. */
1193 hist_file_name
= (! NILP (Vpurify_flag
)
1194 ? concat2 (Ffile_name_directory (file
),
1195 Ffile_name_nondirectory (found
))
1200 /* Check for the presence of old-style quotes and warn about them. */
1201 specbind (Qold_style_backquotes
, Qnil
);
1202 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1204 if (suffix_p (found
, ".elc") || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1205 /* Load .elc files directly, but not when they are
1206 remote and have no handler! */
1214 && ! (version
= safe_to_load_version (fd
)))
1217 if (!load_dangerous_libraries
)
1218 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1219 else if (!NILP (nomessage
) && !force_load_messages
)
1220 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1225 efound
= ENCODE_FILE (found
);
1226 fmode
= "r" FOPEN_BINARY
;
1228 /* openp already checked for newness, no point doing it again.
1229 FIXME would be nice to get a message when openp
1230 ignores suffix order due to load_prefer_newer. */
1231 if (!load_prefer_newer
)
1233 result
= stat (SSDATA (efound
), &s1
);
1236 SSET (efound
, SBYTES (efound
) - 1, 0);
1237 result
= stat (SSDATA (efound
), &s2
);
1238 SSET (efound
, SBYTES (efound
) - 1, 'c');
1242 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1244 /* Make the progress messages mention that source is newer. */
1247 /* If we won't print another message, mention this anyway. */
1248 if (!NILP (nomessage
) && !force_load_messages
)
1250 Lisp_Object msg_file
;
1251 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1252 message_with_string ("Source file `%s' newer than byte-compiled file",
1256 } /* !load_prefer_newer */
1261 /* We are loading a source file (*.el). */
1262 if (!NILP (Vload_source_file_function
))
1269 clear_unwind_protect (fd_index
);
1271 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1272 NILP (noerror
) ? Qnil
: Qt
,
1273 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1274 return unbind_to (count
, val
);
1280 /* We somehow got here with fd == -2, meaning the file is deemed
1281 to be remote. Don't even try to reopen the file locally;
1282 just force a failure. */
1290 clear_unwind_protect (fd_index
);
1291 efound
= ENCODE_FILE (found
);
1292 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1294 stream
= fdopen (fd
, fmode
);
1298 report_file_error ("Opening stdio stream", file
);
1299 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1301 if (! NILP (Vpurify_flag
))
1302 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1304 if (NILP (nomessage
) || force_load_messages
)
1307 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1310 message_with_string ("Loading %s (source)...", file
, 1);
1312 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1314 else /* The typical case; compiled file newer than source file. */
1315 message_with_string ("Loading %s...", file
, 1);
1318 specbind (Qload_file_name
, found
);
1319 specbind (Qinhibit_file_name_operation
, Qnil
);
1320 specbind (Qload_in_progress
, Qt
);
1323 if (lisp_file_lexically_bound_p (Qget_file_char
))
1324 Fset (Qlexical_binding
, Qt
);
1326 if (! version
|| version
>= 22)
1327 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1328 0, Qnil
, Qnil
, Qnil
, Qnil
);
1331 /* We can't handle a file which was compiled with
1332 byte-compile-dynamic by older version of Emacs. */
1333 specbind (Qload_force_doc_strings
, Qt
);
1334 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1335 0, Qnil
, Qnil
, Qnil
, Qnil
);
1337 unbind_to (count
, Qnil
);
1339 /* Run any eval-after-load forms for this file. */
1340 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1341 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1343 xfree (saved_doc_string
);
1344 saved_doc_string
= 0;
1345 saved_doc_string_size
= 0;
1347 xfree (prev_saved_doc_string
);
1348 prev_saved_doc_string
= 0;
1349 prev_saved_doc_string_size
= 0;
1351 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1354 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1357 message_with_string ("Loading %s (source)...done", file
, 1);
1359 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1361 else /* The typical case; compiled file newer than source file. */
1362 message_with_string ("Loading %s...done", file
, 1);
1369 complete_filename_p (Lisp_Object pathname
)
1371 const unsigned char *s
= SDATA (pathname
);
1372 return (IS_DIRECTORY_SEP (s
[0])
1373 || (SCHARS (pathname
) > 2
1374 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1377 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1378 doc
: /* Search for FILENAME through PATH.
1379 Returns the file's name in absolute form, or nil if not found.
1380 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1381 file name when searching.
1382 If non-nil, PREDICATE is used instead of `file-readable-p'.
1383 PREDICATE can also be an integer to pass to the faccessat(2) function,
1384 in which case file-name-handlers are ignored.
1385 This function will normally skip directories, so if you want it to find
1386 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1387 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1390 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1391 if (NILP (predicate
) && fd
>= 0)
1396 /* Search for a file whose name is STR, looking in directories
1397 in the Lisp list PATH, and trying suffixes from SUFFIX.
1398 On success, return a file descriptor (or 1 or -2 as described below).
1399 On failure, return -1 and set errno.
1401 SUFFIXES is a list of strings containing possible suffixes.
1402 The empty suffix is automatically added if the list is empty.
1404 PREDICATE t means the files are binary.
1405 PREDICATE non-nil and non-t means don't open the files,
1406 just look for one that satisfies the predicate. In this case,
1407 return 1 on success. The predicate can be a lisp function or
1408 an integer to pass to `access' (in which case file-name-handlers
1411 If STOREPTR is nonzero, it points to a slot where the name of
1412 the file actually found should be stored as a Lisp string.
1413 nil is stored there on failure.
1415 If the file we find is remote, return -2
1416 but store the found remote file name in *STOREPTR.
1418 If NEWER is true, try all SUFFIXes and return the result for the
1419 newest file that exists. Does not apply to remote files,
1420 or if a non-nil and non-t PREDICATE is specified. */
1423 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1424 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1426 ptrdiff_t fn_size
= 100;
1430 ptrdiff_t want_length
;
1431 Lisp_Object filename
;
1432 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1433 ptrdiff_t max_suffix_len
= 0;
1434 int last_errno
= ENOENT
;
1438 /* The last-modified time of the newest matching file found.
1439 Initialize it to something less than all valid timestamps. */
1440 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1444 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1446 CHECK_STRING_CAR (tail
);
1447 max_suffix_len
= max (max_suffix_len
,
1448 SBYTES (XCAR (tail
)));
1451 string
= filename
= encoded_fn
= save_string
= Qnil
;
1456 absolute
= complete_filename_p (str
);
1458 for (; CONSP (path
); path
= XCDR (path
))
1460 filename
= Fexpand_file_name (str
, XCAR (path
));
1461 if (!complete_filename_p (filename
))
1462 /* If there are non-absolute elts in PATH (eg "."). */
1463 /* Of course, this could conceivably lose if luser sets
1464 default-directory to be something non-absolute... */
1466 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1467 if (!complete_filename_p (filename
))
1468 /* Give up on this path element! */
1472 /* Calculate maximum length of any filename made from
1473 this path element/specified file name and any possible suffix. */
1474 want_length
= max_suffix_len
+ SBYTES (filename
);
1475 if (fn_size
<= want_length
)
1477 fn_size
= 100 + want_length
;
1478 fn
= SAFE_ALLOCA (fn_size
);
1481 /* Loop over suffixes. */
1482 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1483 CONSP (tail
); tail
= XCDR (tail
))
1485 Lisp_Object suffix
= XCAR (tail
);
1486 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1487 Lisp_Object handler
;
1489 /* Concatenate path element/specified name with the suffix.
1490 If the directory starts with /:, remove that. */
1491 int prefixlen
= ((SCHARS (filename
) > 2
1492 && SREF (filename
, 0) == '/'
1493 && SREF (filename
, 1) == ':')
1495 fnlen
= SBYTES (filename
) - prefixlen
;
1496 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1497 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1499 /* Check that the file exists and is not a directory. */
1500 /* We used to only check for handlers on non-absolute file names:
1504 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1505 It's not clear why that was the case and it breaks things like
1506 (load "/bar.el") where the file is actually "/bar.el.gz". */
1507 /* make_string has its own ideas on when to return a unibyte
1508 string and when a multibyte string, but we know better.
1509 We must have a unibyte string when dumping, since
1510 file-name encoding is shaky at best at that time, and in
1511 particular default-file-name-coding-system is reset
1512 several times during loadup. We therefore don't want to
1513 encode the file before passing it to file I/O library
1515 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1516 string
= make_unibyte_string (fn
, fnlen
);
1518 string
= make_string (fn
, fnlen
);
1519 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1520 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1521 && !NATNUMP (predicate
))
1524 if (NILP (predicate
) || EQ (predicate
, Qt
))
1525 exists
= !NILP (Ffile_readable_p (string
));
1528 Lisp_Object tmp
= call1 (predicate
, string
);
1531 else if (EQ (tmp
, Qdir_ok
)
1532 || NILP (Ffile_directory_p (string
)))
1537 last_errno
= EISDIR
;
1543 /* We succeeded; return this descriptor and filename. */
1556 encoded_fn
= ENCODE_FILE (string
);
1557 pfn
= SSDATA (encoded_fn
);
1559 /* Check that we can access or open it. */
1560 if (NATNUMP (predicate
))
1563 if (INT_MAX
< XFASTINT (predicate
))
1564 last_errno
= EINVAL
;
1565 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1569 if (file_directory_p (pfn
))
1570 last_errno
= EISDIR
;
1577 int oflags
= O_RDONLY
+ (NILP (predicate
) ? 0 : O_BINARY
);
1578 fd
= emacs_open (pfn
, oflags
, 0);
1581 if (errno
!= ENOENT
)
1586 int err
= (fstat (fd
, &st
) != 0 ? errno
1587 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1599 if (newer
&& !NATNUMP (predicate
))
1601 struct timespec mtime
= get_stat_mtime (&st
);
1603 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1608 emacs_close (save_fd
);
1611 save_string
= string
;
1616 /* We succeeded; return this descriptor and filename. */
1624 /* No more suffixes. Return the newest. */
1625 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1628 *storeptr
= save_string
;
1644 /* Merge the list we've accumulated of globals from the current input source
1645 into the load_history variable. The details depend on whether
1646 the source has an associated file name or not.
1648 FILENAME is the file name that we are loading from.
1650 ENTIRE is true if loading that entire file, false if evaluating
1654 build_load_history (Lisp_Object filename
, bool entire
)
1656 Lisp_Object tail
, prev
, newelt
;
1657 Lisp_Object tem
, tem2
;
1660 tail
= Vload_history
;
1663 while (CONSP (tail
))
1667 /* Find the feature's previous assoc list... */
1668 if (!NILP (Fequal (filename
, Fcar (tem
))))
1672 /* If we're loading the entire file, remove old data. */
1676 Vload_history
= XCDR (tail
);
1678 Fsetcdr (prev
, XCDR (tail
));
1681 /* Otherwise, cons on new symbols that are not already members. */
1684 tem2
= Vcurrent_load_list
;
1686 while (CONSP (tem2
))
1688 newelt
= XCAR (tem2
);
1690 if (NILP (Fmember (newelt
, tem
)))
1691 Fsetcar (tail
, Fcons (XCAR (tem
),
1692 Fcons (newelt
, XCDR (tem
))));
1705 /* If we're loading an entire file, cons the new assoc onto the
1706 front of load-history, the most-recently-loaded position. Also
1707 do this if we didn't find an existing member for the file. */
1708 if (entire
|| !foundit
)
1709 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1714 readevalloop_1 (int old
)
1716 load_convert_to_unibyte
= old
;
1719 /* Signal an `end-of-file' error, if possible with file name
1722 static _Noreturn
void
1723 end_of_file_error (void)
1725 if (STRINGP (Vload_file_name
))
1726 xsignal1 (Qend_of_file
, Vload_file_name
);
1728 xsignal0 (Qend_of_file
);
1732 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1734 /* If we macroexpand the toplevel form non-recursively and it ends
1735 up being a `progn' (or if it was a progn to start), treat each
1736 form in the progn as a top-level form. This way, if one form in
1737 the progn defines a macro, that macro is in effect when we expand
1738 the remaining forms. See similar code in bytecomp.el. */
1739 val
= call2 (macroexpand
, val
, Qnil
);
1740 if (EQ (CAR_SAFE (val
), Qprogn
))
1742 Lisp_Object subforms
= XCDR (val
);
1744 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1745 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1749 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1753 /* UNIBYTE specifies how to set load_convert_to_unibyte
1754 for this invocation.
1755 READFUN, if non-nil, is used instead of `read'.
1757 START, END specify region to read in current buffer (from eval-region).
1758 If the input is not from a buffer, they must be nil. */
1761 readevalloop (Lisp_Object readcharfun
,
1763 Lisp_Object sourcename
,
1765 Lisp_Object unibyte
, Lisp_Object readfun
,
1766 Lisp_Object start
, Lisp_Object end
)
1770 ptrdiff_t count
= SPECPDL_INDEX ();
1771 struct buffer
*b
= 0;
1772 bool continue_reading_p
;
1773 Lisp_Object lex_bound
;
1774 /* True if reading an entire buffer. */
1775 bool whole_buffer
= 0;
1776 /* True on the first time around. */
1777 bool first_sexp
= 1;
1778 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1780 if (NILP (Ffboundp (macroexpand
))
1781 /* Don't macroexpand in .elc files, since it should have been done
1782 already. We actually don't know whether we're in a .elc file or not,
1783 so we use circumstantial evidence: .el files normally go through
1784 Vload_source_file_function -> load-with-code-conversion
1786 || EQ (readcharfun
, Qget_file_char
)
1787 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1790 if (MARKERP (readcharfun
))
1793 start
= readcharfun
;
1796 if (BUFFERP (readcharfun
))
1797 b
= XBUFFER (readcharfun
);
1798 else if (MARKERP (readcharfun
))
1799 b
= XMARKER (readcharfun
)->buffer
;
1801 /* We assume START is nil when input is not from a buffer. */
1802 if (! NILP (start
) && !b
)
1805 specbind (Qstandard_input
, readcharfun
);
1806 specbind (Qcurrent_load_list
, Qnil
);
1807 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1808 load_convert_to_unibyte
= !NILP (unibyte
);
1810 /* If lexical binding is active (either because it was specified in
1811 the file's header, or via a buffer-local variable), create an empty
1812 lexical environment, otherwise, turn off lexical binding. */
1813 lex_bound
= find_symbol_value (Qlexical_binding
);
1814 specbind (Qinternal_interpreter_environment
,
1815 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1816 ? Qnil
: list1 (Qt
)));
1818 /* Try to ensure sourcename is a truename, except whilst preloading. */
1819 if (NILP (Vpurify_flag
)
1820 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1821 && !NILP (Ffboundp (Qfile_truename
)))
1822 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1824 LOADHIST_ATTACH (sourcename
);
1826 continue_reading_p
= 1;
1827 while (continue_reading_p
)
1829 ptrdiff_t count1
= SPECPDL_INDEX ();
1831 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1832 error ("Reading from killed buffer");
1836 /* Switch to the buffer we are reading from. */
1837 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1838 set_buffer_internal (b
);
1840 /* Save point in it. */
1841 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1842 /* Save ZV in it. */
1843 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1844 /* Those get unbound after we read one expression. */
1846 /* Set point and ZV around stuff to be read. */
1849 Fnarrow_to_region (make_number (BEGV
), end
);
1851 /* Just for cleanliness, convert END to a marker
1852 if it is an integer. */
1854 end
= Fpoint_max_marker ();
1857 /* On the first cycle, we can easily test here
1858 whether we are reading the whole buffer. */
1859 if (b
&& first_sexp
)
1860 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1867 while ((c
= READCHAR
) != '\n' && c
!= -1);
1872 unbind_to (count1
, Qnil
);
1876 /* Ignore whitespace here, so we can detect eof. */
1877 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1878 || c
== NO_BREAK_SPACE
)
1881 if (!NILP (Vpurify_flag
) && c
== '(')
1883 val
= read_list (0, readcharfun
);
1888 read_objects
= Qnil
;
1889 if (!NILP (readfun
))
1891 val
= call1 (readfun
, readcharfun
);
1893 /* If READCHARFUN has set point to ZV, we should
1894 stop reading, even if the form read sets point
1895 to a different value when evaluated. */
1896 if (BUFFERP (readcharfun
))
1898 struct buffer
*buf
= XBUFFER (readcharfun
);
1899 if (BUF_PT (buf
) == BUF_ZV (buf
))
1900 continue_reading_p
= 0;
1903 else if (! NILP (Vload_read_function
))
1904 val
= call1 (Vload_read_function
, readcharfun
);
1906 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1909 if (!NILP (start
) && continue_reading_p
)
1910 start
= Fpoint_marker ();
1912 /* Restore saved point and BEGV. */
1913 unbind_to (count1
, Qnil
);
1915 /* Now eval what we just read. */
1916 if (!NILP (macroexpand
))
1917 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1919 val
= eval_sub (val
);
1923 Vvalues
= Fcons (val
, Vvalues
);
1924 if (EQ (Vstandard_output
, Qt
))
1933 build_load_history (sourcename
,
1934 stream
|| whole_buffer
);
1936 unbind_to (count
, Qnil
);
1939 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1940 doc
: /* Execute the current buffer as Lisp code.
1941 When called from a Lisp program (i.e., not interactively), this
1942 function accepts up to five optional arguments:
1943 BUFFER is the buffer to evaluate (nil means use current buffer).
1944 PRINTFLAG controls printing of output:
1945 A value of nil means discard it; anything else is stream for print.
1946 FILENAME specifies the file name to use for `load-history'.
1947 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1949 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1950 functions should work normally even if PRINTFLAG is nil.
1952 This function preserves the position of point. */)
1953 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1955 ptrdiff_t count
= SPECPDL_INDEX ();
1956 Lisp_Object tem
, buf
;
1959 buf
= Fcurrent_buffer ();
1961 buf
= Fget_buffer (buffer
);
1963 error ("No such buffer");
1965 if (NILP (printflag
) && NILP (do_allow_print
))
1970 if (NILP (filename
))
1971 filename
= BVAR (XBUFFER (buf
), filename
);
1973 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1974 specbind (Qstandard_output
, tem
);
1975 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1976 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1977 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1978 readevalloop (buf
, 0, filename
,
1979 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1980 unbind_to (count
, Qnil
);
1985 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1986 doc
: /* Execute the region as Lisp code.
1987 When called from programs, expects two arguments,
1988 giving starting and ending indices in the current buffer
1989 of the text to be executed.
1990 Programs can pass third argument PRINTFLAG which controls output:
1991 A value of nil means discard it; anything else is stream for printing it.
1992 Also the fourth argument READ-FUNCTION, if non-nil, is used
1993 instead of `read' to read each expression. It gets one argument
1994 which is the input stream for reading characters.
1996 This function does not move point. */)
1997 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1999 /* FIXME: Do the eval-sexp-add-defvars dance! */
2000 ptrdiff_t count
= SPECPDL_INDEX ();
2001 Lisp_Object tem
, cbuf
;
2003 cbuf
= Fcurrent_buffer ();
2005 if (NILP (printflag
))
2009 specbind (Qstandard_output
, tem
);
2010 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2012 /* `readevalloop' calls functions which check the type of start and end. */
2013 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2014 !NILP (printflag
), Qnil
, read_function
,
2017 return unbind_to (count
, Qnil
);
2021 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2022 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2023 If STREAM is nil, use the value of `standard-input' (which see).
2024 STREAM or the value of `standard-input' may be:
2025 a buffer (read from point and advance it)
2026 a marker (read from where it points and advance it)
2027 a function (call it with no arguments for each character,
2028 call it with a char as argument to push a char back)
2029 a string (takes text from string, starting at the beginning)
2030 t (read text line using minibuffer and use it, or read from
2031 standard input in batch mode). */)
2032 (Lisp_Object stream
)
2035 stream
= Vstandard_input
;
2036 if (EQ (stream
, Qt
))
2037 stream
= Qread_char
;
2038 if (EQ (stream
, Qread_char
))
2039 /* FIXME: ?! When is this used !? */
2040 return call1 (intern ("read-minibuffer"),
2041 build_string ("Lisp expression: "));
2043 return read_internal_start (stream
, Qnil
, Qnil
);
2046 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2047 doc
: /* Read one Lisp expression which is represented as text by STRING.
2048 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2049 FINAL-STRING-INDEX is an integer giving the position of the next
2050 remaining character in STRING. START and END optionally delimit
2051 a substring of STRING from which to read; they default to 0 and
2052 (length STRING) respectively. Negative values are counted from
2053 the end of STRING. */)
2054 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2057 CHECK_STRING (string
);
2058 /* `read_internal_start' sets `read_from_string_index'. */
2059 ret
= read_internal_start (string
, start
, end
);
2060 return Fcons (ret
, make_number (read_from_string_index
));
2063 /* Function to set up the global context we need in toplevel read
2064 calls. START and END only used when STREAM is a string. */
2066 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2071 new_backquote_flag
= 0;
2072 read_objects
= Qnil
;
2073 if (EQ (Vread_with_symbol_positions
, Qt
)
2074 || EQ (Vread_with_symbol_positions
, stream
))
2075 Vread_symbol_positions_list
= Qnil
;
2077 if (STRINGP (stream
)
2078 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2080 ptrdiff_t startval
, endval
;
2083 if (STRINGP (stream
))
2086 string
= XCAR (stream
);
2088 validate_subarray (string
, start
, end
, SCHARS (string
),
2089 &startval
, &endval
);
2091 read_from_string_index
= startval
;
2092 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2093 read_from_string_limit
= endval
;
2096 retval
= read0 (stream
);
2097 if (EQ (Vread_with_symbol_positions
, Qt
)
2098 || EQ (Vread_with_symbol_positions
, stream
))
2099 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2104 /* Signal Qinvalid_read_syntax error.
2105 S is error string of length N (if > 0) */
2107 static _Noreturn
void
2108 invalid_syntax (const char *s
)
2110 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2114 /* Use this for recursive reads, in contexts where internal tokens
2118 read0 (Lisp_Object readcharfun
)
2120 register Lisp_Object val
;
2123 val
= read1 (readcharfun
, &c
, 0);
2127 xsignal1 (Qinvalid_read_syntax
,
2128 Fmake_string (make_number (1), make_number (c
)));
2131 static ptrdiff_t read_buffer_size
;
2132 static char *read_buffer
;
2134 /* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes. */
2137 grow_read_buffer (void)
2139 read_buffer
= xpalloc (read_buffer
, &read_buffer_size
,
2140 MAX_MULTIBYTE_LENGTH
, -1, 1);
2143 /* Read a \-escape sequence, assuming we already read the `\'.
2144 If the escape sequence forces unibyte, return eight-bit char. */
2147 read_escape (Lisp_Object readcharfun
, bool stringp
)
2150 /* \u allows up to four hex digits, \U up to eight. Default to the
2151 behavior for \u, and change this value in the case that \U is seen. */
2152 int unicode_hex_count
= 4;
2157 end_of_file_error ();
2187 error ("Invalid escape character syntax");
2190 c
= read_escape (readcharfun
, 0);
2191 return c
| meta_modifier
;
2196 error ("Invalid escape character syntax");
2199 c
= read_escape (readcharfun
, 0);
2200 return c
| shift_modifier
;
2205 error ("Invalid escape character syntax");
2208 c
= read_escape (readcharfun
, 0);
2209 return c
| hyper_modifier
;
2214 error ("Invalid escape character syntax");
2217 c
= read_escape (readcharfun
, 0);
2218 return c
| alt_modifier
;
2222 if (stringp
|| c
!= '-')
2229 c
= read_escape (readcharfun
, 0);
2230 return c
| super_modifier
;
2235 error ("Invalid escape character syntax");
2239 c
= read_escape (readcharfun
, 0);
2240 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2241 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2242 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2243 return c
| ctrl_modifier
;
2244 /* ASCII control chars are made from letters (both cases),
2245 as well as the non-letters within 0100...0137. */
2246 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2247 return (c
& (037 | ~0177));
2248 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2249 return (c
& (037 | ~0177));
2251 return c
| ctrl_modifier
;
2261 /* An octal escape, as in ANSI C. */
2263 register int i
= c
- '0';
2264 register int count
= 0;
2267 if ((c
= READCHAR
) >= '0' && c
<= '7')
2279 if (i
>= 0x80 && i
< 0x100)
2280 i
= BYTE8_TO_CHAR (i
);
2285 /* A hex escape, as in ANSI C. */
2292 if (c
>= '0' && c
<= '9')
2297 else if ((c
>= 'a' && c
<= 'f')
2298 || (c
>= 'A' && c
<= 'F'))
2301 if (c
>= 'a' && c
<= 'f')
2311 /* Allow hex escapes as large as ?\xfffffff, because some
2312 packages use them to denote characters with modifiers. */
2313 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2314 error ("Hex character out of range: \\x%x...", i
);
2318 if (count
< 3 && i
>= 0x80)
2319 return BYTE8_TO_CHAR (i
);
2324 /* Post-Unicode-2.0: Up to eight hex chars. */
2325 unicode_hex_count
= 8;
2328 /* A Unicode escape. We only permit them in strings and characters,
2329 not arbitrarily in the source code, as in some other languages. */
2334 while (++count
<= unicode_hex_count
)
2337 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2339 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2340 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2341 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2343 error ("Non-hex digit used for Unicode escape");
2346 error ("Non-Unicode character: 0x%x", i
);
2355 /* Return the digit that CHARACTER stands for in the given BASE.
2356 Return -1 if CHARACTER is out of range for BASE,
2357 and -2 if CHARACTER is not valid for any supported BASE. */
2359 digit_to_number (int character
, int base
)
2363 if ('0' <= character
&& character
<= '9')
2364 digit
= character
- '0';
2365 else if ('a' <= character
&& character
<= 'z')
2366 digit
= character
- 'a' + 10;
2367 else if ('A' <= character
&& character
<= 'Z')
2368 digit
= character
- 'A' + 10;
2372 return digit
< base
? digit
: -1;
2375 /* Read an integer in radix RADIX using READCHARFUN to read
2376 characters. RADIX must be in the interval [2..36]; if it isn't, a
2377 read error is signaled . Value is the integer read. Signals an
2378 error if encountering invalid read syntax or if RADIX is out of
2382 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2384 /* Room for sign, leading 0, other digits, trailing null byte.
2385 Also, room for invalid syntax diagnostic. */
2386 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2387 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2389 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2391 if (radix
< 2 || radix
> 36)
2399 if (c
== '-' || c
== '+')
2410 /* Ignore redundant leading zeros, so the buffer doesn't
2411 fill up with them. */
2417 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2424 if (p
< buf
+ sizeof buf
- 1)
2438 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2439 invalid_syntax (buf
);
2442 return string_to_number (buf
, radix
, 0);
2446 /* If the next token is ')' or ']' or '.', we store that character
2447 in *PCH and the return value is not interesting. Else, we store
2448 zero in *PCH and we read and return one lisp object.
2450 FIRST_IN_LIST is true if this is the first element of a list. */
2453 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2456 bool uninterned_symbol
= 0;
2463 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2465 end_of_file_error ();
2470 return read_list (0, readcharfun
);
2473 return read_vector (readcharfun
, 0);
2489 /* Accept extended format for hashtables (extensible to
2491 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2492 Lisp_Object tmp
= read_list (0, readcharfun
);
2493 Lisp_Object head
= CAR_SAFE (tmp
);
2494 Lisp_Object data
= Qnil
;
2495 Lisp_Object val
= Qnil
;
2496 /* The size is 2 * number of allowed keywords to
2498 Lisp_Object params
[10];
2500 Lisp_Object key
= Qnil
;
2501 int param_count
= 0;
2503 if (!EQ (head
, Qhash_table
))
2504 error ("Invalid extended read marker at head of #s list "
2505 "(only hash-table allowed)");
2507 tmp
= CDR_SAFE (tmp
);
2509 /* This is repetitive but fast and simple. */
2510 params
[param_count
] = QCsize
;
2511 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2512 if (!NILP (params
[param_count
+ 1]))
2515 params
[param_count
] = QCtest
;
2516 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2517 if (!NILP (params
[param_count
+ 1]))
2520 params
[param_count
] = QCweakness
;
2521 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2522 if (!NILP (params
[param_count
+ 1]))
2525 params
[param_count
] = QCrehash_size
;
2526 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2527 if (!NILP (params
[param_count
+ 1]))
2530 params
[param_count
] = QCrehash_threshold
;
2531 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2532 if (!NILP (params
[param_count
+ 1]))
2535 /* This is the hashtable data. */
2536 data
= Fplist_get (tmp
, Qdata
);
2538 /* Now use params to make a new hashtable and fill it. */
2539 ht
= Fmake_hash_table (param_count
, params
);
2541 while (CONSP (data
))
2546 error ("Odd number of elements in hashtable data");
2549 Fputhash (key
, val
, ht
);
2555 invalid_syntax ("#");
2563 tmp
= read_vector (readcharfun
, 0);
2564 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2565 error ("Invalid size char-table");
2566 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2574 /* Sub char-table can't be read as a regular
2575 vector because of a two C integer fields. */
2576 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2577 ptrdiff_t size
= XINT (Flength (tmp
));
2578 int i
, depth
, min_char
;
2579 struct Lisp_Cons
*cell
;
2582 error ("Zero-sized sub char-table");
2584 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2585 error ("Invalid depth in sub char-table");
2586 depth
= XINT (XCAR (tmp
));
2587 if (chartab_size
[depth
] != size
- 2)
2588 error ("Invalid size in sub char-table");
2589 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2592 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2593 error ("Invalid minimum character in sub-char-table");
2594 min_char
= XINT (XCAR (tmp
));
2595 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2598 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2599 for (i
= 0; i
< size
; i
++)
2601 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2602 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2607 invalid_syntax ("#^^");
2609 invalid_syntax ("#^");
2614 length
= read1 (readcharfun
, pch
, first_in_list
);
2618 Lisp_Object tmp
, val
;
2619 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2620 unsigned char *data
;
2623 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2624 if (STRING_MULTIBYTE (tmp
)
2625 || (size_in_chars
!= SCHARS (tmp
)
2626 /* We used to print 1 char too many
2627 when the number of bits was a multiple of 8.
2628 Accept such input in case it came from an old
2630 && ! (XFASTINT (length
)
2631 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2632 invalid_syntax ("#&...");
2634 val
= make_uninit_bool_vector (XFASTINT (length
));
2635 data
= bool_vector_uchar_data (val
);
2636 memcpy (data
, SDATA (tmp
), size_in_chars
);
2637 /* Clear the extraneous bits in the last byte. */
2638 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2639 data
[size_in_chars
- 1]
2640 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2643 invalid_syntax ("#&...");
2647 /* Accept compiled functions at read-time so that we don't have to
2648 build them using function calls. */
2650 struct Lisp_Vector
*vec
;
2651 tmp
= read_vector (readcharfun
, 1);
2652 vec
= XVECTOR (tmp
);
2653 if (vec
->header
.size
== 0)
2654 invalid_syntax ("Empty byte-code object");
2655 make_byte_code (vec
);
2663 /* Read the string itself. */
2664 tmp
= read1 (readcharfun
, &ch
, 0);
2665 if (ch
!= 0 || !STRINGP (tmp
))
2666 invalid_syntax ("#");
2667 /* Read the intervals and their properties. */
2670 Lisp_Object beg
, end
, plist
;
2672 beg
= read1 (readcharfun
, &ch
, 0);
2677 end
= read1 (readcharfun
, &ch
, 0);
2679 plist
= read1 (readcharfun
, &ch
, 0);
2681 invalid_syntax ("Invalid string property list");
2682 Fset_text_properties (beg
, end
, plist
, tmp
);
2688 /* #@NUMBER is used to skip NUMBER following bytes.
2689 That's used in .elc files to skip over doc strings
2690 and function definitions. */
2693 enum { extra
= 100 };
2694 ptrdiff_t i
, nskip
= 0, digits
= 0;
2696 /* Read a decimal integer. */
2697 while ((c
= READCHAR
) >= 0
2698 && c
>= '0' && c
<= '9')
2700 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2705 if (digits
== 2 && nskip
== 0)
2706 { /* We've just seen #@00, which means "skip to end". */
2707 skip_dyn_eof (readcharfun
);
2712 /* We can't use UNREAD here, because in the code below we side-step
2713 READCHAR. Instead, assume the first char after #@NNN occupies
2714 a single byte, which is the case normally since it's just
2720 if (load_force_doc_strings
2721 && (FROM_FILE_P (readcharfun
)))
2723 /* If we are supposed to force doc strings into core right now,
2724 record the last string that we skipped,
2725 and record where in the file it comes from. */
2727 /* But first exchange saved_doc_string
2728 with prev_saved_doc_string, so we save two strings. */
2730 char *temp
= saved_doc_string
;
2731 ptrdiff_t temp_size
= saved_doc_string_size
;
2732 file_offset temp_pos
= saved_doc_string_position
;
2733 ptrdiff_t temp_len
= saved_doc_string_length
;
2735 saved_doc_string
= prev_saved_doc_string
;
2736 saved_doc_string_size
= prev_saved_doc_string_size
;
2737 saved_doc_string_position
= prev_saved_doc_string_position
;
2738 saved_doc_string_length
= prev_saved_doc_string_length
;
2740 prev_saved_doc_string
= temp
;
2741 prev_saved_doc_string_size
= temp_size
;
2742 prev_saved_doc_string_position
= temp_pos
;
2743 prev_saved_doc_string_length
= temp_len
;
2746 if (saved_doc_string_size
== 0)
2748 saved_doc_string
= xmalloc (nskip
+ extra
);
2749 saved_doc_string_size
= nskip
+ extra
;
2751 if (nskip
> saved_doc_string_size
)
2753 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2754 saved_doc_string_size
= nskip
+ extra
;
2757 saved_doc_string_position
= file_tell (instream
);
2759 /* Copy that many characters into saved_doc_string. */
2761 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2762 saved_doc_string
[i
] = c
= getc (instream
);
2765 saved_doc_string_length
= i
;
2768 /* Skip that many bytes. */
2769 skip_dyn_bytes (readcharfun
, nskip
);
2775 /* #! appears at the beginning of an executable file.
2776 Skip the first line. */
2777 while (c
!= '\n' && c
>= 0)
2782 return Vload_file_name
;
2784 return list2 (Qfunction
, read0 (readcharfun
));
2785 /* #:foo is the uninterned symbol named foo. */
2788 uninterned_symbol
= 1;
2791 && c
!= NO_BREAK_SPACE
2793 || strchr ("\"';()[]#`,", c
) == NULL
)))
2795 /* No symbol character follows, this is the empty
2798 return Fmake_symbol (empty_unibyte_string
);
2802 /* ## is the empty symbol. */
2804 return Fintern (empty_unibyte_string
, Qnil
);
2805 /* Reader forms that can reuse previously read objects. */
2806 if (c
>= '0' && c
<= '9')
2811 /* Read a non-negative integer. */
2812 while (c
>= '0' && c
<= '9')
2814 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2815 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2816 n
= MOST_POSITIVE_FIXNUM
+ 1;
2818 n
= n
* 10 + c
- '0';
2822 if (n
<= MOST_POSITIVE_FIXNUM
)
2824 if (c
== 'r' || c
== 'R')
2825 return read_integer (readcharfun
, n
);
2827 if (! NILP (Vread_circle
))
2829 /* #n=object returns object, but associates it with
2833 /* Make a placeholder for #n# to use temporarily. */
2834 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2835 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2836 read_objects
= Fcons (cell
, read_objects
);
2838 /* Read the object itself. */
2839 tem
= read0 (readcharfun
);
2841 /* Now put it everywhere the placeholder was... */
2842 substitute_object_in_subtree (tem
, placeholder
);
2844 /* ...and #n# will use the real value from now on. */
2845 Fsetcdr (cell
, tem
);
2850 /* #n# returns a previously read object. */
2853 tem
= Fassq (make_number (n
), read_objects
);
2859 /* Fall through to error message. */
2861 else if (c
== 'x' || c
== 'X')
2862 return read_integer (readcharfun
, 16);
2863 else if (c
== 'o' || c
== 'O')
2864 return read_integer (readcharfun
, 8);
2865 else if (c
== 'b' || c
== 'B')
2866 return read_integer (readcharfun
, 2);
2869 invalid_syntax ("#");
2872 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2876 return list2 (Qquote
, read0 (readcharfun
));
2880 int next_char
= READCHAR
;
2882 /* Transition from old-style to new-style:
2883 If we see "(`" it used to mean old-style, which usually works
2884 fine because ` should almost never appear in such a position
2885 for new-style. But occasionally we need "(`" to mean new
2886 style, so we try to distinguish the two by the fact that we
2887 can either write "( `foo" or "(` foo", where the first
2888 intends to use new-style whereas the second intends to use
2889 old-style. For Emacs-25, we should completely remove this
2890 first_in_list exception (old-style can still be obtained via
2892 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2894 Vold_style_backquotes
= Qt
;
2900 bool saved_new_backquote_flag
= new_backquote_flag
;
2902 new_backquote_flag
= 1;
2903 value
= read0 (readcharfun
);
2904 new_backquote_flag
= saved_new_backquote_flag
;
2906 return list2 (Qbackquote
, value
);
2911 int next_char
= READCHAR
;
2913 /* Transition from old-style to new-style:
2914 It used to be impossible to have a new-style , other than within
2915 a new-style `. This is sufficient when ` and , are used in the
2916 normal way, but ` and , can also appear in args to macros that
2917 will not interpret them in the usual way, in which case , may be
2918 used without any ` anywhere near.
2919 So we now use the same heuristic as for backquote: old-style
2920 unquotes are only recognized when first on a list, and when
2921 followed by a space.
2922 Because it's more difficult to peek 2 chars ahead, a new-style
2923 ,@ can still not be used outside of a `, unless it's in the middle
2925 if (new_backquote_flag
2927 || (next_char
!= ' ' && next_char
!= '@'))
2929 Lisp_Object comma_type
= Qnil
;
2934 comma_type
= Qcomma_at
;
2936 comma_type
= Qcomma_dot
;
2939 if (ch
>= 0) UNREAD (ch
);
2940 comma_type
= Qcomma
;
2943 value
= read0 (readcharfun
);
2944 return list2 (comma_type
, value
);
2948 Vold_style_backquotes
= Qt
;
2960 end_of_file_error ();
2962 /* Accept `single space' syntax like (list ? x) where the
2963 whitespace character is SPC or TAB.
2964 Other literal whitespace like NL, CR, and FF are not accepted,
2965 as there are well-established escape sequences for these. */
2966 if (c
== ' ' || c
== '\t')
2967 return make_number (c
);
2970 c
= read_escape (readcharfun
, 0);
2971 modifiers
= c
& CHAR_MODIFIER_MASK
;
2972 c
&= ~CHAR_MODIFIER_MASK
;
2973 if (CHAR_BYTE8_P (c
))
2974 c
= CHAR_TO_BYTE8 (c
);
2977 next_char
= READCHAR
;
2978 ok
= (next_char
<= 040
2979 || (next_char
< 0200
2980 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2983 return make_number (c
);
2985 invalid_syntax ("?");
2990 char *p
= read_buffer
;
2991 char *end
= read_buffer
+ read_buffer_size
;
2993 /* True if we saw an escape sequence specifying
2994 a multibyte character. */
2995 bool force_multibyte
= 0;
2996 /* True if we saw an escape sequence specifying
2997 a single-byte character. */
2998 bool force_singlebyte
= 0;
3000 ptrdiff_t nchars
= 0;
3002 while ((ch
= READCHAR
) >= 0
3005 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3007 ptrdiff_t offset
= p
- read_buffer
;
3008 grow_read_buffer ();
3009 p
= read_buffer
+ offset
;
3010 end
= read_buffer
+ read_buffer_size
;
3017 ch
= read_escape (readcharfun
, 1);
3019 /* CH is -1 if \ newline or \ space has just been seen. */
3022 if (p
== read_buffer
)
3027 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3028 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3030 if (CHAR_BYTE8_P (ch
))
3031 force_singlebyte
= 1;
3032 else if (! ASCII_CHAR_P (ch
))
3033 force_multibyte
= 1;
3034 else /* I.e. ASCII_CHAR_P (ch). */
3036 /* Allow `\C- ' and `\C-?'. */
3037 if (modifiers
== CHAR_CTL
)
3040 ch
= 0, modifiers
= 0;
3042 ch
= 127, modifiers
= 0;
3044 if (modifiers
& CHAR_SHIFT
)
3046 /* Shift modifier is valid only with [A-Za-z]. */
3047 if (ch
>= 'A' && ch
<= 'Z')
3048 modifiers
&= ~CHAR_SHIFT
;
3049 else if (ch
>= 'a' && ch
<= 'z')
3050 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3053 if (modifiers
& CHAR_META
)
3055 /* Move the meta bit to the right place for a
3057 modifiers
&= ~CHAR_META
;
3058 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3059 force_singlebyte
= 1;
3063 /* Any modifiers remaining are invalid. */
3065 error ("Invalid modifier in string");
3066 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3070 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3071 if (CHAR_BYTE8_P (ch
))
3072 force_singlebyte
= 1;
3073 else if (! ASCII_CHAR_P (ch
))
3074 force_multibyte
= 1;
3080 end_of_file_error ();
3082 /* If purifying, and string starts with \ newline,
3083 return zero instead. This is for doc strings
3084 that we are really going to find in etc/DOC.nn.nn. */
3085 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3086 return make_number (0);
3088 if (! force_multibyte
&& force_singlebyte
)
3090 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3091 forms. Convert it to unibyte. */
3092 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3094 p
= read_buffer
+ nchars
;
3097 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3099 || (p
- read_buffer
!= nchars
)));
3104 int next_char
= READCHAR
;
3107 if (next_char
<= 040
3108 || (next_char
< 0200
3109 && strchr ("\"';([#?`,", next_char
) != NULL
))
3115 /* Otherwise, we fall through! Note that the atom-reading loop
3116 below will now loop at least once, assuring that we will not
3117 try to UNREAD two characters in a row. */
3121 if (c
<= 040) goto retry
;
3122 if (c
== NO_BREAK_SPACE
)
3127 char *p
= read_buffer
;
3129 EMACS_INT start_position
= readchar_count
- 1;
3132 char *end
= read_buffer
+ read_buffer_size
;
3136 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3138 ptrdiff_t offset
= p
- read_buffer
;
3139 grow_read_buffer ();
3140 p
= read_buffer
+ offset
;
3141 end
= read_buffer
+ read_buffer_size
;
3148 end_of_file_error ();
3153 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3159 && c
!= NO_BREAK_SPACE
3161 || strchr ("\"';()[]#`,", c
) == NULL
));
3165 ptrdiff_t offset
= p
- read_buffer
;
3166 grow_read_buffer ();
3167 p
= read_buffer
+ offset
;
3168 end
= read_buffer
+ read_buffer_size
;
3174 if (!quoted
&& !uninterned_symbol
)
3176 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3177 if (! NILP (result
))
3181 Lisp_Object name
, result
;
3182 ptrdiff_t nbytes
= p
- read_buffer
;
3185 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3189 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3190 ? make_pure_string
: make_specified_string
)
3191 (read_buffer
, nchars
, nbytes
, multibyte
));
3192 result
= (uninterned_symbol
? Fmake_symbol (name
)
3193 : Fintern (name
, Qnil
));
3195 if (EQ (Vread_with_symbol_positions
, Qt
)
3196 || EQ (Vread_with_symbol_positions
, readcharfun
))
3197 Vread_symbol_positions_list
3198 = Fcons (Fcons (result
, make_number (start_position
)),
3199 Vread_symbol_positions_list
);
3207 /* List of nodes we've seen during substitute_object_in_subtree. */
3208 static Lisp_Object seen_list
;
3211 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3213 Lisp_Object check_object
;
3215 /* We haven't seen any objects when we start. */
3218 /* Make all the substitutions. */
3220 = substitute_object_recurse (object
, placeholder
, object
);
3222 /* Clear seen_list because we're done with it. */
3225 /* The returned object here is expected to always eq the
3227 if (!EQ (check_object
, object
))
3228 error ("Unexpected mutation error in reader");
3231 /* Feval doesn't get called from here, so no gc protection is needed. */
3232 #define SUBSTITUTE(get_val, set_val) \
3234 Lisp_Object old_value = get_val; \
3235 Lisp_Object true_value \
3236 = substitute_object_recurse (object, placeholder, \
3239 if (!EQ (old_value, true_value)) \
3246 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3248 /* If we find the placeholder, return the target object. */
3249 if (EQ (placeholder
, subtree
))
3252 /* If we've been to this node before, don't explore it again. */
3253 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3256 /* If this node can be the entry point to a cycle, remember that
3257 we've seen it. It can only be such an entry point if it was made
3258 by #n=, which means that we can find it as a value in
3260 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3261 seen_list
= Fcons (subtree
, seen_list
);
3263 /* Recurse according to subtree's type.
3264 Every branch must return a Lisp_Object. */
3265 switch (XTYPE (subtree
))
3267 case Lisp_Vectorlike
:
3269 ptrdiff_t i
= 0, length
= 0;
3270 if (BOOL_VECTOR_P (subtree
))
3271 return subtree
; /* No sub-objects anyway. */
3272 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3273 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3274 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3275 else if (VECTORP (subtree
))
3276 length
= ASIZE (subtree
);
3278 /* An unknown pseudovector may contain non-Lisp fields, so we
3279 can't just blindly traverse all its fields. We used to call
3280 `Flength' which signaled `sequencep', so I just preserved this
3282 wrong_type_argument (Qsequencep
, subtree
);
3284 if (SUB_CHAR_TABLE_P (subtree
))
3286 for ( ; i
< length
; i
++)
3287 SUBSTITUTE (AREF (subtree
, i
),
3288 ASET (subtree
, i
, true_value
));
3294 SUBSTITUTE (XCAR (subtree
),
3295 XSETCAR (subtree
, true_value
));
3296 SUBSTITUTE (XCDR (subtree
),
3297 XSETCDR (subtree
, true_value
));
3303 /* Check for text properties in each interval.
3304 substitute_in_interval contains part of the logic. */
3306 INTERVAL root_interval
= string_intervals (subtree
);
3307 AUTO_CONS (arg
, object
, placeholder
);
3309 traverse_intervals_noorder (root_interval
,
3310 &substitute_in_interval
, arg
);
3315 /* Other types don't recurse any further. */
3321 /* Helper function for substitute_object_recurse. */
3323 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3325 Lisp_Object object
= Fcar (arg
);
3326 Lisp_Object placeholder
= Fcdr (arg
);
3328 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3338 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3339 integer syntax and fits in a fixnum, else return the nearest float if CP has
3340 either floating point or integer syntax and BASE is 10, else return nil. If
3341 IGNORE_TRAILING, consider just the longest prefix of CP that has
3342 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3343 number has integer syntax but does not fit. */
3346 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3349 char const *cp
= string
;
3351 bool float_syntax
= 0;
3354 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3355 IEEE floating point hosts, and works around a formerly-common bug where
3356 atof ("-0.0") drops the sign. */
3357 bool negative
= *cp
== '-';
3359 bool signedp
= negative
|| *cp
== '+';
3364 leading_digit
= digit_to_number (*cp
, base
);
3365 if (leading_digit
>= 0)
3370 while (digit_to_number (*cp
, base
) >= 0);
3380 if ('0' <= *cp
&& *cp
<= '9')
3385 while ('0' <= *cp
&& *cp
<= '9');
3387 if (*cp
== 'e' || *cp
== 'E')
3389 char const *ecp
= cp
;
3391 if (*cp
== '+' || *cp
== '-')
3393 if ('0' <= *cp
&& *cp
<= '9')
3398 while ('0' <= *cp
&& *cp
<= '9');
3400 else if (cp
[-1] == '+'
3401 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3407 else if (cp
[-1] == '+'
3408 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3412 /* NAN is a "positive" NaN on all known Emacs hosts. */
3419 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3420 || state
== (LEAD_INT
|E_EXP
));
3423 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3424 any prefix that matches. Otherwise, the entire string must match. */
3425 if (! (ignore_trailing
3426 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3427 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3430 /* If the number uses integer and not float syntax, and is in C-language
3431 range, use its value, preferably as a fixnum. */
3432 if (leading_digit
>= 0 && ! float_syntax
)
3436 /* Fast special case for single-digit integers. This also avoids a
3437 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3438 case some versions of strtoumax accept numbers like "0x1" that Emacs
3440 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3441 return make_number (negative
? -leading_digit
: leading_digit
);
3444 n
= strtoumax (string
+ signedp
, NULL
, base
);
3445 if (errno
== ERANGE
)
3447 /* Unfortunately there's no simple and accurate way to convert
3448 non-base-10 numbers that are out of C-language range. */
3450 xsignal1 (Qoverflow_error
, build_string (string
));
3452 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3454 EMACS_INT signed_n
= n
;
3455 return make_number (negative
? -signed_n
: signed_n
);
3461 /* Either the number uses float syntax, or it does not fit into a fixnum.
3462 Convert it from string to floating point, unless the value is already
3463 known because it is an infinity, a NAN, or its absolute value fits in
3466 value
= atof (string
+ signedp
);
3468 return make_float (negative
? -value
: value
);
3473 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3477 Lisp_Object tem
, item
, vector
;
3478 struct Lisp_Cons
*otem
;
3481 tem
= read_list (1, readcharfun
);
3482 len
= Flength (tem
);
3483 vector
= Fmake_vector (len
, Qnil
);
3485 size
= ASIZE (vector
);
3486 ptr
= XVECTOR (vector
)->contents
;
3487 for (i
= 0; i
< size
; i
++)
3490 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3491 bytecode object, the docstring containing the bytecode and
3492 constants values must be treated as unibyte and passed to
3493 Fread, to get the actual bytecode string and constants vector. */
3494 if (bytecodeflag
&& load_force_doc_strings
)
3496 if (i
== COMPILED_BYTECODE
)
3498 if (!STRINGP (item
))
3499 error ("Invalid byte code");
3501 /* Delay handling the bytecode slot until we know whether
3502 it is lazily-loaded (we can tell by whether the
3503 constants slot is nil). */
3504 ASET (vector
, COMPILED_CONSTANTS
, item
);
3507 else if (i
== COMPILED_CONSTANTS
)
3509 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3513 /* Coerce string to unibyte (like string-as-unibyte,
3514 but without generating extra garbage and
3515 guaranteeing no change in the contents). */
3516 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3517 STRING_SET_UNIBYTE (bytestr
);
3519 item
= Fread (Fcons (bytestr
, readcharfun
));
3521 error ("Invalid byte code");
3523 otem
= XCONS (item
);
3524 bytestr
= XCAR (item
);
3529 /* Now handle the bytecode slot. */
3530 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3532 else if (i
== COMPILED_DOC_STRING
3534 && ! STRING_MULTIBYTE (item
))
3536 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3537 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3539 item
= Fstring_as_multibyte (item
);
3542 ASET (vector
, i
, item
);
3550 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3553 read_list (bool flag
, Lisp_Object readcharfun
)
3555 Lisp_Object val
, tail
;
3556 Lisp_Object elt
, tem
;
3557 /* 0 is the normal case.
3558 1 means this list is a doc reference; replace it with the number 0.
3559 2 means this list is a doc reference; replace it with the doc string. */
3560 int doc_reference
= 0;
3562 /* Initialize this to 1 if we are reading a list. */
3563 bool first_in_list
= flag
<= 0;
3571 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3575 /* While building, if the list starts with #$, treat it specially. */
3576 if (EQ (elt
, Vload_file_name
)
3578 && !NILP (Vpurify_flag
))
3580 if (NILP (Vdoc_file_name
))
3581 /* We have not yet called Snarf-documentation, so assume
3582 this file is described in the DOC file
3583 and Snarf-documentation will fill in the right value later.
3584 For now, replace the whole list with 0. */
3587 /* We have already called Snarf-documentation, so make a relative
3588 file name for this file, so it can be found properly
3589 in the installed Lisp directory.
3590 We don't use Fexpand_file_name because that would make
3591 the directory absolute now. */
3593 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3594 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3597 else if (EQ (elt
, Vload_file_name
)
3599 && load_force_doc_strings
)
3608 invalid_syntax (") or . in a vector");
3615 XSETCDR (tail
, read0 (readcharfun
));
3617 val
= read0 (readcharfun
);
3618 read1 (readcharfun
, &ch
, 0);
3622 if (doc_reference
== 1)
3623 return make_number (0);
3624 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3627 file_offset saved_position
;
3628 /* Get a doc string from the file we are loading.
3629 If it's in saved_doc_string, get it from there.
3631 Here, we don't know if the string is a
3632 bytecode string or a doc string. As a
3633 bytecode string must be unibyte, we always
3634 return a unibyte string. If it is actually a
3635 doc string, caller must make it
3638 /* Position is negative for user variables. */
3639 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3640 if (pos
>= saved_doc_string_position
3641 && pos
< (saved_doc_string_position
3642 + saved_doc_string_length
))
3644 saved
= saved_doc_string
;
3645 saved_position
= saved_doc_string_position
;
3647 /* Look in prev_saved_doc_string the same way. */
3648 else if (pos
>= prev_saved_doc_string_position
3649 && pos
< (prev_saved_doc_string_position
3650 + prev_saved_doc_string_length
))
3652 saved
= prev_saved_doc_string
;
3653 saved_position
= prev_saved_doc_string_position
;
3657 ptrdiff_t start
= pos
- saved_position
;
3660 /* Process quoting with ^A,
3661 and find the end of the string,
3662 which is marked with ^_ (037). */
3663 for (from
= start
, to
= start
;
3664 saved
[from
] != 037;)
3666 int c
= saved
[from
++];
3670 saved
[to
++] = (c
== 1 ? c
3679 return make_unibyte_string (saved
+ start
,
3683 return get_doc_string (val
, 1, 0);
3688 invalid_syntax (". in wrong context");
3690 invalid_syntax ("] in a list");
3694 XSETCDR (tail
, tem
);
3701 static Lisp_Object initial_obarray
;
3703 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3705 static size_t oblookup_last_bucket_number
;
3707 /* Get an error if OBARRAY is not an obarray.
3708 If it is one, return it. */
3711 check_obarray (Lisp_Object obarray
)
3713 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3715 /* If Vobarray is now invalid, force it to be valid. */
3716 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3717 wrong_type_argument (Qvectorp
, obarray
);
3722 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3725 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3729 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3730 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3733 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3735 XSYMBOL (sym
)->constant
= 1;
3736 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3737 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3740 ptr
= aref_addr (obarray
, XINT (index
));
3741 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3746 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3749 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3751 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3754 /* Intern the C string STR: return a symbol with that name,
3755 interned in the current obarray. */
3758 intern_1 (const char *str
, ptrdiff_t len
)
3760 Lisp_Object obarray
= check_obarray (Vobarray
);
3761 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3763 return (SYMBOLP (tem
) ? tem
3764 /* The above `oblookup' was done on the basis of nchars==nbytes, so
3765 the string has to be unibyte. */
3766 : intern_driver (make_unibyte_string (str
, len
),
3771 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3773 Lisp_Object obarray
= check_obarray (Vobarray
);
3774 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3778 /* Creating a non-pure string from a string literal not implemented yet.
3779 We could just use make_string here and live with the extra copy. */
3780 eassert (!NILP (Vpurify_flag
));
3781 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3787 define_symbol (Lisp_Object sym
, char const *str
)
3789 ptrdiff_t len
= strlen (str
);
3790 Lisp_Object string
= make_pure_c_string (str
, len
);
3791 init_symbol (sym
, string
);
3793 /* Qunbound is uninterned, so that it's not confused with any symbol
3794 'unbound' created by a Lisp program. */
3795 if (! EQ (sym
, Qunbound
))
3797 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3798 eassert (INTEGERP (bucket
));
3799 intern_sym (sym
, initial_obarray
, bucket
);
3803 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3804 doc
: /* Return the canonical symbol whose name is STRING.
3805 If there is none, one is created by this function and returned.
3806 A second optional argument specifies the obarray to use;
3807 it defaults to the value of `obarray'. */)
3808 (Lisp_Object string
, Lisp_Object obarray
)
3812 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3813 CHECK_STRING (string
);
3815 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3817 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3822 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3823 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3824 NAME may be a string or a symbol. If it is a symbol, that exact
3825 symbol is searched for.
3826 A second optional argument specifies the obarray to use;
3827 it defaults to the value of `obarray'. */)
3828 (Lisp_Object name
, Lisp_Object obarray
)
3830 register Lisp_Object tem
, string
;
3832 if (NILP (obarray
)) obarray
= Vobarray
;
3833 obarray
= check_obarray (obarray
);
3835 if (!SYMBOLP (name
))
3837 CHECK_STRING (name
);
3841 string
= SYMBOL_NAME (name
);
3843 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3844 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3850 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3851 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3852 The value is t if a symbol was found and deleted, nil otherwise.
3853 NAME may be a string or a symbol. If it is a symbol, that symbol
3854 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3855 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3856 usage: (unintern NAME OBARRAY) */)
3857 (Lisp_Object name
, Lisp_Object obarray
)
3859 register Lisp_Object string
, tem
;
3862 if (NILP (obarray
)) obarray
= Vobarray
;
3863 obarray
= check_obarray (obarray
);
3866 string
= SYMBOL_NAME (name
);
3869 CHECK_STRING (name
);
3873 tem
= oblookup (obarray
, SSDATA (string
),
3878 /* If arg was a symbol, don't delete anything but that symbol itself. */
3879 if (SYMBOLP (name
) && !EQ (name
, tem
))
3882 /* There are plenty of other symbols which will screw up the Emacs
3883 session if we unintern them, as well as even more ways to use
3884 `setq' or `fset' or whatnot to make the Emacs session
3885 unusable. Let's not go down this silly road. --Stef */
3886 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3887 error ("Attempt to unintern t or nil"); */
3889 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3891 hash
= oblookup_last_bucket_number
;
3893 if (EQ (AREF (obarray
, hash
), tem
))
3895 if (XSYMBOL (tem
)->next
)
3898 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3899 ASET (obarray
, hash
, sym
);
3902 ASET (obarray
, hash
, make_number (0));
3906 Lisp_Object tail
, following
;
3908 for (tail
= AREF (obarray
, hash
);
3909 XSYMBOL (tail
)->next
;
3912 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3913 if (EQ (following
, tem
))
3915 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3924 /* Return the symbol in OBARRAY whose names matches the string
3925 of SIZE characters (SIZE_BYTE bytes) at PTR.
3926 If there is no such symbol, return the integer bucket number of
3927 where the symbol would be if it were present.
3929 Also store the bucket number in oblookup_last_bucket_number. */
3932 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3936 register Lisp_Object tail
;
3937 Lisp_Object bucket
, tem
;
3939 obarray
= check_obarray (obarray
);
3940 obsize
= ASIZE (obarray
);
3942 /* This is sometimes needed in the middle of GC. */
3943 obsize
&= ~ARRAY_MARK_FLAG
;
3944 hash
= hash_string (ptr
, size_byte
) % obsize
;
3945 bucket
= AREF (obarray
, hash
);
3946 oblookup_last_bucket_number
= hash
;
3947 if (EQ (bucket
, make_number (0)))
3949 else if (!SYMBOLP (bucket
))
3950 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3952 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3954 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3955 && SCHARS (SYMBOL_NAME (tail
)) == size
3956 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3958 else if (XSYMBOL (tail
)->next
== 0)
3961 XSETINT (tem
, hash
);
3966 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3969 register Lisp_Object tail
;
3970 CHECK_VECTOR (obarray
);
3971 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3973 tail
= AREF (obarray
, i
);
3978 if (XSYMBOL (tail
)->next
== 0)
3980 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3986 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3988 call1 (function
, sym
);
3991 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3992 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3993 OBARRAY defaults to the value of `obarray'. */)
3994 (Lisp_Object function
, Lisp_Object obarray
)
3996 if (NILP (obarray
)) obarray
= Vobarray
;
3997 obarray
= check_obarray (obarray
);
3999 map_obarray (obarray
, mapatoms_1
, function
);
4003 #define OBARRAY_SIZE 1511
4008 Lisp_Object oblength
;
4009 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4011 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4013 Vobarray
= Fmake_vector (oblength
, make_number (0));
4014 initial_obarray
= Vobarray
;
4015 staticpro (&initial_obarray
);
4017 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4018 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4020 DEFSYM (Qunbound
, "unbound");
4022 DEFSYM (Qnil
, "nil");
4023 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4024 XSYMBOL (Qnil
)->constant
= 1;
4025 XSYMBOL (Qnil
)->declared_special
= true;
4028 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4029 XSYMBOL (Qt
)->constant
= 1;
4030 XSYMBOL (Qt
)->declared_special
= true;
4032 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4035 DEFSYM (Qvariable_documentation
, "variable-documentation");
4037 read_buffer
= xmalloc (size
);
4038 read_buffer_size
= size
;
4042 defsubr (struct Lisp_Subr
*sname
)
4044 Lisp_Object sym
, tem
;
4045 sym
= intern_c_string (sname
->symbol_name
);
4046 XSETPVECTYPE (sname
, PVEC_SUBR
);
4047 XSETSUBR (tem
, sname
);
4048 set_symbol_function (sym
, tem
);
4051 #ifdef NOTDEF /* Use fset in subr.el now! */
4053 defalias (struct Lisp_Subr
*sname
, char *string
)
4056 sym
= intern (string
);
4057 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4061 /* Define an "integer variable"; a symbol whose value is forwarded to a
4062 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4063 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4065 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4066 const char *namestring
, EMACS_INT
*address
)
4069 sym
= intern_c_string (namestring
);
4070 i_fwd
->type
= Lisp_Fwd_Int
;
4071 i_fwd
->intvar
= address
;
4072 XSYMBOL (sym
)->declared_special
= 1;
4073 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4074 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4077 /* Similar but define a variable whose value is t if address contains 1,
4078 nil if address contains 0. */
4080 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4081 const char *namestring
, bool *address
)
4084 sym
= intern_c_string (namestring
);
4085 b_fwd
->type
= Lisp_Fwd_Bool
;
4086 b_fwd
->boolvar
= address
;
4087 XSYMBOL (sym
)->declared_special
= 1;
4088 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4089 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4090 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4093 /* Similar but define a variable whose value is the Lisp Object stored
4094 at address. Two versions: with and without gc-marking of the C
4095 variable. The nopro version is used when that variable will be
4096 gc-marked for some other reason, since marking the same slot twice
4097 can cause trouble with strings. */
4099 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4100 const char *namestring
, Lisp_Object
*address
)
4103 sym
= intern_c_string (namestring
);
4104 o_fwd
->type
= Lisp_Fwd_Obj
;
4105 o_fwd
->objvar
= address
;
4106 XSYMBOL (sym
)->declared_special
= 1;
4107 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4108 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4112 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4113 const char *namestring
, Lisp_Object
*address
)
4115 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4116 staticpro (address
);
4119 /* Similar but define a variable whose value is the Lisp Object stored
4120 at a particular offset in the current kboard object. */
4123 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4124 const char *namestring
, int offset
)
4127 sym
= intern_c_string (namestring
);
4128 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4129 ko_fwd
->offset
= offset
;
4130 XSYMBOL (sym
)->declared_special
= 1;
4131 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4132 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4135 /* Check that the elements of lpath exist. */
4138 load_path_check (Lisp_Object lpath
)
4140 Lisp_Object path_tail
;
4142 /* The only elements that might not exist are those from
4143 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4145 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4147 Lisp_Object dirfile
;
4148 dirfile
= Fcar (path_tail
);
4149 if (STRINGP (dirfile
))
4151 dirfile
= Fdirectory_file_name (dirfile
);
4152 if (! file_accessible_directory_p (dirfile
))
4153 dir_warning ("Lisp directory", XCAR (path_tail
));
4158 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4159 This does not include the standard site-lisp directories
4160 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4161 but it does (unless no_site_lisp is set) include site-lisp
4162 directories in the source/build directories if those exist and we
4163 are running uninstalled.
4165 Uses the following logic:
4166 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4167 The remainder is what happens when dumping works:
4168 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4169 Otherwise use PATH_LOADSEARCH.
4171 If !initialized, then just return PATH_DUMPLOADSEARCH.
4173 If Vinstallation_directory is not nil (ie, running uninstalled):
4174 If installation-dir/lisp exists and not already a member,
4175 we must be running uninstalled. Reset the load-path
4176 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4177 refers to the eventual installation directories. Since we
4178 are not yet installed, we should not use them, even if they exist.)
4179 If installation-dir/lisp does not exist, just add
4180 PATH_DUMPLOADSEARCH at the end instead.
4181 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4182 and not already a member) at the front.
4183 If installation-dir != source-dir (ie running an uninstalled,
4184 out-of-tree build) AND install-dir/src/Makefile exists BUT
4185 install-dir/src/Makefile.in does NOT exist (this is a sanity
4186 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4189 load_path_default (void)
4191 Lisp_Object lpath
= Qnil
;
4196 const char *loadpath
= ns_load_path ();
4199 normal
= PATH_LOADSEARCH
;
4201 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4203 lpath
= decode_env_path (0, normal
, 0);
4206 #else /* !CANNOT_DUMP */
4208 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4213 const char *loadpath
= ns_load_path ();
4214 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4216 lpath
= decode_env_path (0, normal
, 0);
4218 if (!NILP (Vinstallation_directory
))
4220 Lisp_Object tem
, tem1
;
4222 /* Add to the path the lisp subdir of the installation
4223 dir, if it is accessible. Note: in out-of-tree builds,
4224 this directory is empty save for Makefile. */
4225 tem
= Fexpand_file_name (build_string ("lisp"),
4226 Vinstallation_directory
);
4227 tem1
= Ffile_accessible_directory_p (tem
);
4230 if (NILP (Fmember (tem
, lpath
)))
4232 /* We are running uninstalled. The default load-path
4233 points to the eventual installed lisp directories.
4234 We should not use those now, even if they exist,
4235 so start over from a clean slate. */
4236 lpath
= list1 (tem
);
4240 /* That dir doesn't exist, so add the build-time
4241 Lisp dirs instead. */
4243 Lisp_Object dump_path
=
4244 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4245 lpath
= nconc2 (lpath
, dump_path
);
4248 /* Add site-lisp under the installation dir, if it exists. */
4251 tem
= Fexpand_file_name (build_string ("site-lisp"),
4252 Vinstallation_directory
);
4253 tem1
= Ffile_accessible_directory_p (tem
);
4256 if (NILP (Fmember (tem
, lpath
)))
4257 lpath
= Fcons (tem
, lpath
);
4261 /* If Emacs was not built in the source directory,
4262 and it is run from where it was built, add to load-path
4263 the lisp and site-lisp dirs under that directory. */
4265 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4269 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4270 Vinstallation_directory
);
4271 tem1
= Ffile_exists_p (tem
);
4273 /* Don't be fooled if they moved the entire source tree
4274 AFTER dumping Emacs. If the build directory is indeed
4275 different from the source dir, src/Makefile.in and
4276 src/Makefile will not be found together. */
4277 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4278 Vinstallation_directory
);
4279 tem2
= Ffile_exists_p (tem
);
4280 if (!NILP (tem1
) && NILP (tem2
))
4282 tem
= Fexpand_file_name (build_string ("lisp"),
4285 if (NILP (Fmember (tem
, lpath
)))
4286 lpath
= Fcons (tem
, lpath
);
4290 tem
= Fexpand_file_name (build_string ("site-lisp"),
4292 tem1
= Ffile_accessible_directory_p (tem
);
4295 if (NILP (Fmember (tem
, lpath
)))
4296 lpath
= Fcons (tem
, lpath
);
4300 } /* Vinstallation_directory != Vsource_directory */
4302 } /* if Vinstallation_directory */
4304 else /* !initialized */
4306 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4307 source directory. We used to add ../lisp (ie the lisp dir in
4308 the build directory) at the front here, but that should not
4309 be necessary, since in out of tree builds lisp/ is empty, save
4311 lpath
= decode_env_path (0, normal
, 0);
4313 #endif /* !CANNOT_DUMP */
4321 /* First, set Vload_path. */
4323 /* Ignore EMACSLOADPATH when dumping. */
4325 bool use_loadpath
= true;
4327 bool use_loadpath
= NILP (Vpurify_flag
);
4330 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4332 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4334 /* Check (non-nil) user-supplied elements. */
4335 load_path_check (Vload_path
);
4337 /* If no nils in the environment variable, use as-is.
4338 Otherwise, replace any nils with the default. */
4339 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4341 Lisp_Object elem
, elpath
= Vload_path
;
4342 Lisp_Object default_lpath
= load_path_default ();
4344 /* Check defaults, before adding site-lisp. */
4345 load_path_check (default_lpath
);
4347 /* Add the site-lisp directories to the front of the default. */
4350 Lisp_Object sitelisp
;
4351 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4352 if (! NILP (sitelisp
))
4353 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4358 /* Replace nils from EMACSLOADPATH by default. */
4359 while (CONSP (elpath
))
4361 elem
= XCAR (elpath
);
4362 elpath
= XCDR (elpath
);
4363 Vload_path
= CALLN (Fappend
, Vload_path
,
4364 NILP (elem
) ? default_lpath
: list1 (elem
));
4366 } /* Fmemq (Qnil, Vload_path) */
4370 Vload_path
= load_path_default ();
4372 /* Check before adding site-lisp directories.
4373 The install should have created them, but they are not
4374 required, so no need to warn if they are absent.
4375 Or we might be running before installation. */
4376 load_path_check (Vload_path
);
4378 /* Add the site-lisp directories at the front. */
4379 if (initialized
&& !no_site_lisp
)
4381 Lisp_Object sitelisp
;
4382 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4383 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4389 load_in_progress
= 0;
4390 Vload_file_name
= Qnil
;
4391 Vstandard_input
= Qt
;
4392 Vloads_in_progress
= Qnil
;
4395 /* Print a warning that directory intended for use USE and with name
4396 DIRNAME cannot be accessed. On entry, errno should correspond to
4397 the access failure. Print the warning on stderr and put it in
4401 dir_warning (char const *use
, Lisp_Object dirname
)
4403 static char const format
[] = "Warning: %s '%s': %s\n";
4404 int access_errno
= errno
;
4405 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)),
4406 strerror (access_errno
));
4408 /* Don't log the warning before we've initialized!! */
4411 char const *diagnostic
= emacs_strerror (access_errno
);
4413 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4414 + strlen (use
) + SBYTES (dirname
)
4415 + strlen (diagnostic
));
4416 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4418 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4424 syms_of_lread (void)
4427 defsubr (&Sread_from_string
);
4429 defsubr (&Sintern_soft
);
4430 defsubr (&Sunintern
);
4431 defsubr (&Sget_load_suffixes
);
4433 defsubr (&Seval_buffer
);
4434 defsubr (&Seval_region
);
4435 defsubr (&Sread_char
);
4436 defsubr (&Sread_char_exclusive
);
4437 defsubr (&Sread_event
);
4438 defsubr (&Sget_file_char
);
4439 defsubr (&Smapatoms
);
4440 defsubr (&Slocate_file_internal
);
4442 DEFVAR_LISP ("obarray", Vobarray
,
4443 doc
: /* Symbol table for use by `intern' and `read'.
4444 It is a vector whose length ought to be prime for best results.
4445 The vector's contents don't make sense if examined from Lisp programs;
4446 to find all the symbols in an obarray, use `mapatoms'. */);
4448 DEFVAR_LISP ("values", Vvalues
,
4449 doc
: /* List of values of all expressions which were read, evaluated and printed.
4450 Order is reverse chronological. */);
4451 XSYMBOL (intern ("values"))->declared_special
= 0;
4453 DEFVAR_LISP ("standard-input", Vstandard_input
,
4454 doc
: /* Stream for read to get input from.
4455 See documentation of `read' for possible values. */);
4456 Vstandard_input
= Qt
;
4458 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4459 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4461 If this variable is a buffer, then only forms read from that buffer
4462 will be added to `read-symbol-positions-list'.
4463 If this variable is t, then all read forms will be added.
4464 The effect of all other values other than nil are not currently
4465 defined, although they may be in the future.
4467 The positions are relative to the last call to `read' or
4468 `read-from-string'. It is probably a bad idea to set this variable at
4469 the toplevel; bind it instead. */);
4470 Vread_with_symbol_positions
= Qnil
;
4472 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4473 doc
: /* A list mapping read symbols to their positions.
4474 This variable is modified during calls to `read' or
4475 `read-from-string', but only when `read-with-symbol-positions' is
4478 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4479 CHAR-POSITION is an integer giving the offset of that occurrence of the
4480 symbol from the position where `read' or `read-from-string' started.
4482 Note that a symbol will appear multiple times in this list, if it was
4483 read multiple times. The list is in the same order as the symbols
4485 Vread_symbol_positions_list
= Qnil
;
4487 DEFVAR_LISP ("read-circle", Vread_circle
,
4488 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4491 DEFVAR_LISP ("load-path", Vload_path
,
4492 doc
: /* List of directories to search for files to load.
4493 Each element is a string (directory file name) or nil (meaning
4494 `default-directory').
4495 Initialized during startup as described in Info node `(elisp)Library Search'.
4496 Use `directory-file-name' when adding items to this path. However, Lisp
4497 programs that process this list should tolerate directories both with
4498 and without trailing slashes. */);
4500 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4501 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4502 This list should not include the empty string.
4503 `load' and related functions try to append these suffixes, in order,
4504 to the specified file name if a Lisp suffix is allowed or required. */);
4506 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4507 build_pure_c_string (".el"),
4508 build_pure_c_string (MODULES_SUFFIX
));
4510 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4511 build_pure_c_string (".el"));
4513 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4514 doc
: /* List of suffixes that indicate representations of \
4516 This list should normally start with the empty string.
4518 Enabling Auto Compression mode appends the suffixes in
4519 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4520 mode removes them again. `load' and related functions use this list to
4521 determine whether they should look for compressed versions of a file
4522 and, if so, which suffixes they should try to append to the file name
4523 in order to do so. However, if you want to customize which suffixes
4524 the loading functions recognize as compression suffixes, you should
4525 customize `jka-compr-load-suffixes' rather than the present variable. */);
4526 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4528 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4529 doc
: /* Non-nil if inside of `load'. */);
4530 DEFSYM (Qload_in_progress
, "load-in-progress");
4532 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4533 doc
: /* An alist of functions to be evalled when particular files are loaded.
4534 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4536 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4537 a symbol (a feature name).
4539 When `load' is run and the file-name argument matches an element's
4540 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4541 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4543 An error in FORMS does not undo the load, but does prevent execution of
4544 the rest of the FORMS. */);
4545 Vafter_load_alist
= Qnil
;
4547 DEFVAR_LISP ("load-history", Vload_history
,
4548 doc
: /* Alist mapping loaded file names to symbols and features.
4549 Each alist element should be a list (FILE-NAME ENTRIES...), where
4550 FILE-NAME is the name of a file that has been loaded into Emacs.
4551 The file name is absolute and true (i.e. it doesn't contain symlinks).
4552 As an exception, one of the alist elements may have FILE-NAME nil,
4553 for symbols and features not associated with any file.
4555 The remaining ENTRIES in the alist element describe the functions and
4556 variables defined in that file, the features provided, and the
4557 features required. Each entry has the form `(provide . FEATURE)',
4558 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4559 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4560 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4561 autoload before this file redefined it as a function. In addition,
4562 entries may also be single symbols, which means that SYMBOL was
4563 defined by `defvar' or `defconst'.
4565 During preloading, the file name recorded is relative to the main Lisp
4566 directory. These file names are converted to absolute at startup. */);
4567 Vload_history
= Qnil
;
4569 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4570 doc
: /* Full name of file being loaded by `load'. */);
4571 Vload_file_name
= Qnil
;
4573 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4574 doc
: /* File name, including directory, of user's initialization file.
4575 If the file loaded had extension `.elc', and the corresponding source file
4576 exists, this variable contains the name of source file, suitable for use
4577 by functions like `custom-save-all' which edit the init file.
4578 While Emacs loads and evaluates the init file, value is the real name
4579 of the file, regardless of whether or not it has the `.elc' extension. */);
4580 Vuser_init_file
= Qnil
;
4582 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4583 doc
: /* Used for internal purposes by `load'. */);
4584 Vcurrent_load_list
= Qnil
;
4586 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4587 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4588 Called with a single argument (the stream from which to read).
4589 The default is to use the function `read'. */);
4590 DEFSYM (Qread
, "read");
4591 Vload_read_function
= Qread
;
4593 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4594 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4595 The value should be a function for doing code conversion before
4596 reading a source file. It can also be nil, in which case loading is
4597 done without any code conversion.
4599 If the value is a function, it is called with four arguments,
4600 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4601 the file to load, FILE is the non-absolute name (for messages etc.),
4602 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4603 `load'. The function should return t if the file was loaded. */);
4604 Vload_source_file_function
= Qnil
;
4606 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4607 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4608 This is useful when the file being loaded is a temporary copy. */);
4609 load_force_doc_strings
= 0;
4611 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4612 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4613 This is normally bound by `load' and `eval-buffer' to control `read',
4614 and is not meant for users to change. */);
4615 load_convert_to_unibyte
= 0;
4617 DEFVAR_LISP ("source-directory", Vsource_directory
,
4618 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4619 You cannot count on them to still be there! */);
4621 = Fexpand_file_name (build_string ("../"),
4622 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4624 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4625 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4626 Vpreloaded_file_list
= Qnil
;
4628 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4629 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4630 Vbyte_boolean_vars
= Qnil
;
4632 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4633 doc
: /* Non-nil means load dangerous compiled Lisp files.
4634 Some versions of XEmacs use different byte codes than Emacs. These
4635 incompatible byte codes can make Emacs crash when it tries to execute
4637 load_dangerous_libraries
= 0;
4639 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4640 doc
: /* Non-nil means force printing messages when loading Lisp files.
4641 This overrides the value of the NOMESSAGE argument to `load'. */);
4642 force_load_messages
= 0;
4644 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4645 doc
: /* Regular expression matching safe to load compiled Lisp files.
4646 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4647 from the file, and matches them against this regular expression.
4648 When the regular expression matches, the file is considered to be safe
4649 to load. See also `load-dangerous-libraries'. */);
4650 Vbytecomp_version_regexp
4651 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4653 DEFSYM (Qlexical_binding
, "lexical-binding");
4654 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4655 doc
: /* Whether to use lexical binding when evaluating code.
4656 Non-nil means that the code in the current buffer should be evaluated
4657 with lexical binding.
4658 This variable is automatically set from the file variables of an
4659 interpreted Lisp file read using `load'. Unlike other file local
4660 variables, this must be set in the first line of a file. */);
4661 Vlexical_binding
= Qnil
;
4662 Fmake_variable_buffer_local (Qlexical_binding
);
4664 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4665 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4666 Veval_buffer_list
= Qnil
;
4668 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4669 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4670 Vold_style_backquotes
= Qnil
;
4671 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4673 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4674 doc
: /* Non-nil means `load' prefers the newest version of a file.
4675 This applies when a filename suffix is not explicitly specified and
4676 `load' is trying various possible suffixes (see `load-suffixes' and
4677 `load-file-rep-suffixes'). Normally, it stops at the first file
4678 that exists unless you explicitly specify one or the other. If this
4679 option is non-nil, it checks all suffixes and uses whichever file is
4681 Note that if you customize this, obviously it will not affect files
4682 that are loaded before your customizations are read! */);
4683 load_prefer_newer
= 0;
4685 /* Vsource_directory was initialized in init_lread. */
4687 DEFSYM (Qcurrent_load_list
, "current-load-list");
4688 DEFSYM (Qstandard_input
, "standard-input");
4689 DEFSYM (Qread_char
, "read-char");
4690 DEFSYM (Qget_file_char
, "get-file-char");
4692 /* Used instead of Qget_file_char while loading *.elc files compiled
4693 by Emacs 21 or older. */
4694 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4696 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4698 DEFSYM (Qbackquote
, "`");
4699 DEFSYM (Qcomma
, ",");
4700 DEFSYM (Qcomma_at
, ",@");
4701 DEFSYM (Qcomma_dot
, ",.");
4703 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4704 DEFSYM (Qascii_character
, "ascii-character");
4705 DEFSYM (Qfunction
, "function");
4706 DEFSYM (Qload
, "load");
4707 DEFSYM (Qload_file_name
, "load-file-name");
4708 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4709 DEFSYM (Qfile_truename
, "file-truename");
4710 DEFSYM (Qdir_ok
, "dir-ok");
4711 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4713 staticpro (&read_objects
);
4714 read_objects
= Qnil
;
4715 staticpro (&seen_list
);
4718 Vloads_in_progress
= Qnil
;
4719 staticpro (&Vloads_in_progress
);
4721 DEFSYM (Qhash_table
, "hash-table");
4722 DEFSYM (Qdata
, "data");
4723 DEFSYM (Qtest
, "test");
4724 DEFSYM (Qsize
, "size");
4725 DEFSYM (Qweakness
, "weakness");
4726 DEFSYM (Qrehash_size
, "rehash-size");
4727 DEFSYM (Qrehash_threshold
, "rehash-threshold");