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
);
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, 5, 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
)
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
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1308 NILP (noerror
) ? Qnil
: Qt
,
1309 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1315 GCPRO3 (file
, found
, hist_file_name
);
1319 /* We somehow got here with fd == -2, meaning the file is deemed
1320 to be remote. Don't even try to reopen the file locally;
1321 just force a failure. */
1330 efound
= ENCODE_FILE (found
);
1331 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1333 stream
= fdopen (fd
, fmode
);
1337 report_file_error ("Opening stdio stream", file
);
1339 if (! NILP (Vpurify_flag
))
1340 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1342 if (NILP (nomessage
) || force_load_messages
)
1345 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1348 message_with_string ("Loading %s (source)...", file
, 1);
1350 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1352 else /* The typical case; compiled file newer than source file. */
1353 message_with_string ("Loading %s...", file
, 1);
1356 specbind (Qload_file_name
, found
);
1357 specbind (Qinhibit_file_name_operation
, Qnil
);
1358 specbind (Qload_in_progress
, Qt
);
1361 if (lisp_file_lexically_bound_p (Qget_file_char
))
1362 Fset (Qlexical_binding
, Qt
);
1364 if (! version
|| version
>= 22)
1365 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1366 0, Qnil
, Qnil
, Qnil
, Qnil
);
1369 /* We can't handle a file which was compiled with
1370 byte-compile-dynamic by older version of Emacs. */
1371 specbind (Qload_force_doc_strings
, Qt
);
1372 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1373 0, Qnil
, Qnil
, Qnil
, Qnil
);
1377 /* Run any eval-after-load forms for this file. */
1378 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1379 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1383 xfree (saved_doc_string
);
1384 saved_doc_string
= 0;
1385 saved_doc_string_size
= 0;
1387 xfree (prev_saved_doc_string
);
1388 prev_saved_doc_string
= 0;
1389 prev_saved_doc_string_size
= 0;
1391 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1394 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1397 message_with_string ("Loading %s (source)...done", file
, 1);
1399 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1401 else /* The typical case; compiled file newer than source file. */
1402 message_with_string ("Loading %s...done", file
, 1);
1409 complete_filename_p (Lisp_Object pathname
)
1411 const unsigned char *s
= SDATA (pathname
);
1412 return (IS_DIRECTORY_SEP (s
[0])
1413 || (SCHARS (pathname
) > 2
1414 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1417 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1418 doc
: /* Search for FILENAME through PATH.
1419 Returns the file's name in absolute form, or nil if not found.
1420 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1421 file name when searching.
1422 If non-nil, PREDICATE is used instead of `file-readable-p'.
1423 PREDICATE can also be an integer to pass to the faccessat(2) function,
1424 in which case file-name-handlers are ignored.
1425 This function will normally skip directories, so if you want it to find
1426 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1427 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1430 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1431 if (NILP (predicate
) && fd
>= 0)
1436 static Lisp_Object Qdir_ok
;
1438 /* Search for a file whose name is STR, looking in directories
1439 in the Lisp list PATH, and trying suffixes from SUFFIX.
1440 On success, return a file descriptor (or 1 or -2 as described below).
1441 On failure, return -1 and set errno.
1443 SUFFIXES is a list of strings containing possible suffixes.
1444 The empty suffix is automatically added if the list is empty.
1446 PREDICATE non-nil means don't open the files,
1447 just look for one that satisfies the predicate. In this case,
1448 return 1 on success. The predicate can be a lisp function or
1449 an integer to pass to `access' (in which case file-name-handlers
1452 If STOREPTR is nonzero, it points to a slot where the name of
1453 the file actually found should be stored as a Lisp string.
1454 nil is stored there on failure.
1456 If the file we find is remote, return -2
1457 but store the found remote file name in *STOREPTR.
1459 If NEWER is true, try all SUFFIXes and return the result for the
1460 newest file that exists. Does not apply to remote files,
1461 or if PREDICATE is specified. */
1464 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1465 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1467 ptrdiff_t fn_size
= 100;
1471 ptrdiff_t want_length
;
1472 Lisp_Object filename
;
1473 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
, gcpro7
;
1474 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1475 ptrdiff_t max_suffix_len
= 0;
1476 int last_errno
= ENOENT
;
1479 /* The last-modified time of the newest matching file found.
1480 Initialize it to something less than all valid timestamps. */
1481 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1485 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1487 CHECK_STRING_CAR (tail
);
1488 max_suffix_len
= max (max_suffix_len
,
1489 SBYTES (XCAR (tail
)));
1492 string
= filename
= encoded_fn
= save_string
= Qnil
;
1493 GCPRO7 (str
, string
, save_string
, filename
, path
, suffixes
, encoded_fn
);
1498 absolute
= complete_filename_p (str
);
1500 for (; CONSP (path
); path
= XCDR (path
))
1502 filename
= Fexpand_file_name (str
, XCAR (path
));
1503 if (!complete_filename_p (filename
))
1504 /* If there are non-absolute elts in PATH (eg "."). */
1505 /* Of course, this could conceivably lose if luser sets
1506 default-directory to be something non-absolute... */
1508 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1509 if (!complete_filename_p (filename
))
1510 /* Give up on this path element! */
1514 /* Calculate maximum length of any filename made from
1515 this path element/specified file name and any possible suffix. */
1516 want_length
= max_suffix_len
+ SBYTES (filename
);
1517 if (fn_size
<= want_length
)
1518 fn
= alloca (fn_size
= 100 + want_length
);
1520 /* Loop over suffixes. */
1521 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1522 CONSP (tail
); tail
= XCDR (tail
))
1524 Lisp_Object suffix
= XCAR (tail
);
1525 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1526 Lisp_Object handler
;
1528 /* Concatenate path element/specified name with the suffix.
1529 If the directory starts with /:, remove that. */
1530 int prefixlen
= ((SCHARS (filename
) > 2
1531 && SREF (filename
, 0) == '/'
1532 && SREF (filename
, 1) == ':')
1534 fnlen
= SBYTES (filename
) - prefixlen
;
1535 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1536 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1538 /* Check that the file exists and is not a directory. */
1539 /* We used to only check for handlers on non-absolute file names:
1543 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1544 It's not clear why that was the case and it breaks things like
1545 (load "/bar.el") where the file is actually "/bar.el.gz". */
1546 /* make_string has its own ideas on when to return a unibyte
1547 string and when a multibyte string, but we know better.
1548 We must have a unibyte string when dumping, since
1549 file-name encoding is shaky at best at that time, and in
1550 particular default-file-name-coding-system is reset
1551 several times during loadup. We therefore don't want to
1552 encode the file before passing it to file I/O library
1554 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1555 string
= make_unibyte_string (fn
, fnlen
);
1557 string
= make_string (fn
, fnlen
);
1558 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1559 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1562 if (NILP (predicate
))
1563 exists
= !NILP (Ffile_readable_p (string
));
1566 Lisp_Object tmp
= call1 (predicate
, string
);
1569 else if (EQ (tmp
, Qdir_ok
)
1570 || NILP (Ffile_directory_p (string
)))
1575 last_errno
= EISDIR
;
1581 /* We succeeded; return this descriptor and filename. */
1594 encoded_fn
= ENCODE_FILE (string
);
1595 pfn
= SSDATA (encoded_fn
);
1597 /* Check that we can access or open it. */
1598 if (NATNUMP (predicate
))
1601 if (INT_MAX
< XFASTINT (predicate
))
1602 last_errno
= EINVAL
;
1603 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1607 if (file_directory_p (pfn
))
1608 last_errno
= EISDIR
;
1615 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1618 if (errno
!= ENOENT
)
1623 int err
= (fstat (fd
, &st
) != 0 ? errno
1624 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1636 if (newer
&& !NATNUMP (predicate
))
1638 struct timespec mtime
= get_stat_mtime (&st
);
1640 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1645 emacs_close (save_fd
);
1648 save_string
= string
;
1653 /* We succeeded; return this descriptor and filename. */
1661 /* No more suffixes. Return the newest. */
1662 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1665 *storeptr
= save_string
;
1681 /* Merge the list we've accumulated of globals from the current input source
1682 into the load_history variable. The details depend on whether
1683 the source has an associated file name or not.
1685 FILENAME is the file name that we are loading from.
1687 ENTIRE is true if loading that entire file, false if evaluating
1691 build_load_history (Lisp_Object filename
, bool entire
)
1693 Lisp_Object tail
, prev
, newelt
;
1694 Lisp_Object tem
, tem2
;
1697 tail
= Vload_history
;
1700 while (CONSP (tail
))
1704 /* Find the feature's previous assoc list... */
1705 if (!NILP (Fequal (filename
, Fcar (tem
))))
1709 /* If we're loading the entire file, remove old data. */
1713 Vload_history
= XCDR (tail
);
1715 Fsetcdr (prev
, XCDR (tail
));
1718 /* Otherwise, cons on new symbols that are not already members. */
1721 tem2
= Vcurrent_load_list
;
1723 while (CONSP (tem2
))
1725 newelt
= XCAR (tem2
);
1727 if (NILP (Fmember (newelt
, tem
)))
1728 Fsetcar (tail
, Fcons (XCAR (tem
),
1729 Fcons (newelt
, XCDR (tem
))));
1742 /* If we're loading an entire file, cons the new assoc onto the
1743 front of load-history, the most-recently-loaded position. Also
1744 do this if we didn't find an existing member for the file. */
1745 if (entire
|| !foundit
)
1746 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1751 readevalloop_1 (int old
)
1753 load_convert_to_unibyte
= old
;
1756 /* Signal an `end-of-file' error, if possible with file name
1759 static _Noreturn
void
1760 end_of_file_error (void)
1762 if (STRINGP (Vload_file_name
))
1763 xsignal1 (Qend_of_file
, Vload_file_name
);
1765 xsignal0 (Qend_of_file
);
1769 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1771 /* If we macroexpand the toplevel form non-recursively and it ends
1772 up being a `progn' (or if it was a progn to start), treat each
1773 form in the progn as a top-level form. This way, if one form in
1774 the progn defines a macro, that macro is in effect when we expand
1775 the remaining forms. See similar code in bytecomp.el. */
1776 val
= call2 (macroexpand
, val
, Qnil
);
1777 if (EQ (CAR_SAFE (val
), Qprogn
))
1779 Lisp_Object subforms
= XCDR (val
);
1781 for (; CONSP (subforms
); subforms
= XCDR (subforms
))
1782 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1786 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1791 /* UNIBYTE specifies how to set load_convert_to_unibyte
1792 for this invocation.
1793 READFUN, if non-nil, is used instead of `read'.
1795 START, END specify region to read in current buffer (from eval-region).
1796 If the input is not from a buffer, they must be nil. */
1799 readevalloop (Lisp_Object readcharfun
,
1801 Lisp_Object sourcename
,
1803 Lisp_Object unibyte
, Lisp_Object readfun
,
1804 Lisp_Object start
, Lisp_Object end
)
1807 register Lisp_Object val
;
1809 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1810 struct buffer
*b
= 0;
1811 bool continue_reading_p
;
1812 Lisp_Object lex_bound
;
1813 /* True if reading an entire buffer. */
1814 bool whole_buffer
= 0;
1815 /* True on the first time around. */
1816 bool first_sexp
= 1;
1817 Lisp_Object compile_fn
= 0;
1819 if (MARKERP (readcharfun
))
1822 start
= readcharfun
;
1825 if (BUFFERP (readcharfun
))
1826 b
= XBUFFER (readcharfun
);
1827 else if (MARKERP (readcharfun
))
1828 b
= XMARKER (readcharfun
)->buffer
;
1830 /* We assume START is nil when input is not from a buffer. */
1831 if (! NILP (start
) && !b
)
1834 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1835 specbind (Qcurrent_load_list
, Qnil
);
1836 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1837 load_convert_to_unibyte
= !NILP (unibyte
);
1839 /* If lexical binding is active (either because it was specified in
1840 the file's header, or via a buffer-local variable), create an empty
1841 lexical environment, otherwise, turn off lexical binding. */
1842 lex_bound
= find_symbol_value (Qlexical_binding
);
1843 specbind (Qinternal_interpreter_environment
,
1844 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1845 ? Qnil
: list1 (Qt
)));
1847 GCPRO4 (sourcename
, readfun
, start
, end
);
1849 /* Try to ensure sourcename is a truename, except whilst preloading. */
1850 if (NILP (Vpurify_flag
)
1851 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1852 && !NILP (Ffboundp (Qfile_truename
)))
1853 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1855 LOADHIST_ATTACH (sourcename
);
1857 continue_reading_p
= 1;
1858 while (continue_reading_p
)
1862 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1863 error ("Reading from killed buffer");
1867 /* Switch to the buffer we are reading from. */
1868 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1869 set_buffer_internal (b
);
1871 /* Save point in it. */
1872 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1873 /* Save ZV in it. */
1874 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1875 /* Those get unbound after we read one expression. */
1877 /* Set point and ZV around stuff to be read. */
1880 Fnarrow_to_region (make_number (BEGV
), end
);
1882 /* Just for cleanliness, convert END to a marker
1883 if it is an integer. */
1885 end
= Fpoint_max_marker ();
1888 /* On the first cycle, we can easily test here
1889 whether we are reading the whole buffer. */
1890 if (b
&& first_sexp
)
1891 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1898 while ((c
= READCHAR
) != '\n' && c
!= -1);
1907 /* Ignore whitespace here, so we can detect eof. */
1908 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1909 || c
== 0xa0) /* NBSP */
1912 if (!NILP (Vpurify_flag
) && c
== '(')
1914 val
= read_list (0, readcharfun
);
1919 read_objects
= Qnil
;
1920 if (!NILP (readfun
))
1922 val
= call1 (readfun
, readcharfun
);
1924 /* If READCHARFUN has set point to ZV, we should
1925 stop reading, even if the form read sets point
1926 to a different value when evaluated. */
1927 if (BUFFERP (readcharfun
))
1929 struct buffer
*buf
= XBUFFER (readcharfun
);
1930 if (BUF_PT (buf
) == BUF_ZV (buf
))
1931 continue_reading_p
= 0;
1934 else if (! NILP (Vload_read_function
))
1935 val
= call1 (Vload_read_function
, readcharfun
);
1937 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1940 if (!NILP (start
) && continue_reading_p
)
1941 start
= Fpoint_marker ();
1943 /* Restore saved point and BEGV. */
1946 val
= eval_sub (val
);
1950 Vvalues
= Fcons (val
, Vvalues
);
1951 if (EQ (Vstandard_output
, Qt
))
1960 build_load_history (sourcename
,
1961 stream
|| whole_buffer
);
1968 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1969 doc
: /* Execute the current buffer as Lisp code.
1970 When called from a Lisp program (i.e., not interactively), this
1971 function accepts up to five optional arguments:
1972 BUFFER is the buffer to evaluate (nil means use current buffer).
1973 PRINTFLAG controls printing of output:
1974 A value of nil means discard it; anything else is stream for print.
1975 FILENAME specifies the file name to use for `load-history'.
1976 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1978 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1979 functions should work normally even if PRINTFLAG is nil.
1981 This function preserves the position of point. */)
1982 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1985 Lisp_Object tem
, buf
;
1988 buf
= Fcurrent_buffer ();
1990 buf
= Fget_buffer (buffer
);
1992 error ("No such buffer");
1994 if (NILP (printflag
) && NILP (do_allow_print
))
1999 if (NILP (filename
))
2000 filename
= BVAR (XBUFFER (buf
), filename
);
2002 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
2003 specbind (Qstandard_output
, tem
);
2004 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
2005 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2006 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
2007 readevalloop (buf
, 0, filename
,
2008 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
2014 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2015 doc
: /* Execute the region as Lisp code.
2016 When called from programs, expects two arguments,
2017 giving starting and ending indices in the current buffer
2018 of the text to be executed.
2019 Programs can pass third argument PRINTFLAG which controls output:
2020 A value of nil means discard it; anything else is stream for printing it.
2021 Also the fourth argument READ-FUNCTION, if non-nil, is used
2022 instead of `read' to read each expression. It gets one argument
2023 which is the input stream for reading characters.
2025 This function does not move point. */)
2026 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2028 /* FIXME: Do the eval-sexp-add-defvars dance! */
2030 Lisp_Object tem
, cbuf
;
2032 cbuf
= Fcurrent_buffer ();
2034 if (NILP (printflag
))
2038 specbind (Qstandard_output
, tem
);
2039 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2041 /* `readevalloop' calls functions which check the type of start and end. */
2042 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2043 !NILP (printflag
), Qnil
, read_function
,
2051 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2052 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2053 If STREAM is nil, use the value of `standard-input' (which see).
2054 STREAM or the value of `standard-input' may be:
2055 a buffer (read from point and advance it)
2056 a marker (read from where it points and advance it)
2057 a function (call it with no arguments for each character,
2058 call it with a char as argument to push a char back)
2059 a string (takes text from string, starting at the beginning)
2060 t (read text line using minibuffer and use it, or read from
2061 standard input in batch mode). */)
2062 (Lisp_Object stream
)
2065 stream
= Vstandard_input
;
2066 if (EQ (stream
, Qt
))
2067 stream
= Qread_char
;
2068 if (EQ (stream
, Qread_char
))
2069 /* FIXME: ?! When is this used !? */
2070 return call1 (intern ("read-minibuffer"),
2071 build_string ("Lisp expression: "));
2073 return read_internal_start (stream
, Qnil
, Qnil
);
2076 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2077 doc
: /* Read one Lisp expression which is represented as text by STRING.
2078 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2079 FINAL-STRING-INDEX is an integer giving the position of the next
2080 remaining character in STRING.
2081 START and END optionally delimit a substring of STRING from which to read;
2082 they default to 0 and (length STRING) respectively. */)
2083 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2086 CHECK_STRING (string
);
2087 /* `read_internal_start' sets `read_from_string_index'. */
2088 ret
= read_internal_start (string
, start
, end
);
2089 return Fcons (ret
, make_number (read_from_string_index
));
2092 /* Function to set up the global context we need in toplevel read
2095 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2096 /* `start', `end' only used when stream is a string. */
2101 new_backquote_flag
= 0;
2102 read_objects
= Qnil
;
2103 if (EQ (Vread_with_symbol_positions
, Qt
)
2104 || EQ (Vread_with_symbol_positions
, stream
))
2105 Vread_symbol_positions_list
= Qnil
;
2107 if (STRINGP (stream
)
2108 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2110 ptrdiff_t startval
, endval
;
2113 if (STRINGP (stream
))
2116 string
= XCAR (stream
);
2119 endval
= SCHARS (string
);
2123 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2124 args_out_of_range (string
, end
);
2125 endval
= XINT (end
);
2132 CHECK_NUMBER (start
);
2133 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2134 args_out_of_range (string
, start
);
2135 startval
= XINT (start
);
2137 read_from_string_index
= startval
;
2138 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2139 read_from_string_limit
= endval
;
2142 retval
= read0 (stream
);
2143 if (EQ (Vread_with_symbol_positions
, Qt
)
2144 || EQ (Vread_with_symbol_positions
, stream
))
2145 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2150 /* Signal Qinvalid_read_syntax error.
2151 S is error string of length N (if > 0) */
2153 static _Noreturn
void
2154 invalid_syntax (const char *s
)
2156 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2160 /* Use this for recursive reads, in contexts where internal tokens
2164 read0 (Lisp_Object readcharfun
)
2166 register Lisp_Object val
;
2169 val
= read1 (readcharfun
, &c
, 0);
2173 xsignal1 (Qinvalid_read_syntax
,
2174 Fmake_string (make_number (1), make_number (c
)));
2177 static ptrdiff_t read_buffer_size
;
2178 static char *read_buffer
;
2180 /* Read a \-escape sequence, assuming we already read the `\'.
2181 If the escape sequence forces unibyte, return eight-bit char. */
2184 read_escape (Lisp_Object readcharfun
, bool stringp
)
2187 /* \u allows up to four hex digits, \U up to eight. Default to the
2188 behavior for \u, and change this value in the case that \U is seen. */
2189 int unicode_hex_count
= 4;
2194 end_of_file_error ();
2224 error ("Invalid escape character syntax");
2227 c
= read_escape (readcharfun
, 0);
2228 return c
| meta_modifier
;
2233 error ("Invalid escape character syntax");
2236 c
= read_escape (readcharfun
, 0);
2237 return c
| shift_modifier
;
2242 error ("Invalid escape character syntax");
2245 c
= read_escape (readcharfun
, 0);
2246 return c
| hyper_modifier
;
2251 error ("Invalid escape character syntax");
2254 c
= read_escape (readcharfun
, 0);
2255 return c
| alt_modifier
;
2259 if (stringp
|| c
!= '-')
2266 c
= read_escape (readcharfun
, 0);
2267 return c
| super_modifier
;
2272 error ("Invalid escape character syntax");
2276 c
= read_escape (readcharfun
, 0);
2277 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2278 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2279 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2280 return c
| ctrl_modifier
;
2281 /* ASCII control chars are made from letters (both cases),
2282 as well as the non-letters within 0100...0137. */
2283 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2284 return (c
& (037 | ~0177));
2285 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2286 return (c
& (037 | ~0177));
2288 return c
| ctrl_modifier
;
2298 /* An octal escape, as in ANSI C. */
2300 register int i
= c
- '0';
2301 register int count
= 0;
2304 if ((c
= READCHAR
) >= '0' && c
<= '7')
2316 if (i
>= 0x80 && i
< 0x100)
2317 i
= BYTE8_TO_CHAR (i
);
2322 /* A hex escape, as in ANSI C. */
2329 if (c
>= '0' && c
<= '9')
2334 else if ((c
>= 'a' && c
<= 'f')
2335 || (c
>= 'A' && c
<= 'F'))
2338 if (c
>= 'a' && c
<= 'f')
2348 /* Allow hex escapes as large as ?\xfffffff, because some
2349 packages use them to denote characters with modifiers. */
2350 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2351 error ("Hex character out of range: \\x%x...", i
);
2355 if (count
< 3 && i
>= 0x80)
2356 return BYTE8_TO_CHAR (i
);
2361 /* Post-Unicode-2.0: Up to eight hex chars. */
2362 unicode_hex_count
= 8;
2365 /* A Unicode escape. We only permit them in strings and characters,
2366 not arbitrarily in the source code, as in some other languages. */
2371 while (++count
<= unicode_hex_count
)
2374 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2376 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2377 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2378 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2380 error ("Non-hex digit used for Unicode escape");
2383 error ("Non-Unicode character: 0x%x", i
);
2392 /* Return the digit that CHARACTER stands for in the given BASE.
2393 Return -1 if CHARACTER is out of range for BASE,
2394 and -2 if CHARACTER is not valid for any supported BASE. */
2396 digit_to_number (int character
, int base
)
2400 if ('0' <= character
&& character
<= '9')
2401 digit
= character
- '0';
2402 else if ('a' <= character
&& character
<= 'z')
2403 digit
= character
- 'a' + 10;
2404 else if ('A' <= character
&& character
<= 'Z')
2405 digit
= character
- 'A' + 10;
2409 return digit
< base
? digit
: -1;
2412 /* Read an integer in radix RADIX using READCHARFUN to read
2413 characters. RADIX must be in the interval [2..36]; if it isn't, a
2414 read error is signaled . Value is the integer read. Signals an
2415 error if encountering invalid read syntax or if RADIX is out of
2419 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2421 /* Room for sign, leading 0, other digits, trailing null byte.
2422 Also, room for invalid syntax diagnostic. */
2423 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2424 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2426 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2428 if (radix
< 2 || radix
> 36)
2436 if (c
== '-' || c
== '+')
2447 /* Ignore redundant leading zeros, so the buffer doesn't
2448 fill up with them. */
2454 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2461 if (p
< buf
+ sizeof buf
- 1)
2475 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2476 invalid_syntax (buf
);
2479 return string_to_number (buf
, radix
, 0);
2483 /* If the next token is ')' or ']' or '.', we store that character
2484 in *PCH and the return value is not interesting. Else, we store
2485 zero in *PCH and we read and return one lisp object.
2487 FIRST_IN_LIST is true if this is the first element of a list. */
2490 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2493 bool uninterned_symbol
= 0;
2500 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2502 end_of_file_error ();
2507 return read_list (0, readcharfun
);
2510 return read_vector (readcharfun
, 0);
2526 /* Accept extended format for hashtables (extensible to
2528 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2529 Lisp_Object tmp
= read_list (0, readcharfun
);
2530 Lisp_Object head
= CAR_SAFE (tmp
);
2531 Lisp_Object data
= Qnil
;
2532 Lisp_Object val
= Qnil
;
2533 /* The size is 2 * number of allowed keywords to
2535 Lisp_Object params
[10];
2537 Lisp_Object key
= Qnil
;
2538 int param_count
= 0;
2540 if (!EQ (head
, Qhash_table
))
2541 error ("Invalid extended read marker at head of #s list "
2542 "(only hash-table allowed)");
2544 tmp
= CDR_SAFE (tmp
);
2546 /* This is repetitive but fast and simple. */
2547 params
[param_count
] = QCsize
;
2548 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2549 if (!NILP (params
[param_count
+ 1]))
2552 params
[param_count
] = QCtest
;
2553 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2554 if (!NILP (params
[param_count
+ 1]))
2557 params
[param_count
] = QCweakness
;
2558 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2559 if (!NILP (params
[param_count
+ 1]))
2562 params
[param_count
] = QCrehash_size
;
2563 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2564 if (!NILP (params
[param_count
+ 1]))
2567 params
[param_count
] = QCrehash_threshold
;
2568 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2569 if (!NILP (params
[param_count
+ 1]))
2572 /* This is the hashtable data. */
2573 data
= Fplist_get (tmp
, Qdata
);
2575 /* Now use params to make a new hashtable and fill it. */
2576 ht
= Fmake_hash_table (param_count
, params
);
2578 while (CONSP (data
))
2583 error ("Odd number of elements in hashtable data");
2586 Fputhash (key
, val
, ht
);
2592 invalid_syntax ("#");
2600 tmp
= read_vector (readcharfun
, 0);
2601 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2602 error ("Invalid size char-table");
2603 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2615 tmp
= read_vector (readcharfun
, 0);
2618 error ("Invalid size char-table");
2619 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2620 error ("Invalid depth in char-table");
2621 depth
= XINT (AREF (tmp
, 0));
2622 if (chartab_size
[depth
] != size
- 2)
2623 error ("Invalid size char-table");
2624 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2627 invalid_syntax ("#^" "^");
2629 invalid_syntax ("#^");
2634 length
= read1 (readcharfun
, pch
, first_in_list
);
2638 Lisp_Object tmp
, val
;
2639 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2640 unsigned char *data
;
2643 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2644 if (STRING_MULTIBYTE (tmp
)
2645 || (size_in_chars
!= SCHARS (tmp
)
2646 /* We used to print 1 char too many
2647 when the number of bits was a multiple of 8.
2648 Accept such input in case it came from an old
2650 && ! (XFASTINT (length
)
2651 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2652 invalid_syntax ("#&...");
2654 val
= make_uninit_bool_vector (XFASTINT (length
));
2655 data
= bool_vector_uchar_data (val
);
2656 memcpy (data
, SDATA (tmp
), size_in_chars
);
2657 /* Clear the extraneous bits in the last byte. */
2658 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2659 data
[size_in_chars
- 1]
2660 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2663 invalid_syntax ("#&...");
2667 /* Accept compiled functions at read-time so that we don't have to
2668 build them using function calls. */
2670 struct Lisp_Vector
*vec
;
2671 tmp
= read_vector (readcharfun
, 1);
2672 vec
= XVECTOR (tmp
);
2673 if (vec
->header
.size
== 0)
2674 invalid_syntax ("Empty byte-code object");
2675 make_byte_code (vec
);
2681 struct gcpro gcpro1
;
2684 /* Read the string itself. */
2685 tmp
= read1 (readcharfun
, &ch
, 0);
2686 if (ch
!= 0 || !STRINGP (tmp
))
2687 invalid_syntax ("#");
2689 /* Read the intervals and their properties. */
2692 Lisp_Object beg
, end
, plist
;
2694 beg
= read1 (readcharfun
, &ch
, 0);
2699 end
= read1 (readcharfun
, &ch
, 0);
2701 plist
= read1 (readcharfun
, &ch
, 0);
2703 invalid_syntax ("Invalid string property list");
2704 Fset_text_properties (beg
, end
, plist
, tmp
);
2710 /* #@NUMBER is used to skip NUMBER following bytes.
2711 That's used in .elc files to skip over doc strings
2712 and function definitions. */
2715 enum { extra
= 100 };
2716 ptrdiff_t i
, nskip
= 0, digits
= 0;
2718 /* Read a decimal integer. */
2719 while ((c
= READCHAR
) >= 0
2720 && c
>= '0' && c
<= '9')
2722 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2727 if (digits
== 2 && nskip
== 0)
2728 { /* We've just seen #@00, which means "skip to end". */
2729 skip_dyn_eof (readcharfun
);
2734 /* We can't use UNREAD here, because in the code below we side-step
2735 READCHAR. Instead, assume the first char after #@NNN occupies
2736 a single byte, which is the case normally since it's just
2742 if (load_force_doc_strings
2743 && (FROM_FILE_P (readcharfun
)))
2745 /* If we are supposed to force doc strings into core right now,
2746 record the last string that we skipped,
2747 and record where in the file it comes from. */
2749 /* But first exchange saved_doc_string
2750 with prev_saved_doc_string, so we save two strings. */
2752 char *temp
= saved_doc_string
;
2753 ptrdiff_t temp_size
= saved_doc_string_size
;
2754 file_offset temp_pos
= saved_doc_string_position
;
2755 ptrdiff_t temp_len
= saved_doc_string_length
;
2757 saved_doc_string
= prev_saved_doc_string
;
2758 saved_doc_string_size
= prev_saved_doc_string_size
;
2759 saved_doc_string_position
= prev_saved_doc_string_position
;
2760 saved_doc_string_length
= prev_saved_doc_string_length
;
2762 prev_saved_doc_string
= temp
;
2763 prev_saved_doc_string_size
= temp_size
;
2764 prev_saved_doc_string_position
= temp_pos
;
2765 prev_saved_doc_string_length
= temp_len
;
2768 if (saved_doc_string_size
== 0)
2770 saved_doc_string
= xmalloc_atomic (nskip
+ extra
);
2771 saved_doc_string_size
= nskip
+ extra
;
2773 if (nskip
> saved_doc_string_size
)
2775 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2776 saved_doc_string_size
= nskip
+ extra
;
2779 saved_doc_string_position
= file_tell (instream
);
2781 /* Copy that many characters into saved_doc_string. */
2783 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2784 saved_doc_string
[i
] = c
= getc (instream
);
2787 saved_doc_string_length
= i
;
2790 /* Skip that many bytes. */
2791 skip_dyn_bytes (readcharfun
, nskip
);
2797 /* #! appears at the beginning of an executable file.
2798 Skip the first line. */
2799 while (c
!= '\n' && c
>= 0)
2804 return Vload_file_name
;
2806 return list2 (Qfunction
, read0 (readcharfun
));
2807 /* #:foo is the uninterned symbol named foo. */
2810 uninterned_symbol
= 1;
2813 && c
!= 0xa0 /* NBSP */
2815 || strchr ("\"';()[]#`,", c
) == NULL
)))
2817 /* No symbol character follows, this is the empty
2820 return Fmake_symbol (empty_unibyte_string
);
2824 /* ## is the empty symbol. */
2826 return Fintern (empty_unibyte_string
, Qnil
);
2827 /* Reader forms that can reuse previously read objects. */
2828 if (c
>= '0' && c
<= '9')
2833 /* Read a non-negative integer. */
2834 while (c
>= '0' && c
<= '9')
2836 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2837 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2838 n
= MOST_POSITIVE_FIXNUM
+ 1;
2840 n
= n
* 10 + c
- '0';
2844 if (n
<= MOST_POSITIVE_FIXNUM
)
2846 if (c
== 'r' || c
== 'R')
2847 return read_integer (readcharfun
, n
);
2849 if (! NILP (Vread_circle
))
2851 /* #n=object returns object, but associates it with
2855 /* Make a placeholder for #n# to use temporarily. */
2856 Lisp_Object placeholder
;
2859 placeholder
= Fcons (Qnil
, Qnil
);
2860 cell
= Fcons (make_number (n
), placeholder
);
2861 read_objects
= Fcons (cell
, read_objects
);
2863 /* Read the object itself. */
2864 tem
= read0 (readcharfun
);
2866 /* Now put it everywhere the placeholder was... */
2867 substitute_object_in_subtree (tem
, placeholder
);
2869 /* ...and #n# will use the real value from now on. */
2870 Fsetcdr (cell
, tem
);
2875 /* #n# returns a previously read object. */
2878 tem
= Fassq (make_number (n
), read_objects
);
2884 /* Fall through to error message. */
2886 else if (c
== 'x' || c
== 'X')
2887 return read_integer (readcharfun
, 16);
2888 else if (c
== 'o' || c
== 'O')
2889 return read_integer (readcharfun
, 8);
2890 else if (c
== 'b' || c
== 'B')
2891 return read_integer (readcharfun
, 2);
2894 invalid_syntax ("#");
2897 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2901 return list2 (Qquote
, read0 (readcharfun
));
2905 int next_char
= READCHAR
;
2907 /* Transition from old-style to new-style:
2908 If we see "(`" it used to mean old-style, which usually works
2909 fine because ` should almost never appear in such a position
2910 for new-style. But occasionally we need "(`" to mean new
2911 style, so we try to distinguish the two by the fact that we
2912 can either write "( `foo" or "(` foo", where the first
2913 intends to use new-style whereas the second intends to use
2914 old-style. For Emacs-25, we should completely remove this
2915 first_in_list exception (old-style can still be obtained via
2917 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2919 Vold_style_backquotes
= Qt
;
2925 bool saved_new_backquote_flag
= new_backquote_flag
;
2927 new_backquote_flag
= 1;
2928 value
= read0 (readcharfun
);
2929 new_backquote_flag
= saved_new_backquote_flag
;
2931 return list2 (Qbackquote
, value
);
2936 int next_char
= READCHAR
;
2938 /* Transition from old-style to new-style:
2939 It used to be impossible to have a new-style , other than within
2940 a new-style `. This is sufficient when ` and , are used in the
2941 normal way, but ` and , can also appear in args to macros that
2942 will not interpret them in the usual way, in which case , may be
2943 used without any ` anywhere near.
2944 So we now use the same heuristic as for backquote: old-style
2945 unquotes are only recognized when first on a list, and when
2946 followed by a space.
2947 Because it's more difficult to peek 2 chars ahead, a new-style
2948 ,@ can still not be used outside of a `, unless it's in the middle
2950 if (new_backquote_flag
2952 || (next_char
!= ' ' && next_char
!= '@'))
2954 Lisp_Object comma_type
= Qnil
;
2959 comma_type
= Qcomma_at
;
2961 comma_type
= Qcomma_dot
;
2964 if (ch
>= 0) UNREAD (ch
);
2965 comma_type
= Qcomma
;
2968 value
= read0 (readcharfun
);
2969 return list2 (comma_type
, value
);
2973 Vold_style_backquotes
= Qt
;
2985 end_of_file_error ();
2987 /* Accept `single space' syntax like (list ? x) where the
2988 whitespace character is SPC or TAB.
2989 Other literal whitespace like NL, CR, and FF are not accepted,
2990 as there are well-established escape sequences for these. */
2991 if (c
== ' ' || c
== '\t')
2992 return make_number (c
);
2995 c
= read_escape (readcharfun
, 0);
2996 modifiers
= c
& CHAR_MODIFIER_MASK
;
2997 c
&= ~CHAR_MODIFIER_MASK
;
2998 if (CHAR_BYTE8_P (c
))
2999 c
= CHAR_TO_BYTE8 (c
);
3002 next_char
= READCHAR
;
3003 ok
= (next_char
<= 040
3004 || (next_char
< 0200
3005 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3008 return make_number (c
);
3010 invalid_syntax ("?");
3015 char *p
= read_buffer
;
3016 char *end
= read_buffer
+ read_buffer_size
;
3018 /* True if we saw an escape sequence specifying
3019 a multibyte character. */
3020 bool force_multibyte
= 0;
3021 /* True if we saw an escape sequence specifying
3022 a single-byte character. */
3023 bool force_singlebyte
= 0;
3025 ptrdiff_t nchars
= 0;
3027 while ((ch
= READCHAR
) >= 0
3030 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3032 ptrdiff_t offset
= p
- read_buffer
;
3033 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3034 memory_full (SIZE_MAX
);
3035 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3036 read_buffer_size
*= 2;
3037 p
= read_buffer
+ offset
;
3038 end
= read_buffer
+ read_buffer_size
;
3045 ch
= read_escape (readcharfun
, 1);
3047 /* CH is -1 if \ newline has just been seen. */
3050 if (p
== read_buffer
)
3055 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3056 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3058 if (CHAR_BYTE8_P (ch
))
3059 force_singlebyte
= 1;
3060 else if (! ASCII_CHAR_P (ch
))
3061 force_multibyte
= 1;
3062 else /* I.e. ASCII_CHAR_P (ch). */
3064 /* Allow `\C- ' and `\C-?'. */
3065 if (modifiers
== CHAR_CTL
)
3068 ch
= 0, modifiers
= 0;
3070 ch
= 127, modifiers
= 0;
3072 if (modifiers
& CHAR_SHIFT
)
3074 /* Shift modifier is valid only with [A-Za-z]. */
3075 if (ch
>= 'A' && ch
<= 'Z')
3076 modifiers
&= ~CHAR_SHIFT
;
3077 else if (ch
>= 'a' && ch
<= 'z')
3078 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3081 if (modifiers
& CHAR_META
)
3083 /* Move the meta bit to the right place for a
3085 modifiers
&= ~CHAR_META
;
3086 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3087 force_singlebyte
= 1;
3091 /* Any modifiers remaining are invalid. */
3093 error ("Invalid modifier in string");
3094 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3098 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3099 if (CHAR_BYTE8_P (ch
))
3100 force_singlebyte
= 1;
3101 else if (! ASCII_CHAR_P (ch
))
3102 force_multibyte
= 1;
3108 end_of_file_error ();
3110 if (! force_multibyte
&& force_singlebyte
)
3112 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3113 forms. Convert it to unibyte. */
3114 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3116 p
= read_buffer
+ nchars
;
3119 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3121 || (p
- read_buffer
!= nchars
)));
3126 int next_char
= READCHAR
;
3129 if (next_char
<= 040
3130 || (next_char
< 0200
3131 && strchr ("\"';([#?`,", next_char
) != NULL
))
3137 /* Otherwise, we fall through! Note that the atom-reading loop
3138 below will now loop at least once, assuring that we will not
3139 try to UNREAD two characters in a row. */
3143 if (c
<= 040) goto retry
;
3144 if (c
== 0xa0) /* NBSP */
3149 char *p
= read_buffer
;
3151 EMACS_INT start_position
= readchar_count
- 1;
3154 char *end
= read_buffer
+ read_buffer_size
;
3158 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3160 ptrdiff_t offset
= p
- read_buffer
;
3161 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3162 memory_full (SIZE_MAX
);
3163 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3164 read_buffer_size
*= 2;
3165 p
= read_buffer
+ offset
;
3166 end
= read_buffer
+ read_buffer_size
;
3173 end_of_file_error ();
3178 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3184 && c
!= 0xa0 /* NBSP */
3186 || strchr ("\"';()[]#`,", c
) == NULL
));
3190 ptrdiff_t offset
= p
- read_buffer
;
3191 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3192 memory_full (SIZE_MAX
);
3193 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3194 read_buffer_size
*= 2;
3195 p
= read_buffer
+ offset
;
3196 end
= read_buffer
+ read_buffer_size
;
3202 if (!quoted
&& !uninterned_symbol
)
3204 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3205 if (! NILP (result
))
3209 Lisp_Object name
, result
;
3210 ptrdiff_t nbytes
= p
- read_buffer
;
3213 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3217 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3218 ? make_pure_string
: make_specified_string
)
3219 (read_buffer
, nchars
, nbytes
, multibyte
));
3220 result
= (uninterned_symbol
? Fmake_symbol (name
)
3221 : Fintern (name
, Qnil
));
3223 if (EQ (Vread_with_symbol_positions
, Qt
)
3224 || EQ (Vread_with_symbol_positions
, readcharfun
))
3225 Vread_symbol_positions_list
3226 = Fcons (Fcons (result
, make_number (start_position
)),
3227 Vread_symbol_positions_list
);
3235 /* List of nodes we've seen during substitute_object_in_subtree. */
3236 static Lisp_Object seen_list
;
3239 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3241 Lisp_Object check_object
;
3243 /* We haven't seen any objects when we start. */
3246 /* Make all the substitutions. */
3248 = substitute_object_recurse (object
, placeholder
, object
);
3250 /* Clear seen_list because we're done with it. */
3253 /* The returned object here is expected to always eq the
3255 if (!EQ (check_object
, object
))
3256 error ("Unexpected mutation error in reader");
3259 /* Feval doesn't get called from here, so no gc protection is needed. */
3260 #define SUBSTITUTE(get_val, set_val) \
3262 Lisp_Object old_value = get_val; \
3263 Lisp_Object true_value \
3264 = substitute_object_recurse (object, placeholder, \
3267 if (!EQ (old_value, true_value)) \
3274 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3276 /* If we find the placeholder, return the target object. */
3277 if (EQ (placeholder
, subtree
))
3280 /* If we've been to this node before, don't explore it again. */
3281 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3284 /* If this node can be the entry point to a cycle, remember that
3285 we've seen it. It can only be such an entry point if it was made
3286 by #n=, which means that we can find it as a value in
3288 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3289 seen_list
= Fcons (subtree
, seen_list
);
3291 /* Recurse according to subtree's type.
3292 Every branch must return a Lisp_Object. */
3293 if (VECTORLIKEP (subtree
))
3295 ptrdiff_t i
, length
= 0;
3296 if (BOOL_VECTOR_P (subtree
))
3297 return subtree
; /* No sub-objects anyway. */
3298 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3299 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3300 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3301 else if (VECTORP (subtree
))
3302 length
= ASIZE (subtree
);
3304 /* An unknown pseudovector may contain non-Lisp fields, so we
3305 can't just blindly traverse all its fields. We used to call
3306 `Flength' which signaled `sequencep', so I just preserved this
3308 wrong_type_argument (Qsequencep
, subtree
);
3310 for (i
= 0; i
< length
; i
++)
3311 SUBSTITUTE (AREF (subtree
, i
),
3312 ASET (subtree
, i
, true_value
));
3315 else if (CONSP (subtree
))
3317 SUBSTITUTE (XCAR (subtree
),
3318 XSETCAR (subtree
, true_value
));
3319 SUBSTITUTE (XCDR (subtree
),
3320 XSETCDR (subtree
, true_value
));
3323 else if (STRINGP (subtree
))
3325 /* Check for text properties in each interval.
3326 substitute_in_interval contains part of the logic. */
3328 INTERVAL root_interval
= string_intervals (subtree
);
3329 Lisp_Object arg
= Fcons (object
, placeholder
);
3331 traverse_intervals_noorder (root_interval
,
3332 &substitute_in_interval
, arg
);
3337 /* Other types don't recurse any further. */
3341 /* Helper function for substitute_object_recurse. */
3343 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3345 Lisp_Object object
= Fcar (arg
);
3346 Lisp_Object placeholder
= Fcdr (arg
);
3348 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3358 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3359 integer syntax and fits in a fixnum, else return the nearest float if CP has
3360 either floating point or integer syntax and BASE is 10, else return nil. If
3361 IGNORE_TRAILING, consider just the longest prefix of CP that has
3362 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3363 number has integer syntax but does not fit. */
3366 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3369 char const *cp
= string
;
3371 bool float_syntax
= 0;
3374 /* Compute NaN and infinities using a variable, to cope with compilers that
3375 think they are smarter than we are. */
3378 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3379 IEEE floating point hosts, and works around a formerly-common bug where
3380 atof ("-0.0") drops the sign. */
3381 bool negative
= *cp
== '-';
3383 bool signedp
= negative
|| *cp
== '+';
3388 leading_digit
= digit_to_number (*cp
, base
);
3389 if (leading_digit
>= 0)
3394 while (digit_to_number (*cp
, base
) >= 0);
3404 if ('0' <= *cp
&& *cp
<= '9')
3409 while ('0' <= *cp
&& *cp
<= '9');
3411 if (*cp
== 'e' || *cp
== 'E')
3413 char const *ecp
= cp
;
3415 if (*cp
== '+' || *cp
== '-')
3417 if ('0' <= *cp
&& *cp
<= '9')
3422 while ('0' <= *cp
&& *cp
<= '9');
3424 else if (cp
[-1] == '+'
3425 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3431 else if (cp
[-1] == '+'
3432 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3436 value
= zero
/ zero
;
3438 /* If that made a "negative" NaN, negate it. */
3441 union { double d
; char c
[sizeof (double)]; }
3442 u_data
, u_minus_zero
;
3444 u_minus_zero
.d
= -0.0;
3445 for (i
= 0; i
< sizeof (double); i
++)
3446 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3452 /* Now VALUE is a positive NaN. */
3458 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3459 || state
== (LEAD_INT
|E_EXP
));
3462 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3463 any prefix that matches. Otherwise, the entire string must match. */
3464 if (! (ignore_trailing
3465 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3466 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3469 /* If the number uses integer and not float syntax, and is in C-language
3470 range, use its value, preferably as a fixnum. */
3471 if (leading_digit
>= 0 && ! float_syntax
)
3475 /* Fast special case for single-digit integers. This also avoids a
3476 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3477 case some versions of strtoumax accept numbers like "0x1" that Emacs
3479 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3480 return make_number (negative
? -leading_digit
: leading_digit
);
3483 n
= strtoumax (string
+ signedp
, NULL
, base
);
3484 if (errno
== ERANGE
)
3486 /* Unfortunately there's no simple and accurate way to convert
3487 non-base-10 numbers that are out of C-language range. */
3489 xsignal1 (Qoverflow_error
, build_string (string
));
3491 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3493 EMACS_INT signed_n
= n
;
3494 return make_number (negative
? -signed_n
: signed_n
);
3500 /* Either the number uses float syntax, or it does not fit into a fixnum.
3501 Convert it from string to floating point, unless the value is already
3502 known because it is an infinity, a NAN, or its absolute value fits in
3505 value
= atof (string
+ signedp
);
3507 return make_float (negative
? -value
: value
);
3512 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3516 Lisp_Object tem
, item
, vector
;
3519 tem
= read_list (1, readcharfun
);
3520 len
= Flength (tem
);
3521 vector
= Fmake_vector (len
, Qnil
);
3523 size
= ASIZE (vector
);
3524 ptr
= XVECTOR (vector
)->contents
;
3525 for (i
= 0; i
< size
; i
++)
3528 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3529 bytecode object, the docstring containing the bytecode and
3530 constants values must be treated as unibyte and passed to
3531 Fread, to get the actual bytecode string and constants vector. */
3532 if (bytecodeflag
&& load_force_doc_strings
)
3534 if (i
== COMPILED_BYTECODE
)
3536 if (!STRINGP (item
))
3537 error ("Invalid byte code");
3539 /* Delay handling the bytecode slot until we know whether
3540 it is lazily-loaded (we can tell by whether the
3541 constants slot is nil). */
3542 ASET (vector
, COMPILED_CONSTANTS
, item
);
3545 else if (i
== COMPILED_CONSTANTS
)
3547 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3551 /* Coerce string to unibyte (like string-as-unibyte,
3552 but without generating extra garbage and
3553 guaranteeing no change in the contents). */
3554 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3555 STRING_SET_UNIBYTE (bytestr
);
3557 item
= Fread (Fcons (bytestr
, readcharfun
));
3559 error ("Invalid byte code");
3561 bytestr
= XCAR (item
);
3565 /* Now handle the bytecode slot. */
3566 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3568 else if (i
== COMPILED_DOC_STRING
3570 && ! STRING_MULTIBYTE (item
))
3572 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3573 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3575 item
= Fstring_as_multibyte (item
);
3578 ASET (vector
, i
, item
);
3584 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3587 read_list (bool flag
, Lisp_Object readcharfun
)
3589 Lisp_Object val
, tail
;
3590 Lisp_Object elt
, tem
;
3591 struct gcpro gcpro1
, gcpro2
;
3592 /* 0 is the normal case.
3593 1 means this list is a doc reference; replace it with the number 0.
3594 2 means this list is a doc reference; replace it with the doc string. */
3595 int doc_reference
= 0;
3597 /* Initialize this to 1 if we are reading a list. */
3598 bool first_in_list
= flag
<= 0;
3607 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3612 /* While building, if the list starts with #$, treat it specially. */
3613 if (EQ (elt
, Vload_file_name
)
3615 && !NILP (Vpurify_flag
))
3617 if (NILP (Vdoc_file_name
))
3618 /* We have not yet called Snarf-documentation, so assume
3619 this file is described in the DOC file
3620 and Snarf-documentation will fill in the right value later.
3621 For now, replace the whole list with 0. */
3624 /* We have already called Snarf-documentation, so make a relative
3625 file name for this file, so it can be found properly
3626 in the installed Lisp directory.
3627 We don't use Fexpand_file_name because that would make
3628 the directory absolute now. */
3629 elt
= concat2 (build_string ("../lisp/"),
3630 Ffile_name_nondirectory (elt
));
3632 else if (EQ (elt
, Vload_file_name
)
3634 && load_force_doc_strings
)
3643 invalid_syntax (") or . in a vector");
3651 XSETCDR (tail
, read0 (readcharfun
));
3653 val
= read0 (readcharfun
);
3654 read1 (readcharfun
, &ch
, 0);
3658 if (doc_reference
== 1)
3659 return make_number (0);
3660 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3663 file_offset saved_position
;
3664 /* Get a doc string from the file we are loading.
3665 If it's in saved_doc_string, get it from there.
3667 Here, we don't know if the string is a
3668 bytecode string or a doc string. As a
3669 bytecode string must be unibyte, we always
3670 return a unibyte string. If it is actually a
3671 doc string, caller must make it
3674 /* Position is negative for user variables. */
3675 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3676 if (pos
>= saved_doc_string_position
3677 && pos
< (saved_doc_string_position
3678 + saved_doc_string_length
))
3680 saved
= saved_doc_string
;
3681 saved_position
= saved_doc_string_position
;
3683 /* Look in prev_saved_doc_string the same way. */
3684 else if (pos
>= prev_saved_doc_string_position
3685 && pos
< (prev_saved_doc_string_position
3686 + prev_saved_doc_string_length
))
3688 saved
= prev_saved_doc_string
;
3689 saved_position
= prev_saved_doc_string_position
;
3693 ptrdiff_t start
= pos
- saved_position
;
3696 /* Process quoting with ^A,
3697 and find the end of the string,
3698 which is marked with ^_ (037). */
3699 for (from
= start
, to
= start
;
3700 saved
[from
] != 037;)
3702 int c
= saved
[from
++];
3706 saved
[to
++] = (c
== 1 ? c
3715 return make_unibyte_string (saved
+ start
,
3719 return get_doc_string (val
, 1, 0);
3724 invalid_syntax (". in wrong context");
3726 invalid_syntax ("] in a list");
3730 XSETCDR (tail
, tem
);
3737 static Lisp_Object initial_obarray
;
3740 obhash (Lisp_Object obarray
)
3742 Lisp_Object tem
= scm_hashq_get_handle (obarrays
, obarray
);
3743 if (SCM_UNLIKELY (scm_is_false (tem
)))
3744 tem
= scm_hashq_create_handle_x (obarrays
, obarray
,
3745 scm_make_obarray ());
3746 return scm_cdr (tem
);
3749 /* Get an error if OBARRAY is not an obarray.
3750 If it is one, return it. */
3753 check_obarray (Lisp_Object obarray
)
3755 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3757 /* If Vobarray is now invalid, force it to be valid. */
3758 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3759 wrong_type_argument (Qvectorp
, obarray
);
3764 /* Intern the C string STR: return a symbol with that name,
3765 interned in the current obarray. */
3768 intern_1 (const char *str
, ptrdiff_t len
)
3770 return Fintern (make_string (str
, len
), Qnil
);
3774 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3776 return Fintern (make_pure_c_string (str
, len
), Qnil
);
3779 DEFUN ("find-symbol", Ffind_symbol
, Sfind_symbol
, 1, 2, 0,
3780 doc
: /* find-symbol */)
3781 (Lisp_Object string
, Lisp_Object obarray
)
3783 Lisp_Object tem
, sstring
, found
;
3785 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3786 CHECK_STRING (string
);
3788 sstring
= scm_from_utf8_stringn (SSDATA (string
), SBYTES (string
));
3789 tem
= scm_find_symbol (sstring
, obhash (obarray
));
3790 if (scm_is_true (tem
))
3792 if (EQ (tem
, Qnil_
))
3794 else if (EQ (tem
, Qt_
))
3796 return scm_values (scm_list_2 (tem
, Qt
));
3799 return scm_values (scm_list_2 (Qnil
, Qnil
));
3802 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3803 doc
: /* Return the canonical symbol whose name is STRING.
3804 If there is none, one is created by this function and returned.
3805 A second optional argument specifies the obarray to use;
3806 it defaults to the value of `obarray'. */)
3807 (Lisp_Object string
, Lisp_Object obarray
)
3809 register Lisp_Object tem
, sym
, *ptr
;
3811 if (NILP (obarray
)) obarray
= Vobarray
;
3812 obarray
= check_obarray (obarray
);
3814 CHECK_STRING (string
);
3816 tem
= Ffind_symbol (string
, obarray
);
3817 if (! NILP (scm_c_value_ref (tem
, 1)))
3818 return scm_c_value_ref (tem
, 0);
3820 sym
= scm_intern (scm_from_utf8_stringn (SSDATA (string
),
3824 if ((SREF (string
, 0) == ':')
3825 && EQ (obarray
, initial_obarray
))
3827 SET_SYMBOL_CONSTANT (XSYMBOL (sym
), 1);
3828 SET_SYMBOL_REDIRECT (XSYMBOL (sym
), SYMBOL_PLAINVAL
);
3829 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3835 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3836 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3837 NAME may be a string or a symbol. If it is a symbol, that exact
3838 symbol is searched for.
3839 A second optional argument specifies the obarray to use;
3840 it defaults to the value of `obarray'. */)
3841 (Lisp_Object name
, Lisp_Object obarray
)
3843 register Lisp_Object tem
, string
, mv
, found
;
3845 string
= SYMBOLP (name
) ? SYMBOL_NAME (name
) : name
;
3846 mv
= Ffind_symbol (string
, obarray
);
3847 tem
= scm_c_value_ref (mv
, 0);
3848 found
= scm_c_value_ref (mv
, 1);
3850 if (NILP (found
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3856 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3857 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3858 The value is t if a symbol was found and deleted, nil otherwise.
3859 NAME may be a string or a symbol. If it is a symbol, that symbol
3860 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3861 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3862 usage: (unintern NAME OBARRAY) */)
3863 (Lisp_Object name
, Lisp_Object obarray
)
3870 obarray
= check_obarray (obarray
);
3875 scm_find_symbol (scm_symbol_to_string (name
),
3878 string
= SYMBOL_NAME (name
);
3882 CHECK_STRING (name
);
3887 return (scm_is_true (scm_unintern (name
, obhash (obarray
))) ? Qt
: Qnil
);
3890 struct map_obarray_data
3892 Lisp_Object obarray
;
3893 void (*fn
) (Lisp_Object
, Lisp_Object
);
3898 map_obarray_inner (void *data
, Lisp_Object sym
)
3900 struct map_obarray_data
*modata
= data
;
3902 Lisp_Object tem
= Ffind_symbol (SYMBOL_NAME (sym
), modata
->obarray
);
3903 if (scm_is_true (scm_c_value_ref (tem
, 1))
3904 && EQ (sym
, scm_c_value_ref (tem
, 0)))
3905 modata
->fn (sym
, modata
->arg
);
3906 return SCM_UNSPECIFIED
;
3910 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3912 struct map_obarray_data data
= { .obarray
= obarray
,
3916 CHECK_VECTOR (obarray
);
3917 scm_obarray_for_each (make_c_closure (map_obarray_inner
, &data
, 1, 0),
3922 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3924 call1 (function
, sym
);
3927 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3928 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3929 OBARRAY defaults to the value of `obarray'. */)
3930 (Lisp_Object function
, Lisp_Object obarray
)
3932 if (NILP (obarray
)) obarray
= Vobarray
;
3933 obarray
= check_obarray (obarray
);
3935 map_obarray (obarray
, mapatoms_1
, function
);
3939 #define OBARRAY_SIZE 1511
3944 Lisp_Object oblength
;
3945 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3947 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3949 Vobarray
= Fmake_vector (oblength
, make_number (0));
3950 initial_obarray
= Vobarray
;
3951 staticpro (&initial_obarray
);
3953 obarrays
= scm_make_hash_table (SCM_UNDEFINED
);
3954 scm_hashq_set_x (obarrays
, Vobarray
, SCM_UNDEFINED
);
3956 Qnil
= SCM_ELISP_NIL
;
3959 Qnil_
= intern_c_string ("nil");
3960 SET_SYMBOL_VAL (XSYMBOL (Qnil_
), Qnil
);
3961 SET_SYMBOL_CONSTANT (XSYMBOL (Qnil_
), 1);
3962 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (Qnil_
), 1);
3964 Qt_
= intern_c_string ("t");
3965 SET_SYMBOL_VAL (XSYMBOL (Qt_
), Qt
);
3966 SET_SYMBOL_CONSTANT (XSYMBOL (Qt_
), 1);
3967 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (Qt_
), 1);
3969 Qunbound
= scm_c_public_ref ("language elisp runtime", "unbound");
3970 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3972 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3975 DEFSYM (Qvariable_documentation
, "variable-documentation");
3977 read_buffer
= xmalloc_atomic (size
);
3978 read_buffer_size
= size
;
3982 defsubr (const char *lname
, scm_t_subr gsubr_fn
, short min_args
, short max_args
, const char *intspec
)
3984 Lisp_Object sym
= intern_c_string (lname
);
3989 fn
= scm_c_make_gsubr (lname
, 0, 0, 1, gsubr_fn
);
3992 fn
= Fcons (Qspecial_operator
,
3993 scm_c_make_gsubr (lname
, 0, 0, 1, gsubr_fn
));
3996 fn
= scm_c_make_gsubr (lname
, min_args
, max_args
- min_args
, 0, gsubr_fn
);
3999 set_symbol_function (sym
, fn
);
4002 Lisp_Object tem
= ((*intspec
!= '(')
4003 ? build_string (intspec
)
4004 : Fcar (Fread_from_string (build_string (intspec
),
4006 scm_set_procedure_property_x (fn
, Qinteractive_form
, tem
);
4010 /* Define an "integer variable"; a symbol whose value is forwarded to a
4011 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4012 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4014 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4015 const char *namestring
, EMACS_INT
*address
)
4018 sym
= intern_c_string (namestring
);
4019 i_fwd
->type
= Lisp_Fwd_Int
;
4020 i_fwd
->intvar
= address
;
4021 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym
), 1);
4022 SET_SYMBOL_REDIRECT (XSYMBOL (sym
), SYMBOL_FORWARDED
);
4023 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4026 /* Similar but define a variable whose value is t if address contains 1,
4027 nil if address contains 0. */
4029 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4030 const char *namestring
, bool *address
)
4033 sym
= intern_c_string (namestring
);
4034 b_fwd
->type
= Lisp_Fwd_Bool
;
4035 b_fwd
->boolvar
= address
;
4036 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym
), 1);
4037 SET_SYMBOL_REDIRECT (XSYMBOL (sym
), SYMBOL_FORWARDED
);
4038 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4039 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4042 /* Similar but define a variable whose value is the Lisp Object stored
4043 at address. Two versions: with and without gc-marking of the C
4044 variable. The nopro version is used when that variable will be
4045 gc-marked for some other reason, since marking the same slot twice
4046 can cause trouble with strings. */
4048 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4049 const char *namestring
, Lisp_Object
*address
)
4052 sym
= intern_c_string (namestring
);
4053 o_fwd
->type
= Lisp_Fwd_Obj
;
4054 o_fwd
->objvar
= address
;
4055 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym
), 1);
4056 SET_SYMBOL_REDIRECT (XSYMBOL (sym
), SYMBOL_FORWARDED
);
4057 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4061 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4062 const char *namestring
, Lisp_Object
*address
)
4064 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4065 staticpro (address
);
4068 /* Similar but define a variable whose value is the Lisp Object stored
4069 at a particular offset in the current kboard object. */
4072 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4073 const char *namestring
, int offset
)
4076 sym
= intern_c_string (namestring
);
4077 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4078 ko_fwd
->offset
= offset
;
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
*)ko_fwd
);
4084 /* Check that the elements of lpath exist. */
4087 load_path_check (Lisp_Object lpath
)
4089 Lisp_Object path_tail
;
4091 /* The only elements that might not exist are those from
4092 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4094 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4096 Lisp_Object dirfile
;
4097 dirfile
= Fcar (path_tail
);
4098 if (STRINGP (dirfile
))
4100 dirfile
= Fdirectory_file_name (dirfile
);
4101 if (! file_accessible_directory_p (SSDATA (dirfile
)))
4102 dir_warning ("Lisp directory", XCAR (path_tail
));
4107 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4108 This does not include the standard site-lisp directories
4109 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4110 but it does (unless no_site_lisp is set) include site-lisp
4111 directories in the source/build directories if those exist and we
4112 are running uninstalled.
4114 Uses the following logic:
4115 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4116 The remainder is what happens when dumping works:
4117 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4118 Otherwise use PATH_LOADSEARCH.
4120 If !initialized, then just return PATH_DUMPLOADSEARCH.
4122 If Vinstallation_directory is not nil (ie, running uninstalled):
4123 If installation-dir/lisp exists and not already a member,
4124 we must be running uninstalled. Reset the load-path
4125 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4126 refers to the eventual installation directories. Since we
4127 are not yet installed, we should not use them, even if they exist.)
4128 If installation-dir/lisp does not exist, just add
4129 PATH_DUMPLOADSEARCH at the end instead.
4130 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4131 and not already a member) at the front.
4132 If installation-dir != source-dir (ie running an uninstalled,
4133 out-of-tree build) AND install-dir/src/Makefile exists BUT
4134 install-dir/src/Makefile.in does NOT exist (this is a sanity
4135 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4138 load_path_default (void)
4140 Lisp_Object lpath
= Qnil
;
4142 bool initialized_or_cannot_dump
;
4145 initialized_or_cannot_dump
= true;
4146 normal
= PATH_LOADSEARCH
;
4148 initialized_or_cannot_dump
= initialized
;
4149 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4152 if (initialized_or_cannot_dump
)
4155 const char *loadpath
= ns_load_path ();
4156 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4158 lpath
= decode_env_path (0, normal
, 0);
4160 if (!NILP (Vinstallation_directory
))
4162 Lisp_Object tem
, tem1
;
4164 /* Add to the path the lisp subdir of the installation
4165 dir, if it is accessible. Note: in out-of-tree builds,
4166 this directory is empty save for Makefile. */
4167 tem
= Fexpand_file_name (build_string ("lisp"),
4168 Vinstallation_directory
);
4169 tem1
= Ffile_accessible_directory_p (tem
);
4172 if (NILP (Fmember (tem
, lpath
)))
4174 /* We are running uninstalled. The default load-path
4175 points to the eventual installed lisp directories.
4176 We should not use those now, even if they exist,
4177 so start over from a clean slate. */
4178 lpath
= list1 (tem
);
4182 /* That dir doesn't exist, so add the build-time
4183 Lisp dirs instead. */
4185 Lisp_Object dump_path
=
4186 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4187 lpath
= nconc2 (lpath
, dump_path
);
4190 /* Add site-lisp under the installation dir, if it exists. */
4193 tem
= Fexpand_file_name (build_string ("site-lisp"),
4194 Vinstallation_directory
);
4195 tem1
= Ffile_accessible_directory_p (tem
);
4198 if (NILP (Fmember (tem
, lpath
)))
4199 lpath
= Fcons (tem
, lpath
);
4203 /* If Emacs was not built in the source directory,
4204 and it is run from where it was built, add to load-path
4205 the lisp and site-lisp dirs under that directory. */
4207 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4211 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4212 Vinstallation_directory
);
4213 tem1
= Ffile_exists_p (tem
);
4215 /* Don't be fooled if they moved the entire source tree
4216 AFTER dumping Emacs. If the build directory is indeed
4217 different from the source dir, src/Makefile.in and
4218 src/Makefile will not be found together. */
4219 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4220 Vinstallation_directory
);
4221 tem2
= Ffile_exists_p (tem
);
4222 if (!NILP (tem1
) && NILP (tem2
))
4224 tem
= Fexpand_file_name (build_string ("lisp"),
4227 if (NILP (Fmember (tem
, lpath
)))
4228 lpath
= Fcons (tem
, lpath
);
4232 tem
= Fexpand_file_name (build_string ("site-lisp"),
4234 tem1
= Ffile_accessible_directory_p (tem
);
4237 if (NILP (Fmember (tem
, lpath
)))
4238 lpath
= Fcons (tem
, lpath
);
4242 } /* Vinstallation_directory != Vsource_directory */
4244 } /* if Vinstallation_directory */
4246 else /* !initialized_or_cannot_dump */
4248 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4249 source directory. We used to add ../lisp (ie the lisp dir in
4250 the build directory) at the front here, but that should not
4251 be necessary, since in out of tree builds lisp/ is empty, save
4253 lpath
= decode_env_path (0, normal
, 0);
4262 /* Set Vsource_directory before calling load_path_default. */
4264 = Fexpand_file_name (build_string ("../"),
4265 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4267 /* Set Vload_path. */
4269 /* Ignore EMACSLOADPATH when dumping. */
4271 bool use_loadpath
= true;
4273 bool use_loadpath
= NILP (Vpurify_flag
);
4276 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4278 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4280 /* Check (non-nil) user-supplied elements. */
4281 load_path_check (Vload_path
);
4283 /* If no nils in the environment variable, use as-is.
4284 Otherwise, replace any nils with the default. */
4285 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4287 Lisp_Object elem
, elpath
= Vload_path
;
4288 Lisp_Object default_lpath
= load_path_default ();
4290 /* Check defaults, before adding site-lisp. */
4291 load_path_check (default_lpath
);
4293 /* Add the site-lisp directories to the front of the default. */
4296 Lisp_Object sitelisp
;
4297 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4298 if (! NILP (sitelisp
))
4299 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4304 /* Replace nils from EMACSLOADPATH by default. */
4305 while (CONSP (elpath
))
4308 elem
= XCAR (elpath
);
4309 elpath
= XCDR (elpath
);
4310 arg
[0] = Vload_path
;
4311 arg
[1] = NILP (elem
) ? default_lpath
: Fcons (elem
, Qnil
);
4312 Vload_path
= Fappend (2, arg
);
4314 } /* Fmemq (Qnil, Vload_path) */
4318 Vload_path
= load_path_default ();
4320 /* Check before adding site-lisp directories.
4321 The install should have created them, but they are not
4322 required, so no need to warn if they are absent.
4323 Or we might be running before installation. */
4324 load_path_check (Vload_path
);
4326 /* Add the site-lisp directories at the front. */
4327 if (initialized
&& !no_site_lisp
)
4329 Lisp_Object sitelisp
;
4330 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4331 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4337 load_in_progress
= 0;
4338 Vload_file_name
= Qnil
;
4339 Vstandard_input
= Qt
;
4340 Vloads_in_progress
= Qnil
;
4343 /* Print a warning that directory intended for use USE and with name
4344 DIRNAME cannot be accessed. On entry, errno should correspond to
4345 the access failure. Print the warning on stderr and put it in
4349 dir_warning (char const *use
, Lisp_Object dirname
)
4351 static char const format
[] = "Warning: %s `%s': %s\n";
4352 int access_errno
= errno
;
4353 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4355 /* Don't log the warning before we've initialized!! */
4358 char const *diagnostic
= emacs_strerror (access_errno
);
4360 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4361 + strlen (use
) + SBYTES (dirname
)
4362 + strlen (diagnostic
));
4363 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4365 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4371 syms_of_lread (void)
4375 DEFVAR_LISP ("obarray", Vobarray
,
4376 doc
: /* Symbol table for use by `intern' and `read'.
4377 It is a vector whose length ought to be prime for best results.
4378 The vector's contents don't make sense if examined from Lisp programs;
4379 to find all the symbols in an obarray, use `mapatoms'. */);
4381 DEFVAR_LISP ("values", Vvalues
,
4382 doc
: /* List of values of all expressions which were read, evaluated and printed.
4383 Order is reverse chronological. */);
4384 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (intern ("values")), 0);
4386 DEFVAR_LISP ("standard-input", Vstandard_input
,
4387 doc
: /* Stream for read to get input from.
4388 See documentation of `read' for possible values. */);
4389 Vstandard_input
= Qt
;
4391 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4392 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4394 If this variable is a buffer, then only forms read from that buffer
4395 will be added to `read-symbol-positions-list'.
4396 If this variable is t, then all read forms will be added.
4397 The effect of all other values other than nil are not currently
4398 defined, although they may be in the future.
4400 The positions are relative to the last call to `read' or
4401 `read-from-string'. It is probably a bad idea to set this variable at
4402 the toplevel; bind it instead. */);
4403 Vread_with_symbol_positions
= Qnil
;
4405 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4406 doc
: /* A list mapping read symbols to their positions.
4407 This variable is modified during calls to `read' or
4408 `read-from-string', but only when `read-with-symbol-positions' is
4411 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4412 CHAR-POSITION is an integer giving the offset of that occurrence of the
4413 symbol from the position where `read' or `read-from-string' started.
4415 Note that a symbol will appear multiple times in this list, if it was
4416 read multiple times. The list is in the same order as the symbols
4418 Vread_symbol_positions_list
= Qnil
;
4420 DEFVAR_LISP ("read-circle", Vread_circle
,
4421 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4424 DEFVAR_LISP ("load-path", Vload_path
,
4425 doc
: /* List of directories to search for files to load.
4426 Each element is a string (directory name) or nil (meaning `default-directory').
4427 Initialized during startup as described in Info node `(elisp)Library Search'. */);
4429 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4430 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4431 This list should not include the empty string.
4432 `load' and related functions try to append these suffixes, in order,
4433 to the specified file name if a Lisp suffix is allowed or required. */);
4434 Vload_suffixes
= list1 (build_pure_c_string (".el"));
4435 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4436 doc
: /* List of suffixes that indicate representations of \
4438 This list should normally start with the empty string.
4440 Enabling Auto Compression mode appends the suffixes in
4441 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4442 mode removes them again. `load' and related functions use this list to
4443 determine whether they should look for compressed versions of a file
4444 and, if so, which suffixes they should try to append to the file name
4445 in order to do so. However, if you want to customize which suffixes
4446 the loading functions recognize as compression suffixes, you should
4447 customize `jka-compr-load-suffixes' rather than the present variable. */);
4448 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4450 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4451 doc
: /* Non-nil if inside of `load'. */);
4452 DEFSYM (Qload_in_progress
, "load-in-progress");
4454 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4455 doc
: /* An alist of functions to be evalled when particular files are loaded.
4456 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4458 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4459 a symbol \(a feature name).
4461 When `load' is run and the file-name argument matches an element's
4462 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4463 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4465 An error in FORMS does not undo the load, but does prevent execution of
4466 the rest of the FORMS. */);
4467 Vafter_load_alist
= Qnil
;
4469 DEFVAR_LISP ("load-history", Vload_history
,
4470 doc
: /* Alist mapping loaded file names to symbols and features.
4471 Each alist element should be a list (FILE-NAME ENTRIES...), where
4472 FILE-NAME is the name of a file that has been loaded into Emacs.
4473 The file name is absolute and true (i.e. it doesn't contain symlinks).
4474 As an exception, one of the alist elements may have FILE-NAME nil,
4475 for symbols and features not associated with any file.
4477 The remaining ENTRIES in the alist element describe the functions and
4478 variables defined in that file, the features provided, and the
4479 features required. Each entry has the form `(provide . FEATURE)',
4480 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4481 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4482 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4483 autoload before this file redefined it as a function. In addition,
4484 entries may also be single symbols, which means that SYMBOL was
4485 defined by `defvar' or `defconst'.
4487 During preloading, the file name recorded is relative to the main Lisp
4488 directory. These file names are converted to absolute at startup. */);
4489 Vload_history
= Qnil
;
4491 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4492 doc
: /* Full name of file being loaded by `load'. */);
4493 Vload_file_name
= Qnil
;
4495 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4496 doc
: /* File name, including directory, of user's initialization file.
4497 If the file loaded had extension `.elc', and the corresponding source file
4498 exists, this variable contains the name of source file, suitable for use
4499 by functions like `custom-save-all' which edit the init file.
4500 While Emacs loads and evaluates the init file, value is the real name
4501 of the file, regardless of whether or not it has the `.elc' extension. */);
4502 Vuser_init_file
= Qnil
;
4504 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4505 doc
: /* Used for internal purposes by `load'. */);
4506 Vcurrent_load_list
= Qnil
;
4508 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4509 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4510 The default is nil, which means use the function `read'. */);
4511 Vload_read_function
= Qnil
;
4513 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4514 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4515 The value should be a function for doing code conversion before
4516 reading a source file. It can also be nil, in which case loading is
4517 done without any code conversion.
4519 If the value is a function, it is called with four arguments,
4520 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4521 the file to load, FILE is the non-absolute name (for messages etc.),
4522 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4523 `load'. The function should return t if the file was loaded. */);
4524 Vload_source_file_function
= Qnil
;
4526 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4527 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4528 This is useful when the file being loaded is a temporary copy. */);
4529 load_force_doc_strings
= 0;
4531 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4532 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4533 This is normally bound by `load' and `eval-buffer' to control `read',
4534 and is not meant for users to change. */);
4535 load_convert_to_unibyte
= 0;
4537 DEFVAR_LISP ("source-directory", Vsource_directory
,
4538 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4539 You cannot count on them to still be there! */);
4541 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4542 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4543 Vpreloaded_file_list
= Qnil
;
4545 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4546 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4547 Vbyte_boolean_vars
= Qnil
;
4549 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4550 doc
: /* Non-nil means load dangerous compiled Lisp files.
4551 Some versions of XEmacs use different byte codes than Emacs. These
4552 incompatible byte codes can make Emacs crash when it tries to execute
4554 load_dangerous_libraries
= 0;
4556 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4557 doc
: /* Non-nil means force printing messages when loading Lisp files.
4558 This overrides the value of the NOMESSAGE argument to `load'. */);
4559 force_load_messages
= 0;
4561 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4562 doc
: /* Regular expression matching safe to load compiled Lisp files.
4563 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4564 from the file, and matches them against this regular expression.
4565 When the regular expression matches, the file is considered to be safe
4566 to load. See also `load-dangerous-libraries'. */);
4567 Vbytecomp_version_regexp
4568 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4570 DEFSYM (Qlexical_binding
, "lexical-binding");
4571 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4572 doc
: /* Whether to use lexical binding when evaluating code.
4573 Non-nil means that the code in the current buffer should be evaluated
4574 with lexical binding.
4575 This variable is automatically set from the file variables of an
4576 interpreted Lisp file read using `load'. Unlike other file local
4577 variables, this must be set in the first line of a file. */);
4578 Vlexical_binding
= Qnil
;
4579 Fmake_variable_buffer_local (Qlexical_binding
);
4581 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4582 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4583 Veval_buffer_list
= Qnil
;
4585 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4586 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4587 Vold_style_backquotes
= Qnil
;
4588 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4590 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4591 doc
: /* Non-nil means `load' prefers the newest version of a file.
4592 This applies when a filename suffix is not explicitly specified and
4593 `load' is trying various possible suffixes (see `load-suffixes' and
4594 `load-file-rep-suffixes'). Normally, it stops at the first file
4595 that exists unless you explicitly specify one or the other. If this
4596 option is non-nil, it checks all suffixes and uses whichever file is
4598 Note that if you customize this, obviously it will not affect files
4599 that are loaded before your customizations are read! */);
4600 load_prefer_newer
= 1;
4602 /* Vsource_directory was initialized in init_lread. */
4604 DEFSYM (Qcurrent_load_list
, "current-load-list");
4605 DEFSYM (Qstandard_input
, "standard-input");
4606 DEFSYM (Qread_char
, "read-char");
4607 DEFSYM (Qget_file_char
, "get-file-char");
4608 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4609 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4611 DEFSYM (Qbackquote
, "`");
4612 DEFSYM (Qcomma
, ",");
4613 DEFSYM (Qcomma_at
, ",@");
4614 DEFSYM (Qcomma_dot
, ",.");
4616 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4617 DEFSYM (Qascii_character
, "ascii-character");
4618 DEFSYM (Qfunction
, "function");
4619 DEFSYM (Qload
, "load");
4620 DEFSYM (Qload_file_name
, "load-file-name");
4621 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4622 DEFSYM (Qfile_truename
, "file-truename");
4623 DEFSYM (Qdir_ok
, "dir-ok");
4624 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4626 staticpro (&read_objects
);
4627 read_objects
= Qnil
;
4628 staticpro (&seen_list
);
4631 Vloads_in_progress
= Qnil
;
4632 staticpro (&Vloads_in_progress
);
4634 DEFSYM (Qhash_table
, "hash-table");
4635 DEFSYM (Qdata
, "data");
4636 DEFSYM (Qtest
, "test");
4637 DEFSYM (Qsize
, "size");
4638 DEFSYM (Qweakness
, "weakness");
4639 DEFSYM (Qrehash_size
, "rehash-size");
4640 DEFSYM (Qrehash_threshold
, "rehash-threshold");