1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2016 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 /* Tell globals.h to define tables needed by init_obarray. */
22 #define DEFINE_SYMBOLS
26 #include <sys/types.h>
30 #include <limits.h> /* For CHAR_BIT. */
32 #include <stat-time.h>
34 #include "dispextern.h"
35 #include "intervals.h"
36 #include "character.h"
44 #include "termhooks.h"
45 #include "blockinput.h"
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
) && STRINGP (XCAR (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
) && STRINGP (XCAR (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', then try
991 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
992 then try FILE unmodified (the exact suffixes in the exact order are
993 determined by `load-suffixes'). Environment variable references in
994 FILE are replaced with their values by calling `substitute-in-file-name'.
995 This function searches the directories in `load-path'.
997 If optional second arg NOERROR is non-nil,
998 report no error if FILE doesn't exist.
999 Print messages at start and end of loading unless
1000 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1002 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1003 suffixes to the specified name FILE.
1004 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1005 the suffix `.elc' or `.el' or the module suffix; don't accept just
1006 FILE unless it ends in one of those suffixes or includes a directory name.
1008 If NOSUFFIX is nil, then if a file could not be found, try looking for
1009 a different representation of the file by adding non-empty suffixes to
1010 its name, before trying another file. Emacs uses this feature to find
1011 compressed versions of files when Auto Compression mode is enabled.
1012 If NOSUFFIX is non-nil, disable this feature.
1014 The suffixes that this function tries out, when NOSUFFIX is nil, are
1015 given by the return value of `get-load-suffixes' and the values listed
1016 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1017 return value of `get-load-suffixes' is used, i.e. the file name is
1018 required to have a non-empty suffix.
1020 When searching suffixes, this function normally stops at the first
1021 one that exists. If the option `load-prefer-newer' is non-nil,
1022 however, it tries all suffixes, and uses whichever file is the newest.
1024 Loading a file records its definitions, and its `provide' and
1025 `require' calls, in an element of `load-history' whose
1026 car is the file name loaded. See `load-history'.
1028 While the file is in the process of being loaded, the variable
1029 `load-in-progress' is non-nil and the variable `load-file-name'
1030 is bound to the file's name.
1032 Return t if the file exists and loads successfully. */)
1033 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1034 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1039 ptrdiff_t count
= SPECPDL_INDEX ();
1040 Lisp_Object found
, efound
, hist_file_name
;
1041 /* True means we printed the ".el is newer" message. */
1043 /* True means we are loading a compiled file. */
1045 Lisp_Object handler
;
1047 const char *fmode
= "r" FOPEN_TEXT
;
1050 CHECK_STRING (file
);
1052 /* If file name is magic, call the handler. */
1053 /* This shouldn't be necessary any more now that `openp' handles it right.
1054 handler = Ffind_file_name_handler (file, Qload);
1055 if (!NILP (handler))
1056 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1058 /* The presence of this call is the result of a historical accident:
1059 it used to be in every file-operation and when it got removed
1060 everywhere, it accidentally stayed here. Since then, enough people
1061 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1062 that it seemed risky to remove. */
1063 if (! NILP (noerror
))
1065 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1066 Qt
, load_error_handler
);
1071 file
= Fsubstitute_in_file_name (file
);
1073 /* Avoid weird lossage with null string as arg,
1074 since it would try to load a directory as a Lisp file. */
1075 if (SCHARS (file
) == 0)
1082 Lisp_Object suffixes
;
1085 if (! NILP (must_suffix
))
1087 /* Don't insist on adding a suffix if FILE already ends with one. */
1088 if (suffix_p (file
, ".el")
1089 || suffix_p (file
, ".elc")
1091 || suffix_p (file
, MODULES_SUFFIX
)
1095 /* Don't insist on adding a suffix
1096 if the argument includes a directory name. */
1097 else if (! NILP (Ffile_name_directory (file
)))
1101 if (!NILP (nosuffix
))
1105 suffixes
= Fget_load_suffixes ();
1106 if (NILP (must_suffix
))
1107 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1110 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1116 report_file_error ("Cannot open load file", file
);
1120 /* Tell startup.el whether or not we found the user's init file. */
1121 if (EQ (Qt
, Vuser_init_file
))
1122 Vuser_init_file
= found
;
1124 /* If FD is -2, that means openp found a magic file. */
1127 if (NILP (Fequal (found
, file
)))
1128 /* If FOUND is a different file name from FILE,
1129 find its handler even if we have already inhibited
1130 the `load' operation on FILE. */
1131 handler
= Ffind_file_name_handler (found
, Qt
);
1133 handler
= Ffind_file_name_handler (found
, Qload
);
1134 if (! NILP (handler
))
1135 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1137 /* Tramp has to deal with semi-broken packages that prepend
1138 drive letters to remote files. For that reason, Tramp
1139 catches file operations that test for file existence, which
1140 makes openp think X:/foo.elc files are remote. However,
1141 Tramp does not catch `load' operations for such files, so we
1142 end up with a nil as the `load' handler above. If we would
1143 continue with fd = -2, we will behave wrongly, and in
1144 particular try reading a .elc file in the "rt" mode instead
1145 of "rb". See bug #9311 for the results. To work around
1146 this, we try to open the file locally, and go with that if it
1148 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1156 /* Pacify older GCC with --enable-gcc-warnings. */
1157 IF_LINT (fd_index
= 0);
1161 fd_index
= SPECPDL_INDEX ();
1162 record_unwind_protect_int (close_file_unwind
, fd
);
1166 if (suffix_p (found
, MODULES_SUFFIX
))
1167 return unbind_to (count
, Fmodule_load (found
));
1170 /* Check if we're stuck in a recursive load cycle.
1172 2000-09-21: It's not possible to just check for the file loaded
1173 being a member of Vloads_in_progress. This fails because of the
1174 way the byte compiler currently works; `provide's are not
1175 evaluated, see font-lock.el/jit-lock.el as an example. This
1176 leads to a certain amount of ``normal'' recursion.
1178 Also, just loading a file recursively is not always an error in
1179 the general case; the second load may do something different. */
1183 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1184 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1185 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1186 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1187 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1190 /* All loads are by default dynamic, unless the file itself specifies
1191 otherwise using a file-variable in the first line. This is bound here
1192 so that it takes effect whether or not we use
1193 Vload_source_file_function. */
1194 specbind (Qlexical_binding
, Qnil
);
1196 /* Get the name for load-history. */
1197 hist_file_name
= (! NILP (Vpurify_flag
)
1198 ? concat2 (Ffile_name_directory (file
),
1199 Ffile_name_nondirectory (found
))
1204 /* Check for the presence of old-style quotes and warn about them. */
1205 specbind (Qold_style_backquotes
, Qnil
);
1206 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1208 if (suffix_p (found
, ".elc") || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1209 /* Load .elc files directly, but not when they are
1210 remote and have no handler! */
1218 && ! (version
= safe_to_load_version (fd
)))
1221 if (!load_dangerous_libraries
)
1222 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1223 else if (!NILP (nomessage
) && !force_load_messages
)
1224 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1229 efound
= ENCODE_FILE (found
);
1230 fmode
= "r" FOPEN_BINARY
;
1232 /* openp already checked for newness, no point doing it again.
1233 FIXME would be nice to get a message when openp
1234 ignores suffix order due to load_prefer_newer. */
1235 if (!load_prefer_newer
)
1237 result
= stat (SSDATA (efound
), &s1
);
1240 SSET (efound
, SBYTES (efound
) - 1, 0);
1241 result
= stat (SSDATA (efound
), &s2
);
1242 SSET (efound
, SBYTES (efound
) - 1, 'c');
1246 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1248 /* Make the progress messages mention that source is newer. */
1251 /* If we won't print another message, mention this anyway. */
1252 if (!NILP (nomessage
) && !force_load_messages
)
1254 Lisp_Object msg_file
;
1255 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1256 message_with_string ("Source file `%s' newer than byte-compiled file",
1260 } /* !load_prefer_newer */
1265 /* We are loading a source file (*.el). */
1266 if (!NILP (Vload_source_file_function
))
1273 clear_unwind_protect (fd_index
);
1275 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1276 NILP (noerror
) ? Qnil
: Qt
,
1277 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1278 return unbind_to (count
, val
);
1284 /* We somehow got here with fd == -2, meaning the file is deemed
1285 to be remote. Don't even try to reopen the file locally;
1286 just force a failure. */
1294 clear_unwind_protect (fd_index
);
1295 efound
= ENCODE_FILE (found
);
1296 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1298 stream
= fdopen (fd
, fmode
);
1302 report_file_error ("Opening stdio stream", file
);
1303 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1305 if (! NILP (Vpurify_flag
))
1306 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1308 if (NILP (nomessage
) || force_load_messages
)
1311 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1314 message_with_string ("Loading %s (source)...", file
, 1);
1316 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1318 else /* The typical case; compiled file newer than source file. */
1319 message_with_string ("Loading %s...", file
, 1);
1322 specbind (Qload_file_name
, found
);
1323 specbind (Qinhibit_file_name_operation
, Qnil
);
1324 specbind (Qload_in_progress
, Qt
);
1327 if (lisp_file_lexically_bound_p (Qget_file_char
))
1328 Fset (Qlexical_binding
, Qt
);
1330 if (! version
|| version
>= 22)
1331 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1332 0, Qnil
, Qnil
, Qnil
, Qnil
);
1335 /* We can't handle a file which was compiled with
1336 byte-compile-dynamic by older version of Emacs. */
1337 specbind (Qload_force_doc_strings
, Qt
);
1338 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1339 0, Qnil
, Qnil
, Qnil
, Qnil
);
1341 unbind_to (count
, Qnil
);
1343 /* Run any eval-after-load forms for this file. */
1344 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1345 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1347 xfree (saved_doc_string
);
1348 saved_doc_string
= 0;
1349 saved_doc_string_size
= 0;
1351 xfree (prev_saved_doc_string
);
1352 prev_saved_doc_string
= 0;
1353 prev_saved_doc_string_size
= 0;
1355 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1358 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1361 message_with_string ("Loading %s (source)...done", file
, 1);
1363 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1365 else /* The typical case; compiled file newer than source file. */
1366 message_with_string ("Loading %s...done", file
, 1);
1373 complete_filename_p (Lisp_Object pathname
)
1375 const unsigned char *s
= SDATA (pathname
);
1376 return (IS_DIRECTORY_SEP (s
[0])
1377 || (SCHARS (pathname
) > 2
1378 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1381 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1382 doc
: /* Search for FILENAME through PATH.
1383 Returns the file's name in absolute form, or nil if not found.
1384 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1385 file name when searching.
1386 If non-nil, PREDICATE is used instead of `file-readable-p'.
1387 PREDICATE can also be an integer to pass to the faccessat(2) function,
1388 in which case file-name-handlers are ignored.
1389 This function will normally skip directories, so if you want it to find
1390 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1391 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1394 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1395 if (NILP (predicate
) && fd
>= 0)
1400 /* Search for a file whose name is STR, looking in directories
1401 in the Lisp list PATH, and trying suffixes from SUFFIX.
1402 On success, return a file descriptor (or 1 or -2 as described below).
1403 On failure, return -1 and set errno.
1405 SUFFIXES is a list of strings containing possible suffixes.
1406 The empty suffix is automatically added if the list is empty.
1408 PREDICATE t means the files are binary.
1409 PREDICATE non-nil and non-t means don't open the files,
1410 just look for one that satisfies the predicate. In this case,
1411 return 1 on success. The predicate can be a lisp function or
1412 an integer to pass to `access' (in which case file-name-handlers
1415 If STOREPTR is nonzero, it points to a slot where the name of
1416 the file actually found should be stored as a Lisp string.
1417 nil is stored there on failure.
1419 If the file we find is remote, return -2
1420 but store the found remote file name in *STOREPTR.
1422 If NEWER is true, try all SUFFIXes and return the result for the
1423 newest file that exists. Does not apply to remote files,
1424 or if a non-nil and non-t PREDICATE is specified. */
1427 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1428 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1430 ptrdiff_t fn_size
= 100;
1434 ptrdiff_t want_length
;
1435 Lisp_Object filename
;
1436 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1437 ptrdiff_t max_suffix_len
= 0;
1438 int last_errno
= ENOENT
;
1442 /* The last-modified time of the newest matching file found.
1443 Initialize it to something less than all valid timestamps. */
1444 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1448 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1450 CHECK_STRING_CAR (tail
);
1451 max_suffix_len
= max (max_suffix_len
,
1452 SBYTES (XCAR (tail
)));
1455 string
= filename
= encoded_fn
= save_string
= Qnil
;
1460 absolute
= complete_filename_p (str
);
1462 for (; CONSP (path
); path
= XCDR (path
))
1464 filename
= Fexpand_file_name (str
, XCAR (path
));
1465 if (!complete_filename_p (filename
))
1466 /* If there are non-absolute elts in PATH (eg "."). */
1467 /* Of course, this could conceivably lose if luser sets
1468 default-directory to be something non-absolute... */
1470 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1471 if (!complete_filename_p (filename
))
1472 /* Give up on this path element! */
1476 /* Calculate maximum length of any filename made from
1477 this path element/specified file name and any possible suffix. */
1478 want_length
= max_suffix_len
+ SBYTES (filename
);
1479 if (fn_size
<= want_length
)
1481 fn_size
= 100 + want_length
;
1482 fn
= SAFE_ALLOCA (fn_size
);
1485 /* Loop over suffixes. */
1486 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1487 CONSP (tail
); tail
= XCDR (tail
))
1489 Lisp_Object suffix
= XCAR (tail
);
1490 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1491 Lisp_Object handler
;
1493 /* Concatenate path element/specified name with the suffix.
1494 If the directory starts with /:, remove that. */
1495 int prefixlen
= ((SCHARS (filename
) > 2
1496 && SREF (filename
, 0) == '/'
1497 && SREF (filename
, 1) == ':')
1499 fnlen
= SBYTES (filename
) - prefixlen
;
1500 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1501 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1503 /* Check that the file exists and is not a directory. */
1504 /* We used to only check for handlers on non-absolute file names:
1508 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1509 It's not clear why that was the case and it breaks things like
1510 (load "/bar.el") where the file is actually "/bar.el.gz". */
1511 /* make_string has its own ideas on when to return a unibyte
1512 string and when a multibyte string, but we know better.
1513 We must have a unibyte string when dumping, since
1514 file-name encoding is shaky at best at that time, and in
1515 particular default-file-name-coding-system is reset
1516 several times during loadup. We therefore don't want to
1517 encode the file before passing it to file I/O library
1519 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1520 string
= make_unibyte_string (fn
, fnlen
);
1522 string
= make_string (fn
, fnlen
);
1523 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1524 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1525 && !NATNUMP (predicate
))
1528 if (NILP (predicate
) || EQ (predicate
, Qt
))
1529 exists
= !NILP (Ffile_readable_p (string
));
1532 Lisp_Object tmp
= call1 (predicate
, string
);
1535 else if (EQ (tmp
, Qdir_ok
)
1536 || NILP (Ffile_directory_p (string
)))
1541 last_errno
= EISDIR
;
1547 /* We succeeded; return this descriptor and filename. */
1560 encoded_fn
= ENCODE_FILE (string
);
1561 pfn
= SSDATA (encoded_fn
);
1563 /* Check that we can access or open it. */
1564 if (NATNUMP (predicate
))
1567 if (INT_MAX
< XFASTINT (predicate
))
1568 last_errno
= EINVAL
;
1569 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1573 if (file_directory_p (pfn
))
1574 last_errno
= EISDIR
;
1581 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1584 if (errno
!= ENOENT
)
1589 int err
= (fstat (fd
, &st
) != 0 ? errno
1590 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1602 if (newer
&& !NATNUMP (predicate
))
1604 struct timespec mtime
= get_stat_mtime (&st
);
1606 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1611 emacs_close (save_fd
);
1614 save_string
= string
;
1619 /* We succeeded; return this descriptor and filename. */
1627 /* No more suffixes. Return the newest. */
1628 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1631 *storeptr
= save_string
;
1647 /* Merge the list we've accumulated of globals from the current input source
1648 into the load_history variable. The details depend on whether
1649 the source has an associated file name or not.
1651 FILENAME is the file name that we are loading from.
1653 ENTIRE is true if loading that entire file, false if evaluating
1657 build_load_history (Lisp_Object filename
, bool entire
)
1659 Lisp_Object tail
, prev
, newelt
;
1660 Lisp_Object tem
, tem2
;
1663 tail
= Vload_history
;
1666 while (CONSP (tail
))
1670 /* Find the feature's previous assoc list... */
1671 if (!NILP (Fequal (filename
, Fcar (tem
))))
1675 /* If we're loading the entire file, remove old data. */
1679 Vload_history
= XCDR (tail
);
1681 Fsetcdr (prev
, XCDR (tail
));
1684 /* Otherwise, cons on new symbols that are not already members. */
1687 tem2
= Vcurrent_load_list
;
1689 while (CONSP (tem2
))
1691 newelt
= XCAR (tem2
);
1693 if (NILP (Fmember (newelt
, tem
)))
1694 Fsetcar (tail
, Fcons (XCAR (tem
),
1695 Fcons (newelt
, XCDR (tem
))));
1708 /* If we're loading an entire file, cons the new assoc onto the
1709 front of load-history, the most-recently-loaded position. Also
1710 do this if we didn't find an existing member for the file. */
1711 if (entire
|| !foundit
)
1712 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1717 readevalloop_1 (int old
)
1719 load_convert_to_unibyte
= old
;
1722 /* Signal an `end-of-file' error, if possible with file name
1725 static _Noreturn
void
1726 end_of_file_error (void)
1728 if (STRINGP (Vload_file_name
))
1729 xsignal1 (Qend_of_file
, Vload_file_name
);
1731 xsignal0 (Qend_of_file
);
1735 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1737 /* If we macroexpand the toplevel form non-recursively and it ends
1738 up being a `progn' (or if it was a progn to start), treat each
1739 form in the progn as a top-level form. This way, if one form in
1740 the progn defines a macro, that macro is in effect when we expand
1741 the remaining forms. See similar code in bytecomp.el. */
1742 val
= call2 (macroexpand
, val
, Qnil
);
1743 if (EQ (CAR_SAFE (val
), Qprogn
))
1745 Lisp_Object subforms
= XCDR (val
);
1747 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1748 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1752 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1756 /* UNIBYTE specifies how to set load_convert_to_unibyte
1757 for this invocation.
1758 READFUN, if non-nil, is used instead of `read'.
1760 START, END specify region to read in current buffer (from eval-region).
1761 If the input is not from a buffer, they must be nil. */
1764 readevalloop (Lisp_Object readcharfun
,
1766 Lisp_Object sourcename
,
1768 Lisp_Object unibyte
, Lisp_Object readfun
,
1769 Lisp_Object start
, Lisp_Object end
)
1773 ptrdiff_t count
= SPECPDL_INDEX ();
1774 struct buffer
*b
= 0;
1775 bool continue_reading_p
;
1776 Lisp_Object lex_bound
;
1777 /* True if reading an entire buffer. */
1778 bool whole_buffer
= 0;
1779 /* True on the first time around. */
1780 bool first_sexp
= 1;
1781 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1783 if (NILP (Ffboundp (macroexpand
))
1784 /* Don't macroexpand in .elc files, since it should have been done
1785 already. We actually don't know whether we're in a .elc file or not,
1786 so we use circumstantial evidence: .el files normally go through
1787 Vload_source_file_function -> load-with-code-conversion
1789 || EQ (readcharfun
, Qget_file_char
)
1790 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1793 if (MARKERP (readcharfun
))
1796 start
= readcharfun
;
1799 if (BUFFERP (readcharfun
))
1800 b
= XBUFFER (readcharfun
);
1801 else if (MARKERP (readcharfun
))
1802 b
= XMARKER (readcharfun
)->buffer
;
1804 /* We assume START is nil when input is not from a buffer. */
1805 if (! NILP (start
) && !b
)
1808 specbind (Qstandard_input
, readcharfun
);
1809 specbind (Qcurrent_load_list
, Qnil
);
1810 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1811 load_convert_to_unibyte
= !NILP (unibyte
);
1813 /* If lexical binding is active (either because it was specified in
1814 the file's header, or via a buffer-local variable), create an empty
1815 lexical environment, otherwise, turn off lexical binding. */
1816 lex_bound
= find_symbol_value (Qlexical_binding
);
1817 specbind (Qinternal_interpreter_environment
,
1818 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1819 ? Qnil
: list1 (Qt
)));
1821 /* Try to ensure sourcename is a truename, except whilst preloading. */
1822 if (NILP (Vpurify_flag
)
1823 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1824 && !NILP (Ffboundp (Qfile_truename
)))
1825 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1827 LOADHIST_ATTACH (sourcename
);
1829 continue_reading_p
= 1;
1830 while (continue_reading_p
)
1832 ptrdiff_t count1
= SPECPDL_INDEX ();
1834 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1835 error ("Reading from killed buffer");
1839 /* Switch to the buffer we are reading from. */
1840 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1841 set_buffer_internal (b
);
1843 /* Save point in it. */
1844 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1845 /* Save ZV in it. */
1846 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1847 /* Those get unbound after we read one expression. */
1849 /* Set point and ZV around stuff to be read. */
1852 Fnarrow_to_region (make_number (BEGV
), end
);
1854 /* Just for cleanliness, convert END to a marker
1855 if it is an integer. */
1857 end
= Fpoint_max_marker ();
1860 /* On the first cycle, we can easily test here
1861 whether we are reading the whole buffer. */
1862 if (b
&& first_sexp
)
1863 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1870 while ((c
= READCHAR
) != '\n' && c
!= -1);
1875 unbind_to (count1
, Qnil
);
1879 /* Ignore whitespace here, so we can detect eof. */
1880 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1881 || c
== NO_BREAK_SPACE
)
1884 if (!NILP (Vpurify_flag
) && c
== '(')
1886 val
= read_list (0, readcharfun
);
1891 read_objects
= Qnil
;
1892 if (!NILP (readfun
))
1894 val
= call1 (readfun
, readcharfun
);
1896 /* If READCHARFUN has set point to ZV, we should
1897 stop reading, even if the form read sets point
1898 to a different value when evaluated. */
1899 if (BUFFERP (readcharfun
))
1901 struct buffer
*buf
= XBUFFER (readcharfun
);
1902 if (BUF_PT (buf
) == BUF_ZV (buf
))
1903 continue_reading_p
= 0;
1906 else if (! NILP (Vload_read_function
))
1907 val
= call1 (Vload_read_function
, readcharfun
);
1909 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1912 if (!NILP (start
) && continue_reading_p
)
1913 start
= Fpoint_marker ();
1915 /* Restore saved point and BEGV. */
1916 unbind_to (count1
, Qnil
);
1918 /* Now eval what we just read. */
1919 if (!NILP (macroexpand
))
1920 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1922 val
= eval_sub (val
);
1926 Vvalues
= Fcons (val
, Vvalues
);
1927 if (EQ (Vstandard_output
, Qt
))
1936 build_load_history (sourcename
,
1937 stream
|| whole_buffer
);
1939 unbind_to (count
, Qnil
);
1942 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1943 doc
: /* Execute the accessible portion of current buffer as Lisp code.
1944 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
1945 When called from a Lisp program (i.e., not interactively), this
1946 function accepts up to five optional arguments:
1947 BUFFER is the buffer to evaluate (nil means use current buffer),
1948 or a name of a buffer (a string).
1949 PRINTFLAG controls printing of output by any output functions in the
1950 evaluated code, such as `print', `princ', and `prin1':
1951 a value of nil means discard it; anything else is the stream to print to.
1952 See Info node `(elisp)Output Streams' for details on streams.
1953 FILENAME specifies the file name to use for `load-history'.
1954 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1956 DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
1957 evaluated code should work normally even if PRINTFLAG is nil, in
1958 which case the output is displayed in the echo area.
1960 This function preserves the position of point. */)
1961 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1963 ptrdiff_t count
= SPECPDL_INDEX ();
1964 Lisp_Object tem
, buf
;
1967 buf
= Fcurrent_buffer ();
1969 buf
= Fget_buffer (buffer
);
1971 error ("No such buffer");
1973 if (NILP (printflag
) && NILP (do_allow_print
))
1978 if (NILP (filename
))
1979 filename
= BVAR (XBUFFER (buf
), filename
);
1981 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1982 specbind (Qstandard_output
, tem
);
1983 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1984 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1985 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1986 readevalloop (buf
, 0, filename
,
1987 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1988 unbind_to (count
, Qnil
);
1993 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1994 doc
: /* Execute the region as Lisp code.
1995 When called from programs, expects two arguments,
1996 giving starting and ending indices in the current buffer
1997 of the text to be executed.
1998 Programs can pass third argument PRINTFLAG which controls output:
1999 a value of nil means discard it; anything else is stream for printing it.
2000 See Info node `(elisp)Output Streams' for details on streams.
2001 Also the fourth argument READ-FUNCTION, if non-nil, is used
2002 instead of `read' to read each expression. It gets one argument
2003 which is the input stream for reading characters.
2005 This function does not move point. */)
2006 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2008 /* FIXME: Do the eval-sexp-add-defvars dance! */
2009 ptrdiff_t count
= SPECPDL_INDEX ();
2010 Lisp_Object tem
, cbuf
;
2012 cbuf
= Fcurrent_buffer ();
2014 if (NILP (printflag
))
2018 specbind (Qstandard_output
, tem
);
2019 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2021 /* `readevalloop' calls functions which check the type of start and end. */
2022 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2023 !NILP (printflag
), Qnil
, read_function
,
2026 return unbind_to (count
, Qnil
);
2030 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2031 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2032 If STREAM is nil, use the value of `standard-input' (which see).
2033 STREAM or the value of `standard-input' may be:
2034 a buffer (read from point and advance it)
2035 a marker (read from where it points and advance it)
2036 a function (call it with no arguments for each character,
2037 call it with a char as argument to push a char back)
2038 a string (takes text from string, starting at the beginning)
2039 t (read text line using minibuffer and use it, or read from
2040 standard input in batch mode). */)
2041 (Lisp_Object stream
)
2044 stream
= Vstandard_input
;
2045 if (EQ (stream
, Qt
))
2046 stream
= Qread_char
;
2047 if (EQ (stream
, Qread_char
))
2048 /* FIXME: ?! When is this used !? */
2049 return call1 (intern ("read-minibuffer"),
2050 build_string ("Lisp expression: "));
2052 return read_internal_start (stream
, Qnil
, Qnil
);
2055 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2056 doc
: /* Read one Lisp expression which is represented as text by STRING.
2057 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2058 FINAL-STRING-INDEX is an integer giving the position of the next
2059 remaining character in STRING. START and END optionally delimit
2060 a substring of STRING from which to read; they default to 0 and
2061 \(length STRING) respectively. Negative values are counted from
2062 the end of STRING. */)
2063 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2066 CHECK_STRING (string
);
2067 /* `read_internal_start' sets `read_from_string_index'. */
2068 ret
= read_internal_start (string
, start
, end
);
2069 return Fcons (ret
, make_number (read_from_string_index
));
2072 /* Function to set up the global context we need in toplevel read
2073 calls. START and END only used when STREAM is a string. */
2075 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2080 new_backquote_flag
= 0;
2081 read_objects
= Qnil
;
2082 if (EQ (Vread_with_symbol_positions
, Qt
)
2083 || EQ (Vread_with_symbol_positions
, stream
))
2084 Vread_symbol_positions_list
= Qnil
;
2086 if (STRINGP (stream
)
2087 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2089 ptrdiff_t startval
, endval
;
2092 if (STRINGP (stream
))
2095 string
= XCAR (stream
);
2097 validate_subarray (string
, start
, end
, SCHARS (string
),
2098 &startval
, &endval
);
2100 read_from_string_index
= startval
;
2101 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2102 read_from_string_limit
= endval
;
2105 retval
= read0 (stream
);
2106 if (EQ (Vread_with_symbol_positions
, Qt
)
2107 || EQ (Vread_with_symbol_positions
, stream
))
2108 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2113 /* Signal Qinvalid_read_syntax error.
2114 S is error string of length N (if > 0) */
2116 static _Noreturn
void
2117 invalid_syntax (const char *s
)
2119 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2123 /* Use this for recursive reads, in contexts where internal tokens
2127 read0 (Lisp_Object readcharfun
)
2129 register Lisp_Object val
;
2132 val
= read1 (readcharfun
, &c
, 0);
2136 xsignal1 (Qinvalid_read_syntax
,
2137 Fmake_string (make_number (1), make_number (c
)));
2140 static ptrdiff_t read_buffer_size
;
2141 static char *read_buffer
;
2143 /* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes. */
2146 grow_read_buffer (void)
2148 read_buffer
= xpalloc (read_buffer
, &read_buffer_size
,
2149 MAX_MULTIBYTE_LENGTH
, -1, 1);
2152 /* Read a \-escape sequence, assuming we already read the `\'.
2153 If the escape sequence forces unibyte, return eight-bit char. */
2156 read_escape (Lisp_Object readcharfun
, bool stringp
)
2159 /* \u allows up to four hex digits, \U up to eight. Default to the
2160 behavior for \u, and change this value in the case that \U is seen. */
2161 int unicode_hex_count
= 4;
2166 end_of_file_error ();
2196 error ("Invalid escape character syntax");
2199 c
= read_escape (readcharfun
, 0);
2200 return c
| meta_modifier
;
2205 error ("Invalid escape character syntax");
2208 c
= read_escape (readcharfun
, 0);
2209 return c
| shift_modifier
;
2214 error ("Invalid escape character syntax");
2217 c
= read_escape (readcharfun
, 0);
2218 return c
| hyper_modifier
;
2223 error ("Invalid escape character syntax");
2226 c
= read_escape (readcharfun
, 0);
2227 return c
| alt_modifier
;
2231 if (stringp
|| c
!= '-')
2238 c
= read_escape (readcharfun
, 0);
2239 return c
| super_modifier
;
2244 error ("Invalid escape character syntax");
2248 c
= read_escape (readcharfun
, 0);
2249 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2250 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2251 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2252 return c
| ctrl_modifier
;
2253 /* ASCII control chars are made from letters (both cases),
2254 as well as the non-letters within 0100...0137. */
2255 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2256 return (c
& (037 | ~0177));
2257 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2258 return (c
& (037 | ~0177));
2260 return c
| ctrl_modifier
;
2270 /* An octal escape, as in ANSI C. */
2272 register int i
= c
- '0';
2273 register int count
= 0;
2276 if ((c
= READCHAR
) >= '0' && c
<= '7')
2288 if (i
>= 0x80 && i
< 0x100)
2289 i
= BYTE8_TO_CHAR (i
);
2294 /* A hex escape, as in ANSI C. */
2301 if (c
>= '0' && c
<= '9')
2306 else if ((c
>= 'a' && c
<= 'f')
2307 || (c
>= 'A' && c
<= 'F'))
2310 if (c
>= 'a' && c
<= 'f')
2320 /* Allow hex escapes as large as ?\xfffffff, because some
2321 packages use them to denote characters with modifiers. */
2322 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2323 error ("Hex character out of range: \\x%x...", i
);
2327 if (count
< 3 && i
>= 0x80)
2328 return BYTE8_TO_CHAR (i
);
2333 /* Post-Unicode-2.0: Up to eight hex chars. */
2334 unicode_hex_count
= 8;
2337 /* A Unicode escape. We only permit them in strings and characters,
2338 not arbitrarily in the source code, as in some other languages. */
2343 while (++count
<= unicode_hex_count
)
2346 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2348 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2349 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2350 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2352 error ("Non-hex digit used for Unicode escape");
2355 error ("Non-Unicode character: 0x%x", i
);
2364 /* Return the digit that CHARACTER stands for in the given BASE.
2365 Return -1 if CHARACTER is out of range for BASE,
2366 and -2 if CHARACTER is not valid for any supported BASE. */
2368 digit_to_number (int character
, int base
)
2372 if ('0' <= character
&& character
<= '9')
2373 digit
= character
- '0';
2374 else if ('a' <= character
&& character
<= 'z')
2375 digit
= character
- 'a' + 10;
2376 else if ('A' <= character
&& character
<= 'Z')
2377 digit
= character
- 'A' + 10;
2381 return digit
< base
? digit
: -1;
2384 /* Read an integer in radix RADIX using READCHARFUN to read
2385 characters. RADIX must be in the interval [2..36]; if it isn't, a
2386 read error is signaled . Value is the integer read. Signals an
2387 error if encountering invalid read syntax or if RADIX is out of
2391 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2393 /* Room for sign, leading 0, other digits, trailing null byte.
2394 Also, room for invalid syntax diagnostic. */
2395 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2396 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2398 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2400 if (radix
< 2 || radix
> 36)
2408 if (c
== '-' || c
== '+')
2419 /* Ignore redundant leading zeros, so the buffer doesn't
2420 fill up with them. */
2426 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2433 if (p
< buf
+ sizeof buf
- 1)
2447 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2448 invalid_syntax (buf
);
2451 return string_to_number (buf
, radix
, 0);
2455 /* If the next token is ')' or ']' or '.', we store that character
2456 in *PCH and the return value is not interesting. Else, we store
2457 zero in *PCH and we read and return one lisp object.
2459 FIRST_IN_LIST is true if this is the first element of a list. */
2462 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2465 bool uninterned_symbol
= 0;
2472 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2474 end_of_file_error ();
2479 return read_list (0, readcharfun
);
2482 return read_vector (readcharfun
, 0);
2498 /* Accept extended format for hashtables (extensible to
2500 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2501 Lisp_Object tmp
= read_list (0, readcharfun
);
2502 Lisp_Object head
= CAR_SAFE (tmp
);
2503 Lisp_Object data
= Qnil
;
2504 Lisp_Object val
= Qnil
;
2505 /* The size is 2 * number of allowed keywords to
2507 Lisp_Object params
[10];
2509 Lisp_Object key
= Qnil
;
2510 int param_count
= 0;
2512 if (!EQ (head
, Qhash_table
))
2513 error ("Invalid extended read marker at head of #s list "
2514 "(only hash-table allowed)");
2516 tmp
= CDR_SAFE (tmp
);
2518 /* This is repetitive but fast and simple. */
2519 params
[param_count
] = QCsize
;
2520 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2521 if (!NILP (params
[param_count
+ 1]))
2524 params
[param_count
] = QCtest
;
2525 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2526 if (!NILP (params
[param_count
+ 1]))
2529 params
[param_count
] = QCweakness
;
2530 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2531 if (!NILP (params
[param_count
+ 1]))
2534 params
[param_count
] = QCrehash_size
;
2535 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2536 if (!NILP (params
[param_count
+ 1]))
2539 params
[param_count
] = QCrehash_threshold
;
2540 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2541 if (!NILP (params
[param_count
+ 1]))
2544 /* This is the hashtable data. */
2545 data
= Fplist_get (tmp
, Qdata
);
2547 /* Now use params to make a new hashtable and fill it. */
2548 ht
= Fmake_hash_table (param_count
, params
);
2550 while (CONSP (data
))
2555 error ("Odd number of elements in hashtable data");
2558 Fputhash (key
, val
, ht
);
2564 invalid_syntax ("#");
2572 tmp
= read_vector (readcharfun
, 0);
2573 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2574 error ("Invalid size char-table");
2575 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2583 /* Sub char-table can't be read as a regular
2584 vector because of a two C integer fields. */
2585 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2586 ptrdiff_t size
= XINT (Flength (tmp
));
2587 int i
, depth
, min_char
;
2588 struct Lisp_Cons
*cell
;
2591 error ("Zero-sized sub char-table");
2593 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2594 error ("Invalid depth in sub char-table");
2595 depth
= XINT (XCAR (tmp
));
2596 if (chartab_size
[depth
] != size
- 2)
2597 error ("Invalid size in sub char-table");
2598 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2601 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2602 error ("Invalid minimum character in sub-char-table");
2603 min_char
= XINT (XCAR (tmp
));
2604 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2607 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2608 for (i
= 0; i
< size
; i
++)
2610 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2611 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2616 invalid_syntax ("#^^");
2618 invalid_syntax ("#^");
2623 length
= read1 (readcharfun
, pch
, first_in_list
);
2627 Lisp_Object tmp
, val
;
2628 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2629 unsigned char *data
;
2632 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2633 if (STRING_MULTIBYTE (tmp
)
2634 || (size_in_chars
!= SCHARS (tmp
)
2635 /* We used to print 1 char too many
2636 when the number of bits was a multiple of 8.
2637 Accept such input in case it came from an old
2639 && ! (XFASTINT (length
)
2640 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2641 invalid_syntax ("#&...");
2643 val
= make_uninit_bool_vector (XFASTINT (length
));
2644 data
= bool_vector_uchar_data (val
);
2645 memcpy (data
, SDATA (tmp
), size_in_chars
);
2646 /* Clear the extraneous bits in the last byte. */
2647 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2648 data
[size_in_chars
- 1]
2649 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2652 invalid_syntax ("#&...");
2656 /* Accept compiled functions at read-time so that we don't have to
2657 build them using function calls. */
2659 struct Lisp_Vector
*vec
;
2660 tmp
= read_vector (readcharfun
, 1);
2661 vec
= XVECTOR (tmp
);
2662 if (vec
->header
.size
== 0)
2663 invalid_syntax ("Empty byte-code object");
2664 make_byte_code (vec
);
2672 /* Read the string itself. */
2673 tmp
= read1 (readcharfun
, &ch
, 0);
2674 if (ch
!= 0 || !STRINGP (tmp
))
2675 invalid_syntax ("#");
2676 /* Read the intervals and their properties. */
2679 Lisp_Object beg
, end
, plist
;
2681 beg
= read1 (readcharfun
, &ch
, 0);
2686 end
= read1 (readcharfun
, &ch
, 0);
2688 plist
= read1 (readcharfun
, &ch
, 0);
2690 invalid_syntax ("Invalid string property list");
2691 Fset_text_properties (beg
, end
, plist
, tmp
);
2697 /* #@NUMBER is used to skip NUMBER following bytes.
2698 That's used in .elc files to skip over doc strings
2699 and function definitions. */
2702 enum { extra
= 100 };
2703 ptrdiff_t i
, nskip
= 0, digits
= 0;
2705 /* Read a decimal integer. */
2706 while ((c
= READCHAR
) >= 0
2707 && c
>= '0' && c
<= '9')
2709 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2714 if (digits
== 2 && nskip
== 0)
2715 { /* We've just seen #@00, which means "skip to end". */
2716 skip_dyn_eof (readcharfun
);
2721 /* We can't use UNREAD here, because in the code below we side-step
2722 READCHAR. Instead, assume the first char after #@NNN occupies
2723 a single byte, which is the case normally since it's just
2729 if (load_force_doc_strings
2730 && (FROM_FILE_P (readcharfun
)))
2732 /* If we are supposed to force doc strings into core right now,
2733 record the last string that we skipped,
2734 and record where in the file it comes from. */
2736 /* But first exchange saved_doc_string
2737 with prev_saved_doc_string, so we save two strings. */
2739 char *temp
= saved_doc_string
;
2740 ptrdiff_t temp_size
= saved_doc_string_size
;
2741 file_offset temp_pos
= saved_doc_string_position
;
2742 ptrdiff_t temp_len
= saved_doc_string_length
;
2744 saved_doc_string
= prev_saved_doc_string
;
2745 saved_doc_string_size
= prev_saved_doc_string_size
;
2746 saved_doc_string_position
= prev_saved_doc_string_position
;
2747 saved_doc_string_length
= prev_saved_doc_string_length
;
2749 prev_saved_doc_string
= temp
;
2750 prev_saved_doc_string_size
= temp_size
;
2751 prev_saved_doc_string_position
= temp_pos
;
2752 prev_saved_doc_string_length
= temp_len
;
2755 if (saved_doc_string_size
== 0)
2757 saved_doc_string
= xmalloc (nskip
+ extra
);
2758 saved_doc_string_size
= nskip
+ extra
;
2760 if (nskip
> saved_doc_string_size
)
2762 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2763 saved_doc_string_size
= nskip
+ extra
;
2766 saved_doc_string_position
= file_tell (instream
);
2768 /* Copy that many characters into saved_doc_string. */
2770 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2771 saved_doc_string
[i
] = c
= getc (instream
);
2774 saved_doc_string_length
= i
;
2777 /* Skip that many bytes. */
2778 skip_dyn_bytes (readcharfun
, nskip
);
2784 /* #! appears at the beginning of an executable file.
2785 Skip the first line. */
2786 while (c
!= '\n' && c
>= 0)
2791 return Vload_file_name
;
2793 return list2 (Qfunction
, read0 (readcharfun
));
2794 /* #:foo is the uninterned symbol named foo. */
2797 uninterned_symbol
= 1;
2800 && c
!= NO_BREAK_SPACE
2802 || strchr ("\"';()[]#`,", c
) == NULL
)))
2804 /* No symbol character follows, this is the empty
2807 return Fmake_symbol (empty_unibyte_string
);
2811 /* ## is the empty symbol. */
2813 return Fintern (empty_unibyte_string
, Qnil
);
2814 /* Reader forms that can reuse previously read objects. */
2815 if (c
>= '0' && c
<= '9')
2820 /* Read a non-negative integer. */
2821 while (c
>= '0' && c
<= '9')
2823 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2824 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2825 n
= MOST_POSITIVE_FIXNUM
+ 1;
2827 n
= n
* 10 + c
- '0';
2831 if (n
<= MOST_POSITIVE_FIXNUM
)
2833 if (c
== 'r' || c
== 'R')
2834 return read_integer (readcharfun
, n
);
2836 if (! NILP (Vread_circle
))
2838 /* #n=object returns object, but associates it with
2842 /* Make a placeholder for #n# to use temporarily. */
2843 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2844 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2845 read_objects
= Fcons (cell
, read_objects
);
2847 /* Read the object itself. */
2848 tem
= read0 (readcharfun
);
2850 /* Now put it everywhere the placeholder was... */
2851 substitute_object_in_subtree (tem
, placeholder
);
2853 /* ...and #n# will use the real value from now on. */
2854 Fsetcdr (cell
, tem
);
2859 /* #n# returns a previously read object. */
2862 tem
= Fassq (make_number (n
), read_objects
);
2868 /* Fall through to error message. */
2870 else if (c
== 'x' || c
== 'X')
2871 return read_integer (readcharfun
, 16);
2872 else if (c
== 'o' || c
== 'O')
2873 return read_integer (readcharfun
, 8);
2874 else if (c
== 'b' || c
== 'B')
2875 return read_integer (readcharfun
, 2);
2878 invalid_syntax ("#");
2881 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2885 return list2 (Qquote
, read0 (readcharfun
));
2889 int next_char
= READCHAR
;
2891 /* Transition from old-style to new-style:
2892 If we see "(`" it used to mean old-style, which usually works
2893 fine because ` should almost never appear in such a position
2894 for new-style. But occasionally we need "(`" to mean new
2895 style, so we try to distinguish the two by the fact that we
2896 can either write "( `foo" or "(` foo", where the first
2897 intends to use new-style whereas the second intends to use
2898 old-style. For Emacs-25, we should completely remove this
2899 first_in_list exception (old-style can still be obtained via
2901 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2903 Vold_style_backquotes
= Qt
;
2909 bool saved_new_backquote_flag
= new_backquote_flag
;
2911 new_backquote_flag
= 1;
2912 value
= read0 (readcharfun
);
2913 new_backquote_flag
= saved_new_backquote_flag
;
2915 return list2 (Qbackquote
, value
);
2920 int next_char
= READCHAR
;
2922 /* Transition from old-style to new-style:
2923 It used to be impossible to have a new-style , other than within
2924 a new-style `. This is sufficient when ` and , are used in the
2925 normal way, but ` and , can also appear in args to macros that
2926 will not interpret them in the usual way, in which case , may be
2927 used without any ` anywhere near.
2928 So we now use the same heuristic as for backquote: old-style
2929 unquotes are only recognized when first on a list, and when
2930 followed by a space.
2931 Because it's more difficult to peek 2 chars ahead, a new-style
2932 ,@ can still not be used outside of a `, unless it's in the middle
2934 if (new_backquote_flag
2936 || (next_char
!= ' ' && next_char
!= '@'))
2938 Lisp_Object comma_type
= Qnil
;
2943 comma_type
= Qcomma_at
;
2945 comma_type
= Qcomma_dot
;
2948 if (ch
>= 0) UNREAD (ch
);
2949 comma_type
= Qcomma
;
2952 value
= read0 (readcharfun
);
2953 return list2 (comma_type
, value
);
2957 Vold_style_backquotes
= Qt
;
2969 end_of_file_error ();
2971 /* Accept `single space' syntax like (list ? x) where the
2972 whitespace character is SPC or TAB.
2973 Other literal whitespace like NL, CR, and FF are not accepted,
2974 as there are well-established escape sequences for these. */
2975 if (c
== ' ' || c
== '\t')
2976 return make_number (c
);
2979 c
= read_escape (readcharfun
, 0);
2980 modifiers
= c
& CHAR_MODIFIER_MASK
;
2981 c
&= ~CHAR_MODIFIER_MASK
;
2982 if (CHAR_BYTE8_P (c
))
2983 c
= CHAR_TO_BYTE8 (c
);
2986 next_char
= READCHAR
;
2987 ok
= (next_char
<= 040
2988 || (next_char
< 0200
2989 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2992 return make_number (c
);
2994 invalid_syntax ("?");
2999 char *p
= read_buffer
;
3000 char *end
= read_buffer
+ read_buffer_size
;
3002 /* True if we saw an escape sequence specifying
3003 a multibyte character. */
3004 bool force_multibyte
= 0;
3005 /* True if we saw an escape sequence specifying
3006 a single-byte character. */
3007 bool force_singlebyte
= 0;
3009 ptrdiff_t nchars
= 0;
3011 while ((ch
= READCHAR
) >= 0
3014 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3016 ptrdiff_t offset
= p
- read_buffer
;
3017 grow_read_buffer ();
3018 p
= read_buffer
+ offset
;
3019 end
= read_buffer
+ read_buffer_size
;
3026 ch
= read_escape (readcharfun
, 1);
3028 /* CH is -1 if \ newline or \ space has just been seen. */
3031 if (p
== read_buffer
)
3036 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3037 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3039 if (CHAR_BYTE8_P (ch
))
3040 force_singlebyte
= 1;
3041 else if (! ASCII_CHAR_P (ch
))
3042 force_multibyte
= 1;
3043 else /* I.e. ASCII_CHAR_P (ch). */
3045 /* Allow `\C- ' and `\C-?'. */
3046 if (modifiers
== CHAR_CTL
)
3049 ch
= 0, modifiers
= 0;
3051 ch
= 127, modifiers
= 0;
3053 if (modifiers
& CHAR_SHIFT
)
3055 /* Shift modifier is valid only with [A-Za-z]. */
3056 if (ch
>= 'A' && ch
<= 'Z')
3057 modifiers
&= ~CHAR_SHIFT
;
3058 else if (ch
>= 'a' && ch
<= 'z')
3059 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3062 if (modifiers
& CHAR_META
)
3064 /* Move the meta bit to the right place for a
3066 modifiers
&= ~CHAR_META
;
3067 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3068 force_singlebyte
= 1;
3072 /* Any modifiers remaining are invalid. */
3074 error ("Invalid modifier in string");
3075 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3079 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3080 if (CHAR_BYTE8_P (ch
))
3081 force_singlebyte
= 1;
3082 else if (! ASCII_CHAR_P (ch
))
3083 force_multibyte
= 1;
3089 end_of_file_error ();
3091 /* If purifying, and string starts with \ newline,
3092 return zero instead. This is for doc strings
3093 that we are really going to find in etc/DOC.nn.nn. */
3094 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3095 return make_number (0);
3097 if (! force_multibyte
&& force_singlebyte
)
3099 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3100 forms. Convert it to unibyte. */
3101 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3103 p
= read_buffer
+ nchars
;
3106 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3108 || (p
- read_buffer
!= nchars
)));
3113 int next_char
= READCHAR
;
3116 if (next_char
<= 040
3117 || (next_char
< 0200
3118 && strchr ("\"';([#?`,", next_char
) != NULL
))
3124 /* Otherwise, we fall through! Note that the atom-reading loop
3125 below will now loop at least once, assuring that we will not
3126 try to UNREAD two characters in a row. */
3130 if (c
<= 040) goto retry
;
3131 if (c
== NO_BREAK_SPACE
)
3136 char *p
= read_buffer
;
3138 EMACS_INT start_position
= readchar_count
- 1;
3141 char *end
= read_buffer
+ read_buffer_size
;
3145 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3147 ptrdiff_t offset
= p
- read_buffer
;
3148 grow_read_buffer ();
3149 p
= read_buffer
+ offset
;
3150 end
= read_buffer
+ read_buffer_size
;
3157 end_of_file_error ();
3162 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3168 && c
!= NO_BREAK_SPACE
3170 || strchr ("\"';()[]#`,", c
) == NULL
));
3174 ptrdiff_t offset
= p
- read_buffer
;
3175 grow_read_buffer ();
3176 p
= read_buffer
+ offset
;
3177 end
= read_buffer
+ read_buffer_size
;
3183 if (!quoted
&& !uninterned_symbol
)
3185 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3186 if (! NILP (result
))
3190 Lisp_Object name
, result
;
3191 ptrdiff_t nbytes
= p
- read_buffer
;
3194 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3198 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3199 ? make_pure_string
: make_specified_string
)
3200 (read_buffer
, nchars
, nbytes
, multibyte
));
3201 result
= (uninterned_symbol
? Fmake_symbol (name
)
3202 : Fintern (name
, Qnil
));
3204 if (EQ (Vread_with_symbol_positions
, Qt
)
3205 || EQ (Vread_with_symbol_positions
, readcharfun
))
3206 Vread_symbol_positions_list
3207 = Fcons (Fcons (result
, make_number (start_position
)),
3208 Vread_symbol_positions_list
);
3216 /* List of nodes we've seen during substitute_object_in_subtree. */
3217 static Lisp_Object seen_list
;
3220 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3222 Lisp_Object check_object
;
3224 /* We haven't seen any objects when we start. */
3227 /* Make all the substitutions. */
3229 = substitute_object_recurse (object
, placeholder
, object
);
3231 /* Clear seen_list because we're done with it. */
3234 /* The returned object here is expected to always eq the
3236 if (!EQ (check_object
, object
))
3237 error ("Unexpected mutation error in reader");
3240 /* Feval doesn't get called from here, so no gc protection is needed. */
3241 #define SUBSTITUTE(get_val, set_val) \
3243 Lisp_Object old_value = get_val; \
3244 Lisp_Object true_value \
3245 = substitute_object_recurse (object, placeholder, \
3248 if (!EQ (old_value, true_value)) \
3255 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3257 /* If we find the placeholder, return the target object. */
3258 if (EQ (placeholder
, subtree
))
3261 /* If we've been to this node before, don't explore it again. */
3262 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3265 /* If this node can be the entry point to a cycle, remember that
3266 we've seen it. It can only be such an entry point if it was made
3267 by #n=, which means that we can find it as a value in
3269 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3270 seen_list
= Fcons (subtree
, seen_list
);
3272 /* Recurse according to subtree's type.
3273 Every branch must return a Lisp_Object. */
3274 switch (XTYPE (subtree
))
3276 case Lisp_Vectorlike
:
3278 ptrdiff_t i
= 0, length
= 0;
3279 if (BOOL_VECTOR_P (subtree
))
3280 return subtree
; /* No sub-objects anyway. */
3281 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3282 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3283 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3284 else if (VECTORP (subtree
))
3285 length
= ASIZE (subtree
);
3287 /* An unknown pseudovector may contain non-Lisp fields, so we
3288 can't just blindly traverse all its fields. We used to call
3289 `Flength' which signaled `sequencep', so I just preserved this
3291 wrong_type_argument (Qsequencep
, subtree
);
3293 if (SUB_CHAR_TABLE_P (subtree
))
3295 for ( ; i
< length
; i
++)
3296 SUBSTITUTE (AREF (subtree
, i
),
3297 ASET (subtree
, i
, true_value
));
3303 SUBSTITUTE (XCAR (subtree
),
3304 XSETCAR (subtree
, true_value
));
3305 SUBSTITUTE (XCDR (subtree
),
3306 XSETCDR (subtree
, true_value
));
3312 /* Check for text properties in each interval.
3313 substitute_in_interval contains part of the logic. */
3315 INTERVAL root_interval
= string_intervals (subtree
);
3316 AUTO_CONS (arg
, object
, placeholder
);
3318 traverse_intervals_noorder (root_interval
,
3319 &substitute_in_interval
, arg
);
3324 /* Other types don't recurse any further. */
3330 /* Helper function for substitute_object_recurse. */
3332 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3334 Lisp_Object object
= Fcar (arg
);
3335 Lisp_Object placeholder
= Fcdr (arg
);
3337 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3347 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3348 integer syntax and fits in a fixnum, else return the nearest float if CP has
3349 either floating point or integer syntax and BASE is 10, else return nil. If
3350 IGNORE_TRAILING, consider just the longest prefix of CP that has
3351 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3352 number has integer syntax but does not fit. */
3355 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3358 char const *cp
= string
;
3360 bool float_syntax
= 0;
3363 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3364 IEEE floating point hosts, and works around a formerly-common bug where
3365 atof ("-0.0") drops the sign. */
3366 bool negative
= *cp
== '-';
3368 bool signedp
= negative
|| *cp
== '+';
3373 leading_digit
= digit_to_number (*cp
, base
);
3374 if (leading_digit
>= 0)
3379 while (digit_to_number (*cp
, base
) >= 0);
3389 if ('0' <= *cp
&& *cp
<= '9')
3394 while ('0' <= *cp
&& *cp
<= '9');
3396 if (*cp
== 'e' || *cp
== 'E')
3398 char const *ecp
= cp
;
3400 if (*cp
== '+' || *cp
== '-')
3402 if ('0' <= *cp
&& *cp
<= '9')
3407 while ('0' <= *cp
&& *cp
<= '9');
3409 else if (cp
[-1] == '+'
3410 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3416 else if (cp
[-1] == '+'
3417 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3421 /* NAN is a "positive" NaN on all known Emacs hosts. */
3428 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3429 || state
== (LEAD_INT
|E_EXP
));
3432 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3433 any prefix that matches. Otherwise, the entire string must match. */
3434 if (! (ignore_trailing
3435 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3436 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3439 /* If the number uses integer and not float syntax, and is in C-language
3440 range, use its value, preferably as a fixnum. */
3441 if (leading_digit
>= 0 && ! float_syntax
)
3445 /* Fast special case for single-digit integers. This also avoids a
3446 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3447 case some versions of strtoumax accept numbers like "0x1" that Emacs
3449 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3450 return make_number (negative
? -leading_digit
: leading_digit
);
3453 n
= strtoumax (string
+ signedp
, NULL
, base
);
3454 if (errno
== ERANGE
)
3456 /* Unfortunately there's no simple and accurate way to convert
3457 non-base-10 numbers that are out of C-language range. */
3459 xsignal1 (Qoverflow_error
, build_string (string
));
3461 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3463 EMACS_INT signed_n
= n
;
3464 return make_number (negative
? -signed_n
: signed_n
);
3470 /* Either the number uses float syntax, or it does not fit into a fixnum.
3471 Convert it from string to floating point, unless the value is already
3472 known because it is an infinity, a NAN, or its absolute value fits in
3475 value
= atof (string
+ signedp
);
3477 return make_float (negative
? -value
: value
);
3482 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3486 Lisp_Object tem
, item
, vector
;
3487 struct Lisp_Cons
*otem
;
3490 tem
= read_list (1, readcharfun
);
3491 len
= Flength (tem
);
3492 vector
= Fmake_vector (len
, Qnil
);
3494 size
= ASIZE (vector
);
3495 ptr
= XVECTOR (vector
)->contents
;
3496 for (i
= 0; i
< size
; i
++)
3499 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3500 bytecode object, the docstring containing the bytecode and
3501 constants values must be treated as unibyte and passed to
3502 Fread, to get the actual bytecode string and constants vector. */
3503 if (bytecodeflag
&& load_force_doc_strings
)
3505 if (i
== COMPILED_BYTECODE
)
3507 if (!STRINGP (item
))
3508 error ("Invalid byte code");
3510 /* Delay handling the bytecode slot until we know whether
3511 it is lazily-loaded (we can tell by whether the
3512 constants slot is nil). */
3513 ASET (vector
, COMPILED_CONSTANTS
, item
);
3516 else if (i
== COMPILED_CONSTANTS
)
3518 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3522 /* Coerce string to unibyte (like string-as-unibyte,
3523 but without generating extra garbage and
3524 guaranteeing no change in the contents). */
3525 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3526 STRING_SET_UNIBYTE (bytestr
);
3528 item
= Fread (Fcons (bytestr
, readcharfun
));
3530 error ("Invalid byte code");
3532 otem
= XCONS (item
);
3533 bytestr
= XCAR (item
);
3538 /* Now handle the bytecode slot. */
3539 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3541 else if (i
== COMPILED_DOC_STRING
3543 && ! STRING_MULTIBYTE (item
))
3545 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3546 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3548 item
= Fstring_as_multibyte (item
);
3551 ASET (vector
, i
, item
);
3559 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3562 read_list (bool flag
, Lisp_Object readcharfun
)
3564 Lisp_Object val
, tail
;
3565 Lisp_Object elt
, tem
;
3566 /* 0 is the normal case.
3567 1 means this list is a doc reference; replace it with the number 0.
3568 2 means this list is a doc reference; replace it with the doc string. */
3569 int doc_reference
= 0;
3571 /* Initialize this to 1 if we are reading a list. */
3572 bool first_in_list
= flag
<= 0;
3580 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3584 /* While building, if the list starts with #$, treat it specially. */
3585 if (EQ (elt
, Vload_file_name
)
3587 && !NILP (Vpurify_flag
))
3589 if (NILP (Vdoc_file_name
))
3590 /* We have not yet called Snarf-documentation, so assume
3591 this file is described in the DOC file
3592 and Snarf-documentation will fill in the right value later.
3593 For now, replace the whole list with 0. */
3596 /* We have already called Snarf-documentation, so make a relative
3597 file name for this file, so it can be found properly
3598 in the installed Lisp directory.
3599 We don't use Fexpand_file_name because that would make
3600 the directory absolute now. */
3602 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3603 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3606 else if (EQ (elt
, Vload_file_name
)
3608 && load_force_doc_strings
)
3617 invalid_syntax (") or . in a vector");
3624 XSETCDR (tail
, read0 (readcharfun
));
3626 val
= read0 (readcharfun
);
3627 read1 (readcharfun
, &ch
, 0);
3631 if (doc_reference
== 1)
3632 return make_number (0);
3633 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3636 file_offset saved_position
;
3637 /* Get a doc string from the file we are loading.
3638 If it's in saved_doc_string, get it from there.
3640 Here, we don't know if the string is a
3641 bytecode string or a doc string. As a
3642 bytecode string must be unibyte, we always
3643 return a unibyte string. If it is actually a
3644 doc string, caller must make it
3647 /* Position is negative for user variables. */
3648 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3649 if (pos
>= saved_doc_string_position
3650 && pos
< (saved_doc_string_position
3651 + saved_doc_string_length
))
3653 saved
= saved_doc_string
;
3654 saved_position
= saved_doc_string_position
;
3656 /* Look in prev_saved_doc_string the same way. */
3657 else if (pos
>= prev_saved_doc_string_position
3658 && pos
< (prev_saved_doc_string_position
3659 + prev_saved_doc_string_length
))
3661 saved
= prev_saved_doc_string
;
3662 saved_position
= prev_saved_doc_string_position
;
3666 ptrdiff_t start
= pos
- saved_position
;
3669 /* Process quoting with ^A,
3670 and find the end of the string,
3671 which is marked with ^_ (037). */
3672 for (from
= start
, to
= start
;
3673 saved
[from
] != 037;)
3675 int c
= saved
[from
++];
3679 saved
[to
++] = (c
== 1 ? c
3688 return make_unibyte_string (saved
+ start
,
3692 return get_doc_string (val
, 1, 0);
3697 invalid_syntax (". in wrong context");
3699 invalid_syntax ("] in a list");
3703 XSETCDR (tail
, tem
);
3710 static Lisp_Object initial_obarray
;
3712 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3714 static size_t oblookup_last_bucket_number
;
3716 /* Get an error if OBARRAY is not an obarray.
3717 If it is one, return it. */
3720 check_obarray (Lisp_Object obarray
)
3722 /* We don't want to signal a wrong-type-argument error when we are
3723 shutting down due to a fatal error, and we don't want to hit
3724 assertions in VECTORP and ASIZE if the fatal error was during GC. */
3725 if (!fatal_error_in_progress
3726 && (!VECTORP (obarray
) || ASIZE (obarray
) == 0))
3728 /* If Vobarray is now invalid, force it to be valid. */
3729 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3730 wrong_type_argument (Qvectorp
, obarray
);
3735 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3738 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3742 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3743 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3746 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3748 XSYMBOL (sym
)->constant
= 1;
3749 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3750 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3753 ptr
= aref_addr (obarray
, XINT (index
));
3754 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3759 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3762 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3764 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3767 /* Intern the C string STR: return a symbol with that name,
3768 interned in the current obarray. */
3771 intern_1 (const char *str
, ptrdiff_t len
)
3773 Lisp_Object obarray
= check_obarray (Vobarray
);
3774 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3776 return (SYMBOLP (tem
) ? tem
3777 /* The above `oblookup' was done on the basis of nchars==nbytes, so
3778 the string has to be unibyte. */
3779 : intern_driver (make_unibyte_string (str
, len
),
3784 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3786 Lisp_Object obarray
= check_obarray (Vobarray
);
3787 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3791 /* Creating a non-pure string from a string literal not implemented yet.
3792 We could just use make_string here and live with the extra copy. */
3793 eassert (!NILP (Vpurify_flag
));
3794 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3800 define_symbol (Lisp_Object sym
, char const *str
)
3802 ptrdiff_t len
= strlen (str
);
3803 Lisp_Object string
= make_pure_c_string (str
, len
);
3804 init_symbol (sym
, string
);
3806 /* Qunbound is uninterned, so that it's not confused with any symbol
3807 'unbound' created by a Lisp program. */
3808 if (! EQ (sym
, Qunbound
))
3810 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3811 eassert (INTEGERP (bucket
));
3812 intern_sym (sym
, initial_obarray
, bucket
);
3816 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3817 doc
: /* Return the canonical symbol whose name is STRING.
3818 If there is none, one is created by this function and returned.
3819 A second optional argument specifies the obarray to use;
3820 it defaults to the value of `obarray'. */)
3821 (Lisp_Object string
, Lisp_Object obarray
)
3825 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3826 CHECK_STRING (string
);
3828 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3830 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3835 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3836 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3837 NAME may be a string or a symbol. If it is a symbol, that exact
3838 symbol is searched for.
3839 A second optional argument specifies the obarray to use;
3840 it defaults to the value of `obarray'. */)
3841 (Lisp_Object name
, Lisp_Object obarray
)
3843 register Lisp_Object tem
, string
;
3845 if (NILP (obarray
)) obarray
= Vobarray
;
3846 obarray
= check_obarray (obarray
);
3848 if (!SYMBOLP (name
))
3850 CHECK_STRING (name
);
3854 string
= SYMBOL_NAME (name
);
3856 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3857 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3863 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3864 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3865 The value is t if a symbol was found and deleted, nil otherwise.
3866 NAME may be a string or a symbol. If it is a symbol, that symbol
3867 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3868 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3869 usage: (unintern NAME OBARRAY) */)
3870 (Lisp_Object name
, Lisp_Object obarray
)
3872 register Lisp_Object string
, tem
;
3875 if (NILP (obarray
)) obarray
= Vobarray
;
3876 obarray
= check_obarray (obarray
);
3879 string
= SYMBOL_NAME (name
);
3882 CHECK_STRING (name
);
3886 tem
= oblookup (obarray
, SSDATA (string
),
3891 /* If arg was a symbol, don't delete anything but that symbol itself. */
3892 if (SYMBOLP (name
) && !EQ (name
, tem
))
3895 /* There are plenty of other symbols which will screw up the Emacs
3896 session if we unintern them, as well as even more ways to use
3897 `setq' or `fset' or whatnot to make the Emacs session
3898 unusable. Let's not go down this silly road. --Stef */
3899 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3900 error ("Attempt to unintern t or nil"); */
3902 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3904 hash
= oblookup_last_bucket_number
;
3906 if (EQ (AREF (obarray
, hash
), tem
))
3908 if (XSYMBOL (tem
)->next
)
3911 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3912 ASET (obarray
, hash
, sym
);
3915 ASET (obarray
, hash
, make_number (0));
3919 Lisp_Object tail
, following
;
3921 for (tail
= AREF (obarray
, hash
);
3922 XSYMBOL (tail
)->next
;
3925 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3926 if (EQ (following
, tem
))
3928 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3937 /* Return the symbol in OBARRAY whose names matches the string
3938 of SIZE characters (SIZE_BYTE bytes) at PTR.
3939 If there is no such symbol, return the integer bucket number of
3940 where the symbol would be if it were present.
3942 Also store the bucket number in oblookup_last_bucket_number. */
3945 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3949 register Lisp_Object tail
;
3950 Lisp_Object bucket
, tem
;
3952 obarray
= check_obarray (obarray
);
3953 /* This is sometimes needed in the middle of GC. */
3954 obsize
= gc_asize (obarray
);
3955 hash
= hash_string (ptr
, size_byte
) % obsize
;
3956 bucket
= AREF (obarray
, hash
);
3957 oblookup_last_bucket_number
= hash
;
3958 if (EQ (bucket
, make_number (0)))
3960 else if (!SYMBOLP (bucket
))
3961 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3963 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3965 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3966 && SCHARS (SYMBOL_NAME (tail
)) == size
3967 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3969 else if (XSYMBOL (tail
)->next
== 0)
3972 XSETINT (tem
, hash
);
3977 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3980 register Lisp_Object tail
;
3981 CHECK_VECTOR (obarray
);
3982 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3984 tail
= AREF (obarray
, i
);
3989 if (XSYMBOL (tail
)->next
== 0)
3991 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3997 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3999 call1 (function
, sym
);
4002 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4003 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4004 OBARRAY defaults to the value of `obarray'. */)
4005 (Lisp_Object function
, Lisp_Object obarray
)
4007 if (NILP (obarray
)) obarray
= Vobarray
;
4008 obarray
= check_obarray (obarray
);
4010 map_obarray (obarray
, mapatoms_1
, function
);
4014 #define OBARRAY_SIZE 1511
4019 Lisp_Object oblength
;
4020 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4022 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4024 Vobarray
= Fmake_vector (oblength
, make_number (0));
4025 initial_obarray
= Vobarray
;
4026 staticpro (&initial_obarray
);
4028 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4029 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4031 DEFSYM (Qunbound
, "unbound");
4033 DEFSYM (Qnil
, "nil");
4034 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4035 XSYMBOL (Qnil
)->constant
= 1;
4036 XSYMBOL (Qnil
)->declared_special
= true;
4039 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4040 XSYMBOL (Qt
)->constant
= 1;
4041 XSYMBOL (Qt
)->declared_special
= true;
4043 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4046 DEFSYM (Qvariable_documentation
, "variable-documentation");
4048 read_buffer
= xmalloc (size
);
4049 read_buffer_size
= size
;
4053 defsubr (struct Lisp_Subr
*sname
)
4055 Lisp_Object sym
, tem
;
4056 sym
= intern_c_string (sname
->symbol_name
);
4057 XSETPVECTYPE (sname
, PVEC_SUBR
);
4058 XSETSUBR (tem
, sname
);
4059 set_symbol_function (sym
, tem
);
4062 #ifdef NOTDEF /* Use fset in subr.el now! */
4064 defalias (struct Lisp_Subr
*sname
, char *string
)
4067 sym
= intern (string
);
4068 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4072 /* Define an "integer variable"; a symbol whose value is forwarded to a
4073 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4074 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4076 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4077 const char *namestring
, EMACS_INT
*address
)
4080 sym
= intern_c_string (namestring
);
4081 i_fwd
->type
= Lisp_Fwd_Int
;
4082 i_fwd
->intvar
= address
;
4083 XSYMBOL (sym
)->declared_special
= 1;
4084 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4085 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4088 /* Similar but define a variable whose value is t if address contains 1,
4089 nil if address contains 0. */
4091 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4092 const char *namestring
, bool *address
)
4095 sym
= intern_c_string (namestring
);
4096 b_fwd
->type
= Lisp_Fwd_Bool
;
4097 b_fwd
->boolvar
= address
;
4098 XSYMBOL (sym
)->declared_special
= 1;
4099 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4100 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4101 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4104 /* Similar but define a variable whose value is the Lisp Object stored
4105 at address. Two versions: with and without gc-marking of the C
4106 variable. The nopro version is used when that variable will be
4107 gc-marked for some other reason, since marking the same slot twice
4108 can cause trouble with strings. */
4110 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4111 const char *namestring
, Lisp_Object
*address
)
4114 sym
= intern_c_string (namestring
);
4115 o_fwd
->type
= Lisp_Fwd_Obj
;
4116 o_fwd
->objvar
= address
;
4117 XSYMBOL (sym
)->declared_special
= 1;
4118 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4119 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4123 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4124 const char *namestring
, Lisp_Object
*address
)
4126 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4127 staticpro (address
);
4130 /* Similar but define a variable whose value is the Lisp Object stored
4131 at a particular offset in the current kboard object. */
4134 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4135 const char *namestring
, int offset
)
4138 sym
= intern_c_string (namestring
);
4139 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4140 ko_fwd
->offset
= offset
;
4141 XSYMBOL (sym
)->declared_special
= 1;
4142 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4143 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4146 /* Check that the elements of lpath exist. */
4149 load_path_check (Lisp_Object lpath
)
4151 Lisp_Object path_tail
;
4153 /* The only elements that might not exist are those from
4154 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4156 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4158 Lisp_Object dirfile
;
4159 dirfile
= Fcar (path_tail
);
4160 if (STRINGP (dirfile
))
4162 dirfile
= Fdirectory_file_name (dirfile
);
4163 if (! file_accessible_directory_p (dirfile
))
4164 dir_warning ("Lisp directory", XCAR (path_tail
));
4169 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4170 This does not include the standard site-lisp directories
4171 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4172 but it does (unless no_site_lisp is set) include site-lisp
4173 directories in the source/build directories if those exist and we
4174 are running uninstalled.
4176 Uses the following logic:
4177 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4178 The remainder is what happens when dumping works:
4179 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4180 Otherwise use PATH_LOADSEARCH.
4182 If !initialized, then just return PATH_DUMPLOADSEARCH.
4184 If Vinstallation_directory is not nil (ie, running uninstalled):
4185 If installation-dir/lisp exists and not already a member,
4186 we must be running uninstalled. Reset the load-path
4187 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4188 refers to the eventual installation directories. Since we
4189 are not yet installed, we should not use them, even if they exist.)
4190 If installation-dir/lisp does not exist, just add
4191 PATH_DUMPLOADSEARCH at the end instead.
4192 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4193 and not already a member) at the front.
4194 If installation-dir != source-dir (ie running an uninstalled,
4195 out-of-tree build) AND install-dir/src/Makefile exists BUT
4196 install-dir/src/Makefile.in does NOT exist (this is a sanity
4197 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4200 load_path_default (void)
4202 Lisp_Object lpath
= Qnil
;
4207 const char *loadpath
= ns_load_path ();
4210 normal
= PATH_LOADSEARCH
;
4212 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4214 lpath
= decode_env_path (0, normal
, 0);
4217 #else /* !CANNOT_DUMP */
4219 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4224 const char *loadpath
= ns_load_path ();
4225 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4227 lpath
= decode_env_path (0, normal
, 0);
4229 if (!NILP (Vinstallation_directory
))
4231 Lisp_Object tem
, tem1
;
4233 /* Add to the path the lisp subdir of the installation
4234 dir, if it is accessible. Note: in out-of-tree builds,
4235 this directory is empty save for Makefile. */
4236 tem
= Fexpand_file_name (build_string ("lisp"),
4237 Vinstallation_directory
);
4238 tem1
= Ffile_accessible_directory_p (tem
);
4241 if (NILP (Fmember (tem
, lpath
)))
4243 /* We are running uninstalled. The default load-path
4244 points to the eventual installed lisp directories.
4245 We should not use those now, even if they exist,
4246 so start over from a clean slate. */
4247 lpath
= list1 (tem
);
4251 /* That dir doesn't exist, so add the build-time
4252 Lisp dirs instead. */
4254 Lisp_Object dump_path
=
4255 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4256 lpath
= nconc2 (lpath
, dump_path
);
4259 /* Add site-lisp under the installation dir, if it exists. */
4262 tem
= Fexpand_file_name (build_string ("site-lisp"),
4263 Vinstallation_directory
);
4264 tem1
= Ffile_accessible_directory_p (tem
);
4267 if (NILP (Fmember (tem
, lpath
)))
4268 lpath
= Fcons (tem
, lpath
);
4272 /* If Emacs was not built in the source directory,
4273 and it is run from where it was built, add to load-path
4274 the lisp and site-lisp dirs under that directory. */
4276 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4280 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4281 Vinstallation_directory
);
4282 tem1
= Ffile_exists_p (tem
);
4284 /* Don't be fooled if they moved the entire source tree
4285 AFTER dumping Emacs. If the build directory is indeed
4286 different from the source dir, src/Makefile.in and
4287 src/Makefile will not be found together. */
4288 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4289 Vinstallation_directory
);
4290 tem2
= Ffile_exists_p (tem
);
4291 if (!NILP (tem1
) && NILP (tem2
))
4293 tem
= Fexpand_file_name (build_string ("lisp"),
4296 if (NILP (Fmember (tem
, lpath
)))
4297 lpath
= Fcons (tem
, lpath
);
4301 tem
= Fexpand_file_name (build_string ("site-lisp"),
4303 tem1
= Ffile_accessible_directory_p (tem
);
4306 if (NILP (Fmember (tem
, lpath
)))
4307 lpath
= Fcons (tem
, lpath
);
4311 } /* Vinstallation_directory != Vsource_directory */
4313 } /* if Vinstallation_directory */
4315 else /* !initialized */
4317 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4318 source directory. We used to add ../lisp (ie the lisp dir in
4319 the build directory) at the front here, but that should not
4320 be necessary, since in out of tree builds lisp/ is empty, save
4322 lpath
= decode_env_path (0, normal
, 0);
4324 #endif /* !CANNOT_DUMP */
4332 /* First, set Vload_path. */
4334 /* Ignore EMACSLOADPATH when dumping. */
4336 bool use_loadpath
= true;
4338 bool use_loadpath
= NILP (Vpurify_flag
);
4341 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4343 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4345 /* Check (non-nil) user-supplied elements. */
4346 load_path_check (Vload_path
);
4348 /* If no nils in the environment variable, use as-is.
4349 Otherwise, replace any nils with the default. */
4350 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4352 Lisp_Object elem
, elpath
= Vload_path
;
4353 Lisp_Object default_lpath
= load_path_default ();
4355 /* Check defaults, before adding site-lisp. */
4356 load_path_check (default_lpath
);
4358 /* Add the site-lisp directories to the front of the default. */
4359 if (!no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4361 Lisp_Object sitelisp
;
4362 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4363 if (! NILP (sitelisp
))
4364 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4369 /* Replace nils from EMACSLOADPATH by default. */
4370 while (CONSP (elpath
))
4372 elem
= XCAR (elpath
);
4373 elpath
= XCDR (elpath
);
4374 Vload_path
= CALLN (Fappend
, Vload_path
,
4375 NILP (elem
) ? default_lpath
: list1 (elem
));
4377 } /* Fmemq (Qnil, Vload_path) */
4381 Vload_path
= load_path_default ();
4383 /* Check before adding site-lisp directories.
4384 The install should have created them, but they are not
4385 required, so no need to warn if they are absent.
4386 Or we might be running before installation. */
4387 load_path_check (Vload_path
);
4389 /* Add the site-lisp directories at the front. */
4390 if (initialized
&& !no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4392 Lisp_Object sitelisp
;
4393 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4394 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4400 load_in_progress
= 0;
4401 Vload_file_name
= Qnil
;
4402 Vstandard_input
= Qt
;
4403 Vloads_in_progress
= Qnil
;
4406 /* Print a warning that directory intended for use USE and with name
4407 DIRNAME cannot be accessed. On entry, errno should correspond to
4408 the access failure. Print the warning on stderr and put it in
4412 dir_warning (char const *use
, Lisp_Object dirname
)
4414 static char const format
[] = "Warning: %s '%s': %s\n";
4415 int access_errno
= errno
;
4416 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)),
4417 strerror (access_errno
));
4419 /* Don't log the warning before we've initialized!! */
4422 char const *diagnostic
= emacs_strerror (access_errno
);
4424 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4425 + strlen (use
) + SBYTES (dirname
)
4426 + strlen (diagnostic
));
4427 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4429 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4435 syms_of_lread (void)
4438 defsubr (&Sread_from_string
);
4440 defsubr (&Sintern_soft
);
4441 defsubr (&Sunintern
);
4442 defsubr (&Sget_load_suffixes
);
4444 defsubr (&Seval_buffer
);
4445 defsubr (&Seval_region
);
4446 defsubr (&Sread_char
);
4447 defsubr (&Sread_char_exclusive
);
4448 defsubr (&Sread_event
);
4449 defsubr (&Sget_file_char
);
4450 defsubr (&Smapatoms
);
4451 defsubr (&Slocate_file_internal
);
4453 DEFVAR_LISP ("obarray", Vobarray
,
4454 doc
: /* Symbol table for use by `intern' and `read'.
4455 It is a vector whose length ought to be prime for best results.
4456 The vector's contents don't make sense if examined from Lisp programs;
4457 to find all the symbols in an obarray, use `mapatoms'. */);
4459 DEFVAR_LISP ("values", Vvalues
,
4460 doc
: /* List of values of all expressions which were read, evaluated and printed.
4461 Order is reverse chronological. */);
4462 XSYMBOL (intern ("values"))->declared_special
= 0;
4464 DEFVAR_LISP ("standard-input", Vstandard_input
,
4465 doc
: /* Stream for read to get input from.
4466 See documentation of `read' for possible values. */);
4467 Vstandard_input
= Qt
;
4469 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4470 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4472 If this variable is a buffer, then only forms read from that buffer
4473 will be added to `read-symbol-positions-list'.
4474 If this variable is t, then all read forms will be added.
4475 The effect of all other values other than nil are not currently
4476 defined, although they may be in the future.
4478 The positions are relative to the last call to `read' or
4479 `read-from-string'. It is probably a bad idea to set this variable at
4480 the toplevel; bind it instead. */);
4481 Vread_with_symbol_positions
= Qnil
;
4483 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4484 doc
: /* A list mapping read symbols to their positions.
4485 This variable is modified during calls to `read' or
4486 `read-from-string', but only when `read-with-symbol-positions' is
4489 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4490 CHAR-POSITION is an integer giving the offset of that occurrence of the
4491 symbol from the position where `read' or `read-from-string' started.
4493 Note that a symbol will appear multiple times in this list, if it was
4494 read multiple times. The list is in the same order as the symbols
4496 Vread_symbol_positions_list
= Qnil
;
4498 DEFVAR_LISP ("read-circle", Vread_circle
,
4499 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4502 DEFVAR_LISP ("load-path", Vload_path
,
4503 doc
: /* List of directories to search for files to load.
4504 Each element is a string (directory file name) or nil (meaning
4505 `default-directory').
4506 Initialized during startup as described in Info node `(elisp)Library Search'.
4507 Use `directory-file-name' when adding items to this path. However, Lisp
4508 programs that process this list should tolerate directories both with
4509 and without trailing slashes. */);
4511 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4512 doc
: /* List of suffixes for Emacs Lisp files and dynamic modules.
4513 This list includes suffixes for both compiled and source Emacs Lisp files.
4514 This list should not include the empty string.
4515 `load' and related functions try to append these suffixes, in order,
4516 to the specified file name if a suffix is allowed or required. */);
4518 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4519 build_pure_c_string (".el"),
4520 build_pure_c_string (MODULES_SUFFIX
));
4522 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4523 build_pure_c_string (".el"));
4525 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix
,
4526 doc
: /* Suffix of loadable module file, or nil of modules are not supported. */);
4528 Vmodule_file_suffix
= build_pure_c_string (MODULES_SUFFIX
);
4530 Vmodule_file_suffix
= Qnil
;
4532 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4533 doc
: /* List of suffixes that indicate representations of \
4535 This list should normally start with the empty string.
4537 Enabling Auto Compression mode appends the suffixes in
4538 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4539 mode removes them again. `load' and related functions use this list to
4540 determine whether they should look for compressed versions of a file
4541 and, if so, which suffixes they should try to append to the file name
4542 in order to do so. However, if you want to customize which suffixes
4543 the loading functions recognize as compression suffixes, you should
4544 customize `jka-compr-load-suffixes' rather than the present variable. */);
4545 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4547 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4548 doc
: /* Non-nil if inside of `load'. */);
4549 DEFSYM (Qload_in_progress
, "load-in-progress");
4551 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4552 doc
: /* An alist of functions to be evalled when particular files are loaded.
4553 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4555 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4556 a symbol (a feature name).
4558 When `load' is run and the file-name argument matches an element's
4559 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4560 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4562 An error in FORMS does not undo the load, but does prevent execution of
4563 the rest of the FORMS. */);
4564 Vafter_load_alist
= Qnil
;
4566 DEFVAR_LISP ("load-history", Vload_history
,
4567 doc
: /* Alist mapping loaded file names to symbols and features.
4568 Each alist element should be a list (FILE-NAME ENTRIES...), where
4569 FILE-NAME is the name of a file that has been loaded into Emacs.
4570 The file name is absolute and true (i.e. it doesn't contain symlinks).
4571 As an exception, one of the alist elements may have FILE-NAME nil,
4572 for symbols and features not associated with any file.
4574 The remaining ENTRIES in the alist element describe the functions and
4575 variables defined in that file, the features provided, and the
4576 features required. Each entry has the form `(provide . FEATURE)',
4577 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4578 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4579 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4580 autoload before this file redefined it as a function. In addition,
4581 entries may also be single symbols, which means that SYMBOL was
4582 defined by `defvar' or `defconst'.
4584 During preloading, the file name recorded is relative to the main Lisp
4585 directory. These file names are converted to absolute at startup. */);
4586 Vload_history
= Qnil
;
4588 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4589 doc
: /* Full name of file being loaded by `load'. */);
4590 Vload_file_name
= Qnil
;
4592 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4593 doc
: /* File name, including directory, of user's initialization file.
4594 If the file loaded had extension `.elc', and the corresponding source file
4595 exists, this variable contains the name of source file, suitable for use
4596 by functions like `custom-save-all' which edit the init file.
4597 While Emacs loads and evaluates the init file, value is the real name
4598 of the file, regardless of whether or not it has the `.elc' extension. */);
4599 Vuser_init_file
= Qnil
;
4601 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4602 doc
: /* Used for internal purposes by `load'. */);
4603 Vcurrent_load_list
= Qnil
;
4605 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4606 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4607 Called with a single argument (the stream from which to read).
4608 The default is to use the function `read'. */);
4609 DEFSYM (Qread
, "read");
4610 Vload_read_function
= Qread
;
4612 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4613 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4614 The value should be a function for doing code conversion before
4615 reading a source file. It can also be nil, in which case loading is
4616 done without any code conversion.
4618 If the value is a function, it is called with four arguments,
4619 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4620 the file to load, FILE is the non-absolute name (for messages etc.),
4621 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4622 `load'. The function should return t if the file was loaded. */);
4623 Vload_source_file_function
= Qnil
;
4625 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4626 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4627 This is useful when the file being loaded is a temporary copy. */);
4628 load_force_doc_strings
= 0;
4630 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4631 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4632 This is normally bound by `load' and `eval-buffer' to control `read',
4633 and is not meant for users to change. */);
4634 load_convert_to_unibyte
= 0;
4636 DEFVAR_LISP ("source-directory", Vsource_directory
,
4637 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4638 You cannot count on them to still be there! */);
4640 = Fexpand_file_name (build_string ("../"),
4641 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4643 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4644 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4645 Vpreloaded_file_list
= Qnil
;
4647 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4648 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4649 Vbyte_boolean_vars
= Qnil
;
4651 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4652 doc
: /* Non-nil means load dangerous compiled Lisp files.
4653 Some versions of XEmacs use different byte codes than Emacs. These
4654 incompatible byte codes can make Emacs crash when it tries to execute
4656 load_dangerous_libraries
= 0;
4658 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4659 doc
: /* Non-nil means force printing messages when loading Lisp files.
4660 This overrides the value of the NOMESSAGE argument to `load'. */);
4661 force_load_messages
= 0;
4663 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4664 doc
: /* Regular expression matching safe to load compiled Lisp files.
4665 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4666 from the file, and matches them against this regular expression.
4667 When the regular expression matches, the file is considered to be safe
4668 to load. See also `load-dangerous-libraries'. */);
4669 Vbytecomp_version_regexp
4670 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4672 DEFSYM (Qlexical_binding
, "lexical-binding");
4673 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4674 doc
: /* Whether to use lexical binding when evaluating code.
4675 Non-nil means that the code in the current buffer should be evaluated
4676 with lexical binding.
4677 This variable is automatically set from the file variables of an
4678 interpreted Lisp file read using `load'. Unlike other file local
4679 variables, this must be set in the first line of a file. */);
4680 Vlexical_binding
= Qnil
;
4681 Fmake_variable_buffer_local (Qlexical_binding
);
4683 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4684 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4685 Veval_buffer_list
= Qnil
;
4687 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4688 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4689 Vold_style_backquotes
= Qnil
;
4690 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4692 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4693 doc
: /* Non-nil means `load' prefers the newest version of a file.
4694 This applies when a filename suffix is not explicitly specified and
4695 `load' is trying various possible suffixes (see `load-suffixes' and
4696 `load-file-rep-suffixes'). Normally, it stops at the first file
4697 that exists unless you explicitly specify one or the other. If this
4698 option is non-nil, it checks all suffixes and uses whichever file is
4700 Note that if you customize this, obviously it will not affect files
4701 that are loaded before your customizations are read! */);
4702 load_prefer_newer
= 0;
4704 /* Vsource_directory was initialized in init_lread. */
4706 DEFSYM (Qcurrent_load_list
, "current-load-list");
4707 DEFSYM (Qstandard_input
, "standard-input");
4708 DEFSYM (Qread_char
, "read-char");
4709 DEFSYM (Qget_file_char
, "get-file-char");
4711 /* Used instead of Qget_file_char while loading *.elc files compiled
4712 by Emacs 21 or older. */
4713 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4715 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4717 DEFSYM (Qbackquote
, "`");
4718 DEFSYM (Qcomma
, ",");
4719 DEFSYM (Qcomma_at
, ",@");
4720 DEFSYM (Qcomma_dot
, ",.");
4722 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4723 DEFSYM (Qascii_character
, "ascii-character");
4724 DEFSYM (Qfunction
, "function");
4725 DEFSYM (Qload
, "load");
4726 DEFSYM (Qload_file_name
, "load-file-name");
4727 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4728 DEFSYM (Qfile_truename
, "file-truename");
4729 DEFSYM (Qdir_ok
, "dir-ok");
4730 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4732 staticpro (&read_objects
);
4733 read_objects
= Qnil
;
4734 staticpro (&seen_list
);
4737 Vloads_in_progress
= Qnil
;
4738 staticpro (&Vloads_in_progress
);
4740 DEFSYM (Qhash_table
, "hash-table");
4741 DEFSYM (Qdata
, "data");
4742 DEFSYM (Qtest
, "test");
4743 DEFSYM (Qsize
, "size");
4744 DEFSYM (Qweakness
, "weakness");
4745 DEFSYM (Qrehash_size
, "rehash-size");
4746 DEFSYM (Qrehash_threshold
, "rehash-threshold");