1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2015 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 /* Tell globals.h to define tables needed by init_obarray. */
22 #define DEFINE_SYMBOLS
26 #include <sys/types.h>
30 #include <limits.h> /* For CHAR_BIT. */
32 #include <stat-time.h>
34 #include "dispextern.h"
35 #include "intervals.h"
36 #include "character.h"
44 #include "termhooks.h"
45 #include "blockinput.h"
59 #endif /* HAVE_SETLOCALE */
64 #define file_offset off_t
65 #define file_tell ftello
67 #define file_offset long
68 #define file_tell ftell
71 /* The association list of objects read with the #n=object form.
72 Each member of the list has the form (n . object), and is used to
73 look up the object for the corresponding #n# construct.
74 It must be set to nil before all top-level calls to read0. */
75 static Lisp_Object read_objects
;
77 /* File for get_file_char to read from. Use by load. */
78 static FILE *instream
;
80 /* For use within read-from-string (this reader is non-reentrant!!) */
81 static ptrdiff_t read_from_string_index
;
82 static ptrdiff_t read_from_string_index_byte
;
83 static ptrdiff_t read_from_string_limit
;
85 /* Number of characters read in the current call to Fread or
87 static EMACS_INT readchar_count
;
89 /* This contains the last string skipped with #@. */
90 static char *saved_doc_string
;
91 /* Length of buffer allocated in saved_doc_string. */
92 static ptrdiff_t saved_doc_string_size
;
93 /* Length of actual data in saved_doc_string. */
94 static ptrdiff_t saved_doc_string_length
;
95 /* This is the file position that string came from. */
96 static file_offset saved_doc_string_position
;
98 /* This contains the previous string skipped with #@.
99 We copy it from saved_doc_string when a new string
100 is put in saved_doc_string. */
101 static char *prev_saved_doc_string
;
102 /* Length of buffer allocated in prev_saved_doc_string. */
103 static ptrdiff_t prev_saved_doc_string_size
;
104 /* Length of actual data in prev_saved_doc_string. */
105 static ptrdiff_t prev_saved_doc_string_length
;
106 /* This is the file position that string came from. */
107 static file_offset prev_saved_doc_string_position
;
109 /* True means inside a new-style backquote
110 with no surrounding parentheses.
111 Fread initializes this to false, so we need not specbind it
112 or worry about what happens to it when there is an error. */
113 static bool new_backquote_flag
;
115 /* A list of file names for files being loaded in Fload. Used to
116 check for recursive loads. */
118 static Lisp_Object Vloads_in_progress
;
120 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
123 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
124 Lisp_Object
, Lisp_Object
,
125 Lisp_Object
, Lisp_Object
);
127 /* Functions that read one byte from the current source READCHARFUN
128 or unreads one byte. If the integer argument C is -1, it returns
129 one read byte, or -1 when there's no more byte in the source. If C
130 is 0 or positive, it unreads C, and the return value is not
133 static int readbyte_for_lambda (int, Lisp_Object
);
134 static int readbyte_from_file (int, Lisp_Object
);
135 static int readbyte_from_string (int, Lisp_Object
);
137 /* Handle unreading and rereading of characters.
138 Write READCHAR to read a character,
139 UNREAD(c) to unread c to be read again.
141 These macros correctly read/unread multibyte characters. */
143 #define READCHAR readchar (readcharfun, NULL)
144 #define UNREAD(c) unreadchar (readcharfun, c)
146 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
147 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
149 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
150 Qlambda, or a cons, we use this to keep an unread character because
151 a file stream can't handle multibyte-char unreading. The value -1
152 means that there's no unread character. */
153 static int unread_char
;
156 readchar (Lisp_Object readcharfun
, bool *multibyte
)
160 int (*readbyte
) (int, Lisp_Object
);
161 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
163 bool emacs_mule_encoding
= 0;
170 if (BUFFERP (readcharfun
))
172 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
174 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
176 if (! BUFFER_LIVE_P (inbuffer
))
179 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
182 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
184 /* Fetch the character code from the buffer. */
185 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
186 BUF_INC_POS (inbuffer
, pt_byte
);
193 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
194 if (! ASCII_CHAR_P (c
))
195 c
= BYTE8_TO_CHAR (c
);
198 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
202 if (MARKERP (readcharfun
))
204 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
206 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
208 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
211 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
213 /* Fetch the character code from the buffer. */
214 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
215 BUF_INC_POS (inbuffer
, bytepos
);
222 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
223 if (! ASCII_CHAR_P (c
))
224 c
= BYTE8_TO_CHAR (c
);
228 XMARKER (readcharfun
)->bytepos
= bytepos
;
229 XMARKER (readcharfun
)->charpos
++;
234 if (EQ (readcharfun
, Qlambda
))
236 readbyte
= readbyte_for_lambda
;
240 if (EQ (readcharfun
, Qget_file_char
))
242 readbyte
= readbyte_from_file
;
246 if (STRINGP (readcharfun
))
248 if (read_from_string_index
>= read_from_string_limit
)
250 else if (STRING_MULTIBYTE (readcharfun
))
254 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
255 read_from_string_index
,
256 read_from_string_index_byte
);
260 c
= SREF (readcharfun
, read_from_string_index_byte
);
261 read_from_string_index
++;
262 read_from_string_index_byte
++;
267 if (CONSP (readcharfun
))
269 /* This is the case that read_vector is reading from a unibyte
270 string that contains a byte sequence previously skipped
271 because of #@NUMBER. The car part of readcharfun is that
272 string, and the cdr part is a value of readcharfun given to
274 readbyte
= readbyte_from_string
;
275 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
276 emacs_mule_encoding
= 1;
280 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
282 readbyte
= readbyte_from_file
;
283 emacs_mule_encoding
= 1;
287 tem
= call0 (readcharfun
);
294 if (unread_char
>= 0)
300 c
= (*readbyte
) (-1, readcharfun
);
305 if (ASCII_CHAR_P (c
))
307 if (emacs_mule_encoding
)
308 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
311 len
= BYTES_BY_CHAR_HEAD (c
);
314 c
= (*readbyte
) (-1, readcharfun
);
315 if (c
< 0 || ! TRAILING_CODE_P (c
))
318 (*readbyte
) (buf
[i
], readcharfun
);
319 return BYTE8_TO_CHAR (buf
[0]);
323 return STRING_CHAR (buf
);
326 #define FROM_FILE_P(readcharfun) \
327 (EQ (readcharfun, Qget_file_char) \
328 || EQ (readcharfun, Qget_emacs_mule_file_char))
331 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
333 if (FROM_FILE_P (readcharfun
))
335 block_input (); /* FIXME: Not sure if it's needed. */
336 fseek (instream
, n
, SEEK_CUR
);
340 { /* We're not reading directly from a file. In that case, it's difficult
341 to reliably count bytes, since these are usually meant for the file's
342 encoding, whereas we're now typically in the internal encoding.
343 But luckily, skip_dyn_bytes is used to skip over a single
344 dynamic-docstring (or dynamic byte-code) which is always quoted such
345 that \037 is the final char. */
349 } while (c
>= 0 && c
!= '\037');
354 skip_dyn_eof (Lisp_Object readcharfun
)
356 if (FROM_FILE_P (readcharfun
))
358 block_input (); /* FIXME: Not sure if it's needed. */
359 fseek (instream
, 0, SEEK_END
);
363 while (READCHAR
>= 0);
366 /* Unread the character C in the way appropriate for the stream READCHARFUN.
367 If the stream is a user function, call it with the char as argument. */
370 unreadchar (Lisp_Object readcharfun
, int c
)
374 /* Don't back up the pointer if we're unreading the end-of-input mark,
375 since readchar didn't advance it when we read it. */
377 else if (BUFFERP (readcharfun
))
379 struct buffer
*b
= XBUFFER (readcharfun
);
380 ptrdiff_t charpos
= BUF_PT (b
);
381 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
383 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
384 BUF_DEC_POS (b
, bytepos
);
388 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
390 else if (MARKERP (readcharfun
))
392 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
393 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
395 XMARKER (readcharfun
)->charpos
--;
396 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
397 BUF_DEC_POS (b
, bytepos
);
401 XMARKER (readcharfun
)->bytepos
= bytepos
;
403 else if (STRINGP (readcharfun
))
405 read_from_string_index
--;
406 read_from_string_index_byte
407 = string_char_to_byte (readcharfun
, read_from_string_index
);
409 else if (CONSP (readcharfun
))
413 else if (EQ (readcharfun
, Qlambda
))
417 else if (FROM_FILE_P (readcharfun
))
422 call1 (readcharfun
, make_number (c
));
426 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
428 return read_bytecode_char (c
>= 0);
433 readbyte_from_file (int c
, Lisp_Object readcharfun
)
438 ungetc (c
, instream
);
446 /* Interrupted reads have been observed while reading over the network. */
447 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
458 return (c
== EOF
? -1 : c
);
462 readbyte_from_string (int c
, Lisp_Object readcharfun
)
464 Lisp_Object string
= XCAR (readcharfun
);
468 read_from_string_index
--;
469 read_from_string_index_byte
470 = string_char_to_byte (string
, read_from_string_index
);
473 if (read_from_string_index
>= read_from_string_limit
)
476 FETCH_STRING_CHAR_ADVANCE (c
, string
,
477 read_from_string_index
,
478 read_from_string_index_byte
);
483 /* Read one non-ASCII character from INSTREAM. The character is
484 encoded in `emacs-mule' and the first byte is already read in
488 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
490 /* Emacs-mule coding uses at most 4-byte for one character. */
491 unsigned char buf
[4];
492 int len
= emacs_mule_bytes
[c
];
493 struct charset
*charset
;
498 /* C is not a valid leading-code of `emacs-mule'. */
499 return BYTE8_TO_CHAR (c
);
505 c
= (*readbyte
) (-1, readcharfun
);
509 (*readbyte
) (buf
[i
], readcharfun
);
510 return BYTE8_TO_CHAR (buf
[0]);
517 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
518 code
= buf
[1] & 0x7F;
522 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
523 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
525 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
526 code
= buf
[2] & 0x7F;
530 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
531 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
536 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
537 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
539 c
= DECODE_CHAR (charset
, code
);
541 Fsignal (Qinvalid_read_syntax
,
542 list1 (build_string ("invalid multibyte form")));
547 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
549 static Lisp_Object
read0 (Lisp_Object
);
550 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
552 static Lisp_Object
read_list (bool, Lisp_Object
);
553 static Lisp_Object
read_vector (Lisp_Object
, bool);
555 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
557 static void substitute_object_in_subtree (Lisp_Object
,
559 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
562 /* Get a character from the tty. */
564 /* Read input events until we get one that's acceptable for our purposes.
566 If NO_SWITCH_FRAME, switch-frame events are stashed
567 until we get a character we like, and then stuffed into
570 If ASCII_REQUIRED, check function key events to see
571 if the unmodified version of the symbol has a Qascii_character
572 property, and use that character, if present.
574 If ERROR_NONASCII, signal an error if the input we
575 get isn't an ASCII character with modifiers. If it's false but
576 ASCII_REQUIRED is true, just re-read until we get an ASCII
579 If INPUT_METHOD, invoke the current input method
580 if the character warrants that.
582 If SECONDS is a number, wait that many seconds for input, and
583 return Qnil if no input arrives within that time. */
586 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
587 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
589 Lisp_Object val
, delayed_switch_frame
;
590 struct timespec end_time
;
592 #ifdef HAVE_WINDOW_SYSTEM
593 if (display_hourglass_p
)
597 delayed_switch_frame
= Qnil
;
599 /* Compute timeout. */
600 if (NUMBERP (seconds
))
602 double duration
= extract_float (seconds
);
603 struct timespec wait_time
= dtotimespec (duration
);
604 end_time
= timespec_add (current_timespec (), wait_time
);
607 /* Read until we get an acceptable event. */
610 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
611 NUMBERP (seconds
) ? &end_time
: NULL
);
612 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
617 /* `switch-frame' events are put off until after the next ASCII
618 character. This is better than signaling an error just because
619 the last characters were typed to a separate minibuffer frame,
620 for example. Eventually, some code which can deal with
621 switch-frame events will read it and process it. */
623 && EVENT_HAS_PARAMETERS (val
)
624 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
626 delayed_switch_frame
= val
;
630 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
632 /* Convert certain symbols to their ASCII equivalents. */
635 Lisp_Object tem
, tem1
;
636 tem
= Fget (val
, Qevent_symbol_element_mask
);
639 tem1
= Fget (Fcar (tem
), Qascii_character
);
640 /* Merge this symbol's modifier bits
641 with the ASCII equivalent of its basic code. */
643 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
647 /* If we don't have a character now, deal with it appropriately. */
652 Vunread_command_events
= list1 (val
);
653 error ("Non-character input-event");
660 if (! NILP (delayed_switch_frame
))
661 unread_switch_frame
= delayed_switch_frame
;
665 #ifdef HAVE_WINDOW_SYSTEM
666 if (display_hourglass_p
)
675 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
676 doc
: /* Read a character from the command input (keyboard or macro).
677 It is returned as a number.
678 If the character has modifiers, they are resolved and reflected to the
679 character code if possible (e.g. C-SPC -> 0).
681 If the user generates an event which is not a character (i.e. a mouse
682 click or function key event), `read-char' signals an error. As an
683 exception, switch-frame events are put off until non-character events
685 If you want to read non-character events, or ignore them, call
686 `read-event' or `read-char-exclusive' instead.
688 If the optional argument PROMPT is non-nil, display that as a prompt.
689 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
690 input method is turned on in the current buffer, that input method
691 is used for reading a character.
692 If the optional argument SECONDS is non-nil, it should be a number
693 specifying the maximum number of seconds to wait for input. If no
694 input arrives in that time, return nil. SECONDS may be a
695 floating-point value. */)
696 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
701 message_with_string ("%s", prompt
, 0);
702 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
704 return (NILP (val
) ? Qnil
705 : make_number (char_resolve_modifier_mask (XINT (val
))));
708 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
709 doc
: /* Read an event object from the input stream.
710 If the optional argument PROMPT is non-nil, display that as a prompt.
711 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
712 input method is turned on in the current buffer, that input method
713 is used for reading a character.
714 If the optional argument SECONDS is non-nil, it should be a number
715 specifying the maximum number of seconds to wait for input. If no
716 input arrives in that time, return nil. SECONDS may be a
717 floating-point value. */)
718 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
721 message_with_string ("%s", prompt
, 0);
722 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
725 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
726 doc
: /* Read a character from the command input (keyboard or macro).
727 It is returned as a number. Non-character events are ignored.
728 If the character has modifiers, they are resolved and reflected to the
729 character code if possible (e.g. C-SPC -> 0).
731 If the optional argument PROMPT is non-nil, display that as a prompt.
732 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
733 input method is turned on in the current buffer, that input method
734 is used for reading a character.
735 If the optional argument SECONDS is non-nil, it should be a number
736 specifying the maximum number of seconds to wait for input. If no
737 input arrives in that time, return nil. SECONDS may be a
738 floating-point value. */)
739 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
744 message_with_string ("%s", prompt
, 0);
746 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
748 return (NILP (val
) ? Qnil
749 : make_number (char_resolve_modifier_mask (XINT (val
))));
752 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
753 doc
: /* Don't use this yourself. */)
756 register Lisp_Object val
;
758 XSETINT (val
, getc (instream
));
766 /* Return true if the lisp code read using READCHARFUN defines a non-nil
767 `lexical-binding' file variable. After returning, the stream is
768 positioned following the first line, if it is a comment or #! line,
769 otherwise nothing is read. */
772 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
785 while (ch
!= '\n' && ch
!= EOF
)
787 if (ch
== '\n') ch
= READCHAR
;
788 /* It is OK to leave the position after a #! line, since
789 that is what read1 does. */
793 /* The first line isn't a comment, just give up. */
799 /* Look for an appropriate file-variable in the first line. */
803 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
804 } beg_end_state
= NOMINAL
;
805 bool in_file_vars
= 0;
807 #define UPDATE_BEG_END_STATE(ch) \
808 if (beg_end_state == NOMINAL) \
809 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
810 else if (beg_end_state == AFTER_FIRST_DASH) \
811 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
812 else if (beg_end_state == AFTER_ASTERIX) \
815 in_file_vars = !in_file_vars; \
816 beg_end_state = NOMINAL; \
819 /* Skip until we get to the file vars, if any. */
823 UPDATE_BEG_END_STATE (ch
);
825 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
829 char var
[100], val
[100];
834 /* Read a variable name. */
835 while (ch
== ' ' || ch
== '\t')
839 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
841 if (i
< sizeof var
- 1)
843 UPDATE_BEG_END_STATE (ch
);
847 /* Stop scanning if no colon was found before end marker. */
848 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
851 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
857 /* Read a variable value. */
860 while (ch
== ' ' || ch
== '\t')
864 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
866 if (i
< sizeof val
- 1)
868 UPDATE_BEG_END_STATE (ch
);
872 /* The value was terminated by an end-marker, which remove. */
874 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
878 if (strcmp (var
, "lexical-binding") == 0)
881 rv
= (strcmp (val
, "nil") != 0);
887 while (ch
!= '\n' && ch
!= EOF
)
894 /* Value is a version number of byte compiled code if the file
895 associated with file descriptor FD is a compiled Lisp file that's
896 safe to load. Only files compiled with Emacs are safe to load.
897 Files compiled with XEmacs can lead to a crash in Fbyte_code
898 because of an incompatible change in the byte compiler. */
901 safe_to_load_version (int fd
)
907 /* Read the first few bytes from the file, and look for a line
908 specifying the byte compiler version used. */
909 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
912 /* Skip to the next newline, skipping over the initial `ELC'
913 with NUL bytes following it, but note the version. */
914 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
919 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
920 buf
+ i
, nbytes
- i
) < 0)
924 lseek (fd
, 0, SEEK_SET
);
929 /* Callback for record_unwind_protect. Restore the old load list OLD,
930 after loading a file successfully. */
933 record_load_unwind (Lisp_Object old
)
935 Vloads_in_progress
= old
;
938 /* This handler function is used via internal_condition_case_1. */
941 load_error_handler (Lisp_Object data
)
947 load_warn_old_style_backquotes (Lisp_Object file
)
949 if (!NILP (Vold_style_backquotes
))
951 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
952 CALLN (Fmessage
, format
, file
);
956 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
957 doc
: /* Return the suffixes that `load' should try if a suffix is \
959 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
962 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
963 while (CONSP (suffixes
))
965 Lisp_Object exts
= Vload_file_rep_suffixes
;
966 suffix
= XCAR (suffixes
);
967 suffixes
= XCDR (suffixes
);
972 lst
= Fcons (concat2 (suffix
, ext
), lst
);
975 return Fnreverse (lst
);
978 /* Returns true if STRING ends with SUFFIX */
980 suffix_p (Lisp_Object string
, const char *suffix
)
982 ptrdiff_t suffix_len
= strlen (suffix
);
983 ptrdiff_t string_len
= SBYTES (string
);
985 return string_len
>= suffix_len
&& !strcmp (SSDATA (string
) + string_len
- suffix_len
, suffix
);
988 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
989 doc
: /* Execute a file of Lisp code named FILE.
990 First try FILE with `.elc' appended, then try with `.el', 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 int oflags
= O_RDONLY
+ (NILP (predicate
) ? 0 : O_BINARY
);
1582 fd
= emacs_open (pfn
, oflags
, 0);
1585 if (errno
!= ENOENT
)
1590 int err
= (fstat (fd
, &st
) != 0 ? errno
1591 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1603 if (newer
&& !NATNUMP (predicate
))
1605 struct timespec mtime
= get_stat_mtime (&st
);
1607 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1612 emacs_close (save_fd
);
1615 save_string
= string
;
1620 /* We succeeded; return this descriptor and filename. */
1628 /* No more suffixes. Return the newest. */
1629 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1632 *storeptr
= save_string
;
1648 /* Merge the list we've accumulated of globals from the current input source
1649 into the load_history variable. The details depend on whether
1650 the source has an associated file name or not.
1652 FILENAME is the file name that we are loading from.
1654 ENTIRE is true if loading that entire file, false if evaluating
1658 build_load_history (Lisp_Object filename
, bool entire
)
1660 Lisp_Object tail
, prev
, newelt
;
1661 Lisp_Object tem
, tem2
;
1664 tail
= Vload_history
;
1667 while (CONSP (tail
))
1671 /* Find the feature's previous assoc list... */
1672 if (!NILP (Fequal (filename
, Fcar (tem
))))
1676 /* If we're loading the entire file, remove old data. */
1680 Vload_history
= XCDR (tail
);
1682 Fsetcdr (prev
, XCDR (tail
));
1685 /* Otherwise, cons on new symbols that are not already members. */
1688 tem2
= Vcurrent_load_list
;
1690 while (CONSP (tem2
))
1692 newelt
= XCAR (tem2
);
1694 if (NILP (Fmember (newelt
, tem
)))
1695 Fsetcar (tail
, Fcons (XCAR (tem
),
1696 Fcons (newelt
, XCDR (tem
))));
1709 /* If we're loading an entire file, cons the new assoc onto the
1710 front of load-history, the most-recently-loaded position. Also
1711 do this if we didn't find an existing member for the file. */
1712 if (entire
|| !foundit
)
1713 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1718 readevalloop_1 (int old
)
1720 load_convert_to_unibyte
= old
;
1723 /* Signal an `end-of-file' error, if possible with file name
1726 static _Noreturn
void
1727 end_of_file_error (void)
1729 if (STRINGP (Vload_file_name
))
1730 xsignal1 (Qend_of_file
, Vload_file_name
);
1732 xsignal0 (Qend_of_file
);
1736 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1738 /* If we macroexpand the toplevel form non-recursively and it ends
1739 up being a `progn' (or if it was a progn to start), treat each
1740 form in the progn as a top-level form. This way, if one form in
1741 the progn defines a macro, that macro is in effect when we expand
1742 the remaining forms. See similar code in bytecomp.el. */
1743 val
= call2 (macroexpand
, val
, Qnil
);
1744 if (EQ (CAR_SAFE (val
), Qprogn
))
1746 Lisp_Object subforms
= XCDR (val
);
1748 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1749 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1753 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1757 /* UNIBYTE specifies how to set load_convert_to_unibyte
1758 for this invocation.
1759 READFUN, if non-nil, is used instead of `read'.
1761 START, END specify region to read in current buffer (from eval-region).
1762 If the input is not from a buffer, they must be nil. */
1765 readevalloop (Lisp_Object readcharfun
,
1767 Lisp_Object sourcename
,
1769 Lisp_Object unibyte
, Lisp_Object readfun
,
1770 Lisp_Object start
, Lisp_Object end
)
1774 ptrdiff_t count
= SPECPDL_INDEX ();
1775 struct buffer
*b
= 0;
1776 bool continue_reading_p
;
1777 Lisp_Object lex_bound
;
1778 /* True if reading an entire buffer. */
1779 bool whole_buffer
= 0;
1780 /* True on the first time around. */
1781 bool first_sexp
= 1;
1782 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1784 if (NILP (Ffboundp (macroexpand
))
1785 /* Don't macroexpand in .elc files, since it should have been done
1786 already. We actually don't know whether we're in a .elc file or not,
1787 so we use circumstantial evidence: .el files normally go through
1788 Vload_source_file_function -> load-with-code-conversion
1790 || EQ (readcharfun
, Qget_file_char
)
1791 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1794 if (MARKERP (readcharfun
))
1797 start
= readcharfun
;
1800 if (BUFFERP (readcharfun
))
1801 b
= XBUFFER (readcharfun
);
1802 else if (MARKERP (readcharfun
))
1803 b
= XMARKER (readcharfun
)->buffer
;
1805 /* We assume START is nil when input is not from a buffer. */
1806 if (! NILP (start
) && !b
)
1809 specbind (Qstandard_input
, readcharfun
);
1810 specbind (Qcurrent_load_list
, Qnil
);
1811 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1812 load_convert_to_unibyte
= !NILP (unibyte
);
1814 /* If lexical binding is active (either because it was specified in
1815 the file's header, or via a buffer-local variable), create an empty
1816 lexical environment, otherwise, turn off lexical binding. */
1817 lex_bound
= find_symbol_value (Qlexical_binding
);
1818 specbind (Qinternal_interpreter_environment
,
1819 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1820 ? Qnil
: list1 (Qt
)));
1822 /* Try to ensure sourcename is a truename, except whilst preloading. */
1823 if (NILP (Vpurify_flag
)
1824 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1825 && !NILP (Ffboundp (Qfile_truename
)))
1826 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1828 LOADHIST_ATTACH (sourcename
);
1830 continue_reading_p
= 1;
1831 while (continue_reading_p
)
1833 ptrdiff_t count1
= SPECPDL_INDEX ();
1835 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1836 error ("Reading from killed buffer");
1840 /* Switch to the buffer we are reading from. */
1841 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1842 set_buffer_internal (b
);
1844 /* Save point in it. */
1845 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1846 /* Save ZV in it. */
1847 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1848 /* Those get unbound after we read one expression. */
1850 /* Set point and ZV around stuff to be read. */
1853 Fnarrow_to_region (make_number (BEGV
), end
);
1855 /* Just for cleanliness, convert END to a marker
1856 if it is an integer. */
1858 end
= Fpoint_max_marker ();
1861 /* On the first cycle, we can easily test here
1862 whether we are reading the whole buffer. */
1863 if (b
&& first_sexp
)
1864 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1871 while ((c
= READCHAR
) != '\n' && c
!= -1);
1876 unbind_to (count1
, Qnil
);
1880 /* Ignore whitespace here, so we can detect eof. */
1881 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1882 || c
== NO_BREAK_SPACE
)
1885 if (!NILP (Vpurify_flag
) && c
== '(')
1887 val
= read_list (0, readcharfun
);
1892 read_objects
= Qnil
;
1893 if (!NILP (readfun
))
1895 val
= call1 (readfun
, readcharfun
);
1897 /* If READCHARFUN has set point to ZV, we should
1898 stop reading, even if the form read sets point
1899 to a different value when evaluated. */
1900 if (BUFFERP (readcharfun
))
1902 struct buffer
*buf
= XBUFFER (readcharfun
);
1903 if (BUF_PT (buf
) == BUF_ZV (buf
))
1904 continue_reading_p
= 0;
1907 else if (! NILP (Vload_read_function
))
1908 val
= call1 (Vload_read_function
, readcharfun
);
1910 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1913 if (!NILP (start
) && continue_reading_p
)
1914 start
= Fpoint_marker ();
1916 /* Restore saved point and BEGV. */
1917 unbind_to (count1
, Qnil
);
1919 /* Now eval what we just read. */
1920 if (!NILP (macroexpand
))
1921 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1923 val
= eval_sub (val
);
1927 Vvalues
= Fcons (val
, Vvalues
);
1928 if (EQ (Vstandard_output
, Qt
))
1937 build_load_history (sourcename
,
1938 stream
|| whole_buffer
);
1940 unbind_to (count
, Qnil
);
1943 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1944 doc
: /* Execute the accessible portion of current buffer as Lisp code.
1945 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
1946 When called from a Lisp program (i.e., not interactively), this
1947 function accepts up to five optional arguments:
1948 BUFFER is the buffer to evaluate (nil means use current buffer),
1949 or a name of a buffer (a string).
1950 PRINTFLAG controls printing of output by any output functions in the
1951 evaluated code, such as `print', `princ', and `prin1':
1952 a value of nil means discard it; anything else is the stream to print to.
1953 See Info node `(elisp)Output Streams' for details on streams.
1954 FILENAME specifies the file name to use for `load-history'.
1955 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1957 DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
1958 evaluated code should work normally even if PRINTFLAG is nil, in
1959 which case the output is displayed in the echo area.
1961 This function preserves the position of point. */)
1962 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1964 ptrdiff_t count
= SPECPDL_INDEX ();
1965 Lisp_Object tem
, buf
;
1968 buf
= Fcurrent_buffer ();
1970 buf
= Fget_buffer (buffer
);
1972 error ("No such buffer");
1974 if (NILP (printflag
) && NILP (do_allow_print
))
1979 if (NILP (filename
))
1980 filename
= BVAR (XBUFFER (buf
), filename
);
1982 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1983 specbind (Qstandard_output
, tem
);
1984 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1985 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1986 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1987 readevalloop (buf
, 0, filename
,
1988 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1989 unbind_to (count
, Qnil
);
1994 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1995 doc
: /* Execute the region as Lisp code.
1996 When called from programs, expects two arguments,
1997 giving starting and ending indices in the current buffer
1998 of the text to be executed.
1999 Programs can pass third argument PRINTFLAG which controls output:
2000 a value of nil means discard it; anything else is stream for printing it.
2001 See Info node `(elisp)Output Streams' for details on streams.
2002 Also the fourth argument READ-FUNCTION, if non-nil, is used
2003 instead of `read' to read each expression. It gets one argument
2004 which is the input stream for reading characters.
2006 This function does not move point. */)
2007 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2009 /* FIXME: Do the eval-sexp-add-defvars dance! */
2010 ptrdiff_t count
= SPECPDL_INDEX ();
2011 Lisp_Object tem
, cbuf
;
2013 cbuf
= Fcurrent_buffer ();
2015 if (NILP (printflag
))
2019 specbind (Qstandard_output
, tem
);
2020 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2022 /* `readevalloop' calls functions which check the type of start and end. */
2023 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2024 !NILP (printflag
), Qnil
, read_function
,
2027 return unbind_to (count
, Qnil
);
2031 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2032 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2033 If STREAM is nil, use the value of `standard-input' (which see).
2034 STREAM or the value of `standard-input' may be:
2035 a buffer (read from point and advance it)
2036 a marker (read from where it points and advance it)
2037 a function (call it with no arguments for each character,
2038 call it with a char as argument to push a char back)
2039 a string (takes text from string, starting at the beginning)
2040 t (read text line using minibuffer and use it, or read from
2041 standard input in batch mode). */)
2042 (Lisp_Object stream
)
2045 stream
= Vstandard_input
;
2046 if (EQ (stream
, Qt
))
2047 stream
= Qread_char
;
2048 if (EQ (stream
, Qread_char
))
2049 /* FIXME: ?! When is this used !? */
2050 return call1 (intern ("read-minibuffer"),
2051 build_string ("Lisp expression: "));
2053 return read_internal_start (stream
, Qnil
, Qnil
);
2056 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2057 doc
: /* Read one Lisp expression which is represented as text by STRING.
2058 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2059 FINAL-STRING-INDEX is an integer giving the position of the next
2060 remaining character in STRING. START and END optionally delimit
2061 a substring of STRING from which to read; they default to 0 and
2062 (length STRING) respectively. Negative values are counted from
2063 the end of STRING. */)
2064 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2067 CHECK_STRING (string
);
2068 /* `read_internal_start' sets `read_from_string_index'. */
2069 ret
= read_internal_start (string
, start
, end
);
2070 return Fcons (ret
, make_number (read_from_string_index
));
2073 /* Function to set up the global context we need in toplevel read
2074 calls. START and END only used when STREAM is a string. */
2076 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2081 new_backquote_flag
= 0;
2082 read_objects
= Qnil
;
2083 if (EQ (Vread_with_symbol_positions
, Qt
)
2084 || EQ (Vread_with_symbol_positions
, stream
))
2085 Vread_symbol_positions_list
= Qnil
;
2087 if (STRINGP (stream
)
2088 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2090 ptrdiff_t startval
, endval
;
2093 if (STRINGP (stream
))
2096 string
= XCAR (stream
);
2098 validate_subarray (string
, start
, end
, SCHARS (string
),
2099 &startval
, &endval
);
2101 read_from_string_index
= startval
;
2102 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2103 read_from_string_limit
= endval
;
2106 retval
= read0 (stream
);
2107 if (EQ (Vread_with_symbol_positions
, Qt
)
2108 || EQ (Vread_with_symbol_positions
, stream
))
2109 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2114 /* Signal Qinvalid_read_syntax error.
2115 S is error string of length N (if > 0) */
2117 static _Noreturn
void
2118 invalid_syntax (const char *s
)
2120 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2124 /* Use this for recursive reads, in contexts where internal tokens
2128 read0 (Lisp_Object readcharfun
)
2130 register Lisp_Object val
;
2133 val
= read1 (readcharfun
, &c
, 0);
2137 xsignal1 (Qinvalid_read_syntax
,
2138 Fmake_string (make_number (1), make_number (c
)));
2141 static ptrdiff_t read_buffer_size
;
2142 static char *read_buffer
;
2144 /* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes. */
2147 grow_read_buffer (void)
2149 read_buffer
= xpalloc (read_buffer
, &read_buffer_size
,
2150 MAX_MULTIBYTE_LENGTH
, -1, 1);
2153 /* Read a \-escape sequence, assuming we already read the `\'.
2154 If the escape sequence forces unibyte, return eight-bit char. */
2157 read_escape (Lisp_Object readcharfun
, bool stringp
)
2160 /* \u allows up to four hex digits, \U up to eight. Default to the
2161 behavior for \u, and change this value in the case that \U is seen. */
2162 int unicode_hex_count
= 4;
2167 end_of_file_error ();
2197 error ("Invalid escape character syntax");
2200 c
= read_escape (readcharfun
, 0);
2201 return c
| meta_modifier
;
2206 error ("Invalid escape character syntax");
2209 c
= read_escape (readcharfun
, 0);
2210 return c
| shift_modifier
;
2215 error ("Invalid escape character syntax");
2218 c
= read_escape (readcharfun
, 0);
2219 return c
| hyper_modifier
;
2224 error ("Invalid escape character syntax");
2227 c
= read_escape (readcharfun
, 0);
2228 return c
| alt_modifier
;
2232 if (stringp
|| c
!= '-')
2239 c
= read_escape (readcharfun
, 0);
2240 return c
| super_modifier
;
2245 error ("Invalid escape character syntax");
2249 c
= read_escape (readcharfun
, 0);
2250 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2251 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2252 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2253 return c
| ctrl_modifier
;
2254 /* ASCII control chars are made from letters (both cases),
2255 as well as the non-letters within 0100...0137. */
2256 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2257 return (c
& (037 | ~0177));
2258 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2259 return (c
& (037 | ~0177));
2261 return c
| ctrl_modifier
;
2271 /* An octal escape, as in ANSI C. */
2273 register int i
= c
- '0';
2274 register int count
= 0;
2277 if ((c
= READCHAR
) >= '0' && c
<= '7')
2289 if (i
>= 0x80 && i
< 0x100)
2290 i
= BYTE8_TO_CHAR (i
);
2295 /* A hex escape, as in ANSI C. */
2302 if (c
>= '0' && c
<= '9')
2307 else if ((c
>= 'a' && c
<= 'f')
2308 || (c
>= 'A' && c
<= 'F'))
2311 if (c
>= 'a' && c
<= 'f')
2321 /* Allow hex escapes as large as ?\xfffffff, because some
2322 packages use them to denote characters with modifiers. */
2323 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2324 error ("Hex character out of range: \\x%x...", i
);
2328 if (count
< 3 && i
>= 0x80)
2329 return BYTE8_TO_CHAR (i
);
2334 /* Post-Unicode-2.0: Up to eight hex chars. */
2335 unicode_hex_count
= 8;
2338 /* A Unicode escape. We only permit them in strings and characters,
2339 not arbitrarily in the source code, as in some other languages. */
2344 while (++count
<= unicode_hex_count
)
2347 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2349 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2350 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2351 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2353 error ("Non-hex digit used for Unicode escape");
2356 error ("Non-Unicode character: 0x%x", i
);
2365 /* Return the digit that CHARACTER stands for in the given BASE.
2366 Return -1 if CHARACTER is out of range for BASE,
2367 and -2 if CHARACTER is not valid for any supported BASE. */
2369 digit_to_number (int character
, int base
)
2373 if ('0' <= character
&& character
<= '9')
2374 digit
= character
- '0';
2375 else if ('a' <= character
&& character
<= 'z')
2376 digit
= character
- 'a' + 10;
2377 else if ('A' <= character
&& character
<= 'Z')
2378 digit
= character
- 'A' + 10;
2382 return digit
< base
? digit
: -1;
2385 /* Read an integer in radix RADIX using READCHARFUN to read
2386 characters. RADIX must be in the interval [2..36]; if it isn't, a
2387 read error is signaled . Value is the integer read. Signals an
2388 error if encountering invalid read syntax or if RADIX is out of
2392 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2394 /* Room for sign, leading 0, other digits, trailing null byte.
2395 Also, room for invalid syntax diagnostic. */
2396 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2397 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2399 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2401 if (radix
< 2 || radix
> 36)
2409 if (c
== '-' || c
== '+')
2420 /* Ignore redundant leading zeros, so the buffer doesn't
2421 fill up with them. */
2427 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2434 if (p
< buf
+ sizeof buf
- 1)
2448 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2449 invalid_syntax (buf
);
2452 return string_to_number (buf
, radix
, 0);
2456 /* If the next token is ')' or ']' or '.', we store that character
2457 in *PCH and the return value is not interesting. Else, we store
2458 zero in *PCH and we read and return one lisp object.
2460 FIRST_IN_LIST is true if this is the first element of a list. */
2463 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2466 bool uninterned_symbol
= 0;
2473 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2475 end_of_file_error ();
2480 return read_list (0, readcharfun
);
2483 return read_vector (readcharfun
, 0);
2499 /* Accept extended format for hashtables (extensible to
2501 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2502 Lisp_Object tmp
= read_list (0, readcharfun
);
2503 Lisp_Object head
= CAR_SAFE (tmp
);
2504 Lisp_Object data
= Qnil
;
2505 Lisp_Object val
= Qnil
;
2506 /* The size is 2 * number of allowed keywords to
2508 Lisp_Object params
[10];
2510 Lisp_Object key
= Qnil
;
2511 int param_count
= 0;
2513 if (!EQ (head
, Qhash_table
))
2514 error ("Invalid extended read marker at head of #s list "
2515 "(only hash-table allowed)");
2517 tmp
= CDR_SAFE (tmp
);
2519 /* This is repetitive but fast and simple. */
2520 params
[param_count
] = QCsize
;
2521 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2522 if (!NILP (params
[param_count
+ 1]))
2525 params
[param_count
] = QCtest
;
2526 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2527 if (!NILP (params
[param_count
+ 1]))
2530 params
[param_count
] = QCweakness
;
2531 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2532 if (!NILP (params
[param_count
+ 1]))
2535 params
[param_count
] = QCrehash_size
;
2536 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2537 if (!NILP (params
[param_count
+ 1]))
2540 params
[param_count
] = QCrehash_threshold
;
2541 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2542 if (!NILP (params
[param_count
+ 1]))
2545 /* This is the hashtable data. */
2546 data
= Fplist_get (tmp
, Qdata
);
2548 /* Now use params to make a new hashtable and fill it. */
2549 ht
= Fmake_hash_table (param_count
, params
);
2551 while (CONSP (data
))
2556 error ("Odd number of elements in hashtable data");
2559 Fputhash (key
, val
, ht
);
2565 invalid_syntax ("#");
2573 tmp
= read_vector (readcharfun
, 0);
2574 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2575 error ("Invalid size char-table");
2576 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2584 /* Sub char-table can't be read as a regular
2585 vector because of a two C integer fields. */
2586 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2587 ptrdiff_t size
= XINT (Flength (tmp
));
2588 int i
, depth
, min_char
;
2589 struct Lisp_Cons
*cell
;
2592 error ("Zero-sized sub char-table");
2594 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2595 error ("Invalid depth in sub char-table");
2596 depth
= XINT (XCAR (tmp
));
2597 if (chartab_size
[depth
] != size
- 2)
2598 error ("Invalid size in sub char-table");
2599 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2602 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2603 error ("Invalid minimum character in sub-char-table");
2604 min_char
= XINT (XCAR (tmp
));
2605 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2608 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2609 for (i
= 0; i
< size
; i
++)
2611 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2612 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2617 invalid_syntax ("#^^");
2619 invalid_syntax ("#^");
2624 length
= read1 (readcharfun
, pch
, first_in_list
);
2628 Lisp_Object tmp
, val
;
2629 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2630 unsigned char *data
;
2633 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2634 if (STRING_MULTIBYTE (tmp
)
2635 || (size_in_chars
!= SCHARS (tmp
)
2636 /* We used to print 1 char too many
2637 when the number of bits was a multiple of 8.
2638 Accept such input in case it came from an old
2640 && ! (XFASTINT (length
)
2641 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2642 invalid_syntax ("#&...");
2644 val
= make_uninit_bool_vector (XFASTINT (length
));
2645 data
= bool_vector_uchar_data (val
);
2646 memcpy (data
, SDATA (tmp
), size_in_chars
);
2647 /* Clear the extraneous bits in the last byte. */
2648 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2649 data
[size_in_chars
- 1]
2650 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2653 invalid_syntax ("#&...");
2657 /* Accept compiled functions at read-time so that we don't have to
2658 build them using function calls. */
2660 struct Lisp_Vector
*vec
;
2661 tmp
= read_vector (readcharfun
, 1);
2662 vec
= XVECTOR (tmp
);
2663 if (vec
->header
.size
== 0)
2664 invalid_syntax ("Empty byte-code object");
2665 make_byte_code (vec
);
2673 /* Read the string itself. */
2674 tmp
= read1 (readcharfun
, &ch
, 0);
2675 if (ch
!= 0 || !STRINGP (tmp
))
2676 invalid_syntax ("#");
2677 /* Read the intervals and their properties. */
2680 Lisp_Object beg
, end
, plist
;
2682 beg
= read1 (readcharfun
, &ch
, 0);
2687 end
= read1 (readcharfun
, &ch
, 0);
2689 plist
= read1 (readcharfun
, &ch
, 0);
2691 invalid_syntax ("Invalid string property list");
2692 Fset_text_properties (beg
, end
, plist
, tmp
);
2698 /* #@NUMBER is used to skip NUMBER following bytes.
2699 That's used in .elc files to skip over doc strings
2700 and function definitions. */
2703 enum { extra
= 100 };
2704 ptrdiff_t i
, nskip
= 0, digits
= 0;
2706 /* Read a decimal integer. */
2707 while ((c
= READCHAR
) >= 0
2708 && c
>= '0' && c
<= '9')
2710 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2715 if (digits
== 2 && nskip
== 0)
2716 { /* We've just seen #@00, which means "skip to end". */
2717 skip_dyn_eof (readcharfun
);
2722 /* We can't use UNREAD here, because in the code below we side-step
2723 READCHAR. Instead, assume the first char after #@NNN occupies
2724 a single byte, which is the case normally since it's just
2730 if (load_force_doc_strings
2731 && (FROM_FILE_P (readcharfun
)))
2733 /* If we are supposed to force doc strings into core right now,
2734 record the last string that we skipped,
2735 and record where in the file it comes from. */
2737 /* But first exchange saved_doc_string
2738 with prev_saved_doc_string, so we save two strings. */
2740 char *temp
= saved_doc_string
;
2741 ptrdiff_t temp_size
= saved_doc_string_size
;
2742 file_offset temp_pos
= saved_doc_string_position
;
2743 ptrdiff_t temp_len
= saved_doc_string_length
;
2745 saved_doc_string
= prev_saved_doc_string
;
2746 saved_doc_string_size
= prev_saved_doc_string_size
;
2747 saved_doc_string_position
= prev_saved_doc_string_position
;
2748 saved_doc_string_length
= prev_saved_doc_string_length
;
2750 prev_saved_doc_string
= temp
;
2751 prev_saved_doc_string_size
= temp_size
;
2752 prev_saved_doc_string_position
= temp_pos
;
2753 prev_saved_doc_string_length
= temp_len
;
2756 if (saved_doc_string_size
== 0)
2758 saved_doc_string
= xmalloc (nskip
+ extra
);
2759 saved_doc_string_size
= nskip
+ extra
;
2761 if (nskip
> saved_doc_string_size
)
2763 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2764 saved_doc_string_size
= nskip
+ extra
;
2767 saved_doc_string_position
= file_tell (instream
);
2769 /* Copy that many characters into saved_doc_string. */
2771 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2772 saved_doc_string
[i
] = c
= getc (instream
);
2775 saved_doc_string_length
= i
;
2778 /* Skip that many bytes. */
2779 skip_dyn_bytes (readcharfun
, nskip
);
2785 /* #! appears at the beginning of an executable file.
2786 Skip the first line. */
2787 while (c
!= '\n' && c
>= 0)
2792 return Vload_file_name
;
2794 return list2 (Qfunction
, read0 (readcharfun
));
2795 /* #:foo is the uninterned symbol named foo. */
2798 uninterned_symbol
= 1;
2801 && c
!= NO_BREAK_SPACE
2803 || strchr ("\"';()[]#`,", c
) == NULL
)))
2805 /* No symbol character follows, this is the empty
2808 return Fmake_symbol (empty_unibyte_string
);
2812 /* ## is the empty symbol. */
2814 return Fintern (empty_unibyte_string
, Qnil
);
2815 /* Reader forms that can reuse previously read objects. */
2816 if (c
>= '0' && c
<= '9')
2821 /* Read a non-negative integer. */
2822 while (c
>= '0' && c
<= '9')
2824 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2825 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2826 n
= MOST_POSITIVE_FIXNUM
+ 1;
2828 n
= n
* 10 + c
- '0';
2832 if (n
<= MOST_POSITIVE_FIXNUM
)
2834 if (c
== 'r' || c
== 'R')
2835 return read_integer (readcharfun
, n
);
2837 if (! NILP (Vread_circle
))
2839 /* #n=object returns object, but associates it with
2843 /* Make a placeholder for #n# to use temporarily. */
2844 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2845 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2846 read_objects
= Fcons (cell
, read_objects
);
2848 /* Read the object itself. */
2849 tem
= read0 (readcharfun
);
2851 /* Now put it everywhere the placeholder was... */
2852 substitute_object_in_subtree (tem
, placeholder
);
2854 /* ...and #n# will use the real value from now on. */
2855 Fsetcdr (cell
, tem
);
2860 /* #n# returns a previously read object. */
2863 tem
= Fassq (make_number (n
), read_objects
);
2869 /* Fall through to error message. */
2871 else if (c
== 'x' || c
== 'X')
2872 return read_integer (readcharfun
, 16);
2873 else if (c
== 'o' || c
== 'O')
2874 return read_integer (readcharfun
, 8);
2875 else if (c
== 'b' || c
== 'B')
2876 return read_integer (readcharfun
, 2);
2879 invalid_syntax ("#");
2882 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2886 return list2 (Qquote
, read0 (readcharfun
));
2890 int next_char
= READCHAR
;
2892 /* Transition from old-style to new-style:
2893 If we see "(`" it used to mean old-style, which usually works
2894 fine because ` should almost never appear in such a position
2895 for new-style. But occasionally we need "(`" to mean new
2896 style, so we try to distinguish the two by the fact that we
2897 can either write "( `foo" or "(` foo", where the first
2898 intends to use new-style whereas the second intends to use
2899 old-style. For Emacs-25, we should completely remove this
2900 first_in_list exception (old-style can still be obtained via
2902 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2904 Vold_style_backquotes
= Qt
;
2910 bool saved_new_backquote_flag
= new_backquote_flag
;
2912 new_backquote_flag
= 1;
2913 value
= read0 (readcharfun
);
2914 new_backquote_flag
= saved_new_backquote_flag
;
2916 return list2 (Qbackquote
, value
);
2921 int next_char
= READCHAR
;
2923 /* Transition from old-style to new-style:
2924 It used to be impossible to have a new-style , other than within
2925 a new-style `. This is sufficient when ` and , are used in the
2926 normal way, but ` and , can also appear in args to macros that
2927 will not interpret them in the usual way, in which case , may be
2928 used without any ` anywhere near.
2929 So we now use the same heuristic as for backquote: old-style
2930 unquotes are only recognized when first on a list, and when
2931 followed by a space.
2932 Because it's more difficult to peek 2 chars ahead, a new-style
2933 ,@ can still not be used outside of a `, unless it's in the middle
2935 if (new_backquote_flag
2937 || (next_char
!= ' ' && next_char
!= '@'))
2939 Lisp_Object comma_type
= Qnil
;
2944 comma_type
= Qcomma_at
;
2946 comma_type
= Qcomma_dot
;
2949 if (ch
>= 0) UNREAD (ch
);
2950 comma_type
= Qcomma
;
2953 value
= read0 (readcharfun
);
2954 return list2 (comma_type
, value
);
2958 Vold_style_backquotes
= Qt
;
2970 end_of_file_error ();
2972 /* Accept `single space' syntax like (list ? x) where the
2973 whitespace character is SPC or TAB.
2974 Other literal whitespace like NL, CR, and FF are not accepted,
2975 as there are well-established escape sequences for these. */
2976 if (c
== ' ' || c
== '\t')
2977 return make_number (c
);
2980 c
= read_escape (readcharfun
, 0);
2981 modifiers
= c
& CHAR_MODIFIER_MASK
;
2982 c
&= ~CHAR_MODIFIER_MASK
;
2983 if (CHAR_BYTE8_P (c
))
2984 c
= CHAR_TO_BYTE8 (c
);
2987 next_char
= READCHAR
;
2988 ok
= (next_char
<= 040
2989 || (next_char
< 0200
2990 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2993 return make_number (c
);
2995 invalid_syntax ("?");
3000 char *p
= read_buffer
;
3001 char *end
= read_buffer
+ read_buffer_size
;
3003 /* True if we saw an escape sequence specifying
3004 a multibyte character. */
3005 bool force_multibyte
= 0;
3006 /* True if we saw an escape sequence specifying
3007 a single-byte character. */
3008 bool force_singlebyte
= 0;
3010 ptrdiff_t nchars
= 0;
3012 while ((ch
= READCHAR
) >= 0
3015 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3017 ptrdiff_t offset
= p
- read_buffer
;
3018 grow_read_buffer ();
3019 p
= read_buffer
+ offset
;
3020 end
= read_buffer
+ read_buffer_size
;
3027 ch
= read_escape (readcharfun
, 1);
3029 /* CH is -1 if \ newline or \ space has just been seen. */
3032 if (p
== read_buffer
)
3037 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3038 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3040 if (CHAR_BYTE8_P (ch
))
3041 force_singlebyte
= 1;
3042 else if (! ASCII_CHAR_P (ch
))
3043 force_multibyte
= 1;
3044 else /* I.e. ASCII_CHAR_P (ch). */
3046 /* Allow `\C- ' and `\C-?'. */
3047 if (modifiers
== CHAR_CTL
)
3050 ch
= 0, modifiers
= 0;
3052 ch
= 127, modifiers
= 0;
3054 if (modifiers
& CHAR_SHIFT
)
3056 /* Shift modifier is valid only with [A-Za-z]. */
3057 if (ch
>= 'A' && ch
<= 'Z')
3058 modifiers
&= ~CHAR_SHIFT
;
3059 else if (ch
>= 'a' && ch
<= 'z')
3060 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3063 if (modifiers
& CHAR_META
)
3065 /* Move the meta bit to the right place for a
3067 modifiers
&= ~CHAR_META
;
3068 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3069 force_singlebyte
= 1;
3073 /* Any modifiers remaining are invalid. */
3075 error ("Invalid modifier in string");
3076 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3080 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3081 if (CHAR_BYTE8_P (ch
))
3082 force_singlebyte
= 1;
3083 else if (! ASCII_CHAR_P (ch
))
3084 force_multibyte
= 1;
3090 end_of_file_error ();
3092 /* If purifying, and string starts with \ newline,
3093 return zero instead. This is for doc strings
3094 that we are really going to find in etc/DOC.nn.nn. */
3095 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3096 return make_number (0);
3098 if (! force_multibyte
&& force_singlebyte
)
3100 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3101 forms. Convert it to unibyte. */
3102 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3104 p
= read_buffer
+ nchars
;
3107 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3109 || (p
- read_buffer
!= nchars
)));
3114 int next_char
= READCHAR
;
3117 if (next_char
<= 040
3118 || (next_char
< 0200
3119 && strchr ("\"';([#?`,", next_char
) != NULL
))
3125 /* Otherwise, we fall through! Note that the atom-reading loop
3126 below will now loop at least once, assuring that we will not
3127 try to UNREAD two characters in a row. */
3131 if (c
<= 040) goto retry
;
3132 if (c
== NO_BREAK_SPACE
)
3137 char *p
= read_buffer
;
3139 EMACS_INT start_position
= readchar_count
- 1;
3142 char *end
= read_buffer
+ read_buffer_size
;
3146 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3148 ptrdiff_t offset
= p
- read_buffer
;
3149 grow_read_buffer ();
3150 p
= read_buffer
+ offset
;
3151 end
= read_buffer
+ read_buffer_size
;
3158 end_of_file_error ();
3163 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3169 && c
!= NO_BREAK_SPACE
3171 || strchr ("\"';()[]#`,", c
) == NULL
));
3175 ptrdiff_t offset
= p
- read_buffer
;
3176 grow_read_buffer ();
3177 p
= read_buffer
+ offset
;
3178 end
= read_buffer
+ read_buffer_size
;
3184 if (!quoted
&& !uninterned_symbol
)
3186 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3187 if (! NILP (result
))
3191 Lisp_Object name
, result
;
3192 ptrdiff_t nbytes
= p
- read_buffer
;
3195 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3199 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3200 ? make_pure_string
: make_specified_string
)
3201 (read_buffer
, nchars
, nbytes
, multibyte
));
3202 result
= (uninterned_symbol
? Fmake_symbol (name
)
3203 : Fintern (name
, Qnil
));
3205 if (EQ (Vread_with_symbol_positions
, Qt
)
3206 || EQ (Vread_with_symbol_positions
, readcharfun
))
3207 Vread_symbol_positions_list
3208 = Fcons (Fcons (result
, make_number (start_position
)),
3209 Vread_symbol_positions_list
);
3217 /* List of nodes we've seen during substitute_object_in_subtree. */
3218 static Lisp_Object seen_list
;
3221 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3223 Lisp_Object check_object
;
3225 /* We haven't seen any objects when we start. */
3228 /* Make all the substitutions. */
3230 = substitute_object_recurse (object
, placeholder
, object
);
3232 /* Clear seen_list because we're done with it. */
3235 /* The returned object here is expected to always eq the
3237 if (!EQ (check_object
, object
))
3238 error ("Unexpected mutation error in reader");
3241 /* Feval doesn't get called from here, so no gc protection is needed. */
3242 #define SUBSTITUTE(get_val, set_val) \
3244 Lisp_Object old_value = get_val; \
3245 Lisp_Object true_value \
3246 = substitute_object_recurse (object, placeholder, \
3249 if (!EQ (old_value, true_value)) \
3256 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3258 /* If we find the placeholder, return the target object. */
3259 if (EQ (placeholder
, subtree
))
3262 /* If we've been to this node before, don't explore it again. */
3263 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3266 /* If this node can be the entry point to a cycle, remember that
3267 we've seen it. It can only be such an entry point if it was made
3268 by #n=, which means that we can find it as a value in
3270 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3271 seen_list
= Fcons (subtree
, seen_list
);
3273 /* Recurse according to subtree's type.
3274 Every branch must return a Lisp_Object. */
3275 switch (XTYPE (subtree
))
3277 case Lisp_Vectorlike
:
3279 ptrdiff_t i
= 0, length
= 0;
3280 if (BOOL_VECTOR_P (subtree
))
3281 return subtree
; /* No sub-objects anyway. */
3282 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3283 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3284 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3285 else if (VECTORP (subtree
))
3286 length
= ASIZE (subtree
);
3288 /* An unknown pseudovector may contain non-Lisp fields, so we
3289 can't just blindly traverse all its fields. We used to call
3290 `Flength' which signaled `sequencep', so I just preserved this
3292 wrong_type_argument (Qsequencep
, subtree
);
3294 if (SUB_CHAR_TABLE_P (subtree
))
3296 for ( ; i
< length
; i
++)
3297 SUBSTITUTE (AREF (subtree
, i
),
3298 ASET (subtree
, i
, true_value
));
3304 SUBSTITUTE (XCAR (subtree
),
3305 XSETCAR (subtree
, true_value
));
3306 SUBSTITUTE (XCDR (subtree
),
3307 XSETCDR (subtree
, true_value
));
3313 /* Check for text properties in each interval.
3314 substitute_in_interval contains part of the logic. */
3316 INTERVAL root_interval
= string_intervals (subtree
);
3317 AUTO_CONS (arg
, object
, placeholder
);
3319 traverse_intervals_noorder (root_interval
,
3320 &substitute_in_interval
, arg
);
3325 /* Other types don't recurse any further. */
3331 /* Helper function for substitute_object_recurse. */
3333 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3335 Lisp_Object object
= Fcar (arg
);
3336 Lisp_Object placeholder
= Fcdr (arg
);
3338 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3348 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3349 integer syntax and fits in a fixnum, else return the nearest float if CP has
3350 either floating point or integer syntax and BASE is 10, else return nil. If
3351 IGNORE_TRAILING, consider just the longest prefix of CP that has
3352 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3353 number has integer syntax but does not fit. */
3356 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3359 char const *cp
= string
;
3361 bool float_syntax
= 0;
3364 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3365 IEEE floating point hosts, and works around a formerly-common bug where
3366 atof ("-0.0") drops the sign. */
3367 bool negative
= *cp
== '-';
3369 bool signedp
= negative
|| *cp
== '+';
3374 leading_digit
= digit_to_number (*cp
, base
);
3375 if (leading_digit
>= 0)
3380 while (digit_to_number (*cp
, base
) >= 0);
3390 if ('0' <= *cp
&& *cp
<= '9')
3395 while ('0' <= *cp
&& *cp
<= '9');
3397 if (*cp
== 'e' || *cp
== 'E')
3399 char const *ecp
= cp
;
3401 if (*cp
== '+' || *cp
== '-')
3403 if ('0' <= *cp
&& *cp
<= '9')
3408 while ('0' <= *cp
&& *cp
<= '9');
3410 else if (cp
[-1] == '+'
3411 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3417 else if (cp
[-1] == '+'
3418 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3422 /* NAN is a "positive" NaN on all known Emacs hosts. */
3429 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3430 || state
== (LEAD_INT
|E_EXP
));
3433 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3434 any prefix that matches. Otherwise, the entire string must match. */
3435 if (! (ignore_trailing
3436 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3437 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3440 /* If the number uses integer and not float syntax, and is in C-language
3441 range, use its value, preferably as a fixnum. */
3442 if (leading_digit
>= 0 && ! float_syntax
)
3446 /* Fast special case for single-digit integers. This also avoids a
3447 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3448 case some versions of strtoumax accept numbers like "0x1" that Emacs
3450 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3451 return make_number (negative
? -leading_digit
: leading_digit
);
3454 n
= strtoumax (string
+ signedp
, NULL
, base
);
3455 if (errno
== ERANGE
)
3457 /* Unfortunately there's no simple and accurate way to convert
3458 non-base-10 numbers that are out of C-language range. */
3460 xsignal1 (Qoverflow_error
, build_string (string
));
3462 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3464 EMACS_INT signed_n
= n
;
3465 return make_number (negative
? -signed_n
: signed_n
);
3471 /* Either the number uses float syntax, or it does not fit into a fixnum.
3472 Convert it from string to floating point, unless the value is already
3473 known because it is an infinity, a NAN, or its absolute value fits in
3476 value
= atof (string
+ signedp
);
3478 return make_float (negative
? -value
: value
);
3483 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3487 Lisp_Object tem
, item
, vector
;
3488 struct Lisp_Cons
*otem
;
3491 tem
= read_list (1, readcharfun
);
3492 len
= Flength (tem
);
3493 vector
= Fmake_vector (len
, Qnil
);
3495 size
= ASIZE (vector
);
3496 ptr
= XVECTOR (vector
)->contents
;
3497 for (i
= 0; i
< size
; i
++)
3500 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3501 bytecode object, the docstring containing the bytecode and
3502 constants values must be treated as unibyte and passed to
3503 Fread, to get the actual bytecode string and constants vector. */
3504 if (bytecodeflag
&& load_force_doc_strings
)
3506 if (i
== COMPILED_BYTECODE
)
3508 if (!STRINGP (item
))
3509 error ("Invalid byte code");
3511 /* Delay handling the bytecode slot until we know whether
3512 it is lazily-loaded (we can tell by whether the
3513 constants slot is nil). */
3514 ASET (vector
, COMPILED_CONSTANTS
, item
);
3517 else if (i
== COMPILED_CONSTANTS
)
3519 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3523 /* Coerce string to unibyte (like string-as-unibyte,
3524 but without generating extra garbage and
3525 guaranteeing no change in the contents). */
3526 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3527 STRING_SET_UNIBYTE (bytestr
);
3529 item
= Fread (Fcons (bytestr
, readcharfun
));
3531 error ("Invalid byte code");
3533 otem
= XCONS (item
);
3534 bytestr
= XCAR (item
);
3539 /* Now handle the bytecode slot. */
3540 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3542 else if (i
== COMPILED_DOC_STRING
3544 && ! STRING_MULTIBYTE (item
))
3546 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3547 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3549 item
= Fstring_as_multibyte (item
);
3552 ASET (vector
, i
, item
);
3560 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3563 read_list (bool flag
, Lisp_Object readcharfun
)
3565 Lisp_Object val
, tail
;
3566 Lisp_Object elt
, tem
;
3567 /* 0 is the normal case.
3568 1 means this list is a doc reference; replace it with the number 0.
3569 2 means this list is a doc reference; replace it with the doc string. */
3570 int doc_reference
= 0;
3572 /* Initialize this to 1 if we are reading a list. */
3573 bool first_in_list
= flag
<= 0;
3581 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3585 /* While building, if the list starts with #$, treat it specially. */
3586 if (EQ (elt
, Vload_file_name
)
3588 && !NILP (Vpurify_flag
))
3590 if (NILP (Vdoc_file_name
))
3591 /* We have not yet called Snarf-documentation, so assume
3592 this file is described in the DOC file
3593 and Snarf-documentation will fill in the right value later.
3594 For now, replace the whole list with 0. */
3597 /* We have already called Snarf-documentation, so make a relative
3598 file name for this file, so it can be found properly
3599 in the installed Lisp directory.
3600 We don't use Fexpand_file_name because that would make
3601 the directory absolute now. */
3603 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3604 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3607 else if (EQ (elt
, Vload_file_name
)
3609 && load_force_doc_strings
)
3618 invalid_syntax (") or . in a vector");
3625 XSETCDR (tail
, read0 (readcharfun
));
3627 val
= read0 (readcharfun
);
3628 read1 (readcharfun
, &ch
, 0);
3632 if (doc_reference
== 1)
3633 return make_number (0);
3634 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3637 file_offset saved_position
;
3638 /* Get a doc string from the file we are loading.
3639 If it's in saved_doc_string, get it from there.
3641 Here, we don't know if the string is a
3642 bytecode string or a doc string. As a
3643 bytecode string must be unibyte, we always
3644 return a unibyte string. If it is actually a
3645 doc string, caller must make it
3648 /* Position is negative for user variables. */
3649 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3650 if (pos
>= saved_doc_string_position
3651 && pos
< (saved_doc_string_position
3652 + saved_doc_string_length
))
3654 saved
= saved_doc_string
;
3655 saved_position
= saved_doc_string_position
;
3657 /* Look in prev_saved_doc_string the same way. */
3658 else if (pos
>= prev_saved_doc_string_position
3659 && pos
< (prev_saved_doc_string_position
3660 + prev_saved_doc_string_length
))
3662 saved
= prev_saved_doc_string
;
3663 saved_position
= prev_saved_doc_string_position
;
3667 ptrdiff_t start
= pos
- saved_position
;
3670 /* Process quoting with ^A,
3671 and find the end of the string,
3672 which is marked with ^_ (037). */
3673 for (from
= start
, to
= start
;
3674 saved
[from
] != 037;)
3676 int c
= saved
[from
++];
3680 saved
[to
++] = (c
== 1 ? c
3689 return make_unibyte_string (saved
+ start
,
3693 return get_doc_string (val
, 1, 0);
3698 invalid_syntax (". in wrong context");
3700 invalid_syntax ("] in a list");
3704 XSETCDR (tail
, tem
);
3711 static Lisp_Object initial_obarray
;
3713 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3715 static size_t oblookup_last_bucket_number
;
3717 /* Get an error if OBARRAY is not an obarray.
3718 If it is one, return it. */
3721 check_obarray (Lisp_Object obarray
)
3723 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3725 /* If Vobarray is now invalid, force it to be valid. */
3726 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3727 wrong_type_argument (Qvectorp
, obarray
);
3732 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3735 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3739 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3740 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3743 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3745 XSYMBOL (sym
)->constant
= 1;
3746 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3747 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3750 ptr
= aref_addr (obarray
, XINT (index
));
3751 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3756 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3759 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3761 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3764 /* Intern the C string STR: return a symbol with that name,
3765 interned in the current obarray. */
3768 intern_1 (const char *str
, ptrdiff_t len
)
3770 Lisp_Object obarray
= check_obarray (Vobarray
);
3771 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3773 return (SYMBOLP (tem
) ? tem
3774 /* The above `oblookup' was done on the basis of nchars==nbytes, so
3775 the string has to be unibyte. */
3776 : intern_driver (make_unibyte_string (str
, len
),
3781 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3783 Lisp_Object obarray
= check_obarray (Vobarray
);
3784 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3788 /* Creating a non-pure string from a string literal not implemented yet.
3789 We could just use make_string here and live with the extra copy. */
3790 eassert (!NILP (Vpurify_flag
));
3791 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3797 define_symbol (Lisp_Object sym
, char const *str
)
3799 ptrdiff_t len
= strlen (str
);
3800 Lisp_Object string
= make_pure_c_string (str
, len
);
3801 init_symbol (sym
, string
);
3803 /* Qunbound is uninterned, so that it's not confused with any symbol
3804 'unbound' created by a Lisp program. */
3805 if (! EQ (sym
, Qunbound
))
3807 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3808 eassert (INTEGERP (bucket
));
3809 intern_sym (sym
, initial_obarray
, bucket
);
3813 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3814 doc
: /* Return the canonical symbol whose name is STRING.
3815 If there is none, one is created by this function and returned.
3816 A second optional argument specifies the obarray to use;
3817 it defaults to the value of `obarray'. */)
3818 (Lisp_Object string
, Lisp_Object obarray
)
3822 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3823 CHECK_STRING (string
);
3825 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3827 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3832 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3833 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3834 NAME may be a string or a symbol. If it is a symbol, that exact
3835 symbol is searched for.
3836 A second optional argument specifies the obarray to use;
3837 it defaults to the value of `obarray'. */)
3838 (Lisp_Object name
, Lisp_Object obarray
)
3840 register Lisp_Object tem
, string
;
3842 if (NILP (obarray
)) obarray
= Vobarray
;
3843 obarray
= check_obarray (obarray
);
3845 if (!SYMBOLP (name
))
3847 CHECK_STRING (name
);
3851 string
= SYMBOL_NAME (name
);
3853 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3854 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3860 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3861 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3862 The value is t if a symbol was found and deleted, nil otherwise.
3863 NAME may be a string or a symbol. If it is a symbol, that symbol
3864 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3865 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3866 usage: (unintern NAME OBARRAY) */)
3867 (Lisp_Object name
, Lisp_Object obarray
)
3869 register Lisp_Object string
, tem
;
3872 if (NILP (obarray
)) obarray
= Vobarray
;
3873 obarray
= check_obarray (obarray
);
3876 string
= SYMBOL_NAME (name
);
3879 CHECK_STRING (name
);
3883 tem
= oblookup (obarray
, SSDATA (string
),
3888 /* If arg was a symbol, don't delete anything but that symbol itself. */
3889 if (SYMBOLP (name
) && !EQ (name
, tem
))
3892 /* There are plenty of other symbols which will screw up the Emacs
3893 session if we unintern them, as well as even more ways to use
3894 `setq' or `fset' or whatnot to make the Emacs session
3895 unusable. Let's not go down this silly road. --Stef */
3896 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3897 error ("Attempt to unintern t or nil"); */
3899 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3901 hash
= oblookup_last_bucket_number
;
3903 if (EQ (AREF (obarray
, hash
), tem
))
3905 if (XSYMBOL (tem
)->next
)
3908 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3909 ASET (obarray
, hash
, sym
);
3912 ASET (obarray
, hash
, make_number (0));
3916 Lisp_Object tail
, following
;
3918 for (tail
= AREF (obarray
, hash
);
3919 XSYMBOL (tail
)->next
;
3922 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3923 if (EQ (following
, tem
))
3925 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3934 /* Return the symbol in OBARRAY whose names matches the string
3935 of SIZE characters (SIZE_BYTE bytes) at PTR.
3936 If there is no such symbol, return the integer bucket number of
3937 where the symbol would be if it were present.
3939 Also store the bucket number in oblookup_last_bucket_number. */
3942 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3946 register Lisp_Object tail
;
3947 Lisp_Object bucket
, tem
;
3949 obarray
= check_obarray (obarray
);
3950 /* This is sometimes needed in the middle of GC. */
3951 obsize
= gc_asize (obarray
);
3952 hash
= hash_string (ptr
, size_byte
) % obsize
;
3953 bucket
= AREF (obarray
, hash
);
3954 oblookup_last_bucket_number
= hash
;
3955 if (EQ (bucket
, make_number (0)))
3957 else if (!SYMBOLP (bucket
))
3958 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3960 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3962 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3963 && SCHARS (SYMBOL_NAME (tail
)) == size
3964 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3966 else if (XSYMBOL (tail
)->next
== 0)
3969 XSETINT (tem
, hash
);
3974 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3977 register Lisp_Object tail
;
3978 CHECK_VECTOR (obarray
);
3979 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3981 tail
= AREF (obarray
, i
);
3986 if (XSYMBOL (tail
)->next
== 0)
3988 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3994 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3996 call1 (function
, sym
);
3999 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4000 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4001 OBARRAY defaults to the value of `obarray'. */)
4002 (Lisp_Object function
, Lisp_Object obarray
)
4004 if (NILP (obarray
)) obarray
= Vobarray
;
4005 obarray
= check_obarray (obarray
);
4007 map_obarray (obarray
, mapatoms_1
, function
);
4011 #define OBARRAY_SIZE 1511
4016 Lisp_Object oblength
;
4017 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4019 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4021 Vobarray
= Fmake_vector (oblength
, make_number (0));
4022 initial_obarray
= Vobarray
;
4023 staticpro (&initial_obarray
);
4025 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4026 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4028 DEFSYM (Qunbound
, "unbound");
4030 DEFSYM (Qnil
, "nil");
4031 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4032 XSYMBOL (Qnil
)->constant
= 1;
4033 XSYMBOL (Qnil
)->declared_special
= true;
4036 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4037 XSYMBOL (Qt
)->constant
= 1;
4038 XSYMBOL (Qt
)->declared_special
= true;
4040 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4043 DEFSYM (Qvariable_documentation
, "variable-documentation");
4045 read_buffer
= xmalloc (size
);
4046 read_buffer_size
= size
;
4050 defsubr (struct Lisp_Subr
*sname
)
4052 Lisp_Object sym
, tem
;
4053 sym
= intern_c_string (sname
->symbol_name
);
4054 XSETPVECTYPE (sname
, PVEC_SUBR
);
4055 XSETSUBR (tem
, sname
);
4056 set_symbol_function (sym
, tem
);
4059 #ifdef NOTDEF /* Use fset in subr.el now! */
4061 defalias (struct Lisp_Subr
*sname
, char *string
)
4064 sym
= intern (string
);
4065 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4069 /* Define an "integer variable"; a symbol whose value is forwarded to a
4070 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4071 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4073 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4074 const char *namestring
, EMACS_INT
*address
)
4077 sym
= intern_c_string (namestring
);
4078 i_fwd
->type
= Lisp_Fwd_Int
;
4079 i_fwd
->intvar
= address
;
4080 XSYMBOL (sym
)->declared_special
= 1;
4081 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4082 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4085 /* Similar but define a variable whose value is t if address contains 1,
4086 nil if address contains 0. */
4088 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4089 const char *namestring
, bool *address
)
4092 sym
= intern_c_string (namestring
);
4093 b_fwd
->type
= Lisp_Fwd_Bool
;
4094 b_fwd
->boolvar
= address
;
4095 XSYMBOL (sym
)->declared_special
= 1;
4096 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4097 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4098 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4101 /* Similar but define a variable whose value is the Lisp Object stored
4102 at address. Two versions: with and without gc-marking of the C
4103 variable. The nopro version is used when that variable will be
4104 gc-marked for some other reason, since marking the same slot twice
4105 can cause trouble with strings. */
4107 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4108 const char *namestring
, Lisp_Object
*address
)
4111 sym
= intern_c_string (namestring
);
4112 o_fwd
->type
= Lisp_Fwd_Obj
;
4113 o_fwd
->objvar
= address
;
4114 XSYMBOL (sym
)->declared_special
= 1;
4115 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4116 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4120 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4121 const char *namestring
, Lisp_Object
*address
)
4123 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4124 staticpro (address
);
4127 /* Similar but define a variable whose value is the Lisp Object stored
4128 at a particular offset in the current kboard object. */
4131 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4132 const char *namestring
, int offset
)
4135 sym
= intern_c_string (namestring
);
4136 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4137 ko_fwd
->offset
= offset
;
4138 XSYMBOL (sym
)->declared_special
= 1;
4139 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4140 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4143 /* Check that the elements of lpath exist. */
4146 load_path_check (Lisp_Object lpath
)
4148 Lisp_Object path_tail
;
4150 /* The only elements that might not exist are those from
4151 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4153 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4155 Lisp_Object dirfile
;
4156 dirfile
= Fcar (path_tail
);
4157 if (STRINGP (dirfile
))
4159 dirfile
= Fdirectory_file_name (dirfile
);
4160 if (! file_accessible_directory_p (dirfile
))
4161 dir_warning ("Lisp directory", XCAR (path_tail
));
4166 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4167 This does not include the standard site-lisp directories
4168 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4169 but it does (unless no_site_lisp is set) include site-lisp
4170 directories in the source/build directories if those exist and we
4171 are running uninstalled.
4173 Uses the following logic:
4174 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4175 The remainder is what happens when dumping works:
4176 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4177 Otherwise use PATH_LOADSEARCH.
4179 If !initialized, then just return PATH_DUMPLOADSEARCH.
4181 If Vinstallation_directory is not nil (ie, running uninstalled):
4182 If installation-dir/lisp exists and not already a member,
4183 we must be running uninstalled. Reset the load-path
4184 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4185 refers to the eventual installation directories. Since we
4186 are not yet installed, we should not use them, even if they exist.)
4187 If installation-dir/lisp does not exist, just add
4188 PATH_DUMPLOADSEARCH at the end instead.
4189 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4190 and not already a member) at the front.
4191 If installation-dir != source-dir (ie running an uninstalled,
4192 out-of-tree build) AND install-dir/src/Makefile exists BUT
4193 install-dir/src/Makefile.in does NOT exist (this is a sanity
4194 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4197 load_path_default (void)
4199 Lisp_Object lpath
= Qnil
;
4204 const char *loadpath
= ns_load_path ();
4207 normal
= PATH_LOADSEARCH
;
4209 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4211 lpath
= decode_env_path (0, normal
, 0);
4214 #else /* !CANNOT_DUMP */
4216 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4221 const char *loadpath
= ns_load_path ();
4222 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4224 lpath
= decode_env_path (0, normal
, 0);
4226 if (!NILP (Vinstallation_directory
))
4228 Lisp_Object tem
, tem1
;
4230 /* Add to the path the lisp subdir of the installation
4231 dir, if it is accessible. Note: in out-of-tree builds,
4232 this directory is empty save for Makefile. */
4233 tem
= Fexpand_file_name (build_string ("lisp"),
4234 Vinstallation_directory
);
4235 tem1
= Ffile_accessible_directory_p (tem
);
4238 if (NILP (Fmember (tem
, lpath
)))
4240 /* We are running uninstalled. The default load-path
4241 points to the eventual installed lisp directories.
4242 We should not use those now, even if they exist,
4243 so start over from a clean slate. */
4244 lpath
= list1 (tem
);
4248 /* That dir doesn't exist, so add the build-time
4249 Lisp dirs instead. */
4251 Lisp_Object dump_path
=
4252 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4253 lpath
= nconc2 (lpath
, dump_path
);
4256 /* Add site-lisp under the installation dir, if it exists. */
4259 tem
= Fexpand_file_name (build_string ("site-lisp"),
4260 Vinstallation_directory
);
4261 tem1
= Ffile_accessible_directory_p (tem
);
4264 if (NILP (Fmember (tem
, lpath
)))
4265 lpath
= Fcons (tem
, lpath
);
4269 /* If Emacs was not built in the source directory,
4270 and it is run from where it was built, add to load-path
4271 the lisp and site-lisp dirs under that directory. */
4273 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4277 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4278 Vinstallation_directory
);
4279 tem1
= Ffile_exists_p (tem
);
4281 /* Don't be fooled if they moved the entire source tree
4282 AFTER dumping Emacs. If the build directory is indeed
4283 different from the source dir, src/Makefile.in and
4284 src/Makefile will not be found together. */
4285 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4286 Vinstallation_directory
);
4287 tem2
= Ffile_exists_p (tem
);
4288 if (!NILP (tem1
) && NILP (tem2
))
4290 tem
= Fexpand_file_name (build_string ("lisp"),
4293 if (NILP (Fmember (tem
, lpath
)))
4294 lpath
= Fcons (tem
, lpath
);
4298 tem
= Fexpand_file_name (build_string ("site-lisp"),
4300 tem1
= Ffile_accessible_directory_p (tem
);
4303 if (NILP (Fmember (tem
, lpath
)))
4304 lpath
= Fcons (tem
, lpath
);
4308 } /* Vinstallation_directory != Vsource_directory */
4310 } /* if Vinstallation_directory */
4312 else /* !initialized */
4314 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4315 source directory. We used to add ../lisp (ie the lisp dir in
4316 the build directory) at the front here, but that should not
4317 be necessary, since in out of tree builds lisp/ is empty, save
4319 lpath
= decode_env_path (0, normal
, 0);
4321 #endif /* !CANNOT_DUMP */
4329 /* First, set Vload_path. */
4331 /* Ignore EMACSLOADPATH when dumping. */
4333 bool use_loadpath
= true;
4335 bool use_loadpath
= NILP (Vpurify_flag
);
4338 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4340 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4342 /* Check (non-nil) user-supplied elements. */
4343 load_path_check (Vload_path
);
4345 /* If no nils in the environment variable, use as-is.
4346 Otherwise, replace any nils with the default. */
4347 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4349 Lisp_Object elem
, elpath
= Vload_path
;
4350 Lisp_Object default_lpath
= load_path_default ();
4352 /* Check defaults, before adding site-lisp. */
4353 load_path_check (default_lpath
);
4355 /* Add the site-lisp directories to the front of the default. */
4356 if (!no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4358 Lisp_Object sitelisp
;
4359 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4360 if (! NILP (sitelisp
))
4361 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4366 /* Replace nils from EMACSLOADPATH by default. */
4367 while (CONSP (elpath
))
4369 elem
= XCAR (elpath
);
4370 elpath
= XCDR (elpath
);
4371 Vload_path
= CALLN (Fappend
, Vload_path
,
4372 NILP (elem
) ? default_lpath
: list1 (elem
));
4374 } /* Fmemq (Qnil, Vload_path) */
4378 Vload_path
= load_path_default ();
4380 /* Check before adding site-lisp directories.
4381 The install should have created them, but they are not
4382 required, so no need to warn if they are absent.
4383 Or we might be running before installation. */
4384 load_path_check (Vload_path
);
4386 /* Add the site-lisp directories at the front. */
4387 if (initialized
&& !no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4389 Lisp_Object sitelisp
;
4390 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4391 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4397 load_in_progress
= 0;
4398 Vload_file_name
= Qnil
;
4399 Vstandard_input
= Qt
;
4400 Vloads_in_progress
= Qnil
;
4403 /* Print a warning that directory intended for use USE and with name
4404 DIRNAME cannot be accessed. On entry, errno should correspond to
4405 the access failure. Print the warning on stderr and put it in
4409 dir_warning (char const *use
, Lisp_Object dirname
)
4411 static char const format
[] = "Warning: %s '%s': %s\n";
4412 int access_errno
= errno
;
4413 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)),
4414 strerror (access_errno
));
4416 /* Don't log the warning before we've initialized!! */
4419 char const *diagnostic
= emacs_strerror (access_errno
);
4421 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4422 + strlen (use
) + SBYTES (dirname
)
4423 + strlen (diagnostic
));
4424 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4426 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4432 syms_of_lread (void)
4435 defsubr (&Sread_from_string
);
4437 defsubr (&Sintern_soft
);
4438 defsubr (&Sunintern
);
4439 defsubr (&Sget_load_suffixes
);
4441 defsubr (&Seval_buffer
);
4442 defsubr (&Seval_region
);
4443 defsubr (&Sread_char
);
4444 defsubr (&Sread_char_exclusive
);
4445 defsubr (&Sread_event
);
4446 defsubr (&Sget_file_char
);
4447 defsubr (&Smapatoms
);
4448 defsubr (&Slocate_file_internal
);
4450 DEFVAR_LISP ("obarray", Vobarray
,
4451 doc
: /* Symbol table for use by `intern' and `read'.
4452 It is a vector whose length ought to be prime for best results.
4453 The vector's contents don't make sense if examined from Lisp programs;
4454 to find all the symbols in an obarray, use `mapatoms'. */);
4456 DEFVAR_LISP ("values", Vvalues
,
4457 doc
: /* List of values of all expressions which were read, evaluated and printed.
4458 Order is reverse chronological. */);
4459 XSYMBOL (intern ("values"))->declared_special
= 0;
4461 DEFVAR_LISP ("standard-input", Vstandard_input
,
4462 doc
: /* Stream for read to get input from.
4463 See documentation of `read' for possible values. */);
4464 Vstandard_input
= Qt
;
4466 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4467 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4469 If this variable is a buffer, then only forms read from that buffer
4470 will be added to `read-symbol-positions-list'.
4471 If this variable is t, then all read forms will be added.
4472 The effect of all other values other than nil are not currently
4473 defined, although they may be in the future.
4475 The positions are relative to the last call to `read' or
4476 `read-from-string'. It is probably a bad idea to set this variable at
4477 the toplevel; bind it instead. */);
4478 Vread_with_symbol_positions
= Qnil
;
4480 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4481 doc
: /* A list mapping read symbols to their positions.
4482 This variable is modified during calls to `read' or
4483 `read-from-string', but only when `read-with-symbol-positions' is
4486 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4487 CHAR-POSITION is an integer giving the offset of that occurrence of the
4488 symbol from the position where `read' or `read-from-string' started.
4490 Note that a symbol will appear multiple times in this list, if it was
4491 read multiple times. The list is in the same order as the symbols
4493 Vread_symbol_positions_list
= Qnil
;
4495 DEFVAR_LISP ("read-circle", Vread_circle
,
4496 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4499 DEFVAR_LISP ("load-path", Vload_path
,
4500 doc
: /* List of directories to search for files to load.
4501 Each element is a string (directory file name) or nil (meaning
4502 `default-directory').
4503 Initialized during startup as described in Info node `(elisp)Library Search'.
4504 Use `directory-file-name' when adding items to this path. However, Lisp
4505 programs that process this list should tolerate directories both with
4506 and without trailing slashes. */);
4508 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4509 doc
: /* List of suffixes for Emacs Lisp files and dynamic modules.
4510 This list includes suffixes for both compiled and source Emacs Lisp files.
4511 This list should not include the empty string.
4512 `load' and related functions try to append these suffixes, in order,
4513 to the specified file name if a suffix is allowed or required. */);
4515 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4516 build_pure_c_string (".el"),
4517 build_pure_c_string (MODULES_SUFFIX
));
4519 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4520 build_pure_c_string (".el"));
4522 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix
,
4523 doc
: /* Suffix of loadable module file, or nil of modules are not supported. */);
4525 Vmodule_file_suffix
= build_pure_c_string (MODULES_SUFFIX
);
4527 Vmodule_file_suffix
= Qnil
;
4529 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4530 doc
: /* List of suffixes that indicate representations of \
4532 This list should normally start with the empty string.
4534 Enabling Auto Compression mode appends the suffixes in
4535 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4536 mode removes them again. `load' and related functions use this list to
4537 determine whether they should look for compressed versions of a file
4538 and, if so, which suffixes they should try to append to the file name
4539 in order to do so. However, if you want to customize which suffixes
4540 the loading functions recognize as compression suffixes, you should
4541 customize `jka-compr-load-suffixes' rather than the present variable. */);
4542 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4544 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4545 doc
: /* Non-nil if inside of `load'. */);
4546 DEFSYM (Qload_in_progress
, "load-in-progress");
4548 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4549 doc
: /* An alist of functions to be evalled when particular files are loaded.
4550 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4552 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4553 a symbol (a feature name).
4555 When `load' is run and the file-name argument matches an element's
4556 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4557 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4559 An error in FORMS does not undo the load, but does prevent execution of
4560 the rest of the FORMS. */);
4561 Vafter_load_alist
= Qnil
;
4563 DEFVAR_LISP ("load-history", Vload_history
,
4564 doc
: /* Alist mapping loaded file names to symbols and features.
4565 Each alist element should be a list (FILE-NAME ENTRIES...), where
4566 FILE-NAME is the name of a file that has been loaded into Emacs.
4567 The file name is absolute and true (i.e. it doesn't contain symlinks).
4568 As an exception, one of the alist elements may have FILE-NAME nil,
4569 for symbols and features not associated with any file.
4571 The remaining ENTRIES in the alist element describe the functions and
4572 variables defined in that file, the features provided, and the
4573 features required. Each entry has the form `(provide . FEATURE)',
4574 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4575 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4576 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4577 autoload before this file redefined it as a function. In addition,
4578 entries may also be single symbols, which means that SYMBOL was
4579 defined by `defvar' or `defconst'.
4581 During preloading, the file name recorded is relative to the main Lisp
4582 directory. These file names are converted to absolute at startup. */);
4583 Vload_history
= Qnil
;
4585 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4586 doc
: /* Full name of file being loaded by `load'. */);
4587 Vload_file_name
= Qnil
;
4589 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4590 doc
: /* File name, including directory, of user's initialization file.
4591 If the file loaded had extension `.elc', and the corresponding source file
4592 exists, this variable contains the name of source file, suitable for use
4593 by functions like `custom-save-all' which edit the init file.
4594 While Emacs loads and evaluates the init file, value is the real name
4595 of the file, regardless of whether or not it has the `.elc' extension. */);
4596 Vuser_init_file
= Qnil
;
4598 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4599 doc
: /* Used for internal purposes by `load'. */);
4600 Vcurrent_load_list
= Qnil
;
4602 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4603 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4604 Called with a single argument (the stream from which to read).
4605 The default is to use the function `read'. */);
4606 DEFSYM (Qread
, "read");
4607 Vload_read_function
= Qread
;
4609 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4610 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4611 The value should be a function for doing code conversion before
4612 reading a source file. It can also be nil, in which case loading is
4613 done without any code conversion.
4615 If the value is a function, it is called with four arguments,
4616 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4617 the file to load, FILE is the non-absolute name (for messages etc.),
4618 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4619 `load'. The function should return t if the file was loaded. */);
4620 Vload_source_file_function
= Qnil
;
4622 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4623 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4624 This is useful when the file being loaded is a temporary copy. */);
4625 load_force_doc_strings
= 0;
4627 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4628 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4629 This is normally bound by `load' and `eval-buffer' to control `read',
4630 and is not meant for users to change. */);
4631 load_convert_to_unibyte
= 0;
4633 DEFVAR_LISP ("source-directory", Vsource_directory
,
4634 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4635 You cannot count on them to still be there! */);
4637 = Fexpand_file_name (build_string ("../"),
4638 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4640 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4641 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4642 Vpreloaded_file_list
= Qnil
;
4644 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4645 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4646 Vbyte_boolean_vars
= Qnil
;
4648 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4649 doc
: /* Non-nil means load dangerous compiled Lisp files.
4650 Some versions of XEmacs use different byte codes than Emacs. These
4651 incompatible byte codes can make Emacs crash when it tries to execute
4653 load_dangerous_libraries
= 0;
4655 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4656 doc
: /* Non-nil means force printing messages when loading Lisp files.
4657 This overrides the value of the NOMESSAGE argument to `load'. */);
4658 force_load_messages
= 0;
4660 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4661 doc
: /* Regular expression matching safe to load compiled Lisp files.
4662 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4663 from the file, and matches them against this regular expression.
4664 When the regular expression matches, the file is considered to be safe
4665 to load. See also `load-dangerous-libraries'. */);
4666 Vbytecomp_version_regexp
4667 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4669 DEFSYM (Qlexical_binding
, "lexical-binding");
4670 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4671 doc
: /* Whether to use lexical binding when evaluating code.
4672 Non-nil means that the code in the current buffer should be evaluated
4673 with lexical binding.
4674 This variable is automatically set from the file variables of an
4675 interpreted Lisp file read using `load'. Unlike other file local
4676 variables, this must be set in the first line of a file. */);
4677 Vlexical_binding
= Qnil
;
4678 Fmake_variable_buffer_local (Qlexical_binding
);
4680 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4681 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4682 Veval_buffer_list
= Qnil
;
4684 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4685 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4686 Vold_style_backquotes
= Qnil
;
4687 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4689 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4690 doc
: /* Non-nil means `load' prefers the newest version of a file.
4691 This applies when a filename suffix is not explicitly specified and
4692 `load' is trying various possible suffixes (see `load-suffixes' and
4693 `load-file-rep-suffixes'). Normally, it stops at the first file
4694 that exists unless you explicitly specify one or the other. If this
4695 option is non-nil, it checks all suffixes and uses whichever file is
4697 Note that if you customize this, obviously it will not affect files
4698 that are loaded before your customizations are read! */);
4699 load_prefer_newer
= 0;
4701 /* Vsource_directory was initialized in init_lread. */
4703 DEFSYM (Qcurrent_load_list
, "current-load-list");
4704 DEFSYM (Qstandard_input
, "standard-input");
4705 DEFSYM (Qread_char
, "read-char");
4706 DEFSYM (Qget_file_char
, "get-file-char");
4708 /* Used instead of Qget_file_char while loading *.elc files compiled
4709 by Emacs 21 or older. */
4710 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4712 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4714 DEFSYM (Qbackquote
, "`");
4715 DEFSYM (Qcomma
, ",");
4716 DEFSYM (Qcomma_at
, ",@");
4717 DEFSYM (Qcomma_dot
, ",.");
4719 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4720 DEFSYM (Qascii_character
, "ascii-character");
4721 DEFSYM (Qfunction
, "function");
4722 DEFSYM (Qload
, "load");
4723 DEFSYM (Qload_file_name
, "load-file-name");
4724 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4725 DEFSYM (Qfile_truename
, "file-truename");
4726 DEFSYM (Qdir_ok
, "dir-ok");
4727 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4729 staticpro (&read_objects
);
4730 read_objects
= Qnil
;
4731 staticpro (&seen_list
);
4734 Vloads_in_progress
= Qnil
;
4735 staticpro (&Vloads_in_progress
);
4737 DEFSYM (Qhash_table
, "hash-table");
4738 DEFSYM (Qdata
, "data");
4739 DEFSYM (Qtest
, "test");
4740 DEFSYM (Qsize
, "size");
4741 DEFSYM (Qweakness
, "weakness");
4742 DEFSYM (Qrehash_size
, "rehash-size");
4743 DEFSYM (Qrehash_threshold
, "rehash-threshold");