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. */
31 #include <stat-time.h>
33 #include "intervals.h"
34 #include "character.h"
42 #include "termhooks.h"
43 #include "blockinput.h"
57 #endif /* HAVE_SETLOCALE */
62 #define file_offset off_t
63 #define file_tell ftello
65 #define file_offset long
66 #define file_tell ftell
69 /* The association list of objects read with the #n=object form.
70 Each member of the list has the form (n . object), and is used to
71 look up the object for the corresponding #n# construct.
72 It must be set to nil before all top-level calls to read0. */
73 static Lisp_Object read_objects
;
75 /* File for get_file_char to read from. Use by load. */
76 static FILE *instream
;
78 /* For use within read-from-string (this reader is non-reentrant!!) */
79 static ptrdiff_t read_from_string_index
;
80 static ptrdiff_t read_from_string_index_byte
;
81 static ptrdiff_t read_from_string_limit
;
83 /* Number of characters read in the current call to Fread or
85 static EMACS_INT readchar_count
;
87 /* This contains the last string skipped with #@. */
88 static char *saved_doc_string
;
89 /* Length of buffer allocated in saved_doc_string. */
90 static ptrdiff_t saved_doc_string_size
;
91 /* Length of actual data in saved_doc_string. */
92 static ptrdiff_t saved_doc_string_length
;
93 /* This is the file position that string came from. */
94 static file_offset saved_doc_string_position
;
96 /* This contains the previous string skipped with #@.
97 We copy it from saved_doc_string when a new string
98 is put in saved_doc_string. */
99 static char *prev_saved_doc_string
;
100 /* Length of buffer allocated in prev_saved_doc_string. */
101 static ptrdiff_t prev_saved_doc_string_size
;
102 /* Length of actual data in prev_saved_doc_string. */
103 static ptrdiff_t prev_saved_doc_string_length
;
104 /* This is the file position that string came from. */
105 static file_offset prev_saved_doc_string_position
;
107 /* True means inside a new-style backquote
108 with no surrounding parentheses.
109 Fread initializes this to false, so we need not specbind it
110 or worry about what happens to it when there is an error. */
111 static bool new_backquote_flag
;
113 /* A list of file names for files being loaded in Fload. Used to
114 check for recursive loads. */
116 static Lisp_Object Vloads_in_progress
;
118 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
121 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
122 Lisp_Object
, Lisp_Object
,
123 Lisp_Object
, Lisp_Object
);
125 /* Functions that read one byte from the current source READCHARFUN
126 or unreads one byte. If the integer argument C is -1, it returns
127 one read byte, or -1 when there's no more byte in the source. If C
128 is 0 or positive, it unreads C, and the return value is not
131 static int readbyte_for_lambda (int, Lisp_Object
);
132 static int readbyte_from_file (int, Lisp_Object
);
133 static int readbyte_from_string (int, Lisp_Object
);
135 /* Handle unreading and rereading of characters.
136 Write READCHAR to read a character,
137 UNREAD(c) to unread c to be read again.
139 These macros correctly read/unread multibyte characters. */
141 #define READCHAR readchar (readcharfun, NULL)
142 #define UNREAD(c) unreadchar (readcharfun, c)
144 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
145 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
147 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
148 Qlambda, or a cons, we use this to keep an unread character because
149 a file stream can't handle multibyte-char unreading. The value -1
150 means that there's no unread character. */
151 static int unread_char
;
154 readchar (Lisp_Object readcharfun
, bool *multibyte
)
158 int (*readbyte
) (int, Lisp_Object
);
159 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
161 bool emacs_mule_encoding
= 0;
168 if (BUFFERP (readcharfun
))
170 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
172 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
174 if (! BUFFER_LIVE_P (inbuffer
))
177 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
180 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
182 /* Fetch the character code from the buffer. */
183 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
184 BUF_INC_POS (inbuffer
, pt_byte
);
191 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
192 if (! ASCII_CHAR_P (c
))
193 c
= BYTE8_TO_CHAR (c
);
196 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
200 if (MARKERP (readcharfun
))
202 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
204 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
206 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
209 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
211 /* Fetch the character code from the buffer. */
212 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
213 BUF_INC_POS (inbuffer
, bytepos
);
220 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
221 if (! ASCII_CHAR_P (c
))
222 c
= BYTE8_TO_CHAR (c
);
226 XMARKER (readcharfun
)->bytepos
= bytepos
;
227 XMARKER (readcharfun
)->charpos
++;
232 if (EQ (readcharfun
, Qlambda
))
234 readbyte
= readbyte_for_lambda
;
238 if (EQ (readcharfun
, Qget_file_char
))
240 readbyte
= readbyte_from_file
;
244 if (STRINGP (readcharfun
))
246 if (read_from_string_index
>= read_from_string_limit
)
248 else if (STRING_MULTIBYTE (readcharfun
))
252 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
253 read_from_string_index
,
254 read_from_string_index_byte
);
258 c
= SREF (readcharfun
, read_from_string_index_byte
);
259 read_from_string_index
++;
260 read_from_string_index_byte
++;
265 if (CONSP (readcharfun
))
267 /* This is the case that read_vector is reading from a unibyte
268 string that contains a byte sequence previously skipped
269 because of #@NUMBER. The car part of readcharfun is that
270 string, and the cdr part is a value of readcharfun given to
272 readbyte
= readbyte_from_string
;
273 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
274 emacs_mule_encoding
= 1;
278 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
280 readbyte
= readbyte_from_file
;
281 emacs_mule_encoding
= 1;
285 tem
= call0 (readcharfun
);
292 if (unread_char
>= 0)
298 c
= (*readbyte
) (-1, readcharfun
);
303 if (ASCII_CHAR_P (c
))
305 if (emacs_mule_encoding
)
306 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
309 len
= BYTES_BY_CHAR_HEAD (c
);
312 c
= (*readbyte
) (-1, readcharfun
);
313 if (c
< 0 || ! TRAILING_CODE_P (c
))
316 (*readbyte
) (buf
[i
], readcharfun
);
317 return BYTE8_TO_CHAR (buf
[0]);
321 return STRING_CHAR (buf
);
324 #define FROM_FILE_P(readcharfun) \
325 (EQ (readcharfun, Qget_file_char) \
326 || EQ (readcharfun, Qget_emacs_mule_file_char))
329 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
331 if (FROM_FILE_P (readcharfun
))
333 block_input (); /* FIXME: Not sure if it's needed. */
334 fseek (instream
, n
, SEEK_CUR
);
338 { /* We're not reading directly from a file. In that case, it's difficult
339 to reliably count bytes, since these are usually meant for the file's
340 encoding, whereas we're now typically in the internal encoding.
341 But luckily, skip_dyn_bytes is used to skip over a single
342 dynamic-docstring (or dynamic byte-code) which is always quoted such
343 that \037 is the final char. */
347 } while (c
>= 0 && c
!= '\037');
352 skip_dyn_eof (Lisp_Object readcharfun
)
354 if (FROM_FILE_P (readcharfun
))
356 block_input (); /* FIXME: Not sure if it's needed. */
357 fseek (instream
, 0, SEEK_END
);
361 while (READCHAR
>= 0);
364 /* Unread the character C in the way appropriate for the stream READCHARFUN.
365 If the stream is a user function, call it with the char as argument. */
368 unreadchar (Lisp_Object readcharfun
, int c
)
372 /* Don't back up the pointer if we're unreading the end-of-input mark,
373 since readchar didn't advance it when we read it. */
375 else if (BUFFERP (readcharfun
))
377 struct buffer
*b
= XBUFFER (readcharfun
);
378 ptrdiff_t charpos
= BUF_PT (b
);
379 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
381 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
382 BUF_DEC_POS (b
, bytepos
);
386 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
388 else if (MARKERP (readcharfun
))
390 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
391 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
393 XMARKER (readcharfun
)->charpos
--;
394 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
395 BUF_DEC_POS (b
, bytepos
);
399 XMARKER (readcharfun
)->bytepos
= bytepos
;
401 else if (STRINGP (readcharfun
))
403 read_from_string_index
--;
404 read_from_string_index_byte
405 = string_char_to_byte (readcharfun
, read_from_string_index
);
407 else if (CONSP (readcharfun
))
411 else if (EQ (readcharfun
, Qlambda
))
415 else if (FROM_FILE_P (readcharfun
))
420 call1 (readcharfun
, make_number (c
));
424 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
426 return read_bytecode_char (c
>= 0);
431 readbyte_from_file (int c
, Lisp_Object readcharfun
)
436 ungetc (c
, instream
);
444 /* Interrupted reads have been observed while reading over the network. */
445 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
456 return (c
== EOF
? -1 : c
);
460 readbyte_from_string (int c
, Lisp_Object readcharfun
)
462 Lisp_Object string
= XCAR (readcharfun
);
466 read_from_string_index
--;
467 read_from_string_index_byte
468 = string_char_to_byte (string
, read_from_string_index
);
471 if (read_from_string_index
>= read_from_string_limit
)
474 FETCH_STRING_CHAR_ADVANCE (c
, string
,
475 read_from_string_index
,
476 read_from_string_index_byte
);
481 /* Read one non-ASCII character from INSTREAM. The character is
482 encoded in `emacs-mule' and the first byte is already read in
486 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
488 /* Emacs-mule coding uses at most 4-byte for one character. */
489 unsigned char buf
[4];
490 int len
= emacs_mule_bytes
[c
];
491 struct charset
*charset
;
496 /* C is not a valid leading-code of `emacs-mule'. */
497 return BYTE8_TO_CHAR (c
);
503 c
= (*readbyte
) (-1, readcharfun
);
507 (*readbyte
) (buf
[i
], readcharfun
);
508 return BYTE8_TO_CHAR (buf
[0]);
515 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
516 code
= buf
[1] & 0x7F;
520 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
521 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
523 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
524 code
= buf
[2] & 0x7F;
528 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
529 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
534 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
535 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
537 c
= DECODE_CHAR (charset
, code
);
539 Fsignal (Qinvalid_read_syntax
,
540 list1 (build_string ("invalid multibyte form")));
545 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
547 static Lisp_Object
read0 (Lisp_Object
);
548 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
550 static Lisp_Object
read_list (bool, Lisp_Object
);
551 static Lisp_Object
read_vector (Lisp_Object
, bool);
553 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
555 static void substitute_object_in_subtree (Lisp_Object
,
557 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
560 /* Get a character from the tty. */
562 /* Read input events until we get one that's acceptable for our purposes.
564 If NO_SWITCH_FRAME, switch-frame events are stashed
565 until we get a character we like, and then stuffed into
568 If ASCII_REQUIRED, check function key events to see
569 if the unmodified version of the symbol has a Qascii_character
570 property, and use that character, if present.
572 If ERROR_NONASCII, signal an error if the input we
573 get isn't an ASCII character with modifiers. If it's false but
574 ASCII_REQUIRED is true, just re-read until we get an ASCII
577 If INPUT_METHOD, invoke the current input method
578 if the character warrants that.
580 If SECONDS is a number, wait that many seconds for input, and
581 return Qnil if no input arrives within that time. */
584 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
585 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
587 Lisp_Object val
, delayed_switch_frame
;
588 struct timespec end_time
;
590 #ifdef HAVE_WINDOW_SYSTEM
591 if (display_hourglass_p
)
595 delayed_switch_frame
= Qnil
;
597 /* Compute timeout. */
598 if (NUMBERP (seconds
))
600 double duration
= extract_float (seconds
);
601 struct timespec wait_time
= dtotimespec (duration
);
602 end_time
= timespec_add (current_timespec (), wait_time
);
605 /* Read until we get an acceptable event. */
608 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
609 NUMBERP (seconds
) ? &end_time
: NULL
);
610 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
615 /* `switch-frame' events are put off until after the next ASCII
616 character. This is better than signaling an error just because
617 the last characters were typed to a separate minibuffer frame,
618 for example. Eventually, some code which can deal with
619 switch-frame events will read it and process it. */
621 && EVENT_HAS_PARAMETERS (val
)
622 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
624 delayed_switch_frame
= val
;
628 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
630 /* Convert certain symbols to their ASCII equivalents. */
633 Lisp_Object tem
, tem1
;
634 tem
= Fget (val
, Qevent_symbol_element_mask
);
637 tem1
= Fget (Fcar (tem
), Qascii_character
);
638 /* Merge this symbol's modifier bits
639 with the ASCII equivalent of its basic code. */
641 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
645 /* If we don't have a character now, deal with it appropriately. */
650 Vunread_command_events
= list1 (val
);
651 error ("Non-character input-event");
658 if (! NILP (delayed_switch_frame
))
659 unread_switch_frame
= delayed_switch_frame
;
663 #ifdef HAVE_WINDOW_SYSTEM
664 if (display_hourglass_p
)
673 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
674 doc
: /* Read a character from the command input (keyboard or macro).
675 It is returned as a number.
676 If the character has modifiers, they are resolved and reflected to the
677 character code if possible (e.g. C-SPC -> 0).
679 If the user generates an event which is not a character (i.e. a mouse
680 click or function key event), `read-char' signals an error. As an
681 exception, switch-frame events are put off until non-character events
683 If you want to read non-character events, or ignore them, call
684 `read-event' or `read-char-exclusive' instead.
686 If the optional argument PROMPT is non-nil, display that as a prompt.
687 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
688 input method is turned on in the current buffer, that input method
689 is used for reading a character.
690 If the optional argument SECONDS is non-nil, it should be a number
691 specifying the maximum number of seconds to wait for input. If no
692 input arrives in that time, return nil. SECONDS may be a
693 floating-point value. */)
694 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
699 message_with_string ("%s", prompt
, 0);
700 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
702 return (NILP (val
) ? Qnil
703 : make_number (char_resolve_modifier_mask (XINT (val
))));
706 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
707 doc
: /* Read an event object from the input stream.
708 If the optional argument PROMPT is non-nil, display that as a prompt.
709 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
710 input method is turned on in the current buffer, that input method
711 is used for reading a character.
712 If the optional argument SECONDS is non-nil, it should be a number
713 specifying the maximum number of seconds to wait for input. If no
714 input arrives in that time, return nil. SECONDS may be a
715 floating-point value. */)
716 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
719 message_with_string ("%s", prompt
, 0);
720 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
723 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
724 doc
: /* Read a character from the command input (keyboard or macro).
725 It is returned as a number. Non-character events are ignored.
726 If the character has modifiers, they are resolved and reflected to the
727 character code if possible (e.g. C-SPC -> 0).
729 If the optional argument PROMPT is non-nil, display that as a prompt.
730 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
731 input method is turned on in the current buffer, that input method
732 is used for reading a character.
733 If the optional argument SECONDS is non-nil, it should be a number
734 specifying the maximum number of seconds to wait for input. If no
735 input arrives in that time, return nil. SECONDS may be a
736 floating-point value. */)
737 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
742 message_with_string ("%s", prompt
, 0);
744 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
746 return (NILP (val
) ? Qnil
747 : make_number (char_resolve_modifier_mask (XINT (val
))));
750 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
751 doc
: /* Don't use this yourself. */)
754 register Lisp_Object val
;
756 XSETINT (val
, getc (instream
));
764 /* Return true if the lisp code read using READCHARFUN defines a non-nil
765 `lexical-binding' file variable. After returning, the stream is
766 positioned following the first line, if it is a comment or #! line,
767 otherwise nothing is read. */
770 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
783 while (ch
!= '\n' && ch
!= EOF
)
785 if (ch
== '\n') ch
= READCHAR
;
786 /* It is OK to leave the position after a #! line, since
787 that is what read1 does. */
791 /* The first line isn't a comment, just give up. */
797 /* Look for an appropriate file-variable in the first line. */
801 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
802 } beg_end_state
= NOMINAL
;
803 bool in_file_vars
= 0;
805 #define UPDATE_BEG_END_STATE(ch) \
806 if (beg_end_state == NOMINAL) \
807 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
808 else if (beg_end_state == AFTER_FIRST_DASH) \
809 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
810 else if (beg_end_state == AFTER_ASTERIX) \
813 in_file_vars = !in_file_vars; \
814 beg_end_state = NOMINAL; \
817 /* Skip until we get to the file vars, if any. */
821 UPDATE_BEG_END_STATE (ch
);
823 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
827 char var
[100], val
[100];
832 /* Read a variable name. */
833 while (ch
== ' ' || ch
== '\t')
837 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
839 if (i
< sizeof var
- 1)
841 UPDATE_BEG_END_STATE (ch
);
845 /* Stop scanning if no colon was found before end marker. */
846 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
849 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
855 /* Read a variable value. */
858 while (ch
== ' ' || ch
== '\t')
862 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
864 if (i
< sizeof val
- 1)
866 UPDATE_BEG_END_STATE (ch
);
870 /* The value was terminated by an end-marker, which remove. */
872 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
876 if (strcmp (var
, "lexical-binding") == 0)
879 rv
= (strcmp (val
, "nil") != 0);
885 while (ch
!= '\n' && ch
!= EOF
)
892 /* Value is a version number of byte compiled code if the file
893 associated with file descriptor FD is a compiled Lisp file that's
894 safe to load. Only files compiled with Emacs are safe to load.
895 Files compiled with XEmacs can lead to a crash in Fbyte_code
896 because of an incompatible change in the byte compiler. */
899 safe_to_load_version (int fd
)
905 /* Read the first few bytes from the file, and look for a line
906 specifying the byte compiler version used. */
907 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
910 /* Skip to the next newline, skipping over the initial `ELC'
911 with NUL bytes following it, but note the version. */
912 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
917 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
918 buf
+ i
, nbytes
- i
) < 0)
922 lseek (fd
, 0, SEEK_SET
);
927 /* Callback for record_unwind_protect. Restore the old load list OLD,
928 after loading a file successfully. */
931 record_load_unwind (Lisp_Object old
)
933 Vloads_in_progress
= old
;
936 /* This handler function is used via internal_condition_case_1. */
939 load_error_handler (Lisp_Object data
)
945 load_warn_old_style_backquotes (Lisp_Object file
)
947 if (!NILP (Vold_style_backquotes
))
949 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
950 CALLN (Fmessage
, format
, file
);
954 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
955 doc
: /* Return the suffixes that `load' should try if a suffix is \
957 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
960 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
961 while (CONSP (suffixes
))
963 Lisp_Object exts
= Vload_file_rep_suffixes
;
964 suffix
= XCAR (suffixes
);
965 suffixes
= XCDR (suffixes
);
970 lst
= Fcons (concat2 (suffix
, ext
), lst
);
973 return Fnreverse (lst
);
976 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
977 doc
: /* Execute a file of Lisp code named FILE.
978 First try FILE with `.elc' appended, then try with `.el',
979 then try FILE unmodified (the exact suffixes in the exact order are
980 determined by `load-suffixes'). Environment variable references in
981 FILE are replaced with their values by calling `substitute-in-file-name'.
982 This function searches the directories in `load-path'.
984 If optional second arg NOERROR is non-nil,
985 report no error if FILE doesn't exist.
986 Print messages at start and end of loading unless
987 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
989 If optional fourth arg NOSUFFIX is non-nil, don't try adding
990 suffixes `.elc' or `.el' to the specified name FILE.
991 If optional fifth arg MUST-SUFFIX is non-nil, insist on
992 the suffix `.elc' or `.el'; don't accept just FILE unless
993 it ends in one of those suffixes or includes a directory name.
995 If NOSUFFIX is nil, then if a file could not be found, try looking for
996 a different representation of the file by adding non-empty suffixes to
997 its name, before trying another file. Emacs uses this feature to find
998 compressed versions of files when Auto Compression mode is enabled.
999 If NOSUFFIX is non-nil, disable this feature.
1001 The suffixes that this function tries out, when NOSUFFIX is nil, are
1002 given by the return value of `get-load-suffixes' and the values listed
1003 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1004 return value of `get-load-suffixes' is used, i.e. the file name is
1005 required to have a non-empty suffix.
1007 When searching suffixes, this function normally stops at the first
1008 one that exists. If the option `load-prefer-newer' is non-nil,
1009 however, it tries all suffixes, and uses whichever file is the newest.
1011 Loading a file records its definitions, and its `provide' and
1012 `require' calls, in an element of `load-history' whose
1013 car is the file name loaded. See `load-history'.
1015 While the file is in the process of being loaded, the variable
1016 `load-in-progress' is non-nil and the variable `load-file-name'
1017 is bound to the file's name.
1019 Return t if the file exists and loads successfully. */)
1020 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1021 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1026 ptrdiff_t count
= SPECPDL_INDEX ();
1027 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1028 Lisp_Object found
, efound
, hist_file_name
;
1029 /* True means we printed the ".el is newer" message. */
1031 /* True means we are loading a compiled file. */
1033 Lisp_Object handler
;
1035 const char *fmode
= "r";
1042 CHECK_STRING (file
);
1044 /* If file name is magic, call the handler. */
1045 /* This shouldn't be necessary any more now that `openp' handles it right.
1046 handler = Ffind_file_name_handler (file, Qload);
1047 if (!NILP (handler))
1048 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1050 /* Do this after the handler to avoid
1051 the need to gcpro noerror, nomessage and nosuffix.
1052 (Below here, we care only whether they are nil or not.)
1053 The presence of this call is the result of a historical accident:
1054 it used to be in every file-operation and when it got removed
1055 everywhere, it accidentally stayed here. Since then, enough people
1056 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1057 that it seemed risky to remove. */
1058 if (! NILP (noerror
))
1060 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1061 Qt
, load_error_handler
);
1066 file
= Fsubstitute_in_file_name (file
);
1068 /* Avoid weird lossage with null string as arg,
1069 since it would try to load a directory as a Lisp file. */
1070 if (SCHARS (file
) == 0)
1077 Lisp_Object suffixes
;
1079 GCPRO2 (file
, found
);
1081 if (! NILP (must_suffix
))
1083 /* Don't insist on adding a suffix if FILE already ends with one. */
1084 ptrdiff_t size
= SBYTES (file
);
1086 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1089 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1091 /* Don't insist on adding a suffix
1092 if the argument includes a directory name. */
1093 else if (! NILP (Ffile_name_directory (file
)))
1097 if (!NILP (nosuffix
))
1101 suffixes
= Fget_load_suffixes ();
1102 if (NILP (must_suffix
))
1103 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1106 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1113 report_file_error ("Cannot open load file", file
);
1117 /* Tell startup.el whether or not we found the user's init file. */
1118 if (EQ (Qt
, Vuser_init_file
))
1119 Vuser_init_file
= found
;
1121 /* If FD is -2, that means openp found a magic file. */
1124 if (NILP (Fequal (found
, file
)))
1125 /* If FOUND is a different file name from FILE,
1126 find its handler even if we have already inhibited
1127 the `load' operation on FILE. */
1128 handler
= Ffind_file_name_handler (found
, Qt
);
1130 handler
= Ffind_file_name_handler (found
, Qload
);
1131 if (! NILP (handler
))
1132 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1134 /* Tramp has to deal with semi-broken packages that prepend
1135 drive letters to remote files. For that reason, Tramp
1136 catches file operations that test for file existence, which
1137 makes openp think X:/foo.elc files are remote. However,
1138 Tramp does not catch `load' operations for such files, so we
1139 end up with a nil as the `load' handler above. If we would
1140 continue with fd = -2, we will behave wrongly, and in
1141 particular try reading a .elc file in the "rt" mode instead
1142 of "rb". See bug #9311 for the results. To work around
1143 this, we try to open the file locally, and go with that if it
1145 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1153 /* Pacify older GCC with --enable-gcc-warnings. */
1154 IF_LINT (fd_index
= 0);
1158 fd_index
= SPECPDL_INDEX ();
1159 record_unwind_protect_int (close_file_unwind
, fd
);
1162 /* Check if we're stuck in a recursive load cycle.
1164 2000-09-21: It's not possible to just check for the file loaded
1165 being a member of Vloads_in_progress. This fails because of the
1166 way the byte compiler currently works; `provide's are not
1167 evaluated, see font-lock.el/jit-lock.el as an example. This
1168 leads to a certain amount of ``normal'' recursion.
1170 Also, just loading a file recursively is not always an error in
1171 the general case; the second load may do something different. */
1175 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1176 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1177 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1178 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1179 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1182 /* All loads are by default dynamic, unless the file itself specifies
1183 otherwise using a file-variable in the first line. This is bound here
1184 so that it takes effect whether or not we use
1185 Vload_source_file_function. */
1186 specbind (Qlexical_binding
, Qnil
);
1188 /* Get the name for load-history. */
1189 hist_file_name
= (! NILP (Vpurify_flag
)
1190 ? concat2 (Ffile_name_directory (file
),
1191 Ffile_name_nondirectory (found
))
1196 /* Check for the presence of old-style quotes and warn about them. */
1197 specbind (Qold_style_backquotes
, Qnil
);
1198 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1200 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1201 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1202 /* Load .elc files directly, but not when they are
1203 remote and have no handler! */
1210 GCPRO3 (file
, found
, hist_file_name
);
1213 && ! (version
= safe_to_load_version (fd
)))
1216 if (!load_dangerous_libraries
)
1217 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1218 else if (!NILP (nomessage
) && !force_load_messages
)
1219 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1224 efound
= ENCODE_FILE (found
);
1230 /* openp already checked for newness, no point doing it again.
1231 FIXME would be nice to get a message when openp
1232 ignores suffix order due to load_prefer_newer. */
1233 if (!load_prefer_newer
)
1235 result
= stat (SSDATA (efound
), &s1
);
1238 SSET (efound
, SBYTES (efound
) - 1, 0);
1239 result
= stat (SSDATA (efound
), &s2
);
1240 SSET (efound
, SBYTES (efound
) - 1, 'c');
1244 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1246 /* Make the progress messages mention that source is newer. */
1249 /* If we won't print another message, mention this anyway. */
1250 if (!NILP (nomessage
) && !force_load_messages
)
1252 Lisp_Object msg_file
;
1253 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1254 message_with_string ("Source file `%s' newer than byte-compiled file",
1258 } /* !load_prefer_newer */
1264 /* We are loading a source file (*.el). */
1265 if (!NILP (Vload_source_file_function
))
1272 clear_unwind_protect (fd_index
);
1274 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1275 NILP (noerror
) ? Qnil
: Qt
,
1276 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1277 return unbind_to (count
, val
);
1281 GCPRO3 (file
, found
, hist_file_name
);
1285 /* We somehow got here with fd == -2, meaning the file is deemed
1286 to be remote. Don't even try to reopen the file locally;
1287 just force a failure. */
1295 clear_unwind_protect (fd_index
);
1296 efound
= ENCODE_FILE (found
);
1297 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1299 stream
= fdopen (fd
, fmode
);
1303 report_file_error ("Opening stdio stream", file
);
1304 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1306 if (! NILP (Vpurify_flag
))
1307 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1309 if (NILP (nomessage
) || force_load_messages
)
1312 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1315 message_with_string ("Loading %s (source)...", file
, 1);
1317 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1319 else /* The typical case; compiled file newer than source file. */
1320 message_with_string ("Loading %s...", file
, 1);
1323 specbind (Qload_file_name
, found
);
1324 specbind (Qinhibit_file_name_operation
, Qnil
);
1325 specbind (Qload_in_progress
, Qt
);
1328 if (lisp_file_lexically_bound_p (Qget_file_char
))
1329 Fset (Qlexical_binding
, Qt
);
1331 if (! version
|| version
>= 22)
1332 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1333 0, Qnil
, Qnil
, Qnil
, Qnil
);
1336 /* We can't handle a file which was compiled with
1337 byte-compile-dynamic by older version of Emacs. */
1338 specbind (Qload_force_doc_strings
, Qt
);
1339 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1340 0, Qnil
, Qnil
, Qnil
, Qnil
);
1342 unbind_to (count
, Qnil
);
1344 /* Run any eval-after-load forms for this file. */
1345 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1346 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1350 xfree (saved_doc_string
);
1351 saved_doc_string
= 0;
1352 saved_doc_string_size
= 0;
1354 xfree (prev_saved_doc_string
);
1355 prev_saved_doc_string
= 0;
1356 prev_saved_doc_string_size
= 0;
1358 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1361 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1364 message_with_string ("Loading %s (source)...done", file
, 1);
1366 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1368 else /* The typical case; compiled file newer than source file. */
1369 message_with_string ("Loading %s...done", file
, 1);
1376 complete_filename_p (Lisp_Object pathname
)
1378 const unsigned char *s
= SDATA (pathname
);
1379 return (IS_DIRECTORY_SEP (s
[0])
1380 || (SCHARS (pathname
) > 2
1381 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1384 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1385 doc
: /* Search for FILENAME through PATH.
1386 Returns the file's name in absolute form, or nil if not found.
1387 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1388 file name when searching.
1389 If non-nil, PREDICATE is used instead of `file-readable-p'.
1390 PREDICATE can also be an integer to pass to the faccessat(2) function,
1391 in which case file-name-handlers are ignored.
1392 This function will normally skip directories, so if you want it to find
1393 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1394 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1397 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1398 if (NILP (predicate
) && fd
>= 0)
1403 /* Search for a file whose name is STR, looking in directories
1404 in the Lisp list PATH, and trying suffixes from SUFFIX.
1405 On success, return a file descriptor (or 1 or -2 as described below).
1406 On failure, return -1 and set errno.
1408 SUFFIXES is a list of strings containing possible suffixes.
1409 The empty suffix is automatically added if the list is empty.
1411 PREDICATE non-nil means don't open the files,
1412 just look for one that satisfies the predicate. In this case,
1413 return 1 on success. The predicate can be a lisp function or
1414 an integer to pass to `access' (in which case file-name-handlers
1417 If STOREPTR is nonzero, it points to a slot where the name of
1418 the file actually found should be stored as a Lisp string.
1419 nil is stored there on failure.
1421 If the file we find is remote, return -2
1422 but store the found remote file name in *STOREPTR.
1424 If NEWER is true, try all SUFFIXes and return the result for the
1425 newest file that exists. Does not apply to remote files,
1426 or if PREDICATE is specified. */
1429 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1430 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1432 ptrdiff_t fn_size
= 100;
1436 ptrdiff_t want_length
;
1437 Lisp_Object filename
;
1438 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
, gcpro7
;
1439 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1440 ptrdiff_t max_suffix_len
= 0;
1441 int last_errno
= ENOENT
;
1445 /* The last-modified time of the newest matching file found.
1446 Initialize it to something less than all valid timestamps. */
1447 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1451 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1453 CHECK_STRING_CAR (tail
);
1454 max_suffix_len
= max (max_suffix_len
,
1455 SBYTES (XCAR (tail
)));
1458 string
= filename
= encoded_fn
= save_string
= Qnil
;
1459 GCPRO7 (str
, string
, save_string
, filename
, path
, suffixes
, encoded_fn
);
1464 absolute
= complete_filename_p (str
);
1466 for (; CONSP (path
); path
= XCDR (path
))
1468 filename
= Fexpand_file_name (str
, XCAR (path
));
1469 if (!complete_filename_p (filename
))
1470 /* If there are non-absolute elts in PATH (eg "."). */
1471 /* Of course, this could conceivably lose if luser sets
1472 default-directory to be something non-absolute... */
1474 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1475 if (!complete_filename_p (filename
))
1476 /* Give up on this path element! */
1480 /* Calculate maximum length of any filename made from
1481 this path element/specified file name and any possible suffix. */
1482 want_length
= max_suffix_len
+ SBYTES (filename
);
1483 if (fn_size
<= want_length
)
1485 fn_size
= 100 + want_length
;
1486 fn
= SAFE_ALLOCA (fn_size
);
1489 /* Loop over suffixes. */
1490 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1491 CONSP (tail
); tail
= XCDR (tail
))
1493 Lisp_Object suffix
= XCAR (tail
);
1494 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1495 Lisp_Object handler
;
1497 /* Concatenate path element/specified name with the suffix.
1498 If the directory starts with /:, remove that. */
1499 int prefixlen
= ((SCHARS (filename
) > 2
1500 && SREF (filename
, 0) == '/'
1501 && SREF (filename
, 1) == ':')
1503 fnlen
= SBYTES (filename
) - prefixlen
;
1504 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1505 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1507 /* Check that the file exists and is not a directory. */
1508 /* We used to only check for handlers on non-absolute file names:
1512 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1513 It's not clear why that was the case and it breaks things like
1514 (load "/bar.el") where the file is actually "/bar.el.gz". */
1515 /* make_string has its own ideas on when to return a unibyte
1516 string and when a multibyte string, but we know better.
1517 We must have a unibyte string when dumping, since
1518 file-name encoding is shaky at best at that time, and in
1519 particular default-file-name-coding-system is reset
1520 several times during loadup. We therefore don't want to
1521 encode the file before passing it to file I/O library
1523 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1524 string
= make_unibyte_string (fn
, fnlen
);
1526 string
= make_string (fn
, fnlen
);
1527 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1528 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1531 if (NILP (predicate
))
1532 exists
= !NILP (Ffile_readable_p (string
));
1535 Lisp_Object tmp
= call1 (predicate
, string
);
1538 else if (EQ (tmp
, Qdir_ok
)
1539 || NILP (Ffile_directory_p (string
)))
1544 last_errno
= EISDIR
;
1550 /* We succeeded; return this descriptor and filename. */
1564 encoded_fn
= ENCODE_FILE (string
);
1565 pfn
= SSDATA (encoded_fn
);
1567 /* Check that we can access or open it. */
1568 if (NATNUMP (predicate
))
1571 if (INT_MAX
< XFASTINT (predicate
))
1572 last_errno
= EINVAL
;
1573 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1577 if (file_directory_p (pfn
))
1578 last_errno
= EISDIR
;
1585 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1588 if (errno
!= ENOENT
)
1593 int err
= (fstat (fd
, &st
) != 0 ? errno
1594 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1606 if (newer
&& !NATNUMP (predicate
))
1608 struct timespec mtime
= get_stat_mtime (&st
);
1610 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1615 emacs_close (save_fd
);
1618 save_string
= string
;
1623 /* We succeeded; return this descriptor and filename. */
1632 /* No more suffixes. Return the newest. */
1633 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1636 *storeptr
= save_string
;
1654 /* Merge the list we've accumulated of globals from the current input source
1655 into the load_history variable. The details depend on whether
1656 the source has an associated file name or not.
1658 FILENAME is the file name that we are loading from.
1660 ENTIRE is true if loading that entire file, false if evaluating
1664 build_load_history (Lisp_Object filename
, bool entire
)
1666 Lisp_Object tail
, prev
, newelt
;
1667 Lisp_Object tem
, tem2
;
1670 tail
= Vload_history
;
1673 while (CONSP (tail
))
1677 /* Find the feature's previous assoc list... */
1678 if (!NILP (Fequal (filename
, Fcar (tem
))))
1682 /* If we're loading the entire file, remove old data. */
1686 Vload_history
= XCDR (tail
);
1688 Fsetcdr (prev
, XCDR (tail
));
1691 /* Otherwise, cons on new symbols that are not already members. */
1694 tem2
= Vcurrent_load_list
;
1696 while (CONSP (tem2
))
1698 newelt
= XCAR (tem2
);
1700 if (NILP (Fmember (newelt
, tem
)))
1701 Fsetcar (tail
, Fcons (XCAR (tem
),
1702 Fcons (newelt
, XCDR (tem
))));
1715 /* If we're loading an entire file, cons the new assoc onto the
1716 front of load-history, the most-recently-loaded position. Also
1717 do this if we didn't find an existing member for the file. */
1718 if (entire
|| !foundit
)
1719 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1724 readevalloop_1 (int old
)
1726 load_convert_to_unibyte
= old
;
1729 /* Signal an `end-of-file' error, if possible with file name
1732 static _Noreturn
void
1733 end_of_file_error (void)
1735 if (STRINGP (Vload_file_name
))
1736 xsignal1 (Qend_of_file
, Vload_file_name
);
1738 xsignal0 (Qend_of_file
);
1742 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1744 /* If we macroexpand the toplevel form non-recursively and it ends
1745 up being a `progn' (or if it was a progn to start), treat each
1746 form in the progn as a top-level form. This way, if one form in
1747 the progn defines a macro, that macro is in effect when we expand
1748 the remaining forms. See similar code in bytecomp.el. */
1749 val
= call2 (macroexpand
, val
, Qnil
);
1750 if (EQ (CAR_SAFE (val
), Qprogn
))
1752 struct gcpro gcpro1
;
1753 Lisp_Object subforms
= XCDR (val
);
1756 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1757 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1762 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1766 /* UNIBYTE specifies how to set load_convert_to_unibyte
1767 for this invocation.
1768 READFUN, if non-nil, is used instead of `read'.
1770 START, END specify region to read in current buffer (from eval-region).
1771 If the input is not from a buffer, they must be nil. */
1774 readevalloop (Lisp_Object readcharfun
,
1776 Lisp_Object sourcename
,
1778 Lisp_Object unibyte
, Lisp_Object readfun
,
1779 Lisp_Object start
, Lisp_Object end
)
1782 register Lisp_Object val
;
1783 ptrdiff_t count
= SPECPDL_INDEX ();
1784 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1785 struct buffer
*b
= 0;
1786 bool continue_reading_p
;
1787 Lisp_Object lex_bound
;
1788 /* True if reading an entire buffer. */
1789 bool whole_buffer
= 0;
1790 /* True on the first time around. */
1791 bool first_sexp
= 1;
1792 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1794 if (NILP (Ffboundp (macroexpand
))
1795 /* Don't macroexpand in .elc files, since it should have been done
1796 already. We actually don't know whether we're in a .elc file or not,
1797 so we use circumstantial evidence: .el files normally go through
1798 Vload_source_file_function -> load-with-code-conversion
1800 || EQ (readcharfun
, Qget_file_char
)
1801 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1804 if (MARKERP (readcharfun
))
1807 start
= readcharfun
;
1810 if (BUFFERP (readcharfun
))
1811 b
= XBUFFER (readcharfun
);
1812 else if (MARKERP (readcharfun
))
1813 b
= XMARKER (readcharfun
)->buffer
;
1815 /* We assume START is nil when input is not from a buffer. */
1816 if (! NILP (start
) && !b
)
1819 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1820 specbind (Qcurrent_load_list
, Qnil
);
1821 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1822 load_convert_to_unibyte
= !NILP (unibyte
);
1824 /* If lexical binding is active (either because it was specified in
1825 the file's header, or via a buffer-local variable), create an empty
1826 lexical environment, otherwise, turn off lexical binding. */
1827 lex_bound
= find_symbol_value (Qlexical_binding
);
1828 specbind (Qinternal_interpreter_environment
,
1829 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1830 ? Qnil
: list1 (Qt
)));
1832 GCPRO4 (sourcename
, readfun
, start
, end
);
1834 /* Try to ensure sourcename is a truename, except whilst preloading. */
1835 if (NILP (Vpurify_flag
)
1836 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1837 && !NILP (Ffboundp (Qfile_truename
)))
1838 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1840 LOADHIST_ATTACH (sourcename
);
1842 continue_reading_p
= 1;
1843 while (continue_reading_p
)
1845 ptrdiff_t count1
= SPECPDL_INDEX ();
1847 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1848 error ("Reading from killed buffer");
1852 /* Switch to the buffer we are reading from. */
1853 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1854 set_buffer_internal (b
);
1856 /* Save point in it. */
1857 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1858 /* Save ZV in it. */
1859 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1860 /* Those get unbound after we read one expression. */
1862 /* Set point and ZV around stuff to be read. */
1865 Fnarrow_to_region (make_number (BEGV
), end
);
1867 /* Just for cleanliness, convert END to a marker
1868 if it is an integer. */
1870 end
= Fpoint_max_marker ();
1873 /* On the first cycle, we can easily test here
1874 whether we are reading the whole buffer. */
1875 if (b
&& first_sexp
)
1876 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1883 while ((c
= READCHAR
) != '\n' && c
!= -1);
1888 unbind_to (count1
, Qnil
);
1892 /* Ignore whitespace here, so we can detect eof. */
1893 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1894 || c
== 0xa0) /* NBSP */
1897 if (!NILP (Vpurify_flag
) && c
== '(')
1899 val
= read_list (0, readcharfun
);
1904 read_objects
= Qnil
;
1905 if (!NILP (readfun
))
1907 val
= call1 (readfun
, readcharfun
);
1909 /* If READCHARFUN has set point to ZV, we should
1910 stop reading, even if the form read sets point
1911 to a different value when evaluated. */
1912 if (BUFFERP (readcharfun
))
1914 struct buffer
*buf
= XBUFFER (readcharfun
);
1915 if (BUF_PT (buf
) == BUF_ZV (buf
))
1916 continue_reading_p
= 0;
1919 else if (! NILP (Vload_read_function
))
1920 val
= call1 (Vload_read_function
, readcharfun
);
1922 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1925 if (!NILP (start
) && continue_reading_p
)
1926 start
= Fpoint_marker ();
1928 /* Restore saved point and BEGV. */
1929 unbind_to (count1
, Qnil
);
1931 /* Now eval what we just read. */
1932 if (!NILP (macroexpand
))
1933 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1935 val
= eval_sub (val
);
1939 Vvalues
= Fcons (val
, Vvalues
);
1940 if (EQ (Vstandard_output
, Qt
))
1949 build_load_history (sourcename
,
1950 stream
|| whole_buffer
);
1954 unbind_to (count
, Qnil
);
1957 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1958 doc
: /* Execute the current buffer as Lisp code.
1959 When called from a Lisp program (i.e., not interactively), this
1960 function accepts up to five optional arguments:
1961 BUFFER is the buffer to evaluate (nil means use current buffer).
1962 PRINTFLAG controls printing of output:
1963 A value of nil means discard it; anything else is stream for print.
1964 FILENAME specifies the file name to use for `load-history'.
1965 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1967 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1968 functions should work normally even if PRINTFLAG is nil.
1970 This function preserves the position of point. */)
1971 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1973 ptrdiff_t count
= SPECPDL_INDEX ();
1974 Lisp_Object tem
, buf
;
1977 buf
= Fcurrent_buffer ();
1979 buf
= Fget_buffer (buffer
);
1981 error ("No such buffer");
1983 if (NILP (printflag
) && NILP (do_allow_print
))
1988 if (NILP (filename
))
1989 filename
= BVAR (XBUFFER (buf
), filename
);
1991 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1992 specbind (Qstandard_output
, tem
);
1993 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1994 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1995 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1996 readevalloop (buf
, 0, filename
,
1997 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1998 unbind_to (count
, Qnil
);
2003 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2004 doc
: /* Execute the region as Lisp code.
2005 When called from programs, expects two arguments,
2006 giving starting and ending indices in the current buffer
2007 of the text to be executed.
2008 Programs can pass third argument PRINTFLAG which controls output:
2009 A value of nil means discard it; anything else is stream for printing it.
2010 Also the fourth argument READ-FUNCTION, if non-nil, is used
2011 instead of `read' to read each expression. It gets one argument
2012 which is the input stream for reading characters.
2014 This function does not move point. */)
2015 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2017 /* FIXME: Do the eval-sexp-add-defvars dance! */
2018 ptrdiff_t count
= SPECPDL_INDEX ();
2019 Lisp_Object tem
, cbuf
;
2021 cbuf
= Fcurrent_buffer ();
2023 if (NILP (printflag
))
2027 specbind (Qstandard_output
, tem
);
2028 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2030 /* `readevalloop' calls functions which check the type of start and end. */
2031 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2032 !NILP (printflag
), Qnil
, read_function
,
2035 return unbind_to (count
, Qnil
);
2039 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2040 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2041 If STREAM is nil, use the value of `standard-input' (which see).
2042 STREAM or the value of `standard-input' may be:
2043 a buffer (read from point and advance it)
2044 a marker (read from where it points and advance it)
2045 a function (call it with no arguments for each character,
2046 call it with a char as argument to push a char back)
2047 a string (takes text from string, starting at the beginning)
2048 t (read text line using minibuffer and use it, or read from
2049 standard input in batch mode). */)
2050 (Lisp_Object stream
)
2053 stream
= Vstandard_input
;
2054 if (EQ (stream
, Qt
))
2055 stream
= Qread_char
;
2056 if (EQ (stream
, Qread_char
))
2057 /* FIXME: ?! When is this used !? */
2058 return call1 (intern ("read-minibuffer"),
2059 build_string ("Lisp expression: "));
2061 return read_internal_start (stream
, Qnil
, Qnil
);
2064 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2065 doc
: /* Read one Lisp expression which is represented as text by STRING.
2066 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2067 FINAL-STRING-INDEX is an integer giving the position of the next
2068 remaining character in STRING. START and END optionally delimit
2069 a substring of STRING from which to read; they default to 0 and
2070 (length STRING) respectively. Negative values are counted from
2071 the end of STRING. */)
2072 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2075 CHECK_STRING (string
);
2076 /* `read_internal_start' sets `read_from_string_index'. */
2077 ret
= read_internal_start (string
, start
, end
);
2078 return Fcons (ret
, make_number (read_from_string_index
));
2081 /* Function to set up the global context we need in toplevel read
2082 calls. START and END only used when STREAM is a string. */
2084 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2089 new_backquote_flag
= 0;
2090 read_objects
= Qnil
;
2091 if (EQ (Vread_with_symbol_positions
, Qt
)
2092 || EQ (Vread_with_symbol_positions
, stream
))
2093 Vread_symbol_positions_list
= Qnil
;
2095 if (STRINGP (stream
)
2096 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2098 ptrdiff_t startval
, endval
;
2101 if (STRINGP (stream
))
2104 string
= XCAR (stream
);
2106 validate_subarray (string
, start
, end
, SCHARS (string
),
2107 &startval
, &endval
);
2109 read_from_string_index
= startval
;
2110 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2111 read_from_string_limit
= endval
;
2114 retval
= read0 (stream
);
2115 if (EQ (Vread_with_symbol_positions
, Qt
)
2116 || EQ (Vread_with_symbol_positions
, stream
))
2117 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2122 /* Signal Qinvalid_read_syntax error.
2123 S is error string of length N (if > 0) */
2125 static _Noreturn
void
2126 invalid_syntax (const char *s
)
2128 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2132 /* Use this for recursive reads, in contexts where internal tokens
2136 read0 (Lisp_Object readcharfun
)
2138 register Lisp_Object val
;
2141 val
= read1 (readcharfun
, &c
, 0);
2145 xsignal1 (Qinvalid_read_syntax
,
2146 Fmake_string (make_number (1), make_number (c
)));
2149 static ptrdiff_t read_buffer_size
;
2150 static char *read_buffer
;
2152 /* Read a \-escape sequence, assuming we already read the `\'.
2153 If the escape sequence forces unibyte, return eight-bit char. */
2156 read_escape (Lisp_Object readcharfun
, bool stringp
)
2159 /* \u allows up to four hex digits, \U up to eight. Default to the
2160 behavior for \u, and change this value in the case that \U is seen. */
2161 int unicode_hex_count
= 4;
2166 end_of_file_error ();
2196 error ("Invalid escape character syntax");
2199 c
= read_escape (readcharfun
, 0);
2200 return c
| meta_modifier
;
2205 error ("Invalid escape character syntax");
2208 c
= read_escape (readcharfun
, 0);
2209 return c
| shift_modifier
;
2214 error ("Invalid escape character syntax");
2217 c
= read_escape (readcharfun
, 0);
2218 return c
| hyper_modifier
;
2223 error ("Invalid escape character syntax");
2226 c
= read_escape (readcharfun
, 0);
2227 return c
| alt_modifier
;
2231 if (stringp
|| c
!= '-')
2238 c
= read_escape (readcharfun
, 0);
2239 return c
| super_modifier
;
2244 error ("Invalid escape character syntax");
2248 c
= read_escape (readcharfun
, 0);
2249 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2250 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2251 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2252 return c
| ctrl_modifier
;
2253 /* ASCII control chars are made from letters (both cases),
2254 as well as the non-letters within 0100...0137. */
2255 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2256 return (c
& (037 | ~0177));
2257 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2258 return (c
& (037 | ~0177));
2260 return c
| ctrl_modifier
;
2270 /* An octal escape, as in ANSI C. */
2272 register int i
= c
- '0';
2273 register int count
= 0;
2276 if ((c
= READCHAR
) >= '0' && c
<= '7')
2288 if (i
>= 0x80 && i
< 0x100)
2289 i
= BYTE8_TO_CHAR (i
);
2294 /* A hex escape, as in ANSI C. */
2301 if (c
>= '0' && c
<= '9')
2306 else if ((c
>= 'a' && c
<= 'f')
2307 || (c
>= 'A' && c
<= 'F'))
2310 if (c
>= 'a' && c
<= 'f')
2320 /* Allow hex escapes as large as ?\xfffffff, because some
2321 packages use them to denote characters with modifiers. */
2322 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2323 error ("Hex character out of range: \\x%x...", i
);
2327 if (count
< 3 && i
>= 0x80)
2328 return BYTE8_TO_CHAR (i
);
2333 /* Post-Unicode-2.0: Up to eight hex chars. */
2334 unicode_hex_count
= 8;
2337 /* A Unicode escape. We only permit them in strings and characters,
2338 not arbitrarily in the source code, as in some other languages. */
2343 while (++count
<= unicode_hex_count
)
2346 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2348 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2349 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2350 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2352 error ("Non-hex digit used for Unicode escape");
2355 error ("Non-Unicode character: 0x%x", i
);
2364 /* Return the digit that CHARACTER stands for in the given BASE.
2365 Return -1 if CHARACTER is out of range for BASE,
2366 and -2 if CHARACTER is not valid for any supported BASE. */
2368 digit_to_number (int character
, int base
)
2372 if ('0' <= character
&& character
<= '9')
2373 digit
= character
- '0';
2374 else if ('a' <= character
&& character
<= 'z')
2375 digit
= character
- 'a' + 10;
2376 else if ('A' <= character
&& character
<= 'Z')
2377 digit
= character
- 'A' + 10;
2381 return digit
< base
? digit
: -1;
2384 /* Read an integer in radix RADIX using READCHARFUN to read
2385 characters. RADIX must be in the interval [2..36]; if it isn't, a
2386 read error is signaled . Value is the integer read. Signals an
2387 error if encountering invalid read syntax or if RADIX is out of
2391 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2393 /* Room for sign, leading 0, other digits, trailing null byte.
2394 Also, room for invalid syntax diagnostic. */
2395 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2396 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2398 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2400 if (radix
< 2 || radix
> 36)
2408 if (c
== '-' || c
== '+')
2419 /* Ignore redundant leading zeros, so the buffer doesn't
2420 fill up with them. */
2426 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2433 if (p
< buf
+ sizeof buf
- 1)
2447 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2448 invalid_syntax (buf
);
2451 return string_to_number (buf
, radix
, 0);
2455 /* If the next token is ')' or ']' or '.', we store that character
2456 in *PCH and the return value is not interesting. Else, we store
2457 zero in *PCH and we read and return one lisp object.
2459 FIRST_IN_LIST is true if this is the first element of a list. */
2462 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2465 bool uninterned_symbol
= 0;
2472 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2474 end_of_file_error ();
2479 return read_list (0, readcharfun
);
2482 return read_vector (readcharfun
, 0);
2498 /* Accept extended format for hashtables (extensible to
2500 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2501 Lisp_Object tmp
= read_list (0, readcharfun
);
2502 Lisp_Object head
= CAR_SAFE (tmp
);
2503 Lisp_Object data
= Qnil
;
2504 Lisp_Object val
= Qnil
;
2505 /* The size is 2 * number of allowed keywords to
2507 Lisp_Object params
[10];
2509 Lisp_Object key
= Qnil
;
2510 int param_count
= 0;
2512 if (!EQ (head
, Qhash_table
))
2513 error ("Invalid extended read marker at head of #s list "
2514 "(only hash-table allowed)");
2516 tmp
= CDR_SAFE (tmp
);
2518 /* This is repetitive but fast and simple. */
2519 params
[param_count
] = QCsize
;
2520 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2521 if (!NILP (params
[param_count
+ 1]))
2524 params
[param_count
] = QCtest
;
2525 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2526 if (!NILP (params
[param_count
+ 1]))
2529 params
[param_count
] = QCweakness
;
2530 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2531 if (!NILP (params
[param_count
+ 1]))
2534 params
[param_count
] = QCrehash_size
;
2535 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2536 if (!NILP (params
[param_count
+ 1]))
2539 params
[param_count
] = QCrehash_threshold
;
2540 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2541 if (!NILP (params
[param_count
+ 1]))
2544 /* This is the hashtable data. */
2545 data
= Fplist_get (tmp
, Qdata
);
2547 /* Now use params to make a new hashtable and fill it. */
2548 ht
= Fmake_hash_table (param_count
, params
);
2550 while (CONSP (data
))
2555 error ("Odd number of elements in hashtable data");
2558 Fputhash (key
, val
, ht
);
2564 invalid_syntax ("#");
2572 tmp
= read_vector (readcharfun
, 0);
2573 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2574 error ("Invalid size char-table");
2575 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2583 /* Sub char-table can't be read as a regular
2584 vector because of a two C integer fields. */
2585 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2586 ptrdiff_t size
= XINT (Flength (tmp
));
2587 int i
, depth
, min_char
;
2588 struct Lisp_Cons
*cell
;
2591 error ("Zero-sized sub char-table");
2593 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2594 error ("Invalid depth in sub char-table");
2595 depth
= XINT (XCAR (tmp
));
2596 if (chartab_size
[depth
] != size
- 2)
2597 error ("Invalid size in sub char-table");
2598 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2601 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2602 error ("Invalid minimum character in sub-char-table");
2603 min_char
= XINT (XCAR (tmp
));
2604 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2607 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2608 for (i
= 0; i
< size
; i
++)
2610 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2611 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2616 invalid_syntax ("#^^");
2618 invalid_syntax ("#^");
2623 length
= read1 (readcharfun
, pch
, first_in_list
);
2627 Lisp_Object tmp
, val
;
2628 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2629 unsigned char *data
;
2632 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2633 if (STRING_MULTIBYTE (tmp
)
2634 || (size_in_chars
!= SCHARS (tmp
)
2635 /* We used to print 1 char too many
2636 when the number of bits was a multiple of 8.
2637 Accept such input in case it came from an old
2639 && ! (XFASTINT (length
)
2640 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2641 invalid_syntax ("#&...");
2643 val
= make_uninit_bool_vector (XFASTINT (length
));
2644 data
= bool_vector_uchar_data (val
);
2645 memcpy (data
, SDATA (tmp
), size_in_chars
);
2646 /* Clear the extraneous bits in the last byte. */
2647 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2648 data
[size_in_chars
- 1]
2649 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2652 invalid_syntax ("#&...");
2656 /* Accept compiled functions at read-time so that we don't have to
2657 build them using function calls. */
2659 struct Lisp_Vector
*vec
;
2660 tmp
= read_vector (readcharfun
, 1);
2661 vec
= XVECTOR (tmp
);
2662 if (vec
->header
.size
== 0)
2663 invalid_syntax ("Empty byte-code object");
2664 make_byte_code (vec
);
2670 struct gcpro gcpro1
;
2673 /* Read the string itself. */
2674 tmp
= read1 (readcharfun
, &ch
, 0);
2675 if (ch
!= 0 || !STRINGP (tmp
))
2676 invalid_syntax ("#");
2678 /* Read the intervals and their properties. */
2681 Lisp_Object beg
, end
, plist
;
2683 beg
= read1 (readcharfun
, &ch
, 0);
2688 end
= read1 (readcharfun
, &ch
, 0);
2690 plist
= read1 (readcharfun
, &ch
, 0);
2692 invalid_syntax ("Invalid string property list");
2693 Fset_text_properties (beg
, end
, plist
, tmp
);
2699 /* #@NUMBER is used to skip NUMBER following bytes.
2700 That's used in .elc files to skip over doc strings
2701 and function definitions. */
2704 enum { extra
= 100 };
2705 ptrdiff_t i
, nskip
= 0, digits
= 0;
2707 /* Read a decimal integer. */
2708 while ((c
= READCHAR
) >= 0
2709 && c
>= '0' && c
<= '9')
2711 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2716 if (digits
== 2 && nskip
== 0)
2717 { /* We've just seen #@00, which means "skip to end". */
2718 skip_dyn_eof (readcharfun
);
2723 /* We can't use UNREAD here, because in the code below we side-step
2724 READCHAR. Instead, assume the first char after #@NNN occupies
2725 a single byte, which is the case normally since it's just
2731 if (load_force_doc_strings
2732 && (FROM_FILE_P (readcharfun
)))
2734 /* If we are supposed to force doc strings into core right now,
2735 record the last string that we skipped,
2736 and record where in the file it comes from. */
2738 /* But first exchange saved_doc_string
2739 with prev_saved_doc_string, so we save two strings. */
2741 char *temp
= saved_doc_string
;
2742 ptrdiff_t temp_size
= saved_doc_string_size
;
2743 file_offset temp_pos
= saved_doc_string_position
;
2744 ptrdiff_t temp_len
= saved_doc_string_length
;
2746 saved_doc_string
= prev_saved_doc_string
;
2747 saved_doc_string_size
= prev_saved_doc_string_size
;
2748 saved_doc_string_position
= prev_saved_doc_string_position
;
2749 saved_doc_string_length
= prev_saved_doc_string_length
;
2751 prev_saved_doc_string
= temp
;
2752 prev_saved_doc_string_size
= temp_size
;
2753 prev_saved_doc_string_position
= temp_pos
;
2754 prev_saved_doc_string_length
= temp_len
;
2757 if (saved_doc_string_size
== 0)
2759 saved_doc_string
= xmalloc (nskip
+ extra
);
2760 saved_doc_string_size
= nskip
+ extra
;
2762 if (nskip
> saved_doc_string_size
)
2764 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2765 saved_doc_string_size
= nskip
+ extra
;
2768 saved_doc_string_position
= file_tell (instream
);
2770 /* Copy that many characters into saved_doc_string. */
2772 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2773 saved_doc_string
[i
] = c
= getc (instream
);
2776 saved_doc_string_length
= i
;
2779 /* Skip that many bytes. */
2780 skip_dyn_bytes (readcharfun
, nskip
);
2786 /* #! appears at the beginning of an executable file.
2787 Skip the first line. */
2788 while (c
!= '\n' && c
>= 0)
2793 return Vload_file_name
;
2795 return list2 (Qfunction
, read0 (readcharfun
));
2796 /* #:foo is the uninterned symbol named foo. */
2799 uninterned_symbol
= 1;
2802 && c
!= 0xa0 /* NBSP */
2804 || strchr ("\"';()[]#`,", c
) == NULL
)))
2806 /* No symbol character follows, this is the empty
2809 return Fmake_symbol (empty_unibyte_string
);
2813 /* ## is the empty symbol. */
2815 return Fintern (empty_unibyte_string
, Qnil
);
2816 /* Reader forms that can reuse previously read objects. */
2817 if (c
>= '0' && c
<= '9')
2822 /* Read a non-negative integer. */
2823 while (c
>= '0' && c
<= '9')
2825 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2826 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2827 n
= MOST_POSITIVE_FIXNUM
+ 1;
2829 n
= n
* 10 + c
- '0';
2833 if (n
<= MOST_POSITIVE_FIXNUM
)
2835 if (c
== 'r' || c
== 'R')
2836 return read_integer (readcharfun
, n
);
2838 if (! NILP (Vread_circle
))
2840 /* #n=object returns object, but associates it with
2844 /* Make a placeholder for #n# to use temporarily. */
2845 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2846 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2847 read_objects
= Fcons (cell
, read_objects
);
2849 /* Read the object itself. */
2850 tem
= read0 (readcharfun
);
2852 /* Now put it everywhere the placeholder was... */
2853 substitute_object_in_subtree (tem
, placeholder
);
2855 /* ...and #n# will use the real value from now on. */
2856 Fsetcdr (cell
, tem
);
2861 /* #n# returns a previously read object. */
2864 tem
= Fassq (make_number (n
), read_objects
);
2870 /* Fall through to error message. */
2872 else if (c
== 'x' || c
== 'X')
2873 return read_integer (readcharfun
, 16);
2874 else if (c
== 'o' || c
== 'O')
2875 return read_integer (readcharfun
, 8);
2876 else if (c
== 'b' || c
== 'B')
2877 return read_integer (readcharfun
, 2);
2880 invalid_syntax ("#");
2883 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2887 return list2 (Qquote
, read0 (readcharfun
));
2891 int next_char
= READCHAR
;
2893 /* Transition from old-style to new-style:
2894 If we see "(`" it used to mean old-style, which usually works
2895 fine because ` should almost never appear in such a position
2896 for new-style. But occasionally we need "(`" to mean new
2897 style, so we try to distinguish the two by the fact that we
2898 can either write "( `foo" or "(` foo", where the first
2899 intends to use new-style whereas the second intends to use
2900 old-style. For Emacs-25, we should completely remove this
2901 first_in_list exception (old-style can still be obtained via
2903 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2905 Vold_style_backquotes
= Qt
;
2911 bool saved_new_backquote_flag
= new_backquote_flag
;
2913 new_backquote_flag
= 1;
2914 value
= read0 (readcharfun
);
2915 new_backquote_flag
= saved_new_backquote_flag
;
2917 return list2 (Qbackquote
, value
);
2922 int next_char
= READCHAR
;
2924 /* Transition from old-style to new-style:
2925 It used to be impossible to have a new-style , other than within
2926 a new-style `. This is sufficient when ` and , are used in the
2927 normal way, but ` and , can also appear in args to macros that
2928 will not interpret them in the usual way, in which case , may be
2929 used without any ` anywhere near.
2930 So we now use the same heuristic as for backquote: old-style
2931 unquotes are only recognized when first on a list, and when
2932 followed by a space.
2933 Because it's more difficult to peek 2 chars ahead, a new-style
2934 ,@ can still not be used outside of a `, unless it's in the middle
2936 if (new_backquote_flag
2938 || (next_char
!= ' ' && next_char
!= '@'))
2940 Lisp_Object comma_type
= Qnil
;
2945 comma_type
= Qcomma_at
;
2947 comma_type
= Qcomma_dot
;
2950 if (ch
>= 0) UNREAD (ch
);
2951 comma_type
= Qcomma
;
2954 value
= read0 (readcharfun
);
2955 return list2 (comma_type
, value
);
2959 Vold_style_backquotes
= Qt
;
2971 end_of_file_error ();
2973 /* Accept `single space' syntax like (list ? x) where the
2974 whitespace character is SPC or TAB.
2975 Other literal whitespace like NL, CR, and FF are not accepted,
2976 as there are well-established escape sequences for these. */
2977 if (c
== ' ' || c
== '\t')
2978 return make_number (c
);
2981 c
= read_escape (readcharfun
, 0);
2982 modifiers
= c
& CHAR_MODIFIER_MASK
;
2983 c
&= ~CHAR_MODIFIER_MASK
;
2984 if (CHAR_BYTE8_P (c
))
2985 c
= CHAR_TO_BYTE8 (c
);
2988 next_char
= READCHAR
;
2989 ok
= (next_char
<= 040
2990 || (next_char
< 0200
2991 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2994 return make_number (c
);
2996 invalid_syntax ("?");
3001 char *p
= read_buffer
;
3002 char *end
= read_buffer
+ read_buffer_size
;
3004 /* True if we saw an escape sequence specifying
3005 a multibyte character. */
3006 bool force_multibyte
= 0;
3007 /* True if we saw an escape sequence specifying
3008 a single-byte character. */
3009 bool force_singlebyte
= 0;
3011 ptrdiff_t nchars
= 0;
3013 while ((ch
= READCHAR
) >= 0
3016 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3018 ptrdiff_t offset
= p
- read_buffer
;
3019 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3020 memory_full (SIZE_MAX
);
3021 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3022 read_buffer_size
*= 2;
3023 p
= read_buffer
+ offset
;
3024 end
= read_buffer
+ read_buffer_size
;
3031 ch
= read_escape (readcharfun
, 1);
3033 /* CH is -1 if \ newline has just been seen. */
3036 if (p
== read_buffer
)
3041 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3042 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3044 if (CHAR_BYTE8_P (ch
))
3045 force_singlebyte
= 1;
3046 else if (! ASCII_CHAR_P (ch
))
3047 force_multibyte
= 1;
3048 else /* I.e. ASCII_CHAR_P (ch). */
3050 /* Allow `\C- ' and `\C-?'. */
3051 if (modifiers
== CHAR_CTL
)
3054 ch
= 0, modifiers
= 0;
3056 ch
= 127, modifiers
= 0;
3058 if (modifiers
& CHAR_SHIFT
)
3060 /* Shift modifier is valid only with [A-Za-z]. */
3061 if (ch
>= 'A' && ch
<= 'Z')
3062 modifiers
&= ~CHAR_SHIFT
;
3063 else if (ch
>= 'a' && ch
<= 'z')
3064 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3067 if (modifiers
& CHAR_META
)
3069 /* Move the meta bit to the right place for a
3071 modifiers
&= ~CHAR_META
;
3072 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3073 force_singlebyte
= 1;
3077 /* Any modifiers remaining are invalid. */
3079 error ("Invalid modifier in string");
3080 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3084 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3085 if (CHAR_BYTE8_P (ch
))
3086 force_singlebyte
= 1;
3087 else if (! ASCII_CHAR_P (ch
))
3088 force_multibyte
= 1;
3094 end_of_file_error ();
3096 /* If purifying, and string starts with \ newline,
3097 return zero instead. This is for doc strings
3098 that we are really going to find in etc/DOC.nn.nn. */
3099 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3100 return make_number (0);
3102 if (! force_multibyte
&& force_singlebyte
)
3104 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3105 forms. Convert it to unibyte. */
3106 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3108 p
= read_buffer
+ nchars
;
3111 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3113 || (p
- read_buffer
!= nchars
)));
3118 int next_char
= READCHAR
;
3121 if (next_char
<= 040
3122 || (next_char
< 0200
3123 && strchr ("\"';([#?`,", next_char
) != NULL
))
3129 /* Otherwise, we fall through! Note that the atom-reading loop
3130 below will now loop at least once, assuring that we will not
3131 try to UNREAD two characters in a row. */
3135 if (c
<= 040) goto retry
;
3136 if (c
== 0xa0) /* NBSP */
3141 char *p
= read_buffer
;
3143 EMACS_INT start_position
= readchar_count
- 1;
3146 char *end
= read_buffer
+ read_buffer_size
;
3150 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3152 ptrdiff_t offset
= p
- read_buffer
;
3153 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3154 memory_full (SIZE_MAX
);
3155 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3156 read_buffer_size
*= 2;
3157 p
= read_buffer
+ offset
;
3158 end
= read_buffer
+ read_buffer_size
;
3165 end_of_file_error ();
3170 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3176 && c
!= 0xa0 /* NBSP */
3178 || strchr ("\"';()[]#`,", c
) == NULL
));
3182 ptrdiff_t offset
= p
- read_buffer
;
3183 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3184 memory_full (SIZE_MAX
);
3185 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3186 read_buffer_size
*= 2;
3187 p
= read_buffer
+ offset
;
3188 end
= read_buffer
+ read_buffer_size
;
3194 if (!quoted
&& !uninterned_symbol
)
3196 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3197 if (! NILP (result
))
3201 Lisp_Object name
, result
;
3202 ptrdiff_t nbytes
= p
- read_buffer
;
3205 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3209 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3210 ? make_pure_string
: make_specified_string
)
3211 (read_buffer
, nchars
, nbytes
, multibyte
));
3212 result
= (uninterned_symbol
? Fmake_symbol (name
)
3213 : Fintern (name
, Qnil
));
3215 if (EQ (Vread_with_symbol_positions
, Qt
)
3216 || EQ (Vread_with_symbol_positions
, readcharfun
))
3217 Vread_symbol_positions_list
3218 = Fcons (Fcons (result
, make_number (start_position
)),
3219 Vread_symbol_positions_list
);
3227 /* List of nodes we've seen during substitute_object_in_subtree. */
3228 static Lisp_Object seen_list
;
3231 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3233 Lisp_Object check_object
;
3235 /* We haven't seen any objects when we start. */
3238 /* Make all the substitutions. */
3240 = substitute_object_recurse (object
, placeholder
, object
);
3242 /* Clear seen_list because we're done with it. */
3245 /* The returned object here is expected to always eq the
3247 if (!EQ (check_object
, object
))
3248 error ("Unexpected mutation error in reader");
3251 /* Feval doesn't get called from here, so no gc protection is needed. */
3252 #define SUBSTITUTE(get_val, set_val) \
3254 Lisp_Object old_value = get_val; \
3255 Lisp_Object true_value \
3256 = substitute_object_recurse (object, placeholder, \
3259 if (!EQ (old_value, true_value)) \
3266 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3268 /* If we find the placeholder, return the target object. */
3269 if (EQ (placeholder
, subtree
))
3272 /* If we've been to this node before, don't explore it again. */
3273 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3276 /* If this node can be the entry point to a cycle, remember that
3277 we've seen it. It can only be such an entry point if it was made
3278 by #n=, which means that we can find it as a value in
3280 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3281 seen_list
= Fcons (subtree
, seen_list
);
3283 /* Recurse according to subtree's type.
3284 Every branch must return a Lisp_Object. */
3285 switch (XTYPE (subtree
))
3287 case Lisp_Vectorlike
:
3289 ptrdiff_t i
, length
= 0;
3290 if (BOOL_VECTOR_P (subtree
))
3291 return subtree
; /* No sub-objects anyway. */
3292 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3293 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3294 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3295 else if (VECTORP (subtree
))
3296 length
= ASIZE (subtree
);
3298 /* An unknown pseudovector may contain non-Lisp fields, so we
3299 can't just blindly traverse all its fields. We used to call
3300 `Flength' which signaled `sequencep', so I just preserved this
3302 wrong_type_argument (Qsequencep
, subtree
);
3304 for (i
= 0; i
< length
; i
++)
3305 SUBSTITUTE (AREF (subtree
, i
),
3306 ASET (subtree
, i
, true_value
));
3312 SUBSTITUTE (XCAR (subtree
),
3313 XSETCAR (subtree
, true_value
));
3314 SUBSTITUTE (XCDR (subtree
),
3315 XSETCDR (subtree
, true_value
));
3321 /* Check for text properties in each interval.
3322 substitute_in_interval contains part of the logic. */
3324 INTERVAL root_interval
= string_intervals (subtree
);
3325 AUTO_CONS (arg
, object
, placeholder
);
3327 traverse_intervals_noorder (root_interval
,
3328 &substitute_in_interval
, arg
);
3333 /* Other types don't recurse any further. */
3339 /* Helper function for substitute_object_recurse. */
3341 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3343 Lisp_Object object
= Fcar (arg
);
3344 Lisp_Object placeholder
= Fcdr (arg
);
3346 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3356 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3357 integer syntax and fits in a fixnum, else return the nearest float if CP has
3358 either floating point or integer syntax and BASE is 10, else return nil. If
3359 IGNORE_TRAILING, consider just the longest prefix of CP that has
3360 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3361 number has integer syntax but does not fit. */
3364 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3367 char const *cp
= string
;
3369 bool float_syntax
= 0;
3372 /* Compute NaN and infinities using a variable, to cope with compilers that
3373 think they are smarter than we are. */
3376 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3377 IEEE floating point hosts, and works around a formerly-common bug where
3378 atof ("-0.0") drops the sign. */
3379 bool negative
= *cp
== '-';
3381 bool signedp
= negative
|| *cp
== '+';
3386 leading_digit
= digit_to_number (*cp
, base
);
3387 if (leading_digit
>= 0)
3392 while (digit_to_number (*cp
, base
) >= 0);
3402 if ('0' <= *cp
&& *cp
<= '9')
3407 while ('0' <= *cp
&& *cp
<= '9');
3409 if (*cp
== 'e' || *cp
== 'E')
3411 char const *ecp
= cp
;
3413 if (*cp
== '+' || *cp
== '-')
3415 if ('0' <= *cp
&& *cp
<= '9')
3420 while ('0' <= *cp
&& *cp
<= '9');
3422 else if (cp
[-1] == '+'
3423 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3429 else if (cp
[-1] == '+'
3430 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3434 value
= zero
/ zero
;
3436 /* If that made a "negative" NaN, negate it. */
3439 union { double d
; char c
[sizeof (double)]; }
3440 u_data
, u_minus_zero
;
3442 u_minus_zero
.d
= -0.0;
3443 for (i
= 0; i
< sizeof (double); i
++)
3444 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3450 /* Now VALUE is a positive NaN. */
3456 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3457 || state
== (LEAD_INT
|E_EXP
));
3460 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3461 any prefix that matches. Otherwise, the entire string must match. */
3462 if (! (ignore_trailing
3463 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3464 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3467 /* If the number uses integer and not float syntax, and is in C-language
3468 range, use its value, preferably as a fixnum. */
3469 if (leading_digit
>= 0 && ! float_syntax
)
3473 /* Fast special case for single-digit integers. This also avoids a
3474 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3475 case some versions of strtoumax accept numbers like "0x1" that Emacs
3477 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3478 return make_number (negative
? -leading_digit
: leading_digit
);
3481 n
= strtoumax (string
+ signedp
, NULL
, base
);
3482 if (errno
== ERANGE
)
3484 /* Unfortunately there's no simple and accurate way to convert
3485 non-base-10 numbers that are out of C-language range. */
3487 xsignal1 (Qoverflow_error
, build_string (string
));
3489 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3491 EMACS_INT signed_n
= n
;
3492 return make_number (negative
? -signed_n
: signed_n
);
3498 /* Either the number uses float syntax, or it does not fit into a fixnum.
3499 Convert it from string to floating point, unless the value is already
3500 known because it is an infinity, a NAN, or its absolute value fits in
3503 value
= atof (string
+ signedp
);
3505 return make_float (negative
? -value
: value
);
3510 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3514 Lisp_Object tem
, item
, vector
;
3515 struct Lisp_Cons
*otem
;
3518 tem
= read_list (1, readcharfun
);
3519 len
= Flength (tem
);
3520 vector
= Fmake_vector (len
, Qnil
);
3522 size
= ASIZE (vector
);
3523 ptr
= XVECTOR (vector
)->contents
;
3524 for (i
= 0; i
< size
; i
++)
3527 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3528 bytecode object, the docstring containing the bytecode and
3529 constants values must be treated as unibyte and passed to
3530 Fread, to get the actual bytecode string and constants vector. */
3531 if (bytecodeflag
&& load_force_doc_strings
)
3533 if (i
== COMPILED_BYTECODE
)
3535 if (!STRINGP (item
))
3536 error ("Invalid byte code");
3538 /* Delay handling the bytecode slot until we know whether
3539 it is lazily-loaded (we can tell by whether the
3540 constants slot is nil). */
3541 ASET (vector
, COMPILED_CONSTANTS
, item
);
3544 else if (i
== COMPILED_CONSTANTS
)
3546 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3550 /* Coerce string to unibyte (like string-as-unibyte,
3551 but without generating extra garbage and
3552 guaranteeing no change in the contents). */
3553 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3554 STRING_SET_UNIBYTE (bytestr
);
3556 item
= Fread (Fcons (bytestr
, readcharfun
));
3558 error ("Invalid byte code");
3560 otem
= XCONS (item
);
3561 bytestr
= XCAR (item
);
3566 /* Now handle the bytecode slot. */
3567 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3569 else if (i
== COMPILED_DOC_STRING
3571 && ! STRING_MULTIBYTE (item
))
3573 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3574 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3576 item
= Fstring_as_multibyte (item
);
3579 ASET (vector
, i
, item
);
3587 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3590 read_list (bool flag
, Lisp_Object readcharfun
)
3592 Lisp_Object val
, tail
;
3593 Lisp_Object elt
, tem
;
3594 struct gcpro gcpro1
, gcpro2
;
3595 /* 0 is the normal case.
3596 1 means this list is a doc reference; replace it with the number 0.
3597 2 means this list is a doc reference; replace it with the doc string. */
3598 int doc_reference
= 0;
3600 /* Initialize this to 1 if we are reading a list. */
3601 bool first_in_list
= flag
<= 0;
3610 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3615 /* While building, if the list starts with #$, treat it specially. */
3616 if (EQ (elt
, Vload_file_name
)
3618 && !NILP (Vpurify_flag
))
3620 if (NILP (Vdoc_file_name
))
3621 /* We have not yet called Snarf-documentation, so assume
3622 this file is described in the DOC file
3623 and Snarf-documentation will fill in the right value later.
3624 For now, replace the whole list with 0. */
3627 /* We have already called Snarf-documentation, so make a relative
3628 file name for this file, so it can be found properly
3629 in the installed Lisp directory.
3630 We don't use Fexpand_file_name because that would make
3631 the directory absolute now. */
3633 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3634 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3637 else if (EQ (elt
, Vload_file_name
)
3639 && load_force_doc_strings
)
3648 invalid_syntax (") or . in a vector");
3656 XSETCDR (tail
, read0 (readcharfun
));
3658 val
= read0 (readcharfun
);
3659 read1 (readcharfun
, &ch
, 0);
3663 if (doc_reference
== 1)
3664 return make_number (0);
3665 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3668 file_offset saved_position
;
3669 /* Get a doc string from the file we are loading.
3670 If it's in saved_doc_string, get it from there.
3672 Here, we don't know if the string is a
3673 bytecode string or a doc string. As a
3674 bytecode string must be unibyte, we always
3675 return a unibyte string. If it is actually a
3676 doc string, caller must make it
3679 /* Position is negative for user variables. */
3680 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3681 if (pos
>= saved_doc_string_position
3682 && pos
< (saved_doc_string_position
3683 + saved_doc_string_length
))
3685 saved
= saved_doc_string
;
3686 saved_position
= saved_doc_string_position
;
3688 /* Look in prev_saved_doc_string the same way. */
3689 else if (pos
>= prev_saved_doc_string_position
3690 && pos
< (prev_saved_doc_string_position
3691 + prev_saved_doc_string_length
))
3693 saved
= prev_saved_doc_string
;
3694 saved_position
= prev_saved_doc_string_position
;
3698 ptrdiff_t start
= pos
- saved_position
;
3701 /* Process quoting with ^A,
3702 and find the end of the string,
3703 which is marked with ^_ (037). */
3704 for (from
= start
, to
= start
;
3705 saved
[from
] != 037;)
3707 int c
= saved
[from
++];
3711 saved
[to
++] = (c
== 1 ? c
3720 return make_unibyte_string (saved
+ start
,
3724 return get_doc_string (val
, 1, 0);
3729 invalid_syntax (". in wrong context");
3731 invalid_syntax ("] in a list");
3735 XSETCDR (tail
, tem
);
3742 static Lisp_Object initial_obarray
;
3744 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3746 static size_t oblookup_last_bucket_number
;
3748 /* Get an error if OBARRAY is not an obarray.
3749 If it is one, return it. */
3752 check_obarray (Lisp_Object obarray
)
3754 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3756 /* If Vobarray is now invalid, force it to be valid. */
3757 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3758 wrong_type_argument (Qvectorp
, obarray
);
3763 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3766 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3770 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3771 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3774 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3776 XSYMBOL (sym
)->constant
= 1;
3777 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3778 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3781 ptr
= aref_addr (obarray
, XINT (index
));
3782 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3787 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3790 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3792 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3795 /* Intern the C string STR: return a symbol with that name,
3796 interned in the current obarray. */
3799 intern_1 (const char *str
, ptrdiff_t len
)
3801 Lisp_Object obarray
= check_obarray (Vobarray
);
3802 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3804 return SYMBOLP (tem
) ? tem
: intern_driver (make_string (str
, len
),
3809 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3811 Lisp_Object obarray
= check_obarray (Vobarray
);
3812 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3816 /* Creating a non-pure string from a string literal not implemented yet.
3817 We could just use make_string here and live with the extra copy. */
3818 eassert (!NILP (Vpurify_flag
));
3819 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3825 define_symbol (Lisp_Object sym
, char const *str
)
3827 ptrdiff_t len
= strlen (str
);
3828 Lisp_Object string
= make_pure_c_string (str
, len
);
3829 init_symbol (sym
, string
);
3831 /* Qunbound is uninterned, so that it's not confused with any symbol
3832 'unbound' created by a Lisp program. */
3833 if (! EQ (sym
, Qunbound
))
3835 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3836 eassert (INTEGERP (bucket
));
3837 intern_sym (sym
, initial_obarray
, bucket
);
3841 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3842 doc
: /* Return the canonical symbol whose name is STRING.
3843 If there is none, one is created by this function and returned.
3844 A second optional argument specifies the obarray to use;
3845 it defaults to the value of `obarray'. */)
3846 (Lisp_Object string
, Lisp_Object obarray
)
3850 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3851 CHECK_STRING (string
);
3853 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3855 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3860 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3861 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3862 NAME may be a string or a symbol. If it is a symbol, that exact
3863 symbol is searched for.
3864 A second optional argument specifies the obarray to use;
3865 it defaults to the value of `obarray'. */)
3866 (Lisp_Object name
, Lisp_Object obarray
)
3868 register Lisp_Object tem
, string
;
3870 if (NILP (obarray
)) obarray
= Vobarray
;
3871 obarray
= check_obarray (obarray
);
3873 if (!SYMBOLP (name
))
3875 CHECK_STRING (name
);
3879 string
= SYMBOL_NAME (name
);
3881 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3882 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3888 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3889 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3890 The value is t if a symbol was found and deleted, nil otherwise.
3891 NAME may be a string or a symbol. If it is a symbol, that symbol
3892 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3893 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3894 usage: (unintern NAME OBARRAY) */)
3895 (Lisp_Object name
, Lisp_Object obarray
)
3897 register Lisp_Object string
, tem
;
3900 if (NILP (obarray
)) obarray
= Vobarray
;
3901 obarray
= check_obarray (obarray
);
3904 string
= SYMBOL_NAME (name
);
3907 CHECK_STRING (name
);
3911 tem
= oblookup (obarray
, SSDATA (string
),
3916 /* If arg was a symbol, don't delete anything but that symbol itself. */
3917 if (SYMBOLP (name
) && !EQ (name
, tem
))
3920 /* There are plenty of other symbols which will screw up the Emacs
3921 session if we unintern them, as well as even more ways to use
3922 `setq' or `fset' or whatnot to make the Emacs session
3923 unusable. Let's not go down this silly road. --Stef */
3924 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3925 error ("Attempt to unintern t or nil"); */
3927 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3929 hash
= oblookup_last_bucket_number
;
3931 if (EQ (AREF (obarray
, hash
), tem
))
3933 if (XSYMBOL (tem
)->next
)
3936 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3937 ASET (obarray
, hash
, sym
);
3940 ASET (obarray
, hash
, make_number (0));
3944 Lisp_Object tail
, following
;
3946 for (tail
= AREF (obarray
, hash
);
3947 XSYMBOL (tail
)->next
;
3950 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3951 if (EQ (following
, tem
))
3953 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3962 /* Return the symbol in OBARRAY whose names matches the string
3963 of SIZE characters (SIZE_BYTE bytes) at PTR.
3964 If there is no such symbol, return the integer bucket number of
3965 where the symbol would be if it were present.
3967 Also store the bucket number in oblookup_last_bucket_number. */
3970 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3974 register Lisp_Object tail
;
3975 Lisp_Object bucket
, tem
;
3977 obarray
= check_obarray (obarray
);
3978 obsize
= ASIZE (obarray
);
3980 /* This is sometimes needed in the middle of GC. */
3981 obsize
&= ~ARRAY_MARK_FLAG
;
3982 hash
= hash_string (ptr
, size_byte
) % obsize
;
3983 bucket
= AREF (obarray
, hash
);
3984 oblookup_last_bucket_number
= hash
;
3985 if (EQ (bucket
, make_number (0)))
3987 else if (!SYMBOLP (bucket
))
3988 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3990 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3992 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3993 && SCHARS (SYMBOL_NAME (tail
)) == size
3994 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3996 else if (XSYMBOL (tail
)->next
== 0)
3999 XSETINT (tem
, hash
);
4004 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
4007 register Lisp_Object tail
;
4008 CHECK_VECTOR (obarray
);
4009 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
4011 tail
= AREF (obarray
, i
);
4016 if (XSYMBOL (tail
)->next
== 0)
4018 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4024 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4026 call1 (function
, sym
);
4029 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4030 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4031 OBARRAY defaults to the value of `obarray'. */)
4032 (Lisp_Object function
, Lisp_Object obarray
)
4034 if (NILP (obarray
)) obarray
= Vobarray
;
4035 obarray
= check_obarray (obarray
);
4037 map_obarray (obarray
, mapatoms_1
, function
);
4041 #define OBARRAY_SIZE 1511
4046 Lisp_Object oblength
;
4047 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4049 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4051 Vobarray
= Fmake_vector (oblength
, make_number (0));
4052 initial_obarray
= Vobarray
;
4053 staticpro (&initial_obarray
);
4055 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4056 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4058 DEFSYM (Qunbound
, "unbound");
4060 DEFSYM (Qnil
, "nil");
4061 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4062 XSYMBOL (Qnil
)->constant
= 1;
4063 XSYMBOL (Qnil
)->declared_special
= true;
4066 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4067 XSYMBOL (Qt
)->constant
= 1;
4068 XSYMBOL (Qt
)->declared_special
= true;
4070 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4073 DEFSYM (Qvariable_documentation
, "variable-documentation");
4075 read_buffer
= xmalloc (size
);
4076 read_buffer_size
= size
;
4080 defsubr (struct Lisp_Subr
*sname
)
4082 Lisp_Object sym
, tem
;
4083 sym
= intern_c_string (sname
->symbol_name
);
4084 XSETPVECTYPE (sname
, PVEC_SUBR
);
4085 XSETSUBR (tem
, sname
);
4086 set_symbol_function (sym
, tem
);
4089 #ifdef NOTDEF /* Use fset in subr.el now! */
4091 defalias (struct Lisp_Subr
*sname
, char *string
)
4094 sym
= intern (string
);
4095 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4099 /* Define an "integer variable"; a symbol whose value is forwarded to a
4100 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4101 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4103 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4104 const char *namestring
, EMACS_INT
*address
)
4107 sym
= intern_c_string (namestring
);
4108 i_fwd
->type
= Lisp_Fwd_Int
;
4109 i_fwd
->intvar
= address
;
4110 XSYMBOL (sym
)->declared_special
= 1;
4111 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4112 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4115 /* Similar but define a variable whose value is t if address contains 1,
4116 nil if address contains 0. */
4118 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4119 const char *namestring
, bool *address
)
4122 sym
= intern_c_string (namestring
);
4123 b_fwd
->type
= Lisp_Fwd_Bool
;
4124 b_fwd
->boolvar
= address
;
4125 XSYMBOL (sym
)->declared_special
= 1;
4126 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4127 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4128 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4131 /* Similar but define a variable whose value is the Lisp Object stored
4132 at address. Two versions: with and without gc-marking of the C
4133 variable. The nopro version is used when that variable will be
4134 gc-marked for some other reason, since marking the same slot twice
4135 can cause trouble with strings. */
4137 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4138 const char *namestring
, Lisp_Object
*address
)
4141 sym
= intern_c_string (namestring
);
4142 o_fwd
->type
= Lisp_Fwd_Obj
;
4143 o_fwd
->objvar
= address
;
4144 XSYMBOL (sym
)->declared_special
= 1;
4145 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4146 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4150 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4151 const char *namestring
, Lisp_Object
*address
)
4153 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4154 staticpro (address
);
4157 /* Similar but define a variable whose value is the Lisp Object stored
4158 at a particular offset in the current kboard object. */
4161 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4162 const char *namestring
, int offset
)
4165 sym
= intern_c_string (namestring
);
4166 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4167 ko_fwd
->offset
= offset
;
4168 XSYMBOL (sym
)->declared_special
= 1;
4169 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4170 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4173 /* Check that the elements of lpath exist. */
4176 load_path_check (Lisp_Object lpath
)
4178 Lisp_Object path_tail
;
4180 /* The only elements that might not exist are those from
4181 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4183 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4185 Lisp_Object dirfile
;
4186 dirfile
= Fcar (path_tail
);
4187 if (STRINGP (dirfile
))
4189 dirfile
= Fdirectory_file_name (dirfile
);
4190 if (! file_accessible_directory_p (dirfile
))
4191 dir_warning ("Lisp directory", XCAR (path_tail
));
4196 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4197 This does not include the standard site-lisp directories
4198 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4199 but it does (unless no_site_lisp is set) include site-lisp
4200 directories in the source/build directories if those exist and we
4201 are running uninstalled.
4203 Uses the following logic:
4204 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4205 The remainder is what happens when dumping works:
4206 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4207 Otherwise use PATH_LOADSEARCH.
4209 If !initialized, then just return PATH_DUMPLOADSEARCH.
4211 If Vinstallation_directory is not nil (ie, running uninstalled):
4212 If installation-dir/lisp exists and not already a member,
4213 we must be running uninstalled. Reset the load-path
4214 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4215 refers to the eventual installation directories. Since we
4216 are not yet installed, we should not use them, even if they exist.)
4217 If installation-dir/lisp does not exist, just add
4218 PATH_DUMPLOADSEARCH at the end instead.
4219 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4220 and not already a member) at the front.
4221 If installation-dir != source-dir (ie running an uninstalled,
4222 out-of-tree build) AND install-dir/src/Makefile exists BUT
4223 install-dir/src/Makefile.in does NOT exist (this is a sanity
4224 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4227 load_path_default (void)
4229 Lisp_Object lpath
= Qnil
;
4234 const char *loadpath
= ns_load_path ();
4237 normal
= PATH_LOADSEARCH
;
4239 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4241 lpath
= decode_env_path (0, normal
, 0);
4244 #else /* !CANNOT_DUMP */
4246 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4251 const char *loadpath
= ns_load_path ();
4252 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4254 lpath
= decode_env_path (0, normal
, 0);
4256 if (!NILP (Vinstallation_directory
))
4258 Lisp_Object tem
, tem1
;
4260 /* Add to the path the lisp subdir of the installation
4261 dir, if it is accessible. Note: in out-of-tree builds,
4262 this directory is empty save for Makefile. */
4263 tem
= Fexpand_file_name (build_string ("lisp"),
4264 Vinstallation_directory
);
4265 tem1
= Ffile_accessible_directory_p (tem
);
4268 if (NILP (Fmember (tem
, lpath
)))
4270 /* We are running uninstalled. The default load-path
4271 points to the eventual installed lisp directories.
4272 We should not use those now, even if they exist,
4273 so start over from a clean slate. */
4274 lpath
= list1 (tem
);
4278 /* That dir doesn't exist, so add the build-time
4279 Lisp dirs instead. */
4281 Lisp_Object dump_path
=
4282 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4283 lpath
= nconc2 (lpath
, dump_path
);
4286 /* Add site-lisp under the installation dir, if it exists. */
4289 tem
= Fexpand_file_name (build_string ("site-lisp"),
4290 Vinstallation_directory
);
4291 tem1
= Ffile_accessible_directory_p (tem
);
4294 if (NILP (Fmember (tem
, lpath
)))
4295 lpath
= Fcons (tem
, lpath
);
4299 /* If Emacs was not built in the source directory,
4300 and it is run from where it was built, add to load-path
4301 the lisp and site-lisp dirs under that directory. */
4303 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4307 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4308 Vinstallation_directory
);
4309 tem1
= Ffile_exists_p (tem
);
4311 /* Don't be fooled if they moved the entire source tree
4312 AFTER dumping Emacs. If the build directory is indeed
4313 different from the source dir, src/Makefile.in and
4314 src/Makefile will not be found together. */
4315 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4316 Vinstallation_directory
);
4317 tem2
= Ffile_exists_p (tem
);
4318 if (!NILP (tem1
) && NILP (tem2
))
4320 tem
= Fexpand_file_name (build_string ("lisp"),
4323 if (NILP (Fmember (tem
, lpath
)))
4324 lpath
= Fcons (tem
, lpath
);
4328 tem
= Fexpand_file_name (build_string ("site-lisp"),
4330 tem1
= Ffile_accessible_directory_p (tem
);
4333 if (NILP (Fmember (tem
, lpath
)))
4334 lpath
= Fcons (tem
, lpath
);
4338 } /* Vinstallation_directory != Vsource_directory */
4340 } /* if Vinstallation_directory */
4342 else /* !initialized */
4344 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4345 source directory. We used to add ../lisp (ie the lisp dir in
4346 the build directory) at the front here, but that should not
4347 be necessary, since in out of tree builds lisp/ is empty, save
4349 lpath
= decode_env_path (0, normal
, 0);
4351 #endif /* !CANNOT_DUMP */
4359 /* First, set Vload_path. */
4361 /* Ignore EMACSLOADPATH when dumping. */
4363 bool use_loadpath
= true;
4365 bool use_loadpath
= NILP (Vpurify_flag
);
4368 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4370 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4372 /* Check (non-nil) user-supplied elements. */
4373 load_path_check (Vload_path
);
4375 /* If no nils in the environment variable, use as-is.
4376 Otherwise, replace any nils with the default. */
4377 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4379 Lisp_Object elem
, elpath
= Vload_path
;
4380 Lisp_Object default_lpath
= load_path_default ();
4382 /* Check defaults, before adding site-lisp. */
4383 load_path_check (default_lpath
);
4385 /* Add the site-lisp directories to the front of the default. */
4388 Lisp_Object sitelisp
;
4389 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4390 if (! NILP (sitelisp
))
4391 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4396 /* Replace nils from EMACSLOADPATH by default. */
4397 while (CONSP (elpath
))
4399 elem
= XCAR (elpath
);
4400 elpath
= XCDR (elpath
);
4401 Vload_path
= CALLN (Fappend
, Vload_path
,
4402 NILP (elem
) ? default_lpath
: list1 (elem
));
4404 } /* Fmemq (Qnil, Vload_path) */
4408 Vload_path
= load_path_default ();
4410 /* Check before adding site-lisp directories.
4411 The install should have created them, but they are not
4412 required, so no need to warn if they are absent.
4413 Or we might be running before installation. */
4414 load_path_check (Vload_path
);
4416 /* Add the site-lisp directories at the front. */
4417 if (initialized
&& !no_site_lisp
)
4419 Lisp_Object sitelisp
;
4420 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4421 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4427 load_in_progress
= 0;
4428 Vload_file_name
= Qnil
;
4429 Vstandard_input
= Qt
;
4430 Vloads_in_progress
= Qnil
;
4433 /* Print a warning that directory intended for use USE and with name
4434 DIRNAME cannot be accessed. On entry, errno should correspond to
4435 the access failure. Print the warning on stderr and put it in
4439 dir_warning (char const *use
, Lisp_Object dirname
)
4441 static char const format
[] = "Warning: %s `%s': %s\n";
4442 int access_errno
= errno
;
4443 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4445 /* Don't log the warning before we've initialized!! */
4448 char const *diagnostic
= emacs_strerror (access_errno
);
4450 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4451 + strlen (use
) + SBYTES (dirname
)
4452 + strlen (diagnostic
));
4453 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4455 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4461 syms_of_lread (void)
4464 defsubr (&Sread_from_string
);
4466 defsubr (&Sintern_soft
);
4467 defsubr (&Sunintern
);
4468 defsubr (&Sget_load_suffixes
);
4470 defsubr (&Seval_buffer
);
4471 defsubr (&Seval_region
);
4472 defsubr (&Sread_char
);
4473 defsubr (&Sread_char_exclusive
);
4474 defsubr (&Sread_event
);
4475 defsubr (&Sget_file_char
);
4476 defsubr (&Smapatoms
);
4477 defsubr (&Slocate_file_internal
);
4479 DEFVAR_LISP ("obarray", Vobarray
,
4480 doc
: /* Symbol table for use by `intern' and `read'.
4481 It is a vector whose length ought to be prime for best results.
4482 The vector's contents don't make sense if examined from Lisp programs;
4483 to find all the symbols in an obarray, use `mapatoms'. */);
4485 DEFVAR_LISP ("values", Vvalues
,
4486 doc
: /* List of values of all expressions which were read, evaluated and printed.
4487 Order is reverse chronological. */);
4488 XSYMBOL (intern ("values"))->declared_special
= 0;
4490 DEFVAR_LISP ("standard-input", Vstandard_input
,
4491 doc
: /* Stream for read to get input from.
4492 See documentation of `read' for possible values. */);
4493 Vstandard_input
= Qt
;
4495 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4496 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4498 If this variable is a buffer, then only forms read from that buffer
4499 will be added to `read-symbol-positions-list'.
4500 If this variable is t, then all read forms will be added.
4501 The effect of all other values other than nil are not currently
4502 defined, although they may be in the future.
4504 The positions are relative to the last call to `read' or
4505 `read-from-string'. It is probably a bad idea to set this variable at
4506 the toplevel; bind it instead. */);
4507 Vread_with_symbol_positions
= Qnil
;
4509 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4510 doc
: /* A list mapping read symbols to their positions.
4511 This variable is modified during calls to `read' or
4512 `read-from-string', but only when `read-with-symbol-positions' is
4515 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4516 CHAR-POSITION is an integer giving the offset of that occurrence of the
4517 symbol from the position where `read' or `read-from-string' started.
4519 Note that a symbol will appear multiple times in this list, if it was
4520 read multiple times. The list is in the same order as the symbols
4522 Vread_symbol_positions_list
= Qnil
;
4524 DEFVAR_LISP ("read-circle", Vread_circle
,
4525 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4528 DEFVAR_LISP ("load-path", Vload_path
,
4529 doc
: /* List of directories to search for files to load.
4530 Each element is a string (directory name) or nil (meaning `default-directory').
4531 Initialized during startup as described in Info node `(elisp)Library Search'. */);
4533 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4534 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4535 This list should not include the empty string.
4536 `load' and related functions try to append these suffixes, in order,
4537 to the specified file name if a Lisp suffix is allowed or required. */);
4538 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4539 build_pure_c_string (".el"));
4540 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4541 doc
: /* List of suffixes that indicate representations of \
4543 This list should normally start with the empty string.
4545 Enabling Auto Compression mode appends the suffixes in
4546 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4547 mode removes them again. `load' and related functions use this list to
4548 determine whether they should look for compressed versions of a file
4549 and, if so, which suffixes they should try to append to the file name
4550 in order to do so. However, if you want to customize which suffixes
4551 the loading functions recognize as compression suffixes, you should
4552 customize `jka-compr-load-suffixes' rather than the present variable. */);
4553 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4555 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4556 doc
: /* Non-nil if inside of `load'. */);
4557 DEFSYM (Qload_in_progress
, "load-in-progress");
4559 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4560 doc
: /* An alist of functions to be evalled when particular files are loaded.
4561 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4563 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4564 a symbol \(a feature name).
4566 When `load' is run and the file-name argument matches an element's
4567 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4568 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4570 An error in FORMS does not undo the load, but does prevent execution of
4571 the rest of the FORMS. */);
4572 Vafter_load_alist
= Qnil
;
4574 DEFVAR_LISP ("load-history", Vload_history
,
4575 doc
: /* Alist mapping loaded file names to symbols and features.
4576 Each alist element should be a list (FILE-NAME ENTRIES...), where
4577 FILE-NAME is the name of a file that has been loaded into Emacs.
4578 The file name is absolute and true (i.e. it doesn't contain symlinks).
4579 As an exception, one of the alist elements may have FILE-NAME nil,
4580 for symbols and features not associated with any file.
4582 The remaining ENTRIES in the alist element describe the functions and
4583 variables defined in that file, the features provided, and the
4584 features required. Each entry has the form `(provide . FEATURE)',
4585 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4586 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4587 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4588 autoload before this file redefined it as a function. In addition,
4589 entries may also be single symbols, which means that SYMBOL was
4590 defined by `defvar' or `defconst'.
4592 During preloading, the file name recorded is relative to the main Lisp
4593 directory. These file names are converted to absolute at startup. */);
4594 Vload_history
= Qnil
;
4596 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4597 doc
: /* Full name of file being loaded by `load'. */);
4598 Vload_file_name
= Qnil
;
4600 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4601 doc
: /* File name, including directory, of user's initialization file.
4602 If the file loaded had extension `.elc', and the corresponding source file
4603 exists, this variable contains the name of source file, suitable for use
4604 by functions like `custom-save-all' which edit the init file.
4605 While Emacs loads and evaluates the init file, value is the real name
4606 of the file, regardless of whether or not it has the `.elc' extension. */);
4607 Vuser_init_file
= Qnil
;
4609 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4610 doc
: /* Used for internal purposes by `load'. */);
4611 Vcurrent_load_list
= Qnil
;
4613 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4614 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4615 The default is nil, which means use the function `read'. */);
4616 Vload_read_function
= Qnil
;
4618 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4619 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4620 The value should be a function for doing code conversion before
4621 reading a source file. It can also be nil, in which case loading is
4622 done without any code conversion.
4624 If the value is a function, it is called with four arguments,
4625 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4626 the file to load, FILE is the non-absolute name (for messages etc.),
4627 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4628 `load'. The function should return t if the file was loaded. */);
4629 Vload_source_file_function
= Qnil
;
4631 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4632 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4633 This is useful when the file being loaded is a temporary copy. */);
4634 load_force_doc_strings
= 0;
4636 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4637 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4638 This is normally bound by `load' and `eval-buffer' to control `read',
4639 and is not meant for users to change. */);
4640 load_convert_to_unibyte
= 0;
4642 DEFVAR_LISP ("source-directory", Vsource_directory
,
4643 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4644 You cannot count on them to still be there! */);
4646 = Fexpand_file_name (build_string ("../"),
4647 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4649 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4650 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4651 Vpreloaded_file_list
= Qnil
;
4653 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4654 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4655 Vbyte_boolean_vars
= Qnil
;
4657 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4658 doc
: /* Non-nil means load dangerous compiled Lisp files.
4659 Some versions of XEmacs use different byte codes than Emacs. These
4660 incompatible byte codes can make Emacs crash when it tries to execute
4662 load_dangerous_libraries
= 0;
4664 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4665 doc
: /* Non-nil means force printing messages when loading Lisp files.
4666 This overrides the value of the NOMESSAGE argument to `load'. */);
4667 force_load_messages
= 0;
4669 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4670 doc
: /* Regular expression matching safe to load compiled Lisp files.
4671 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4672 from the file, and matches them against this regular expression.
4673 When the regular expression matches, the file is considered to be safe
4674 to load. See also `load-dangerous-libraries'. */);
4675 Vbytecomp_version_regexp
4676 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4678 DEFSYM (Qlexical_binding
, "lexical-binding");
4679 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4680 doc
: /* Whether to use lexical binding when evaluating code.
4681 Non-nil means that the code in the current buffer should be evaluated
4682 with lexical binding.
4683 This variable is automatically set from the file variables of an
4684 interpreted Lisp file read using `load'. Unlike other file local
4685 variables, this must be set in the first line of a file. */);
4686 Vlexical_binding
= Qnil
;
4687 Fmake_variable_buffer_local (Qlexical_binding
);
4689 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4690 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4691 Veval_buffer_list
= Qnil
;
4693 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4694 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4695 Vold_style_backquotes
= Qnil
;
4696 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4698 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4699 doc
: /* Non-nil means `load' prefers the newest version of a file.
4700 This applies when a filename suffix is not explicitly specified and
4701 `load' is trying various possible suffixes (see `load-suffixes' and
4702 `load-file-rep-suffixes'). Normally, it stops at the first file
4703 that exists unless you explicitly specify one or the other. If this
4704 option is non-nil, it checks all suffixes and uses whichever file is
4706 Note that if you customize this, obviously it will not affect files
4707 that are loaded before your customizations are read! */);
4708 load_prefer_newer
= 0;
4710 /* Vsource_directory was initialized in init_lread. */
4712 DEFSYM (Qcurrent_load_list
, "current-load-list");
4713 DEFSYM (Qstandard_input
, "standard-input");
4714 DEFSYM (Qread_char
, "read-char");
4715 DEFSYM (Qget_file_char
, "get-file-char");
4717 /* Used instead of Qget_file_char while loading *.elc files compiled
4718 by Emacs 21 or older. */
4719 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4721 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4723 DEFSYM (Qbackquote
, "`");
4724 DEFSYM (Qcomma
, ",");
4725 DEFSYM (Qcomma_at
, ",@");
4726 DEFSYM (Qcomma_dot
, ",.");
4728 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4729 DEFSYM (Qascii_character
, "ascii-character");
4730 DEFSYM (Qfunction
, "function");
4731 DEFSYM (Qload
, "load");
4732 DEFSYM (Qload_file_name
, "load-file-name");
4733 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4734 DEFSYM (Qfile_truename
, "file-truename");
4735 DEFSYM (Qdir_ok
, "dir-ok");
4736 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4738 staticpro (&read_objects
);
4739 read_objects
= Qnil
;
4740 staticpro (&seen_list
);
4743 Vloads_in_progress
= Qnil
;
4744 staticpro (&Vloads_in_progress
);
4746 DEFSYM (Qhash_table
, "hash-table");
4747 DEFSYM (Qdata
, "data");
4748 DEFSYM (Qtest
, "test");
4749 DEFSYM (Qsize
, "size");
4750 DEFSYM (Qweakness
, "weakness");
4751 DEFSYM (Qrehash_size
, "rehash-size");
4752 DEFSYM (Qrehash_threshold
, "rehash-threshold");