1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2014 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/>. */
24 #include <sys/types.h>
28 #include <limits.h> /* For CHAR_BIT. */
29 #include <stat-time.h>
31 #include "intervals.h"
32 #include "character.h"
40 #include "termhooks.h"
41 #include "blockinput.h"
56 #endif /* HAVE_SETLOCALE */
61 #define file_offset off_t
62 #define file_tell ftello
64 #define file_offset long
65 #define file_tell ftell
70 /* Hash table read constants. */
71 static Lisp_Object Qhash_table
, Qdata
;
72 static Lisp_Object Qtest
, Qsize
;
73 static Lisp_Object Qweakness
;
74 static Lisp_Object Qrehash_size
;
75 static Lisp_Object Qrehash_threshold
;
77 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
78 Lisp_Object Qstandard_input
;
79 Lisp_Object Qvariable_documentation
;
80 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
81 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
82 static Lisp_Object Qinhibit_file_name_operation
;
83 static Lisp_Object Qeval_buffer_list
;
84 Lisp_Object Qlexical_binding
;
85 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
87 /* Used instead of Qget_file_char while loading *.elc files compiled
88 by Emacs 21 or older. */
89 static Lisp_Object Qget_emacs_mule_file_char
;
91 static Lisp_Object Qload_force_doc_strings
;
93 static Lisp_Object Qload_in_progress
;
95 /* The association list of objects read with the #n=object form.
96 Each member of the list has the form (n . object), and is used to
97 look up the object for the corresponding #n# construct.
98 It must be set to nil before all top-level calls to read0. */
99 static Lisp_Object read_objects
;
101 /* File for get_file_char to read from. Use by load. */
102 static FILE *instream
;
104 /* For use within read-from-string (this reader is non-reentrant!!) */
105 static ptrdiff_t read_from_string_index
;
106 static ptrdiff_t read_from_string_index_byte
;
107 static ptrdiff_t read_from_string_limit
;
109 /* Number of characters read in the current call to Fread or
110 Fread_from_string. */
111 static EMACS_INT readchar_count
;
113 /* This contains the last string skipped with #@. */
114 static char *saved_doc_string
;
115 /* Length of buffer allocated in saved_doc_string. */
116 static ptrdiff_t saved_doc_string_size
;
117 /* Length of actual data in saved_doc_string. */
118 static ptrdiff_t saved_doc_string_length
;
119 /* This is the file position that string came from. */
120 static file_offset saved_doc_string_position
;
122 /* This contains the previous string skipped with #@.
123 We copy it from saved_doc_string when a new string
124 is put in saved_doc_string. */
125 static char *prev_saved_doc_string
;
126 /* Length of buffer allocated in prev_saved_doc_string. */
127 static ptrdiff_t prev_saved_doc_string_size
;
128 /* Length of actual data in prev_saved_doc_string. */
129 static ptrdiff_t prev_saved_doc_string_length
;
130 /* This is the file position that string came from. */
131 static file_offset prev_saved_doc_string_position
;
133 /* True means inside a new-style backquote
134 with no surrounding parentheses.
135 Fread initializes this to false, so we need not specbind it
136 or worry about what happens to it when there is an error. */
137 static bool new_backquote_flag
;
138 static Lisp_Object Qold_style_backquotes
;
140 /* A list of file names for files being loaded in Fload. Used to
141 check for recursive loads. */
143 static Lisp_Object Vloads_in_progress
;
145 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
148 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
149 Lisp_Object
, Lisp_Object
,
150 Lisp_Object
, Lisp_Object
, bool);
152 /* Functions that read one byte from the current source READCHARFUN
153 or unreads one byte. If the integer argument C is -1, it returns
154 one read byte, or -1 when there's no more byte in the source. If C
155 is 0 or positive, it unreads C, and the return value is not
158 static int readbyte_for_lambda (int, Lisp_Object
);
159 static int readbyte_from_file (int, Lisp_Object
);
160 static int readbyte_from_string (int, Lisp_Object
);
162 /* Handle unreading and rereading of characters.
163 Write READCHAR to read a character,
164 UNREAD(c) to unread c to be read again.
166 These macros correctly read/unread multibyte characters. */
168 #define READCHAR readchar (readcharfun, NULL)
169 #define UNREAD(c) unreadchar (readcharfun, c)
171 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
172 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
174 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
175 Qlambda, or a cons, we use this to keep an unread character because
176 a file stream can't handle multibyte-char unreading. The value -1
177 means that there's no unread character. */
178 static int unread_char
;
181 readchar (Lisp_Object readcharfun
, bool *multibyte
)
185 int (*readbyte
) (int, Lisp_Object
);
186 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
188 bool emacs_mule_encoding
= 0;
195 if (BUFFERP (readcharfun
))
197 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
199 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
201 if (! BUFFER_LIVE_P (inbuffer
))
204 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
207 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
209 /* Fetch the character code from the buffer. */
210 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
211 BUF_INC_POS (inbuffer
, pt_byte
);
218 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
219 if (! ASCII_CHAR_P (c
))
220 c
= BYTE8_TO_CHAR (c
);
223 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
227 if (MARKERP (readcharfun
))
229 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
231 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
233 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
236 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
238 /* Fetch the character code from the buffer. */
239 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
240 BUF_INC_POS (inbuffer
, bytepos
);
247 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
248 if (! ASCII_CHAR_P (c
))
249 c
= BYTE8_TO_CHAR (c
);
253 XMARKER (readcharfun
)->bytepos
= bytepos
;
254 XMARKER (readcharfun
)->charpos
++;
259 if (EQ (readcharfun
, Qlambda
))
261 readbyte
= readbyte_for_lambda
;
265 if (EQ (readcharfun
, Qget_file_char
))
267 readbyte
= readbyte_from_file
;
271 if (STRINGP (readcharfun
))
273 if (read_from_string_index
>= read_from_string_limit
)
275 else if (STRING_MULTIBYTE (readcharfun
))
279 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
280 read_from_string_index
,
281 read_from_string_index_byte
);
285 c
= SREF (readcharfun
, read_from_string_index_byte
);
286 read_from_string_index
++;
287 read_from_string_index_byte
++;
292 if (CONSP (readcharfun
))
294 /* This is the case that read_vector is reading from a unibyte
295 string that contains a byte sequence previously skipped
296 because of #@NUMBER. The car part of readcharfun is that
297 string, and the cdr part is a value of readcharfun given to
299 readbyte
= readbyte_from_string
;
300 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
301 emacs_mule_encoding
= 1;
305 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
307 readbyte
= readbyte_from_file
;
308 emacs_mule_encoding
= 1;
312 tem
= call0 (readcharfun
);
319 if (unread_char
>= 0)
325 c
= (*readbyte
) (-1, readcharfun
);
330 if (ASCII_CHAR_P (c
))
332 if (emacs_mule_encoding
)
333 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
336 len
= BYTES_BY_CHAR_HEAD (c
);
339 c
= (*readbyte
) (-1, readcharfun
);
340 if (c
< 0 || ! TRAILING_CODE_P (c
))
343 (*readbyte
) (buf
[i
], readcharfun
);
344 return BYTE8_TO_CHAR (buf
[0]);
348 return STRING_CHAR (buf
);
351 #define FROM_FILE_P(readcharfun) \
352 (EQ (readcharfun, Qget_file_char) \
353 || EQ (readcharfun, Qget_emacs_mule_file_char))
356 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
358 if (FROM_FILE_P (readcharfun
))
360 block_input (); /* FIXME: Not sure if it's needed. */
361 fseek (instream
, n
, SEEK_CUR
);
365 { /* We're not reading directly from a file. In that case, it's difficult
366 to reliably count bytes, since these are usually meant for the file's
367 encoding, whereas we're now typically in the internal encoding.
368 But luckily, skip_dyn_bytes is used to skip over a single
369 dynamic-docstring (or dynamic byte-code) which is always quoted such
370 that \037 is the final char. */
374 } while (c
>= 0 && c
!= '\037');
379 skip_dyn_eof (Lisp_Object readcharfun
)
381 if (FROM_FILE_P (readcharfun
))
383 block_input (); /* FIXME: Not sure if it's needed. */
384 fseek (instream
, 0, SEEK_END
);
388 while (READCHAR
>= 0);
391 /* Unread the character C in the way appropriate for the stream READCHARFUN.
392 If the stream is a user function, call it with the char as argument. */
395 unreadchar (Lisp_Object readcharfun
, int c
)
399 /* Don't back up the pointer if we're unreading the end-of-input mark,
400 since readchar didn't advance it when we read it. */
402 else if (BUFFERP (readcharfun
))
404 struct buffer
*b
= XBUFFER (readcharfun
);
405 ptrdiff_t charpos
= BUF_PT (b
);
406 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
408 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
409 BUF_DEC_POS (b
, bytepos
);
413 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
415 else if (MARKERP (readcharfun
))
417 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
418 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
420 XMARKER (readcharfun
)->charpos
--;
421 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
422 BUF_DEC_POS (b
, bytepos
);
426 XMARKER (readcharfun
)->bytepos
= bytepos
;
428 else if (STRINGP (readcharfun
))
430 read_from_string_index
--;
431 read_from_string_index_byte
432 = string_char_to_byte (readcharfun
, read_from_string_index
);
434 else if (CONSP (readcharfun
))
438 else if (EQ (readcharfun
, Qlambda
))
442 else if (FROM_FILE_P (readcharfun
))
447 call1 (readcharfun
, make_number (c
));
451 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
453 return read_bytecode_char (c
>= 0);
458 readbyte_from_file (int c
, Lisp_Object readcharfun
)
463 ungetc (c
, instream
);
471 /* Interrupted reads have been observed while reading over the network. */
472 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
483 return (c
== EOF
? -1 : c
);
487 readbyte_from_string (int c
, Lisp_Object readcharfun
)
489 Lisp_Object string
= XCAR (readcharfun
);
493 read_from_string_index
--;
494 read_from_string_index_byte
495 = string_char_to_byte (string
, read_from_string_index
);
498 if (read_from_string_index
>= read_from_string_limit
)
501 FETCH_STRING_CHAR_ADVANCE (c
, string
,
502 read_from_string_index
,
503 read_from_string_index_byte
);
508 /* Read one non-ASCII character from INSTREAM. The character is
509 encoded in `emacs-mule' and the first byte is already read in
513 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
515 /* Emacs-mule coding uses at most 4-byte for one character. */
516 unsigned char buf
[4];
517 int len
= emacs_mule_bytes
[c
];
518 struct charset
*charset
;
523 /* C is not a valid leading-code of `emacs-mule'. */
524 return BYTE8_TO_CHAR (c
);
530 c
= (*readbyte
) (-1, readcharfun
);
534 (*readbyte
) (buf
[i
], readcharfun
);
535 return BYTE8_TO_CHAR (buf
[0]);
542 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
543 code
= buf
[1] & 0x7F;
547 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
548 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
550 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
551 code
= buf
[2] & 0x7F;
555 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
556 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
561 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
562 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
564 c
= DECODE_CHAR (charset
, code
);
566 Fsignal (Qinvalid_read_syntax
,
567 list1 (build_string ("invalid multibyte form")));
572 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
574 static Lisp_Object
read0 (Lisp_Object
);
575 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
577 static Lisp_Object
read_list (bool, Lisp_Object
);
578 static Lisp_Object
read_vector (Lisp_Object
, bool);
580 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
582 static void substitute_object_in_subtree (Lisp_Object
,
584 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
587 /* Get a character from the tty. */
589 /* Read input events until we get one that's acceptable for our purposes.
591 If NO_SWITCH_FRAME, switch-frame events are stashed
592 until we get a character we like, and then stuffed into
595 If ASCII_REQUIRED, check function key events to see
596 if the unmodified version of the symbol has a Qascii_character
597 property, and use that character, if present.
599 If ERROR_NONASCII, signal an error if the input we
600 get isn't an ASCII character with modifiers. If it's false but
601 ASCII_REQUIRED is true, just re-read until we get an ASCII
604 If INPUT_METHOD, invoke the current input method
605 if the character warrants that.
607 If SECONDS is a number, wait that many seconds for input, and
608 return Qnil if no input arrives within that time. */
611 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
612 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
614 Lisp_Object val
, delayed_switch_frame
;
615 struct timespec end_time
;
617 #ifdef HAVE_WINDOW_SYSTEM
618 if (display_hourglass_p
)
622 delayed_switch_frame
= Qnil
;
624 /* Compute timeout. */
625 if (NUMBERP (seconds
))
627 double duration
= extract_float (seconds
);
628 struct timespec wait_time
= dtotimespec (duration
);
629 end_time
= timespec_add (current_timespec (), wait_time
);
632 /* Read until we get an acceptable event. */
635 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
636 NUMBERP (seconds
) ? &end_time
: NULL
);
637 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
642 /* `switch-frame' events are put off until after the next ASCII
643 character. This is better than signaling an error just because
644 the last characters were typed to a separate minibuffer frame,
645 for example. Eventually, some code which can deal with
646 switch-frame events will read it and process it. */
648 && EVENT_HAS_PARAMETERS (val
)
649 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
651 delayed_switch_frame
= val
;
655 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
657 /* Convert certain symbols to their ASCII equivalents. */
660 Lisp_Object tem
, tem1
;
661 tem
= Fget (val
, Qevent_symbol_element_mask
);
664 tem1
= Fget (Fcar (tem
), Qascii_character
);
665 /* Merge this symbol's modifier bits
666 with the ASCII equivalent of its basic code. */
668 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
672 /* If we don't have a character now, deal with it appropriately. */
677 Vunread_command_events
= list1 (val
);
678 error ("Non-character input-event");
685 if (! NILP (delayed_switch_frame
))
686 unread_switch_frame
= delayed_switch_frame
;
690 #ifdef HAVE_WINDOW_SYSTEM
691 if (display_hourglass_p
)
700 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
701 doc
: /* Read a character from the command input (keyboard or macro).
702 It is returned as a number.
703 If the character has modifiers, they are resolved and reflected to the
704 character code if possible (e.g. C-SPC -> 0).
706 If the user generates an event which is not a character (i.e. a mouse
707 click or function key event), `read-char' signals an error. As an
708 exception, switch-frame events are put off until non-character events
710 If you want to read non-character events, or ignore them, call
711 `read-event' or `read-char-exclusive' instead.
713 If the optional argument PROMPT is non-nil, display that as a prompt.
714 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
715 input method is turned on in the current buffer, that input method
716 is used for reading a character.
717 If the optional argument SECONDS is non-nil, it should be a number
718 specifying the maximum number of seconds to wait for input. If no
719 input arrives in that time, return nil. SECONDS may be a
720 floating-point value. */)
721 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
726 message_with_string ("%s", prompt
, 0);
727 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
729 return (NILP (val
) ? Qnil
730 : make_number (char_resolve_modifier_mask (XINT (val
))));
733 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
734 doc
: /* Read an event object from the input stream.
735 If the optional argument PROMPT is non-nil, display that as a prompt.
736 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
737 input method is turned on in the current buffer, that input method
738 is used for reading a character.
739 If the optional argument SECONDS is non-nil, it should be a number
740 specifying the maximum number of seconds to wait for input. If no
741 input arrives in that time, return nil. SECONDS may be a
742 floating-point value. */)
743 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
746 message_with_string ("%s", prompt
, 0);
747 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
750 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
751 doc
: /* Read a character from the command input (keyboard or macro).
752 It is returned as a number. Non-character events are ignored.
753 If the character has modifiers, they are resolved and reflected to the
754 character code if possible (e.g. C-SPC -> 0).
756 If the optional argument PROMPT is non-nil, display that as a prompt.
757 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
758 input method is turned on in the current buffer, that input method
759 is used for reading a character.
760 If the optional argument SECONDS is non-nil, it should be a number
761 specifying the maximum number of seconds to wait for input. If no
762 input arrives in that time, return nil. SECONDS may be a
763 floating-point value. */)
764 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
769 message_with_string ("%s", prompt
, 0);
771 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
773 return (NILP (val
) ? Qnil
774 : make_number (char_resolve_modifier_mask (XINT (val
))));
777 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
778 doc
: /* Don't use this yourself. */)
781 register Lisp_Object val
;
783 XSETINT (val
, getc (instream
));
791 /* Return true if the lisp code read using READCHARFUN defines a non-nil
792 `lexical-binding' file variable. After returning, the stream is
793 positioned following the first line, if it is a comment or #! line,
794 otherwise nothing is read. */
797 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
810 while (ch
!= '\n' && ch
!= EOF
)
812 if (ch
== '\n') ch
= READCHAR
;
813 /* It is OK to leave the position after a #! line, since
814 that is what read1 does. */
818 /* The first line isn't a comment, just give up. */
824 /* Look for an appropriate file-variable in the first line. */
828 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
829 } beg_end_state
= NOMINAL
;
830 bool in_file_vars
= 0;
832 #define UPDATE_BEG_END_STATE(ch) \
833 if (beg_end_state == NOMINAL) \
834 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
835 else if (beg_end_state == AFTER_FIRST_DASH) \
836 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
837 else if (beg_end_state == AFTER_ASTERIX) \
840 in_file_vars = !in_file_vars; \
841 beg_end_state = NOMINAL; \
844 /* Skip until we get to the file vars, if any. */
848 UPDATE_BEG_END_STATE (ch
);
850 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
854 char var
[100], val
[100];
859 /* Read a variable name. */
860 while (ch
== ' ' || ch
== '\t')
864 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
866 if (i
< sizeof var
- 1)
868 UPDATE_BEG_END_STATE (ch
);
872 /* Stop scanning if no colon was found before end marker. */
873 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
876 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
882 /* Read a variable value. */
885 while (ch
== ' ' || ch
== '\t')
889 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
891 if (i
< sizeof val
- 1)
893 UPDATE_BEG_END_STATE (ch
);
897 /* The value was terminated by an end-marker, which remove. */
899 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
903 if (strcmp (var
, "lexical-binding") == 0)
906 rv
= (strcmp (val
, "nil") != 0);
912 while (ch
!= '\n' && ch
!= EOF
)
919 /* Value is a version number of byte compiled code if the file
920 associated with file descriptor FD is a compiled Lisp file that's
921 safe to load. Only files compiled with Emacs are safe to load.
922 Files compiled with XEmacs can lead to a crash in Fbyte_code
923 because of an incompatible change in the byte compiler. */
926 safe_to_load_version (int fd
)
932 /* Read the first few bytes from the file, and look for a line
933 specifying the byte compiler version used. */
934 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
937 /* Skip to the next newline, skipping over the initial `ELC'
938 with NUL bytes following it, but note the version. */
939 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
944 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
945 buf
+ i
, nbytes
- i
) < 0)
949 lseek (fd
, 0, SEEK_SET
);
954 /* Callback for record_unwind_protect. Restore the old load list OLD,
955 after loading a file successfully. */
958 record_load_unwind (Lisp_Object old
)
960 Vloads_in_progress
= old
;
963 /* This handler function is used via internal_condition_case_1. */
966 load_error_handler (Lisp_Object data
)
972 load_warn_old_style_backquotes (Lisp_Object file
)
974 if (!NILP (Vold_style_backquotes
))
977 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
983 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
984 doc
: /* Return the suffixes that `load' should try if a suffix is \
986 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
989 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
990 while (CONSP (suffixes
))
992 Lisp_Object exts
= Vload_file_rep_suffixes
;
993 suffix
= XCAR (suffixes
);
994 suffixes
= XCDR (suffixes
);
999 lst
= Fcons (concat2 (suffix
, ext
), lst
);
1002 return Fnreverse (lst
);
1005 DEFUN ("load", Fload
, Sload
, 1, 6, 0,
1006 doc
: /* Execute a file of Lisp code named FILE.
1007 First try FILE with `.elc' appended, then try with `.el',
1008 then try FILE unmodified (the exact suffixes in the exact order are
1009 determined by `load-suffixes'). Environment variable references in
1010 FILE are replaced with their values by calling `substitute-in-file-name'.
1011 This function searches the directories in `load-path'.
1013 If optional second arg NOERROR is non-nil,
1014 report no error if FILE doesn't exist.
1015 Print messages at start and end of loading unless
1016 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1018 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1019 suffixes `.elc' or `.el' to the specified name FILE.
1020 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1021 the suffix `.elc' or `.el'; don't accept just FILE unless
1022 it ends in one of those suffixes or includes a directory name.
1024 If NOSUFFIX is nil, then if a file could not be found, try looking for
1025 a different representation of the file by adding non-empty suffixes to
1026 its name, before trying another file. Emacs uses this feature to find
1027 compressed versions of files when Auto Compression mode is enabled.
1028 If NOSUFFIX is non-nil, disable this feature.
1030 The suffixes that this function tries out, when NOSUFFIX is nil, are
1031 given by the return value of `get-load-suffixes' and the values listed
1032 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1033 return value of `get-load-suffixes' is used, i.e. the file name is
1034 required to have a non-empty suffix.
1036 When searching suffixes, this function normally stops at the first
1037 one that exists. If the option `load-prefer-newer' is non-nil,
1038 however, it tries all suffixes, and uses whichever file is the newest.
1040 Loading a file records its definitions, and its `provide' and
1041 `require' calls, in an element of `load-history' whose
1042 car is the file name loaded. See `load-history'.
1044 While the file is in the process of being loaded, the variable
1045 `load-in-progress' is non-nil and the variable `load-file-name'
1046 is bound to the file's name.
1048 Return t if the file exists and loads successfully. */)
1049 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1050 Lisp_Object nosuffix
, Lisp_Object must_suffix
, Lisp_Object recursive
)
1052 FILE *stream
= NULL
;
1055 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1056 Lisp_Object found
, efound
, hist_file_name
;
1057 /* True means we printed the ".el is newer" message. */
1059 /* True means we are loading a compiled file. */
1061 Lisp_Object handler
;
1063 const char *fmode
= "r";
1070 CHECK_STRING (file
);
1072 /* If file name is magic, call the handler. */
1073 /* This shouldn't be necessary any more now that `openp' handles it right.
1074 handler = Ffind_file_name_handler (file, Qload);
1075 if (!NILP (handler))
1076 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1078 /* Do this after the handler to avoid
1079 the need to gcpro noerror, nomessage and nosuffix.
1080 (Below here, we care only whether they are nil or not.)
1081 The presence of this call is the result of a historical accident:
1082 it used to be in every file-operation and when it got removed
1083 everywhere, it accidentally stayed here. Since then, enough people
1084 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1085 that it seemed risky to remove. */
1086 if (! NILP (noerror
))
1088 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1089 Qt
, load_error_handler
);
1096 file
= Fsubstitute_in_file_name (file
);
1098 /* Avoid weird lossage with null string as arg,
1099 since it would try to load a directory as a Lisp file. */
1100 if (SCHARS (file
) == 0)
1107 Lisp_Object suffixes
;
1109 GCPRO2 (file
, found
);
1111 if (! NILP (must_suffix
))
1113 /* Don't insist on adding a suffix if FILE already ends with one. */
1114 ptrdiff_t size
= SBYTES (file
);
1116 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1119 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1121 /* Don't insist on adding a suffix
1122 if the argument includes a directory name. */
1123 else if (! NILP (Ffile_name_directory (file
)))
1127 if (!NILP (nosuffix
))
1131 suffixes
= Fget_load_suffixes ();
1132 if (NILP (must_suffix
))
1136 arg
[1] = Vload_file_rep_suffixes
;
1137 suffixes
= Fappend (2, arg
);
1141 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1148 report_file_error ("Cannot open load file", file
);
1153 /* Tell startup.el whether or not we found the user's init file. */
1154 if (EQ (Qt
, Vuser_init_file
))
1155 Vuser_init_file
= found
;
1157 /* If FD is -2, that means openp found a magic file. */
1160 if (NILP (Fequal (found
, file
)))
1161 /* If FOUND is a different file name from FILE,
1162 find its handler even if we have already inhibited
1163 the `load' operation on FILE. */
1164 handler
= Ffind_file_name_handler (found
, Qt
);
1166 handler
= Ffind_file_name_handler (found
, Qload
);
1167 if (! NILP (handler
)) {
1169 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1172 /* Tramp has to deal with semi-broken packages that prepend
1173 drive letters to remote files. For that reason, Tramp
1174 catches file operations that test for file existence, which
1175 makes openp think X:/foo.elc files are remote. However,
1176 Tramp does not catch `load' operations for such files, so we
1177 end up with a nil as the `load' handler above. If we would
1178 continue with fd = -2, we will behave wrongly, and in
1179 particular try reading a .elc file in the "rt" mode instead
1180 of "rb". See bug #9311 for the results. To work around
1181 this, we try to open the file locally, and go with that if it
1183 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1191 record_unwind_protect_ptr (close_file_ptr_unwind
, &fd
);
1192 record_unwind_protect_ptr (fclose_ptr_unwind
, &stream
);
1195 /* Check if we're stuck in a recursive load cycle.
1197 2000-09-21: It's not possible to just check for the file loaded
1198 being a member of Vloads_in_progress. This fails because of the
1199 way the byte compiler currently works; `provide's are not
1200 evaluated, see font-lock.el/jit-lock.el as an example. This
1201 leads to a certain amount of ``normal'' recursion.
1203 Also, just loading a file recursively is not always an error in
1204 the general case; the second load may do something different. */
1208 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1209 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1210 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1211 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1212 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1215 /* All loads are by default dynamic, unless the file itself specifies
1216 otherwise using a file-variable in the first line. This is bound here
1217 so that it takes effect whether or not we use
1218 Vload_source_file_function. */
1219 specbind (Qlexical_binding
, Qnil
);
1221 /* Get the name for load-history. */
1222 hist_file_name
= (! NILP (Vpurify_flag
)
1223 ? concat2 (Ffile_name_directory (file
),
1224 Ffile_name_nondirectory (found
))
1229 /* Check for the presence of old-style quotes and warn about them. */
1230 specbind (Qold_style_backquotes
, Qnil
);
1231 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1233 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1234 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1235 /* Load .elc files directly, but not when they are
1236 remote and have no handler! */
1243 GCPRO3 (file
, found
, hist_file_name
);
1246 && ! (version
= safe_to_load_version (fd
)))
1249 if (!load_dangerous_libraries
)
1250 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1251 else if (!NILP (nomessage
) && !force_load_messages
)
1252 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1257 efound
= ENCODE_FILE (found
);
1263 /* openp already checked for newness, no point doing it again.
1264 FIXME would be nice to get a message when openp
1265 ignores suffix order due to load_prefer_newer. */
1266 if (!load_prefer_newer
)
1268 result
= stat (SSDATA (efound
), &s1
);
1271 SSET (efound
, SBYTES (efound
) - 1, 0);
1272 result
= stat (SSDATA (efound
), &s2
);
1273 SSET (efound
, SBYTES (efound
) - 1, 'c');
1277 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1279 /* Make the progress messages mention that source is newer. */
1282 /* If we won't print another message, mention this anyway. */
1283 if (!NILP (nomessage
) && !force_load_messages
)
1285 Lisp_Object msg_file
;
1286 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1287 message_with_string ("Source file `%s' newer than byte-compiled file",
1291 } /* !load_prefer_newer */
1297 /* We are loading a source file (*.el). */
1298 if (!NILP (Vload_source_file_function
))
1307 val
= call5 (Vload_source_file_function
, found
, hist_file_name
,
1308 NILP (noerror
) ? Qnil
: Qt
,
1309 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
,
1310 !NILP (recursive
) ? Qnil
: Qt
);
1316 GCPRO3 (file
, found
, hist_file_name
);
1320 /* We somehow got here with fd == -2, meaning the file is deemed
1321 to be remote. Don't even try to reopen the file locally;
1322 just force a failure. */
1331 efound
= ENCODE_FILE (found
);
1332 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1334 stream
= fdopen (fd
, fmode
);
1338 report_file_error ("Opening stdio stream", file
);
1340 if (! NILP (Vpurify_flag
))
1341 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1343 if (NILP (nomessage
) || force_load_messages
)
1346 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1349 message_with_string ("Loading %s (source)...", file
, 1);
1351 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1353 else /* The typical case; compiled file newer than source file. */
1354 message_with_string ("Loading %s...", file
, 1);
1357 specbind (Qload_file_name
, found
);
1358 specbind (Qinhibit_file_name_operation
, Qnil
);
1359 specbind (Qload_in_progress
, Qt
);
1362 if (lisp_file_lexically_bound_p (Qget_file_char
))
1363 Fset (Qlexical_binding
, Qt
);
1365 if (! version
|| version
>= 22)
1366 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1367 0, Qnil
, Qnil
, Qnil
, Qnil
, NILP (recursive
));
1370 /* We can't handle a file which was compiled with
1371 byte-compile-dynamic by older version of Emacs. */
1372 specbind (Qload_force_doc_strings
, Qt
);
1373 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1374 0, Qnil
, Qnil
, Qnil
, Qnil
, NILP (recursive
));
1378 /* Run any eval-after-load forms for this file. */
1379 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1380 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1384 xfree (saved_doc_string
);
1385 saved_doc_string
= 0;
1386 saved_doc_string_size
= 0;
1388 xfree (prev_saved_doc_string
);
1389 prev_saved_doc_string
= 0;
1390 prev_saved_doc_string_size
= 0;
1392 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1395 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1398 message_with_string ("Loading %s (source)...done", file
, 1);
1400 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1402 else /* The typical case; compiled file newer than source file. */
1403 message_with_string ("Loading %s...done", file
, 1);
1410 complete_filename_p (Lisp_Object pathname
)
1412 const unsigned char *s
= SDATA (pathname
);
1413 return (IS_DIRECTORY_SEP (s
[0])
1414 || (SCHARS (pathname
) > 2
1415 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1418 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1419 doc
: /* Search for FILENAME through PATH.
1420 Returns the file's name in absolute form, or nil if not found.
1421 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1422 file name when searching.
1423 If non-nil, PREDICATE is used instead of `file-readable-p'.
1424 PREDICATE can also be an integer to pass to the faccessat(2) function,
1425 in which case file-name-handlers are ignored.
1426 This function will normally skip directories, so if you want it to find
1427 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1428 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1431 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1432 if (NILP (predicate
) && fd
>= 0)
1437 static Lisp_Object Qdir_ok
;
1439 /* Search for a file whose name is STR, looking in directories
1440 in the Lisp list PATH, and trying suffixes from SUFFIX.
1441 On success, return a file descriptor (or 1 or -2 as described below).
1442 On failure, return -1 and set errno.
1444 SUFFIXES is a list of strings containing possible suffixes.
1445 The empty suffix is automatically added if the list is empty.
1447 PREDICATE non-nil means don't open the files,
1448 just look for one that satisfies the predicate. In this case,
1449 return 1 on success. The predicate can be a lisp function or
1450 an integer to pass to `access' (in which case file-name-handlers
1453 If STOREPTR is nonzero, it points to a slot where the name of
1454 the file actually found should be stored as a Lisp string.
1455 nil is stored there on failure.
1457 If the file we find is remote, return -2
1458 but store the found remote file name in *STOREPTR.
1460 If NEWER is true, try all SUFFIXes and return the result for the
1461 newest file that exists. Does not apply to remote files,
1462 or if PREDICATE is specified. */
1465 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1466 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1468 ptrdiff_t fn_size
= 100;
1472 ptrdiff_t want_length
;
1473 Lisp_Object filename
;
1474 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
, gcpro7
;
1475 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1476 ptrdiff_t max_suffix_len
= 0;
1477 int last_errno
= ENOENT
;
1480 /* The last-modified time of the newest matching file found.
1481 Initialize it to something less than all valid timestamps. */
1482 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1486 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1488 CHECK_STRING_CAR (tail
);
1489 max_suffix_len
= max (max_suffix_len
,
1490 SBYTES (XCAR (tail
)));
1493 string
= filename
= encoded_fn
= save_string
= Qnil
;
1494 GCPRO7 (str
, string
, save_string
, filename
, path
, suffixes
, encoded_fn
);
1499 absolute
= complete_filename_p (str
);
1501 for (; CONSP (path
); path
= XCDR (path
))
1503 filename
= Fexpand_file_name (str
, XCAR (path
));
1504 if (!complete_filename_p (filename
))
1505 /* If there are non-absolute elts in PATH (eg "."). */
1506 /* Of course, this could conceivably lose if luser sets
1507 default-directory to be something non-absolute... */
1509 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1510 if (!complete_filename_p (filename
))
1511 /* Give up on this path element! */
1515 /* Calculate maximum length of any filename made from
1516 this path element/specified file name and any possible suffix. */
1517 want_length
= max_suffix_len
+ SBYTES (filename
);
1518 if (fn_size
<= want_length
)
1519 fn
= alloca (fn_size
= 100 + want_length
);
1521 /* Loop over suffixes. */
1522 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1523 CONSP (tail
); tail
= XCDR (tail
))
1525 Lisp_Object suffix
= XCAR (tail
);
1526 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1527 Lisp_Object handler
;
1529 /* Concatenate path element/specified name with the suffix.
1530 If the directory starts with /:, remove that. */
1531 int prefixlen
= ((SCHARS (filename
) > 2
1532 && SREF (filename
, 0) == '/'
1533 && SREF (filename
, 1) == ':')
1535 fnlen
= SBYTES (filename
) - prefixlen
;
1536 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1537 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1539 /* Check that the file exists and is not a directory. */
1540 /* We used to only check for handlers on non-absolute file names:
1544 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1545 It's not clear why that was the case and it breaks things like
1546 (load "/bar.el") where the file is actually "/bar.el.gz". */
1547 /* make_string has its own ideas on when to return a unibyte
1548 string and when a multibyte string, but we know better.
1549 We must have a unibyte string when dumping, since
1550 file-name encoding is shaky at best at that time, and in
1551 particular default-file-name-coding-system is reset
1552 several times during loadup. We therefore don't want to
1553 encode the file before passing it to file I/O library
1555 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1556 string
= make_unibyte_string (fn
, fnlen
);
1558 string
= make_string (fn
, fnlen
);
1559 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1560 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1563 if (NILP (predicate
))
1564 exists
= !NILP (Ffile_readable_p (string
));
1567 Lisp_Object tmp
= call1 (predicate
, string
);
1570 else if (EQ (tmp
, Qdir_ok
)
1571 || NILP (Ffile_directory_p (string
)))
1576 last_errno
= EISDIR
;
1582 /* We succeeded; return this descriptor and filename. */
1595 encoded_fn
= ENCODE_FILE (string
);
1596 pfn
= SSDATA (encoded_fn
);
1598 /* Check that we can access or open it. */
1599 if (NATNUMP (predicate
))
1602 if (INT_MAX
< XFASTINT (predicate
))
1603 last_errno
= EINVAL
;
1604 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1608 if (file_directory_p (pfn
))
1609 last_errno
= EISDIR
;
1616 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1619 if (errno
!= ENOENT
)
1624 int err
= (fstat (fd
, &st
) != 0 ? errno
1625 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1637 if (newer
&& !NATNUMP (predicate
))
1639 struct timespec mtime
= get_stat_mtime (&st
);
1641 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1646 emacs_close (save_fd
);
1649 save_string
= string
;
1654 /* We succeeded; return this descriptor and filename. */
1662 /* No more suffixes. Return the newest. */
1663 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1666 *storeptr
= save_string
;
1682 /* Merge the list we've accumulated of globals from the current input source
1683 into the load_history variable. The details depend on whether
1684 the source has an associated file name or not.
1686 FILENAME is the file name that we are loading from.
1688 ENTIRE is true if loading that entire file, false if evaluating
1692 build_load_history (Lisp_Object filename
, bool entire
)
1694 Lisp_Object tail
, prev
, newelt
;
1695 Lisp_Object tem
, tem2
;
1698 tail
= Vload_history
;
1701 while (CONSP (tail
))
1705 /* Find the feature's previous assoc list... */
1706 if (!NILP (Fequal (filename
, Fcar (tem
))))
1710 /* If we're loading the entire file, remove old data. */
1714 Vload_history
= XCDR (tail
);
1716 Fsetcdr (prev
, XCDR (tail
));
1719 /* Otherwise, cons on new symbols that are not already members. */
1722 tem2
= Vcurrent_load_list
;
1724 while (CONSP (tem2
))
1726 newelt
= XCAR (tem2
);
1728 if (NILP (Fmember (newelt
, tem
)))
1729 Fsetcar (tail
, Fcons (XCAR (tem
),
1730 Fcons (newelt
, XCDR (tem
))));
1743 /* If we're loading an entire file, cons the new assoc onto the
1744 front of load-history, the most-recently-loaded position. Also
1745 do this if we didn't find an existing member for the file. */
1746 if (entire
|| !foundit
)
1747 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1752 readevalloop_1 (int old
)
1754 load_convert_to_unibyte
= old
;
1757 /* Signal an `end-of-file' error, if possible with file name
1760 static _Noreturn
void
1761 end_of_file_error (void)
1763 if (STRINGP (Vload_file_name
))
1764 xsignal1 (Qend_of_file
, Vload_file_name
);
1766 xsignal0 (Qend_of_file
);
1770 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1772 /* If we macroexpand the toplevel form non-recursively and it ends
1773 up being a `progn' (or if it was a progn to start), treat each
1774 form in the progn as a top-level form. This way, if one form in
1775 the progn defines a macro, that macro is in effect when we expand
1776 the remaining forms. See similar code in bytecomp.el. */
1777 val
= call2 (macroexpand
, val
, Qnil
);
1778 if (EQ (CAR_SAFE (val
), Qprogn
))
1780 Lisp_Object subforms
= XCDR (val
);
1782 for (; CONSP (subforms
); subforms
= XCDR (subforms
))
1783 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1787 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1792 /* UNIBYTE specifies how to set load_convert_to_unibyte
1793 for this invocation.
1794 READFUN, if non-nil, is used instead of `read'.
1796 START, END specify region to read in current buffer (from eval-region).
1797 If the input is not from a buffer, they must be nil. */
1800 readevalloop (Lisp_Object readcharfun
,
1802 Lisp_Object sourcename
,
1804 Lisp_Object unibyte
, Lisp_Object readfun
,
1805 Lisp_Object start
, Lisp_Object end
,
1809 register Lisp_Object val
;
1811 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1812 struct buffer
*b
= 0;
1813 bool continue_reading_p
;
1814 Lisp_Object lex_bound
;
1815 /* True if reading an entire buffer. */
1816 bool whole_buffer
= 0;
1817 /* True on the first time around. */
1818 bool first_sexp
= 1;
1819 Lisp_Object form
= Fcons (Qprogn
, Qnil
);
1820 Lisp_Object tail
= form
;
1821 static Lisp_Object compile_fn
;
1823 /* Automatic whole-file compilation temporarily disabled */
1824 /* if (!NILP (Vload_compat)) */
1827 if (SCM_UNLIKELY (! compile_fn
))
1828 compile_fn
= scm_c_public_ref ("language elisp runtime", "compile-elisp");
1830 if (MARKERP (readcharfun
))
1833 start
= readcharfun
;
1836 if (BUFFERP (readcharfun
))
1837 b
= XBUFFER (readcharfun
);
1838 else if (MARKERP (readcharfun
))
1839 b
= XMARKER (readcharfun
)->buffer
;
1841 /* We assume START is nil when input is not from a buffer. */
1842 if (! NILP (start
) && !b
)
1845 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1846 specbind (Qcurrent_load_list
, Qnil
);
1847 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1848 load_convert_to_unibyte
= !NILP (unibyte
);
1850 /* If lexical binding is active (either because it was specified in
1851 the file's header, or via a buffer-local variable), create an empty
1852 lexical environment, otherwise, turn off lexical binding. */
1853 lex_bound
= find_symbol_value (Qlexical_binding
);
1854 specbind (Qinternal_interpreter_environment
,
1855 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1856 ? Qnil
: list1 (Qt
)));
1858 GCPRO4 (sourcename
, readfun
, start
, end
);
1860 /* Try to ensure sourcename is a truename, except whilst preloading. */
1861 if (NILP (Vpurify_flag
)
1862 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1863 && !NILP (Ffboundp (Qfile_truename
)))
1864 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1866 LOADHIST_ATTACH (sourcename
);
1868 continue_reading_p
= 1;
1869 while (continue_reading_p
)
1873 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1874 error ("Reading from killed buffer");
1878 /* Switch to the buffer we are reading from. */
1879 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1880 set_buffer_internal (b
);
1882 /* Save point in it. */
1883 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1884 /* Save ZV in it. */
1885 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1886 /* Those get unbound after we read one expression. */
1888 /* Set point and ZV around stuff to be read. */
1891 Fnarrow_to_region (make_number (BEGV
), end
);
1893 /* Just for cleanliness, convert END to a marker
1894 if it is an integer. */
1896 end
= Fpoint_max_marker ();
1899 /* On the first cycle, we can easily test here
1900 whether we are reading the whole buffer. */
1901 if (b
&& first_sexp
)
1902 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1909 while ((c
= READCHAR
) != '\n' && c
!= -1);
1918 /* Ignore whitespace here, so we can detect eof. */
1919 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1920 || c
== 0xa0) /* NBSP */
1923 if (!NILP (Vpurify_flag
) && c
== '(')
1925 val
= read_list (0, readcharfun
);
1930 read_objects
= Qnil
;
1931 if (!NILP (readfun
))
1933 val
= call1 (readfun
, readcharfun
);
1935 /* If READCHARFUN has set point to ZV, we should
1936 stop reading, even if the form read sets point
1937 to a different value when evaluated. */
1938 if (BUFFERP (readcharfun
))
1940 struct buffer
*buf
= XBUFFER (readcharfun
);
1941 if (BUF_PT (buf
) == BUF_ZV (buf
))
1942 continue_reading_p
= 0;
1945 else if (! NILP (Vload_read_function
))
1946 val
= call1 (Vload_read_function
, readcharfun
);
1948 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1951 if (!NILP (start
) && continue_reading_p
)
1952 start
= Fpoint_marker ();
1954 /* Restore saved point and BEGV. */
1959 val
= eval_sub (val
);
1962 Vvalues
= Fcons (val
, Vvalues
);
1967 tail
= Fsetcdr (tail
, Fcons (val
, Qnil
));
1974 val
= scm_call_1 (compile_fn
, form
);
1976 if (SCM_UNLIKELY (printflag
))
1978 Vvalues
= Fcons (val
, Vvalues
);
1983 build_load_history (sourcename
,
1984 stream
|| whole_buffer
);
1991 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 6, "",
1992 doc
: /* Execute the current buffer as Lisp code.
1993 When called from a Lisp program (i.e., not interactively), this
1994 function accepts up to five optional arguments:
1995 BUFFER is the buffer to evaluate (nil means use current buffer).
1996 PRINTFLAG controls printing of output:
1997 A value of nil means discard it; anything else is stream for print.
1998 FILENAME specifies the file name to use for `load-history'.
1999 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
2001 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
2002 functions should work normally even if PRINTFLAG is nil.
2004 This function preserves the position of point. */)
2005 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
,
2006 Lisp_Object unibyte
, Lisp_Object do_allow_print
, Lisp_Object batch
)
2009 Lisp_Object tem
, buf
;
2012 buf
= Fcurrent_buffer ();
2014 buf
= Fget_buffer (buffer
);
2016 error ("No such buffer");
2018 if (NILP (printflag
) && NILP (do_allow_print
))
2023 if (NILP (filename
))
2024 filename
= BVAR (XBUFFER (buf
), filename
);
2026 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
2027 specbind (Qstandard_output
, tem
);
2028 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
2029 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2030 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
2031 readevalloop (buf
, 0, filename
,
2032 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
, !NILP (batch
));
2038 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2039 doc
: /* Execute the region as Lisp code.
2040 When called from programs, expects two arguments,
2041 giving starting and ending indices in the current buffer
2042 of the text to be executed.
2043 Programs can pass third argument PRINTFLAG which controls output:
2044 A value of nil means discard it; anything else is stream for printing it.
2045 Also the fourth argument READ-FUNCTION, if non-nil, is used
2046 instead of `read' to read each expression. It gets one argument
2047 which is the input stream for reading characters.
2049 This function does not move point. */)
2050 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2052 /* FIXME: Do the eval-sexp-add-defvars dance! */
2054 Lisp_Object tem
, cbuf
;
2056 cbuf
= Fcurrent_buffer ();
2058 if (NILP (printflag
))
2062 specbind (Qstandard_output
, tem
);
2063 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2065 /* `readevalloop' calls functions which check the type of start and end. */
2066 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2067 !NILP (printflag
), Qnil
, read_function
,
2075 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2076 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2077 If STREAM is nil, use the value of `standard-input' (which see).
2078 STREAM or the value of `standard-input' may be:
2079 a buffer (read from point and advance it)
2080 a marker (read from where it points and advance it)
2081 a function (call it with no arguments for each character,
2082 call it with a char as argument to push a char back)
2083 a string (takes text from string, starting at the beginning)
2084 t (read text line using minibuffer and use it, or read from
2085 standard input in batch mode). */)
2086 (Lisp_Object stream
)
2089 stream
= Vstandard_input
;
2090 if (EQ (stream
, Qt
))
2091 stream
= Qread_char
;
2092 if (EQ (stream
, Qread_char
))
2093 /* FIXME: ?! When is this used !? */
2094 return call1 (intern ("read-minibuffer"),
2095 build_string ("Lisp expression: "));
2097 return read_internal_start (stream
, Qnil
, Qnil
);
2100 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2101 doc
: /* Read one Lisp expression which is represented as text by STRING.
2102 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2103 FINAL-STRING-INDEX is an integer giving the position of the next
2104 remaining character in STRING.
2105 START and END optionally delimit a substring of STRING from which to read;
2106 they default to 0 and (length STRING) respectively. */)
2107 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2110 CHECK_STRING (string
);
2111 /* `read_internal_start' sets `read_from_string_index'. */
2112 ret
= read_internal_start (string
, start
, end
);
2113 return Fcons (ret
, make_number (read_from_string_index
));
2116 /* Function to set up the global context we need in toplevel read
2119 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2120 /* `start', `end' only used when stream is a string. */
2125 new_backquote_flag
= 0;
2126 read_objects
= Qnil
;
2127 if (EQ (Vread_with_symbol_positions
, Qt
)
2128 || EQ (Vread_with_symbol_positions
, stream
))
2129 Vread_symbol_positions_list
= Qnil
;
2131 if (STRINGP (stream
)
2132 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2134 ptrdiff_t startval
, endval
;
2137 if (STRINGP (stream
))
2140 string
= XCAR (stream
);
2143 endval
= SCHARS (string
);
2147 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2148 args_out_of_range (string
, end
);
2149 endval
= XINT (end
);
2156 CHECK_NUMBER (start
);
2157 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2158 args_out_of_range (string
, start
);
2159 startval
= XINT (start
);
2161 read_from_string_index
= startval
;
2162 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2163 read_from_string_limit
= endval
;
2166 retval
= read0 (stream
);
2167 if (EQ (Vread_with_symbol_positions
, Qt
)
2168 || EQ (Vread_with_symbol_positions
, stream
))
2169 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2174 /* Signal Qinvalid_read_syntax error.
2175 S is error string of length N (if > 0) */
2177 static _Noreturn
void
2178 invalid_syntax (const char *s
)
2180 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2184 /* Use this for recursive reads, in contexts where internal tokens
2188 read0 (Lisp_Object readcharfun
)
2190 register Lisp_Object val
;
2193 val
= read1 (readcharfun
, &c
, 0);
2197 xsignal1 (Qinvalid_read_syntax
,
2198 Fmake_string (make_number (1), make_number (c
)));
2201 static ptrdiff_t read_buffer_size
;
2202 static char *read_buffer
;
2204 /* Read a \-escape sequence, assuming we already read the `\'.
2205 If the escape sequence forces unibyte, return eight-bit char. */
2208 read_escape (Lisp_Object readcharfun
, bool stringp
)
2211 /* \u allows up to four hex digits, \U up to eight. Default to the
2212 behavior for \u, and change this value in the case that \U is seen. */
2213 int unicode_hex_count
= 4;
2218 end_of_file_error ();
2248 error ("Invalid escape character syntax");
2251 c
= read_escape (readcharfun
, 0);
2252 return c
| meta_modifier
;
2257 error ("Invalid escape character syntax");
2260 c
= read_escape (readcharfun
, 0);
2261 return c
| shift_modifier
;
2266 error ("Invalid escape character syntax");
2269 c
= read_escape (readcharfun
, 0);
2270 return c
| hyper_modifier
;
2275 error ("Invalid escape character syntax");
2278 c
= read_escape (readcharfun
, 0);
2279 return c
| alt_modifier
;
2283 if (stringp
|| c
!= '-')
2290 c
= read_escape (readcharfun
, 0);
2291 return c
| super_modifier
;
2296 error ("Invalid escape character syntax");
2300 c
= read_escape (readcharfun
, 0);
2301 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2302 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2303 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2304 return c
| ctrl_modifier
;
2305 /* ASCII control chars are made from letters (both cases),
2306 as well as the non-letters within 0100...0137. */
2307 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2308 return (c
& (037 | ~0177));
2309 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2310 return (c
& (037 | ~0177));
2312 return c
| ctrl_modifier
;
2322 /* An octal escape, as in ANSI C. */
2324 register int i
= c
- '0';
2325 register int count
= 0;
2328 if ((c
= READCHAR
) >= '0' && c
<= '7')
2340 if (i
>= 0x80 && i
< 0x100)
2341 i
= BYTE8_TO_CHAR (i
);
2346 /* A hex escape, as in ANSI C. */
2353 if (c
>= '0' && c
<= '9')
2358 else if ((c
>= 'a' && c
<= 'f')
2359 || (c
>= 'A' && c
<= 'F'))
2362 if (c
>= 'a' && c
<= 'f')
2372 /* Allow hex escapes as large as ?\xfffffff, because some
2373 packages use them to denote characters with modifiers. */
2374 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2375 error ("Hex character out of range: \\x%x...", i
);
2379 if (count
< 3 && i
>= 0x80)
2380 return BYTE8_TO_CHAR (i
);
2385 /* Post-Unicode-2.0: Up to eight hex chars. */
2386 unicode_hex_count
= 8;
2389 /* A Unicode escape. We only permit them in strings and characters,
2390 not arbitrarily in the source code, as in some other languages. */
2395 while (++count
<= unicode_hex_count
)
2398 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2400 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2401 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2402 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2404 error ("Non-hex digit used for Unicode escape");
2407 error ("Non-Unicode character: 0x%x", i
);
2416 /* Return the digit that CHARACTER stands for in the given BASE.
2417 Return -1 if CHARACTER is out of range for BASE,
2418 and -2 if CHARACTER is not valid for any supported BASE. */
2420 digit_to_number (int character
, int base
)
2424 if ('0' <= character
&& character
<= '9')
2425 digit
= character
- '0';
2426 else if ('a' <= character
&& character
<= 'z')
2427 digit
= character
- 'a' + 10;
2428 else if ('A' <= character
&& character
<= 'Z')
2429 digit
= character
- 'A' + 10;
2433 return digit
< base
? digit
: -1;
2436 /* Read an integer in radix RADIX using READCHARFUN to read
2437 characters. RADIX must be in the interval [2..36]; if it isn't, a
2438 read error is signaled . Value is the integer read. Signals an
2439 error if encountering invalid read syntax or if RADIX is out of
2443 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2445 /* Room for sign, leading 0, other digits, trailing null byte.
2446 Also, room for invalid syntax diagnostic. */
2447 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2448 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2450 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2452 if (radix
< 2 || radix
> 36)
2460 if (c
== '-' || c
== '+')
2471 /* Ignore redundant leading zeros, so the buffer doesn't
2472 fill up with them. */
2478 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2485 if (p
< buf
+ sizeof buf
- 1)
2499 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2500 invalid_syntax (buf
);
2503 return string_to_number (buf
, radix
, 0);
2507 /* If the next token is ')' or ']' or '.', we store that character
2508 in *PCH and the return value is not interesting. Else, we store
2509 zero in *PCH and we read and return one lisp object.
2511 FIRST_IN_LIST is true if this is the first element of a list. */
2514 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2517 bool uninterned_symbol
= 0;
2524 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2526 end_of_file_error ();
2531 return read_list (0, readcharfun
);
2534 return read_vector (readcharfun
, 0);
2550 /* Accept extended format for hashtables (extensible to
2552 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2553 Lisp_Object tmp
= read_list (0, readcharfun
);
2554 Lisp_Object head
= CAR_SAFE (tmp
);
2555 Lisp_Object data
= Qnil
;
2556 Lisp_Object val
= Qnil
;
2557 /* The size is 2 * number of allowed keywords to
2559 Lisp_Object params
[10];
2561 Lisp_Object key
= Qnil
;
2562 int param_count
= 0;
2564 if (!EQ (head
, Qhash_table
))
2565 error ("Invalid extended read marker at head of #s list "
2566 "(only hash-table allowed)");
2568 tmp
= CDR_SAFE (tmp
);
2570 /* This is repetitive but fast and simple. */
2571 params
[param_count
] = QCsize
;
2572 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2573 if (!NILP (params
[param_count
+ 1]))
2576 params
[param_count
] = QCtest
;
2577 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2578 if (!NILP (params
[param_count
+ 1]))
2581 params
[param_count
] = QCweakness
;
2582 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2583 if (!NILP (params
[param_count
+ 1]))
2586 params
[param_count
] = QCrehash_size
;
2587 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2588 if (!NILP (params
[param_count
+ 1]))
2591 params
[param_count
] = QCrehash_threshold
;
2592 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2593 if (!NILP (params
[param_count
+ 1]))
2596 /* This is the hashtable data. */
2597 data
= Fplist_get (tmp
, Qdata
);
2599 /* Now use params to make a new hashtable and fill it. */
2600 ht
= Fmake_hash_table (param_count
, params
);
2602 while (CONSP (data
))
2607 error ("Odd number of elements in hashtable data");
2610 Fputhash (key
, val
, ht
);
2616 invalid_syntax ("#");
2624 tmp
= read_vector (readcharfun
, 0);
2625 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2626 error ("Invalid size char-table");
2627 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2639 tmp
= read_vector (readcharfun
, 0);
2642 error ("Invalid size char-table");
2643 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2644 error ("Invalid depth in char-table");
2645 depth
= XINT (AREF (tmp
, 0));
2646 if (chartab_size
[depth
] != size
- 2)
2647 error ("Invalid size char-table");
2648 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2651 invalid_syntax ("#^" "^");
2653 invalid_syntax ("#^");
2658 length
= read1 (readcharfun
, pch
, first_in_list
);
2662 Lisp_Object tmp
, val
;
2663 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2664 unsigned char *data
;
2667 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2668 if (STRING_MULTIBYTE (tmp
)
2669 || (size_in_chars
!= SCHARS (tmp
)
2670 /* We used to print 1 char too many
2671 when the number of bits was a multiple of 8.
2672 Accept such input in case it came from an old
2674 && ! (XFASTINT (length
)
2675 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2676 invalid_syntax ("#&...");
2678 val
= make_uninit_bool_vector (XFASTINT (length
));
2679 data
= bool_vector_uchar_data (val
);
2680 memcpy (data
, SDATA (tmp
), size_in_chars
);
2681 /* Clear the extraneous bits in the last byte. */
2682 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2683 data
[size_in_chars
- 1]
2684 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2687 invalid_syntax ("#&...");
2691 /* Accept compiled functions at read-time so that we don't have to
2692 build them using function calls. */
2694 struct Lisp_Vector
*vec
;
2695 tmp
= read_vector (readcharfun
, 1);
2696 vec
= XVECTOR (tmp
);
2697 if (vec
->header
.size
== 0)
2698 invalid_syntax ("Empty byte-code object");
2699 make_byte_code (vec
);
2705 struct gcpro gcpro1
;
2708 /* Read the string itself. */
2709 tmp
= read1 (readcharfun
, &ch
, 0);
2710 if (ch
!= 0 || !STRINGP (tmp
))
2711 invalid_syntax ("#");
2713 /* Read the intervals and their properties. */
2716 Lisp_Object beg
, end
, plist
;
2718 beg
= read1 (readcharfun
, &ch
, 0);
2723 end
= read1 (readcharfun
, &ch
, 0);
2725 plist
= read1 (readcharfun
, &ch
, 0);
2727 invalid_syntax ("Invalid string property list");
2728 Fset_text_properties (beg
, end
, plist
, tmp
);
2734 /* #@NUMBER is used to skip NUMBER following bytes.
2735 That's used in .elc files to skip over doc strings
2736 and function definitions. */
2739 enum { extra
= 100 };
2740 ptrdiff_t i
, nskip
= 0, digits
= 0;
2742 /* Read a decimal integer. */
2743 while ((c
= READCHAR
) >= 0
2744 && c
>= '0' && c
<= '9')
2746 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2751 if (digits
== 2 && nskip
== 0)
2752 { /* We've just seen #@00, which means "skip to end". */
2753 skip_dyn_eof (readcharfun
);
2758 /* We can't use UNREAD here, because in the code below we side-step
2759 READCHAR. Instead, assume the first char after #@NNN occupies
2760 a single byte, which is the case normally since it's just
2766 if (load_force_doc_strings
2767 && (FROM_FILE_P (readcharfun
)))
2769 /* If we are supposed to force doc strings into core right now,
2770 record the last string that we skipped,
2771 and record where in the file it comes from. */
2773 /* But first exchange saved_doc_string
2774 with prev_saved_doc_string, so we save two strings. */
2776 char *temp
= saved_doc_string
;
2777 ptrdiff_t temp_size
= saved_doc_string_size
;
2778 file_offset temp_pos
= saved_doc_string_position
;
2779 ptrdiff_t temp_len
= saved_doc_string_length
;
2781 saved_doc_string
= prev_saved_doc_string
;
2782 saved_doc_string_size
= prev_saved_doc_string_size
;
2783 saved_doc_string_position
= prev_saved_doc_string_position
;
2784 saved_doc_string_length
= prev_saved_doc_string_length
;
2786 prev_saved_doc_string
= temp
;
2787 prev_saved_doc_string_size
= temp_size
;
2788 prev_saved_doc_string_position
= temp_pos
;
2789 prev_saved_doc_string_length
= temp_len
;
2792 if (saved_doc_string_size
== 0)
2794 saved_doc_string
= xmalloc_atomic (nskip
+ extra
);
2795 saved_doc_string_size
= nskip
+ extra
;
2797 if (nskip
> saved_doc_string_size
)
2799 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2800 saved_doc_string_size
= nskip
+ extra
;
2803 saved_doc_string_position
= file_tell (instream
);
2805 /* Copy that many characters into saved_doc_string. */
2807 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2808 saved_doc_string
[i
] = c
= getc (instream
);
2811 saved_doc_string_length
= i
;
2814 /* Skip that many bytes. */
2815 skip_dyn_bytes (readcharfun
, nskip
);
2821 /* #! appears at the beginning of an executable file.
2822 Skip the first line. */
2823 while (c
!= '\n' && c
>= 0)
2828 return Vload_file_name
;
2830 return list2 (Qfunction
, read0 (readcharfun
));
2831 /* #:foo is the uninterned symbol named foo. */
2834 uninterned_symbol
= 1;
2837 && c
!= 0xa0 /* NBSP */
2839 || strchr ("\"';()[]#`,", c
) == NULL
)))
2841 /* No symbol character follows, this is the empty
2844 return Fmake_symbol (empty_unibyte_string
);
2848 /* ## is the empty symbol. */
2850 return Fintern (empty_unibyte_string
, Qnil
);
2851 /* Reader forms that can reuse previously read objects. */
2852 if (c
>= '0' && c
<= '9')
2857 /* Read a non-negative integer. */
2858 while (c
>= '0' && c
<= '9')
2860 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2861 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2862 n
= MOST_POSITIVE_FIXNUM
+ 1;
2864 n
= n
* 10 + c
- '0';
2868 if (n
<= MOST_POSITIVE_FIXNUM
)
2870 if (c
== 'r' || c
== 'R')
2871 return read_integer (readcharfun
, n
);
2873 if (! NILP (Vread_circle
))
2875 /* #n=object returns object, but associates it with
2879 /* Make a placeholder for #n# to use temporarily. */
2880 Lisp_Object placeholder
;
2883 placeholder
= Fcons (Qnil
, Qnil
);
2884 cell
= Fcons (make_number (n
), placeholder
);
2885 read_objects
= Fcons (cell
, read_objects
);
2887 /* Read the object itself. */
2888 tem
= read0 (readcharfun
);
2890 /* Now put it everywhere the placeholder was... */
2891 substitute_object_in_subtree (tem
, placeholder
);
2893 /* ...and #n# will use the real value from now on. */
2894 Fsetcdr (cell
, tem
);
2899 /* #n# returns a previously read object. */
2902 tem
= Fassq (make_number (n
), read_objects
);
2908 /* Fall through to error message. */
2910 else if (c
== 'x' || c
== 'X')
2911 return read_integer (readcharfun
, 16);
2912 else if (c
== 'o' || c
== 'O')
2913 return read_integer (readcharfun
, 8);
2914 else if (c
== 'b' || c
== 'B')
2915 return read_integer (readcharfun
, 2);
2918 invalid_syntax ("#");
2921 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2925 return list2 (Qquote
, read0 (readcharfun
));
2929 int next_char
= READCHAR
;
2931 /* Transition from old-style to new-style:
2932 If we see "(`" it used to mean old-style, which usually works
2933 fine because ` should almost never appear in such a position
2934 for new-style. But occasionally we need "(`" to mean new
2935 style, so we try to distinguish the two by the fact that we
2936 can either write "( `foo" or "(` foo", where the first
2937 intends to use new-style whereas the second intends to use
2938 old-style. For Emacs-25, we should completely remove this
2939 first_in_list exception (old-style can still be obtained via
2941 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2943 Vold_style_backquotes
= Qt
;
2949 bool saved_new_backquote_flag
= new_backquote_flag
;
2951 new_backquote_flag
= 1;
2952 value
= read0 (readcharfun
);
2953 new_backquote_flag
= saved_new_backquote_flag
;
2955 return list2 (Qbackquote
, value
);
2960 int next_char
= READCHAR
;
2962 /* Transition from old-style to new-style:
2963 It used to be impossible to have a new-style , other than within
2964 a new-style `. This is sufficient when ` and , are used in the
2965 normal way, but ` and , can also appear in args to macros that
2966 will not interpret them in the usual way, in which case , may be
2967 used without any ` anywhere near.
2968 So we now use the same heuristic as for backquote: old-style
2969 unquotes are only recognized when first on a list, and when
2970 followed by a space.
2971 Because it's more difficult to peek 2 chars ahead, a new-style
2972 ,@ can still not be used outside of a `, unless it's in the middle
2974 if (new_backquote_flag
2976 || (next_char
!= ' ' && next_char
!= '@'))
2978 Lisp_Object comma_type
= Qnil
;
2983 comma_type
= Qcomma_at
;
2985 comma_type
= Qcomma_dot
;
2988 if (ch
>= 0) UNREAD (ch
);
2989 comma_type
= Qcomma
;
2992 value
= read0 (readcharfun
);
2993 return list2 (comma_type
, value
);
2997 Vold_style_backquotes
= Qt
;
3009 end_of_file_error ();
3011 /* Accept `single space' syntax like (list ? x) where the
3012 whitespace character is SPC or TAB.
3013 Other literal whitespace like NL, CR, and FF are not accepted,
3014 as there are well-established escape sequences for these. */
3015 if (c
== ' ' || c
== '\t')
3016 return make_number (c
);
3019 c
= read_escape (readcharfun
, 0);
3020 modifiers
= c
& CHAR_MODIFIER_MASK
;
3021 c
&= ~CHAR_MODIFIER_MASK
;
3022 if (CHAR_BYTE8_P (c
))
3023 c
= CHAR_TO_BYTE8 (c
);
3026 next_char
= READCHAR
;
3027 ok
= (next_char
<= 040
3028 || (next_char
< 0200
3029 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3032 return make_number (c
);
3034 invalid_syntax ("?");
3039 char *p
= read_buffer
;
3040 char *end
= read_buffer
+ read_buffer_size
;
3042 /* True if we saw an escape sequence specifying
3043 a multibyte character. */
3044 bool force_multibyte
= 0;
3045 /* True if we saw an escape sequence specifying
3046 a single-byte character. */
3047 bool force_singlebyte
= 0;
3049 ptrdiff_t nchars
= 0;
3051 while ((ch
= READCHAR
) >= 0
3054 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3056 ptrdiff_t offset
= p
- read_buffer
;
3057 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3058 memory_full (SIZE_MAX
);
3059 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3060 read_buffer_size
*= 2;
3061 p
= read_buffer
+ offset
;
3062 end
= read_buffer
+ read_buffer_size
;
3069 ch
= read_escape (readcharfun
, 1);
3071 /* CH is -1 if \ newline has just been seen. */
3074 if (p
== read_buffer
)
3079 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3080 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3082 if (CHAR_BYTE8_P (ch
))
3083 force_singlebyte
= 1;
3084 else if (! ASCII_CHAR_P (ch
))
3085 force_multibyte
= 1;
3086 else /* I.e. ASCII_CHAR_P (ch). */
3088 /* Allow `\C- ' and `\C-?'. */
3089 if (modifiers
== CHAR_CTL
)
3092 ch
= 0, modifiers
= 0;
3094 ch
= 127, modifiers
= 0;
3096 if (modifiers
& CHAR_SHIFT
)
3098 /* Shift modifier is valid only with [A-Za-z]. */
3099 if (ch
>= 'A' && ch
<= 'Z')
3100 modifiers
&= ~CHAR_SHIFT
;
3101 else if (ch
>= 'a' && ch
<= 'z')
3102 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3105 if (modifiers
& CHAR_META
)
3107 /* Move the meta bit to the right place for a
3109 modifiers
&= ~CHAR_META
;
3110 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3111 force_singlebyte
= 1;
3115 /* Any modifiers remaining are invalid. */
3117 error ("Invalid modifier in string");
3118 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3122 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3123 if (CHAR_BYTE8_P (ch
))
3124 force_singlebyte
= 1;
3125 else if (! ASCII_CHAR_P (ch
))
3126 force_multibyte
= 1;
3132 end_of_file_error ();
3134 if (! force_multibyte
&& force_singlebyte
)
3136 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3137 forms. Convert it to unibyte. */
3138 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3140 p
= read_buffer
+ nchars
;
3143 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3145 || (p
- read_buffer
!= nchars
)));
3150 int next_char
= READCHAR
;
3153 if (next_char
<= 040
3154 || (next_char
< 0200
3155 && strchr ("\"';([#?`,", next_char
) != NULL
))
3161 /* Otherwise, we fall through! Note that the atom-reading loop
3162 below will now loop at least once, assuring that we will not
3163 try to UNREAD two characters in a row. */
3167 if (c
<= 040) goto retry
;
3168 if (c
== 0xa0) /* NBSP */
3173 char *p
= read_buffer
;
3175 EMACS_INT start_position
= readchar_count
- 1;
3178 char *end
= read_buffer
+ read_buffer_size
;
3182 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3184 ptrdiff_t offset
= p
- read_buffer
;
3185 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3186 memory_full (SIZE_MAX
);
3187 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3188 read_buffer_size
*= 2;
3189 p
= read_buffer
+ offset
;
3190 end
= read_buffer
+ read_buffer_size
;
3197 end_of_file_error ();
3202 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3208 && c
!= 0xa0 /* NBSP */
3210 || strchr ("\"';()[]#`,", c
) == NULL
));
3214 ptrdiff_t offset
= p
- read_buffer
;
3215 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3216 memory_full (SIZE_MAX
);
3217 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3218 read_buffer_size
*= 2;
3219 p
= read_buffer
+ offset
;
3220 end
= read_buffer
+ read_buffer_size
;
3226 if (!quoted
&& !uninterned_symbol
)
3228 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3229 if (! NILP (result
))
3233 Lisp_Object name
, result
;
3234 ptrdiff_t nbytes
= p
- read_buffer
;
3237 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3241 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3242 ? make_pure_string
: make_specified_string
)
3243 (read_buffer
, nchars
, nbytes
, multibyte
));
3244 result
= (uninterned_symbol
? Fmake_symbol (name
)
3245 : Fintern (name
, Qnil
));
3247 if (EQ (Vread_with_symbol_positions
, Qt
)
3248 || EQ (Vread_with_symbol_positions
, readcharfun
))
3249 Vread_symbol_positions_list
3250 = Fcons (Fcons (result
, make_number (start_position
)),
3251 Vread_symbol_positions_list
);
3259 /* List of nodes we've seen during substitute_object_in_subtree. */
3260 static Lisp_Object seen_list
;
3263 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3265 Lisp_Object check_object
;
3267 /* We haven't seen any objects when we start. */
3270 /* Make all the substitutions. */
3272 = substitute_object_recurse (object
, placeholder
, object
);
3274 /* Clear seen_list because we're done with it. */
3277 /* The returned object here is expected to always eq the
3279 if (!EQ (check_object
, object
))
3280 error ("Unexpected mutation error in reader");
3283 /* Feval doesn't get called from here, so no gc protection is needed. */
3284 #define SUBSTITUTE(get_val, set_val) \
3286 Lisp_Object old_value = get_val; \
3287 Lisp_Object true_value \
3288 = substitute_object_recurse (object, placeholder, \
3291 if (!EQ (old_value, true_value)) \
3298 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3300 /* If we find the placeholder, return the target object. */
3301 if (EQ (placeholder
, subtree
))
3304 /* If we've been to this node before, don't explore it again. */
3305 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3308 /* If this node can be the entry point to a cycle, remember that
3309 we've seen it. It can only be such an entry point if it was made
3310 by #n=, which means that we can find it as a value in
3312 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3313 seen_list
= Fcons (subtree
, seen_list
);
3315 /* Recurse according to subtree's type.
3316 Every branch must return a Lisp_Object. */
3317 if (VECTORLIKEP (subtree
))
3319 ptrdiff_t i
, length
= 0;
3320 if (BOOL_VECTOR_P (subtree
))
3321 return subtree
; /* No sub-objects anyway. */
3322 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3323 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3324 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3325 else if (VECTORP (subtree
))
3326 length
= ASIZE (subtree
);
3328 /* An unknown pseudovector may contain non-Lisp fields, so we
3329 can't just blindly traverse all its fields. We used to call
3330 `Flength' which signaled `sequencep', so I just preserved this
3332 wrong_type_argument (Qsequencep
, subtree
);
3334 for (i
= 0; i
< length
; i
++)
3335 SUBSTITUTE (AREF (subtree
, i
),
3336 ASET (subtree
, i
, true_value
));
3339 else if (CONSP (subtree
))
3341 SUBSTITUTE (XCAR (subtree
),
3342 XSETCAR (subtree
, true_value
));
3343 SUBSTITUTE (XCDR (subtree
),
3344 XSETCDR (subtree
, true_value
));
3347 else if (STRINGP (subtree
))
3349 /* Check for text properties in each interval.
3350 substitute_in_interval contains part of the logic. */
3352 INTERVAL root_interval
= string_intervals (subtree
);
3353 Lisp_Object arg
= Fcons (object
, placeholder
);
3355 traverse_intervals_noorder (root_interval
,
3356 &substitute_in_interval
, arg
);
3361 /* Other types don't recurse any further. */
3365 /* Helper function for substitute_object_recurse. */
3367 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3369 Lisp_Object object
= Fcar (arg
);
3370 Lisp_Object placeholder
= Fcdr (arg
);
3372 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3382 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3383 integer syntax and fits in a fixnum, else return the nearest float if CP has
3384 either floating point or integer syntax and BASE is 10, else return nil. If
3385 IGNORE_TRAILING, consider just the longest prefix of CP that has
3386 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3387 number has integer syntax but does not fit. */
3390 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3393 char const *cp
= string
;
3395 bool float_syntax
= 0;
3398 /* Compute NaN and infinities using a variable, to cope with compilers that
3399 think they are smarter than we are. */
3402 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3403 IEEE floating point hosts, and works around a formerly-common bug where
3404 atof ("-0.0") drops the sign. */
3405 bool negative
= *cp
== '-';
3407 bool signedp
= negative
|| *cp
== '+';
3412 leading_digit
= digit_to_number (*cp
, base
);
3413 if (leading_digit
>= 0)
3418 while (digit_to_number (*cp
, base
) >= 0);
3428 if ('0' <= *cp
&& *cp
<= '9')
3433 while ('0' <= *cp
&& *cp
<= '9');
3435 if (*cp
== 'e' || *cp
== 'E')
3437 char const *ecp
= cp
;
3439 if (*cp
== '+' || *cp
== '-')
3441 if ('0' <= *cp
&& *cp
<= '9')
3446 while ('0' <= *cp
&& *cp
<= '9');
3448 else if (cp
[-1] == '+'
3449 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3455 else if (cp
[-1] == '+'
3456 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3460 value
= zero
/ zero
;
3462 /* If that made a "negative" NaN, negate it. */
3465 union { double d
; char c
[sizeof (double)]; }
3466 u_data
, u_minus_zero
;
3468 u_minus_zero
.d
= -0.0;
3469 for (i
= 0; i
< sizeof (double); i
++)
3470 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3476 /* Now VALUE is a positive NaN. */
3482 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3483 || state
== (LEAD_INT
|E_EXP
));
3486 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3487 any prefix that matches. Otherwise, the entire string must match. */
3488 if (! (ignore_trailing
3489 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3490 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3493 /* If the number uses integer and not float syntax, and is in C-language
3494 range, use its value, preferably as a fixnum. */
3495 if (leading_digit
>= 0 && ! float_syntax
)
3499 /* Fast special case for single-digit integers. This also avoids a
3500 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3501 case some versions of strtoumax accept numbers like "0x1" that Emacs
3503 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3504 return make_number (negative
? -leading_digit
: leading_digit
);
3507 n
= strtoumax (string
+ signedp
, NULL
, base
);
3508 if (errno
== ERANGE
)
3510 /* Unfortunately there's no simple and accurate way to convert
3511 non-base-10 numbers that are out of C-language range. */
3513 xsignal1 (Qoverflow_error
, build_string (string
));
3515 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3517 EMACS_INT signed_n
= n
;
3518 return make_number (negative
? -signed_n
: signed_n
);
3524 /* Either the number uses float syntax, or it does not fit into a fixnum.
3525 Convert it from string to floating point, unless the value is already
3526 known because it is an infinity, a NAN, or its absolute value fits in
3529 value
= atof (string
+ signedp
);
3531 return make_float (negative
? -value
: value
);
3536 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3540 Lisp_Object tem
, item
, vector
;
3543 tem
= read_list (1, readcharfun
);
3544 len
= Flength (tem
);
3545 vector
= Fmake_vector (len
, Qnil
);
3547 size
= ASIZE (vector
);
3548 ptr
= XVECTOR (vector
)->contents
;
3549 for (i
= 0; i
< size
; i
++)
3552 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3553 bytecode object, the docstring containing the bytecode and
3554 constants values must be treated as unibyte and passed to
3555 Fread, to get the actual bytecode string and constants vector. */
3556 if (bytecodeflag
&& load_force_doc_strings
)
3558 if (i
== COMPILED_BYTECODE
)
3560 if (!STRINGP (item
))
3561 error ("Invalid byte code");
3563 /* Delay handling the bytecode slot until we know whether
3564 it is lazily-loaded (we can tell by whether the
3565 constants slot is nil). */
3566 ASET (vector
, COMPILED_CONSTANTS
, item
);
3569 else if (i
== COMPILED_CONSTANTS
)
3571 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3575 /* Coerce string to unibyte (like string-as-unibyte,
3576 but without generating extra garbage and
3577 guaranteeing no change in the contents). */
3578 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3579 STRING_SET_UNIBYTE (bytestr
);
3581 item
= Fread (Fcons (bytestr
, readcharfun
));
3583 error ("Invalid byte code");
3585 bytestr
= XCAR (item
);
3589 /* Now handle the bytecode slot. */
3590 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3592 else if (i
== COMPILED_DOC_STRING
3594 && ! STRING_MULTIBYTE (item
))
3596 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3597 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3599 item
= Fstring_as_multibyte (item
);
3602 ASET (vector
, i
, item
);
3608 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3611 read_list (bool flag
, Lisp_Object readcharfun
)
3613 Lisp_Object val
, tail
;
3614 Lisp_Object elt
, tem
;
3615 struct gcpro gcpro1
, gcpro2
;
3616 /* 0 is the normal case.
3617 1 means this list is a doc reference; replace it with the number 0.
3618 2 means this list is a doc reference; replace it with the doc string. */
3619 int doc_reference
= 0;
3621 /* Initialize this to 1 if we are reading a list. */
3622 bool first_in_list
= flag
<= 0;
3631 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3636 /* While building, if the list starts with #$, treat it specially. */
3637 if (EQ (elt
, Vload_file_name
)
3639 && !NILP (Vpurify_flag
))
3641 if (NILP (Vdoc_file_name
))
3642 /* We have not yet called Snarf-documentation, so assume
3643 this file is described in the DOC file
3644 and Snarf-documentation will fill in the right value later.
3645 For now, replace the whole list with 0. */
3648 /* We have already called Snarf-documentation, so make a relative
3649 file name for this file, so it can be found properly
3650 in the installed Lisp directory.
3651 We don't use Fexpand_file_name because that would make
3652 the directory absolute now. */
3653 elt
= concat2 (build_string ("../lisp/"),
3654 Ffile_name_nondirectory (elt
));
3656 else if (EQ (elt
, Vload_file_name
)
3658 && load_force_doc_strings
)
3667 invalid_syntax (") or . in a vector");
3675 XSETCDR (tail
, read0 (readcharfun
));
3677 val
= read0 (readcharfun
);
3678 read1 (readcharfun
, &ch
, 0);
3682 if (doc_reference
== 1)
3683 return make_number (0);
3684 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3687 file_offset saved_position
;
3688 /* Get a doc string from the file we are loading.
3689 If it's in saved_doc_string, get it from there.
3691 Here, we don't know if the string is a
3692 bytecode string or a doc string. As a
3693 bytecode string must be unibyte, we always
3694 return a unibyte string. If it is actually a
3695 doc string, caller must make it
3698 /* Position is negative for user variables. */
3699 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3700 if (pos
>= saved_doc_string_position
3701 && pos
< (saved_doc_string_position
3702 + saved_doc_string_length
))
3704 saved
= saved_doc_string
;
3705 saved_position
= saved_doc_string_position
;
3707 /* Look in prev_saved_doc_string the same way. */
3708 else if (pos
>= prev_saved_doc_string_position
3709 && pos
< (prev_saved_doc_string_position
3710 + prev_saved_doc_string_length
))
3712 saved
= prev_saved_doc_string
;
3713 saved_position
= prev_saved_doc_string_position
;
3717 ptrdiff_t start
= pos
- saved_position
;
3720 /* Process quoting with ^A,
3721 and find the end of the string,
3722 which is marked with ^_ (037). */
3723 for (from
= start
, to
= start
;
3724 saved
[from
] != 037;)
3726 int c
= saved
[from
++];
3730 saved
[to
++] = (c
== 1 ? c
3739 return make_unibyte_string (saved
+ start
,
3743 return get_doc_string (val
, 1, 0);
3748 invalid_syntax (". in wrong context");
3750 invalid_syntax ("] in a list");
3754 XSETCDR (tail
, tem
);
3761 static Lisp_Object initial_obarray
;
3764 obhash (Lisp_Object obarray
)
3766 Lisp_Object tem
= scm_hashq_get_handle (obarrays
, obarray
);
3767 if (SCM_UNLIKELY (scm_is_false (tem
)))
3768 tem
= scm_hashq_create_handle_x (obarrays
, obarray
,
3769 scm_make_obarray ());
3770 return scm_cdr (tem
);
3773 /* Get an error if OBARRAY is not an obarray.
3774 If it is one, return it. */
3777 check_obarray (Lisp_Object obarray
)
3779 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3781 /* If Vobarray is now invalid, force it to be valid. */
3782 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3783 wrong_type_argument (Qvectorp
, obarray
);
3788 /* Intern the C string STR: return a symbol with that name,
3789 interned in the current obarray. */
3792 intern_1 (const char *str
, ptrdiff_t len
)
3794 return Fintern (make_string (str
, len
), Qnil
);
3798 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3800 return Fintern (make_pure_c_string (str
, len
), Qnil
);
3803 DEFUN ("find-symbol", Ffind_symbol
, Sfind_symbol
, 1, 2, 0,
3804 doc
: /* find-symbol */)
3805 (Lisp_Object string
, Lisp_Object obarray
)
3807 Lisp_Object tem
, sstring
, found
;
3809 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3810 CHECK_STRING (string
);
3812 sstring
= scm_from_utf8_stringn (SSDATA (string
), SBYTES (string
));
3813 tem
= scm_find_symbol (sstring
, obhash (obarray
));
3814 if (scm_is_true (tem
))
3816 if (EQ (tem
, Qnil_
))
3818 else if (EQ (tem
, Qt_
))
3820 return scm_values (scm_list_2 (tem
, Qt
));
3823 return scm_values (scm_list_2 (Qnil
, Qnil
));
3826 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3827 doc
: /* Return the canonical symbol whose name is STRING.
3828 If there is none, one is created by this function and returned.
3829 A second optional argument specifies the obarray to use;
3830 it defaults to the value of `obarray'. */)
3831 (Lisp_Object string
, Lisp_Object obarray
)
3833 register Lisp_Object tem
, sym
, *ptr
;
3835 if (NILP (obarray
)) obarray
= Vobarray
;
3836 obarray
= check_obarray (obarray
);
3838 CHECK_STRING (string
);
3840 tem
= Ffind_symbol (string
, obarray
);
3841 if (! NILP (scm_c_value_ref (tem
, 1)))
3842 return scm_c_value_ref (tem
, 0);
3844 sym
= scm_intern (scm_from_utf8_stringn (SSDATA (string
),
3848 if ((SREF (string
, 0) == ':')
3849 && EQ (obarray
, initial_obarray
))
3851 SET_SYMBOL_CONSTANT (XSYMBOL (sym
), 1);
3852 SET_SYMBOL_REDIRECT (XSYMBOL (sym
), SYMBOL_PLAINVAL
);
3853 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3859 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3860 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3861 NAME may be a string or a symbol. If it is a symbol, that exact
3862 symbol is searched for.
3863 A second optional argument specifies the obarray to use;
3864 it defaults to the value of `obarray'. */)
3865 (Lisp_Object name
, Lisp_Object obarray
)
3867 register Lisp_Object tem
, string
, mv
, found
;
3869 string
= SYMBOLP (name
) ? SYMBOL_NAME (name
) : name
;
3870 mv
= Ffind_symbol (string
, obarray
);
3871 tem
= scm_c_value_ref (mv
, 0);
3872 found
= scm_c_value_ref (mv
, 1);
3874 if (NILP (found
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3880 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3881 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3882 The value is t if a symbol was found and deleted, nil otherwise.
3883 NAME may be a string or a symbol. If it is a symbol, that symbol
3884 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3885 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3886 usage: (unintern NAME OBARRAY) */)
3887 (Lisp_Object name
, Lisp_Object obarray
)
3894 obarray
= check_obarray (obarray
);
3899 scm_find_symbol (scm_symbol_to_string (name
),
3902 string
= SYMBOL_NAME (name
);
3906 CHECK_STRING (name
);
3911 return (scm_is_true (scm_unintern (name
, obhash (obarray
))) ? Qt
: Qnil
);
3914 struct map_obarray_data
3916 Lisp_Object obarray
;
3917 void (*fn
) (Lisp_Object
, Lisp_Object
);
3922 map_obarray_inner (void *data
, Lisp_Object sym
)
3924 struct map_obarray_data
*modata
= data
;
3926 Lisp_Object tem
= Ffind_symbol (SYMBOL_NAME (sym
), modata
->obarray
);
3927 if (scm_is_true (scm_c_value_ref (tem
, 1))
3928 && EQ (sym
, scm_c_value_ref (tem
, 0)))
3929 modata
->fn (sym
, modata
->arg
);
3930 return SCM_UNSPECIFIED
;
3934 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3936 struct map_obarray_data data
= { .obarray
= obarray
,
3940 CHECK_VECTOR (obarray
);
3941 scm_obarray_for_each (make_c_closure (map_obarray_inner
, &data
, 1, 0),
3946 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3948 call1 (function
, sym
);
3951 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3952 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3953 OBARRAY defaults to the value of `obarray'. */)
3954 (Lisp_Object function
, Lisp_Object obarray
)
3956 if (NILP (obarray
)) obarray
= Vobarray
;
3957 obarray
= check_obarray (obarray
);
3959 map_obarray (obarray
, mapatoms_1
, function
);
3963 #define OBARRAY_SIZE 1511
3968 Lisp_Object oblength
;
3969 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3971 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3973 Vobarray
= Fmake_vector (oblength
, make_number (0));
3974 initial_obarray
= Vobarray
;
3975 staticpro (&initial_obarray
);
3977 obarrays
= scm_make_hash_table (SCM_UNDEFINED
);
3978 scm_hashq_set_x (obarrays
, Vobarray
, SCM_UNDEFINED
);
3980 Qnil
= SCM_ELISP_NIL
;
3983 Qnil_
= intern_c_string ("nil");
3984 SET_SYMBOL_VAL (XSYMBOL (Qnil_
), Qnil
);
3985 SET_SYMBOL_CONSTANT (XSYMBOL (Qnil_
), 1);
3986 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (Qnil_
), 1);
3988 Qt_
= intern_c_string ("t");
3989 SET_SYMBOL_VAL (XSYMBOL (Qt_
), Qt
);
3990 SET_SYMBOL_CONSTANT (XSYMBOL (Qt_
), 1);
3991 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (Qt_
), 1);
3993 Qunbound
= scm_c_public_ref ("language elisp runtime", "unbound");
3994 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3996 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3999 DEFSYM (Qvariable_documentation
, "variable-documentation");
4001 read_buffer
= xmalloc_atomic (size
);
4002 read_buffer_size
= size
;
4006 defsubr (const char *lname
, scm_t_subr gsubr_fn
, short min_args
, short max_args
, const char *intspec
)
4008 Lisp_Object sym
= intern_c_string (lname
);
4013 fn
= scm_c_make_gsubr (lname
, 0, 0, 1, gsubr_fn
);
4016 fn
= Fcons (Qspecial_operator
,
4017 scm_c_make_gsubr (lname
, 0, 0, 1, gsubr_fn
));
4020 fn
= scm_c_make_gsubr (lname
, min_args
, max_args
- min_args
, 0, gsubr_fn
);
4023 set_symbol_function (sym
, fn
);
4026 Lisp_Object tem
= ((*intspec
!= '(')
4027 ? build_string (intspec
)
4028 : Fcar (Fread_from_string (build_string (intspec
),
4030 scm_set_procedure_property_x (fn
, Qinteractive_form
, tem
);
4034 /* Define an "integer variable"; a symbol whose value is forwarded to a
4035 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4036 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4038 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4039 const char *namestring
, EMACS_INT
*address
)
4042 sym
= intern_c_string (namestring
);
4043 i_fwd
->type
= Lisp_Fwd_Int
;
4044 i_fwd
->intvar
= address
;
4045 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym
), 1);
4046 SET_SYMBOL_REDIRECT (XSYMBOL (sym
), SYMBOL_FORWARDED
);
4047 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4050 /* Similar but define a variable whose value is t if address contains 1,
4051 nil if address contains 0. */
4053 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4054 const char *namestring
, bool *address
)
4057 sym
= intern_c_string (namestring
);
4058 b_fwd
->type
= Lisp_Fwd_Bool
;
4059 b_fwd
->boolvar
= address
;
4060 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym
), 1);
4061 SET_SYMBOL_REDIRECT (XSYMBOL (sym
), SYMBOL_FORWARDED
);
4062 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4063 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4066 /* Similar but define a variable whose value is the Lisp Object stored
4067 at address. Two versions: with and without gc-marking of the C
4068 variable. The nopro version is used when that variable will be
4069 gc-marked for some other reason, since marking the same slot twice
4070 can cause trouble with strings. */
4072 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4073 const char *namestring
, Lisp_Object
*address
)
4076 sym
= intern_c_string (namestring
);
4077 o_fwd
->type
= Lisp_Fwd_Obj
;
4078 o_fwd
->objvar
= address
;
4079 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym
), 1);
4080 SET_SYMBOL_REDIRECT (XSYMBOL (sym
), SYMBOL_FORWARDED
);
4081 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4085 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4086 const char *namestring
, Lisp_Object
*address
)
4088 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4089 staticpro (address
);
4092 /* Similar but define a variable whose value is the Lisp Object stored
4093 at a particular offset in the current kboard object. */
4096 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4097 const char *namestring
, int offset
)
4100 sym
= intern_c_string (namestring
);
4101 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4102 ko_fwd
->offset
= offset
;
4103 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym
), 1);
4104 SET_SYMBOL_REDIRECT (XSYMBOL (sym
), SYMBOL_FORWARDED
);
4105 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4108 /* Check that the elements of lpath exist. */
4111 load_path_check (Lisp_Object lpath
)
4113 Lisp_Object path_tail
;
4115 /* The only elements that might not exist are those from
4116 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4118 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4120 Lisp_Object dirfile
;
4121 dirfile
= Fcar (path_tail
);
4122 if (STRINGP (dirfile
))
4124 dirfile
= Fdirectory_file_name (dirfile
);
4125 if (! file_accessible_directory_p (SSDATA (dirfile
)))
4126 dir_warning ("Lisp directory", XCAR (path_tail
));
4131 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4132 This does not include the standard site-lisp directories
4133 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4134 but it does (unless no_site_lisp is set) include site-lisp
4135 directories in the source/build directories if those exist and we
4136 are running uninstalled.
4138 Uses the following logic:
4139 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4140 The remainder is what happens when dumping works:
4141 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4142 Otherwise use PATH_LOADSEARCH.
4144 If !initialized, then just return PATH_DUMPLOADSEARCH.
4146 If Vinstallation_directory is not nil (ie, running uninstalled):
4147 If installation-dir/lisp exists and not already a member,
4148 we must be running uninstalled. Reset the load-path
4149 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4150 refers to the eventual installation directories. Since we
4151 are not yet installed, we should not use them, even if they exist.)
4152 If installation-dir/lisp does not exist, just add
4153 PATH_DUMPLOADSEARCH at the end instead.
4154 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4155 and not already a member) at the front.
4156 If installation-dir != source-dir (ie running an uninstalled,
4157 out-of-tree build) AND install-dir/src/Makefile exists BUT
4158 install-dir/src/Makefile.in does NOT exist (this is a sanity
4159 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4162 load_path_default (void)
4164 Lisp_Object lpath
= Qnil
;
4169 const char *loadpath
= ns_load_path ();
4172 normal
= PATH_DUMPLOADSEARCH
;
4174 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4176 lpath
= decode_env_path (0, normal
, 0);
4179 #else /* !CANNOT_DUMP */
4181 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4186 const char *loadpath
= ns_load_path ();
4187 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4189 lpath
= decode_env_path (0, normal
, 0);
4191 if (!NILP (Vinstallation_directory
))
4193 Lisp_Object tem
, tem1
;
4195 /* Add to the path the lisp subdir of the installation
4196 dir, if it is accessible. Note: in out-of-tree builds,
4197 this directory is empty save for Makefile. */
4198 tem
= Fexpand_file_name (build_string ("lisp"),
4199 Vinstallation_directory
);
4200 tem1
= Ffile_accessible_directory_p (tem
);
4203 if (NILP (Fmember (tem
, lpath
)))
4205 /* We are running uninstalled. The default load-path
4206 points to the eventual installed lisp directories.
4207 We should not use those now, even if they exist,
4208 so start over from a clean slate. */
4209 lpath
= list1 (tem
);
4213 /* That dir doesn't exist, so add the build-time
4214 Lisp dirs instead. */
4216 Lisp_Object dump_path
=
4217 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4218 lpath
= nconc2 (lpath
, dump_path
);
4221 /* Add site-lisp under the installation dir, if it exists. */
4224 tem
= Fexpand_file_name (build_string ("site-lisp"),
4225 Vinstallation_directory
);
4226 tem1
= Ffile_accessible_directory_p (tem
);
4229 if (NILP (Fmember (tem
, lpath
)))
4230 lpath
= Fcons (tem
, lpath
);
4234 /* If Emacs was not built in the source directory,
4235 and it is run from where it was built, add to load-path
4236 the lisp and site-lisp dirs under that directory. */
4238 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4242 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4243 Vinstallation_directory
);
4244 tem1
= Ffile_exists_p (tem
);
4246 /* Don't be fooled if they moved the entire source tree
4247 AFTER dumping Emacs. If the build directory is indeed
4248 different from the source dir, src/Makefile.in and
4249 src/Makefile will not be found together. */
4250 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4251 Vinstallation_directory
);
4252 tem2
= Ffile_exists_p (tem
);
4253 if (!NILP (tem1
) && NILP (tem2
))
4255 tem
= Fexpand_file_name (build_string ("lisp"),
4258 if (NILP (Fmember (tem
, lpath
)))
4259 lpath
= Fcons (tem
, lpath
);
4263 tem
= Fexpand_file_name (build_string ("site-lisp"),
4265 tem1
= Ffile_accessible_directory_p (tem
);
4268 if (NILP (Fmember (tem
, lpath
)))
4269 lpath
= Fcons (tem
, lpath
);
4273 } /* Vinstallation_directory != Vsource_directory */
4275 } /* if Vinstallation_directory */
4277 else /* !initialized */
4279 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4280 source directory. We used to add ../lisp (ie the lisp dir in
4281 the build directory) at the front here, but that should not
4282 be necessary, since in out of tree builds lisp/ is empty, save
4284 lpath
= decode_env_path (0, normal
, 0);
4286 #endif /* !CANNOT_DUMP */
4294 /* First, set Vload_path. */
4296 /* Ignore EMACSLOADPATH when dumping. */
4298 bool use_loadpath
= true;
4300 bool use_loadpath
= NILP (Vpurify_flag
);
4303 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4305 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4307 /* Check (non-nil) user-supplied elements. */
4308 load_path_check (Vload_path
);
4310 /* If no nils in the environment variable, use as-is.
4311 Otherwise, replace any nils with the default. */
4312 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4314 Lisp_Object elem
, elpath
= Vload_path
;
4315 Lisp_Object default_lpath
= load_path_default ();
4317 /* Check defaults, before adding site-lisp. */
4318 load_path_check (default_lpath
);
4320 /* Add the site-lisp directories to the front of the default. */
4323 Lisp_Object sitelisp
;
4324 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4325 if (! NILP (sitelisp
))
4326 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4331 /* Replace nils from EMACSLOADPATH by default. */
4332 while (CONSP (elpath
))
4335 elem
= XCAR (elpath
);
4336 elpath
= XCDR (elpath
);
4337 arg
[0] = Vload_path
;
4338 arg
[1] = NILP (elem
) ? default_lpath
: Fcons (elem
, Qnil
);
4339 Vload_path
= Fappend (2, arg
);
4341 } /* Fmemq (Qnil, Vload_path) */
4345 Vload_path
= load_path_default ();
4347 /* Check before adding site-lisp directories.
4348 The install should have created them, but they are not
4349 required, so no need to warn if they are absent.
4350 Or we might be running before installation. */
4351 load_path_check (Vload_path
);
4353 /* Add the site-lisp directories at the front. */
4354 if (initialized
&& !no_site_lisp
)
4356 Lisp_Object sitelisp
;
4357 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4358 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4364 load_in_progress
= 0;
4365 Vload_file_name
= Qnil
;
4366 Vstandard_input
= Qt
;
4367 Vloads_in_progress
= Qnil
;
4370 /* Print a warning that directory intended for use USE and with name
4371 DIRNAME cannot be accessed. On entry, errno should correspond to
4372 the access failure. Print the warning on stderr and put it in
4376 dir_warning (char const *use
, Lisp_Object dirname
)
4378 static char const format
[] = "Warning: %s `%s': %s\n";
4379 int access_errno
= errno
;
4380 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4382 /* Don't log the warning before we've initialized!! */
4385 char const *diagnostic
= emacs_strerror (access_errno
);
4387 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4388 + strlen (use
) + SBYTES (dirname
)
4389 + strlen (diagnostic
));
4390 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4392 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4398 syms_of_lread (void)
4402 DEFVAR_LISP ("obarray", Vobarray
,
4403 doc
: /* Symbol table for use by `intern' and `read'.
4404 It is a vector whose length ought to be prime for best results.
4405 The vector's contents don't make sense if examined from Lisp programs;
4406 to find all the symbols in an obarray, use `mapatoms'. */);
4408 DEFVAR_LISP ("values", Vvalues
,
4409 doc
: /* List of values of all expressions which were read, evaluated and printed.
4410 Order is reverse chronological. */);
4411 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (intern ("values")), 0);
4413 DEFVAR_LISP ("standard-input", Vstandard_input
,
4414 doc
: /* Stream for read to get input from.
4415 See documentation of `read' for possible values. */);
4416 Vstandard_input
= Qt
;
4418 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4419 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4421 If this variable is a buffer, then only forms read from that buffer
4422 will be added to `read-symbol-positions-list'.
4423 If this variable is t, then all read forms will be added.
4424 The effect of all other values other than nil are not currently
4425 defined, although they may be in the future.
4427 The positions are relative to the last call to `read' or
4428 `read-from-string'. It is probably a bad idea to set this variable at
4429 the toplevel; bind it instead. */);
4430 Vread_with_symbol_positions
= Qnil
;
4432 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4433 doc
: /* A list mapping read symbols to their positions.
4434 This variable is modified during calls to `read' or
4435 `read-from-string', but only when `read-with-symbol-positions' is
4438 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4439 CHAR-POSITION is an integer giving the offset of that occurrence of the
4440 symbol from the position where `read' or `read-from-string' started.
4442 Note that a symbol will appear multiple times in this list, if it was
4443 read multiple times. The list is in the same order as the symbols
4445 Vread_symbol_positions_list
= Qnil
;
4447 DEFVAR_LISP ("read-circle", Vread_circle
,
4448 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4451 DEFVAR_LISP ("load-path", Vload_path
,
4452 doc
: /* List of directories to search for files to load.
4453 Each element is a string (directory name) or nil (meaning `default-directory').
4454 Initialized during startup as described in Info node `(elisp)Library Search'. */);
4456 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4457 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4458 This list should not include the empty string.
4459 `load' and related functions try to append these suffixes, in order,
4460 to the specified file name if a Lisp suffix is allowed or required. */);
4461 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4462 build_pure_c_string (".el"));
4463 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4464 doc
: /* List of suffixes that indicate representations of \
4466 This list should normally start with the empty string.
4468 Enabling Auto Compression mode appends the suffixes in
4469 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4470 mode removes them again. `load' and related functions use this list to
4471 determine whether they should look for compressed versions of a file
4472 and, if so, which suffixes they should try to append to the file name
4473 in order to do so. However, if you want to customize which suffixes
4474 the loading functions recognize as compression suffixes, you should
4475 customize `jka-compr-load-suffixes' rather than the present variable. */);
4476 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4478 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4479 doc
: /* Non-nil if inside of `load'. */);
4480 DEFSYM (Qload_in_progress
, "load-in-progress");
4482 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4483 doc
: /* An alist of functions to be evalled when particular files are loaded.
4484 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4486 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4487 a symbol \(a feature name).
4489 When `load' is run and the file-name argument matches an element's
4490 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4491 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4493 An error in FORMS does not undo the load, but does prevent execution of
4494 the rest of the FORMS. */);
4495 Vafter_load_alist
= Qnil
;
4497 DEFVAR_LISP ("load-history", Vload_history
,
4498 doc
: /* Alist mapping loaded file names to symbols and features.
4499 Each alist element should be a list (FILE-NAME ENTRIES...), where
4500 FILE-NAME is the name of a file that has been loaded into Emacs.
4501 The file name is absolute and true (i.e. it doesn't contain symlinks).
4502 As an exception, one of the alist elements may have FILE-NAME nil,
4503 for symbols and features not associated with any file.
4505 The remaining ENTRIES in the alist element describe the functions and
4506 variables defined in that file, the features provided, and the
4507 features required. Each entry has the form `(provide . FEATURE)',
4508 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4509 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4510 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4511 autoload before this file redefined it as a function. In addition,
4512 entries may also be single symbols, which means that SYMBOL was
4513 defined by `defvar' or `defconst'.
4515 During preloading, the file name recorded is relative to the main Lisp
4516 directory. These file names are converted to absolute at startup. */);
4517 Vload_history
= Qnil
;
4519 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4520 doc
: /* Full name of file being loaded by `load'. */);
4521 Vload_file_name
= Qnil
;
4523 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4524 doc
: /* File name, including directory, of user's initialization file.
4525 If the file loaded had extension `.elc', and the corresponding source file
4526 exists, this variable contains the name of source file, suitable for use
4527 by functions like `custom-save-all' which edit the init file.
4528 While Emacs loads and evaluates the init file, value is the real name
4529 of the file, regardless of whether or not it has the `.elc' extension. */);
4530 Vuser_init_file
= Qnil
;
4532 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4533 doc
: /* Used for internal purposes by `load'. */);
4534 Vcurrent_load_list
= Qnil
;
4536 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4537 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4538 The default is nil, which means use the function `read'. */);
4539 Vload_read_function
= Qnil
;
4541 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4542 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4543 The value should be a function for doing code conversion before
4544 reading a source file. It can also be nil, in which case loading is
4545 done without any code conversion.
4547 If the value is a function, it is called with four arguments,
4548 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4549 the file to load, FILE is the non-absolute name (for messages etc.),
4550 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4551 `load'. The function should return t if the file was loaded. */);
4552 Vload_source_file_function
= Qnil
;
4554 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4555 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4556 This is useful when the file being loaded is a temporary copy. */);
4557 load_force_doc_strings
= 0;
4559 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4560 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4561 This is normally bound by `load' and `eval-buffer' to control `read',
4562 and is not meant for users to change. */);
4563 load_convert_to_unibyte
= 0;
4565 DEFVAR_LISP ("source-directory", Vsource_directory
,
4566 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4567 You cannot count on them to still be there! */);
4569 = Fexpand_file_name (build_string ("../"),
4570 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4572 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4573 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4574 Vpreloaded_file_list
= Qnil
;
4576 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4577 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4578 Vbyte_boolean_vars
= Qnil
;
4580 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4581 doc
: /* Non-nil means load dangerous compiled Lisp files.
4582 Some versions of XEmacs use different byte codes than Emacs. These
4583 incompatible byte codes can make Emacs crash when it tries to execute
4585 load_dangerous_libraries
= 0;
4587 DEFVAR_LISP ("load-compat", Vload_compat
, 0);
4588 Vload_compat
= Qnil
;
4590 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4591 doc
: /* Non-nil means force printing messages when loading Lisp files.
4592 This overrides the value of the NOMESSAGE argument to `load'. */);
4593 force_load_messages
= 0;
4595 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4596 doc
: /* Regular expression matching safe to load compiled Lisp files.
4597 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4598 from the file, and matches them against this regular expression.
4599 When the regular expression matches, the file is considered to be safe
4600 to load. See also `load-dangerous-libraries'. */);
4601 Vbytecomp_version_regexp
4602 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4604 DEFSYM (Qlexical_binding
, "lexical-binding");
4605 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4606 doc
: /* Whether to use lexical binding when evaluating code.
4607 Non-nil means that the code in the current buffer should be evaluated
4608 with lexical binding.
4609 This variable is automatically set from the file variables of an
4610 interpreted Lisp file read using `load'. Unlike other file local
4611 variables, this must be set in the first line of a file. */);
4612 Vlexical_binding
= Qnil
;
4613 Fmake_variable_buffer_local (Qlexical_binding
);
4615 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4616 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4617 Veval_buffer_list
= Qnil
;
4619 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4620 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4621 Vold_style_backquotes
= Qnil
;
4622 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4624 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4625 doc
: /* Non-nil means `load' prefers the newest version of a file.
4626 This applies when a filename suffix is not explicitly specified and
4627 `load' is trying various possible suffixes (see `load-suffixes' and
4628 `load-file-rep-suffixes'). Normally, it stops at the first file
4629 that exists unless you explicitly specify one or the other. If this
4630 option is non-nil, it checks all suffixes and uses whichever file is
4632 Note that if you customize this, obviously it will not affect files
4633 that are loaded before your customizations are read! */);
4634 load_prefer_newer
= 0;
4636 /* Vsource_directory was initialized in init_lread. */
4638 DEFSYM (Qcurrent_load_list
, "current-load-list");
4639 DEFSYM (Qstandard_input
, "standard-input");
4640 DEFSYM (Qread_char
, "read-char");
4641 DEFSYM (Qget_file_char
, "get-file-char");
4642 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4643 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4645 DEFSYM (Qbackquote
, "`");
4646 DEFSYM (Qcomma
, ",");
4647 DEFSYM (Qcomma_at
, ",@");
4648 DEFSYM (Qcomma_dot
, ",.");
4650 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4651 DEFSYM (Qascii_character
, "ascii-character");
4652 DEFSYM (Qfunction
, "function");
4653 DEFSYM (Qload
, "load");
4654 DEFSYM (Qload_file_name
, "load-file-name");
4655 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4656 DEFSYM (Qfile_truename
, "file-truename");
4657 DEFSYM (Qdir_ok
, "dir-ok");
4658 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4660 staticpro (&read_objects
);
4661 read_objects
= Qnil
;
4662 staticpro (&seen_list
);
4665 Vloads_in_progress
= Qnil
;
4666 staticpro (&Vloads_in_progress
);
4668 DEFSYM (Qhash_table
, "hash-table");
4669 DEFSYM (Qdata
, "data");
4670 DEFSYM (Qtest
, "test");
4671 DEFSYM (Qsize
, "size");
4672 DEFSYM (Qweakness
, "weakness");
4673 DEFSYM (Qrehash_size
, "rehash-size");
4674 DEFSYM (Qrehash_threshold
, "rehash-threshold");