1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2016 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 /* Tell globals.h to define tables needed by init_obarray. */
22 #define DEFINE_SYMBOLS
26 #include <sys/types.h>
30 #include <limits.h> /* For CHAR_BIT. */
32 #include <stat-time.h>
34 #include "dispextern.h"
35 #include "intervals.h"
36 #include "character.h"
44 #include "termhooks.h"
45 #include "blockinput.h"
60 #endif /* HAVE_SETLOCALE */
65 #define file_offset off_t
66 #define file_tell ftello
68 #define file_offset long
69 #define file_tell ftell
72 /* The association list of objects read with the #n=object form.
73 Each member of the list has the form (n . object), and is used to
74 look up the object for the corresponding #n# construct.
75 It must be set to nil before all top-level calls to read0. */
76 static Lisp_Object read_objects
;
78 /* File for get_file_char to read from. Use by load. */
79 static FILE *instream
;
81 /* For use within read-from-string (this reader is non-reentrant!!) */
82 static ptrdiff_t read_from_string_index
;
83 static ptrdiff_t read_from_string_index_byte
;
84 static ptrdiff_t read_from_string_limit
;
86 /* Number of characters read in the current call to Fread or
88 static EMACS_INT readchar_count
;
90 /* This contains the last string skipped with #@. */
91 static char *saved_doc_string
;
92 /* Length of buffer allocated in saved_doc_string. */
93 static ptrdiff_t saved_doc_string_size
;
94 /* Length of actual data in saved_doc_string. */
95 static ptrdiff_t saved_doc_string_length
;
96 /* This is the file position that string came from. */
97 static file_offset saved_doc_string_position
;
99 /* This contains the previous string skipped with #@.
100 We copy it from saved_doc_string when a new string
101 is put in saved_doc_string. */
102 static char *prev_saved_doc_string
;
103 /* Length of buffer allocated in prev_saved_doc_string. */
104 static ptrdiff_t prev_saved_doc_string_size
;
105 /* Length of actual data in prev_saved_doc_string. */
106 static ptrdiff_t prev_saved_doc_string_length
;
107 /* This is the file position that string came from. */
108 static file_offset prev_saved_doc_string_position
;
110 /* True means inside a new-style backquote
111 with no surrounding parentheses.
112 Fread initializes this to false, so we need not specbind it
113 or worry about what happens to it when there is an error. */
114 static bool new_backquote_flag
;
116 /* A list of file names for files being loaded in Fload. Used to
117 check for recursive loads. */
119 static Lisp_Object Vloads_in_progress
;
121 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
124 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
125 Lisp_Object
, Lisp_Object
,
126 Lisp_Object
, Lisp_Object
);
128 /* Functions that read one byte from the current source READCHARFUN
129 or unreads one byte. If the integer argument C is -1, it returns
130 one read byte, or -1 when there's no more byte in the source. If C
131 is 0 or positive, it unreads C, and the return value is not
134 static int readbyte_for_lambda (int, Lisp_Object
);
135 static int readbyte_from_file (int, Lisp_Object
);
136 static int readbyte_from_string (int, Lisp_Object
);
138 /* Handle unreading and rereading of characters.
139 Write READCHAR to read a character,
140 UNREAD(c) to unread c to be read again.
142 These macros correctly read/unread multibyte characters. */
144 #define READCHAR readchar (readcharfun, NULL)
145 #define UNREAD(c) unreadchar (readcharfun, c)
147 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
148 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
150 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
151 Qlambda, or a cons, we use this to keep an unread character because
152 a file stream can't handle multibyte-char unreading. The value -1
153 means that there's no unread character. */
154 static int unread_char
;
157 readchar (Lisp_Object readcharfun
, bool *multibyte
)
161 int (*readbyte
) (int, Lisp_Object
);
162 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
164 bool emacs_mule_encoding
= 0;
171 if (BUFFERP (readcharfun
))
173 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
175 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
177 if (! BUFFER_LIVE_P (inbuffer
))
180 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
183 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
185 /* Fetch the character code from the buffer. */
186 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
187 BUF_INC_POS (inbuffer
, pt_byte
);
194 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
195 if (! ASCII_CHAR_P (c
))
196 c
= BYTE8_TO_CHAR (c
);
199 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
203 if (MARKERP (readcharfun
))
205 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
207 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
209 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
212 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
214 /* Fetch the character code from the buffer. */
215 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
216 BUF_INC_POS (inbuffer
, bytepos
);
223 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
224 if (! ASCII_CHAR_P (c
))
225 c
= BYTE8_TO_CHAR (c
);
229 XMARKER (readcharfun
)->bytepos
= bytepos
;
230 XMARKER (readcharfun
)->charpos
++;
235 if (EQ (readcharfun
, Qlambda
))
237 readbyte
= readbyte_for_lambda
;
241 if (EQ (readcharfun
, Qget_file_char
))
243 readbyte
= readbyte_from_file
;
247 if (STRINGP (readcharfun
))
249 if (read_from_string_index
>= read_from_string_limit
)
251 else if (STRING_MULTIBYTE (readcharfun
))
255 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
256 read_from_string_index
,
257 read_from_string_index_byte
);
261 c
= SREF (readcharfun
, read_from_string_index_byte
);
262 read_from_string_index
++;
263 read_from_string_index_byte
++;
268 if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
270 /* This is the case that read_vector is reading from a unibyte
271 string that contains a byte sequence previously skipped
272 because of #@NUMBER. The car part of readcharfun is that
273 string, and the cdr part is a value of readcharfun given to
275 readbyte
= readbyte_from_string
;
276 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
277 emacs_mule_encoding
= 1;
281 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
283 readbyte
= readbyte_from_file
;
284 emacs_mule_encoding
= 1;
288 tem
= call0 (readcharfun
);
295 if (unread_char
>= 0)
301 c
= (*readbyte
) (-1, readcharfun
);
306 if (ASCII_CHAR_P (c
))
308 if (emacs_mule_encoding
)
309 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
312 len
= BYTES_BY_CHAR_HEAD (c
);
315 c
= (*readbyte
) (-1, readcharfun
);
316 if (c
< 0 || ! TRAILING_CODE_P (c
))
319 (*readbyte
) (buf
[i
], readcharfun
);
320 return BYTE8_TO_CHAR (buf
[0]);
324 return STRING_CHAR (buf
);
327 #define FROM_FILE_P(readcharfun) \
328 (EQ (readcharfun, Qget_file_char) \
329 || EQ (readcharfun, Qget_emacs_mule_file_char))
332 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
334 if (FROM_FILE_P (readcharfun
))
336 block_input (); /* FIXME: Not sure if it's needed. */
337 fseek (instream
, n
, SEEK_CUR
);
341 { /* We're not reading directly from a file. In that case, it's difficult
342 to reliably count bytes, since these are usually meant for the file's
343 encoding, whereas we're now typically in the internal encoding.
344 But luckily, skip_dyn_bytes is used to skip over a single
345 dynamic-docstring (or dynamic byte-code) which is always quoted such
346 that \037 is the final char. */
350 } while (c
>= 0 && c
!= '\037');
355 skip_dyn_eof (Lisp_Object readcharfun
)
357 if (FROM_FILE_P (readcharfun
))
359 block_input (); /* FIXME: Not sure if it's needed. */
360 fseek (instream
, 0, SEEK_END
);
364 while (READCHAR
>= 0);
367 /* Unread the character C in the way appropriate for the stream READCHARFUN.
368 If the stream is a user function, call it with the char as argument. */
371 unreadchar (Lisp_Object readcharfun
, int c
)
375 /* Don't back up the pointer if we're unreading the end-of-input mark,
376 since readchar didn't advance it when we read it. */
378 else if (BUFFERP (readcharfun
))
380 struct buffer
*b
= XBUFFER (readcharfun
);
381 ptrdiff_t charpos
= BUF_PT (b
);
382 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
384 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
385 BUF_DEC_POS (b
, bytepos
);
389 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
391 else if (MARKERP (readcharfun
))
393 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
394 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
396 XMARKER (readcharfun
)->charpos
--;
397 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
398 BUF_DEC_POS (b
, bytepos
);
402 XMARKER (readcharfun
)->bytepos
= bytepos
;
404 else if (STRINGP (readcharfun
))
406 read_from_string_index
--;
407 read_from_string_index_byte
408 = string_char_to_byte (readcharfun
, read_from_string_index
);
410 else if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
414 else if (EQ (readcharfun
, Qlambda
))
418 else if (FROM_FILE_P (readcharfun
))
423 call1 (readcharfun
, make_number (c
));
427 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
429 return read_bytecode_char (c
>= 0);
434 readbyte_from_file (int c
, Lisp_Object readcharfun
)
439 ungetc (c
, instream
);
447 /* Interrupted reads have been observed while reading over the network. */
448 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
459 return (c
== EOF
? -1 : c
);
463 readbyte_from_string (int c
, Lisp_Object readcharfun
)
465 Lisp_Object string
= XCAR (readcharfun
);
469 read_from_string_index
--;
470 read_from_string_index_byte
471 = string_char_to_byte (string
, read_from_string_index
);
474 if (read_from_string_index
>= read_from_string_limit
)
477 FETCH_STRING_CHAR_ADVANCE (c
, string
,
478 read_from_string_index
,
479 read_from_string_index_byte
);
484 /* Read one non-ASCII character from INSTREAM. The character is
485 encoded in `emacs-mule' and the first byte is already read in
489 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
491 /* Emacs-mule coding uses at most 4-byte for one character. */
492 unsigned char buf
[4];
493 int len
= emacs_mule_bytes
[c
];
494 struct charset
*charset
;
499 /* C is not a valid leading-code of `emacs-mule'. */
500 return BYTE8_TO_CHAR (c
);
506 c
= (*readbyte
) (-1, readcharfun
);
510 (*readbyte
) (buf
[i
], readcharfun
);
511 return BYTE8_TO_CHAR (buf
[0]);
518 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
519 code
= buf
[1] & 0x7F;
523 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
524 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
526 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
527 code
= buf
[2] & 0x7F;
531 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
532 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
537 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
538 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
540 c
= DECODE_CHAR (charset
, code
);
542 Fsignal (Qinvalid_read_syntax
,
543 list1 (build_string ("invalid multibyte form")));
548 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
550 static Lisp_Object
read0 (Lisp_Object
);
551 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
553 static Lisp_Object
read_list (bool, Lisp_Object
);
554 static Lisp_Object
read_vector (Lisp_Object
, bool);
556 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
558 static void substitute_object_in_subtree (Lisp_Object
,
560 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
563 /* Get a character from the tty. */
565 /* Read input events until we get one that's acceptable for our purposes.
567 If NO_SWITCH_FRAME, switch-frame events are stashed
568 until we get a character we like, and then stuffed into
571 If ASCII_REQUIRED, check function key events to see
572 if the unmodified version of the symbol has a Qascii_character
573 property, and use that character, if present.
575 If ERROR_NONASCII, signal an error if the input we
576 get isn't an ASCII character with modifiers. If it's false but
577 ASCII_REQUIRED is true, just re-read until we get an ASCII
580 If INPUT_METHOD, invoke the current input method
581 if the character warrants that.
583 If SECONDS is a number, wait that many seconds for input, and
584 return Qnil if no input arrives within that time. */
587 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
588 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
590 Lisp_Object val
, delayed_switch_frame
;
591 struct timespec end_time
;
593 #ifdef HAVE_WINDOW_SYSTEM
594 if (display_hourglass_p
)
598 delayed_switch_frame
= Qnil
;
600 /* Compute timeout. */
601 if (NUMBERP (seconds
))
603 double duration
= extract_float (seconds
);
604 struct timespec wait_time
= dtotimespec (duration
);
605 end_time
= timespec_add (current_timespec (), wait_time
);
608 /* Read until we get an acceptable event. */
611 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
612 NUMBERP (seconds
) ? &end_time
: NULL
);
613 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
618 /* `switch-frame' events are put off until after the next ASCII
619 character. This is better than signaling an error just because
620 the last characters were typed to a separate minibuffer frame,
621 for example. Eventually, some code which can deal with
622 switch-frame events will read it and process it. */
624 && EVENT_HAS_PARAMETERS (val
)
625 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
627 delayed_switch_frame
= val
;
631 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
633 /* Convert certain symbols to their ASCII equivalents. */
636 Lisp_Object tem
, tem1
;
637 tem
= Fget (val
, Qevent_symbol_element_mask
);
640 tem1
= Fget (Fcar (tem
), Qascii_character
);
641 /* Merge this symbol's modifier bits
642 with the ASCII equivalent of its basic code. */
644 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
648 /* If we don't have a character now, deal with it appropriately. */
653 Vunread_command_events
= list1 (val
);
654 error ("Non-character input-event");
661 if (! NILP (delayed_switch_frame
))
662 unread_switch_frame
= delayed_switch_frame
;
666 #ifdef HAVE_WINDOW_SYSTEM
667 if (display_hourglass_p
)
676 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
677 doc
: /* Read a character from the command input (keyboard or macro).
678 It is returned as a number.
679 If the character has modifiers, they are resolved and reflected to the
680 character code if possible (e.g. C-SPC -> 0).
682 If the user generates an event which is not a character (i.e. a mouse
683 click or function key event), `read-char' signals an error. As an
684 exception, switch-frame events are put off until non-character events
686 If you want to read non-character events, or ignore them, call
687 `read-event' or `read-char-exclusive' instead.
689 If the optional argument PROMPT is non-nil, display that as a prompt.
690 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
691 input method is turned on in the current buffer, that input method
692 is used for reading a character.
693 If the optional argument SECONDS is non-nil, it should be a number
694 specifying the maximum number of seconds to wait for input. If no
695 input arrives in that time, return nil. SECONDS may be a
696 floating-point value. */)
697 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
702 message_with_string ("%s", prompt
, 0);
703 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
705 return (NILP (val
) ? Qnil
706 : make_number (char_resolve_modifier_mask (XINT (val
))));
709 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
710 doc
: /* Read an event object from the input stream.
711 If the optional argument PROMPT is non-nil, display that as a prompt.
712 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
713 input method is turned on in the current buffer, that input method
714 is used for reading a character.
715 If the optional argument SECONDS is non-nil, it should be a number
716 specifying the maximum number of seconds to wait for input. If no
717 input arrives in that time, return nil. SECONDS may be a
718 floating-point value. */)
719 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
722 message_with_string ("%s", prompt
, 0);
723 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
726 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
727 doc
: /* Read a character from the command input (keyboard or macro).
728 It is returned as a number. Non-character events are ignored.
729 If the character has modifiers, they are resolved and reflected to the
730 character code if possible (e.g. C-SPC -> 0).
732 If the optional argument PROMPT is non-nil, display that as a prompt.
733 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
734 input method is turned on in the current buffer, that input method
735 is used for reading a character.
736 If the optional argument SECONDS is non-nil, it should be a number
737 specifying the maximum number of seconds to wait for input. If no
738 input arrives in that time, return nil. SECONDS may be a
739 floating-point value. */)
740 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
745 message_with_string ("%s", prompt
, 0);
747 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
749 return (NILP (val
) ? Qnil
750 : make_number (char_resolve_modifier_mask (XINT (val
))));
753 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
754 doc
: /* Don't use this yourself. */)
757 register Lisp_Object val
;
759 XSETINT (val
, getc (instream
));
767 /* Return true if the lisp code read using READCHARFUN defines a non-nil
768 `lexical-binding' file variable. After returning, the stream is
769 positioned following the first line, if it is a comment or #! line,
770 otherwise nothing is read. */
773 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
786 while (ch
!= '\n' && ch
!= EOF
)
788 if (ch
== '\n') ch
= READCHAR
;
789 /* It is OK to leave the position after a #! line, since
790 that is what read1 does. */
794 /* The first line isn't a comment, just give up. */
800 /* Look for an appropriate file-variable in the first line. */
804 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
805 } beg_end_state
= NOMINAL
;
806 bool in_file_vars
= 0;
808 #define UPDATE_BEG_END_STATE(ch) \
809 if (beg_end_state == NOMINAL) \
810 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
811 else if (beg_end_state == AFTER_FIRST_DASH) \
812 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
813 else if (beg_end_state == AFTER_ASTERIX) \
816 in_file_vars = !in_file_vars; \
817 beg_end_state = NOMINAL; \
820 /* Skip until we get to the file vars, if any. */
824 UPDATE_BEG_END_STATE (ch
);
826 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
830 char var
[100], val
[100];
835 /* Read a variable name. */
836 while (ch
== ' ' || ch
== '\t')
840 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
842 if (i
< sizeof var
- 1)
844 UPDATE_BEG_END_STATE (ch
);
848 /* Stop scanning if no colon was found before end marker. */
849 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
852 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
858 /* Read a variable value. */
861 while (ch
== ' ' || ch
== '\t')
865 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
867 if (i
< sizeof val
- 1)
869 UPDATE_BEG_END_STATE (ch
);
873 /* The value was terminated by an end-marker, which remove. */
875 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
879 if (strcmp (var
, "lexical-binding") == 0)
882 rv
= (strcmp (val
, "nil") != 0);
888 while (ch
!= '\n' && ch
!= EOF
)
895 /* Value is a version number of byte compiled code if the file
896 associated with file descriptor FD is a compiled Lisp file that's
897 safe to load. Only files compiled with Emacs are safe to load.
898 Files compiled with XEmacs can lead to a crash in Fbyte_code
899 because of an incompatible change in the byte compiler. */
902 safe_to_load_version (int fd
)
908 /* Read the first few bytes from the file, and look for a line
909 specifying the byte compiler version used. */
910 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
913 /* Skip to the next newline, skipping over the initial `ELC'
914 with NUL bytes following it, but note the version. */
915 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
920 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
921 buf
+ i
, nbytes
- i
) < 0)
925 lseek (fd
, 0, SEEK_SET
);
930 /* Callback for record_unwind_protect. Restore the old load list OLD,
931 after loading a file successfully. */
934 record_load_unwind (Lisp_Object old
)
936 Vloads_in_progress
= old
;
939 /* This handler function is used via internal_condition_case_1. */
942 load_error_handler (Lisp_Object data
)
948 load_warn_old_style_backquotes (Lisp_Object file
)
950 if (!NILP (Vold_style_backquotes
))
952 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
953 CALLN (Fmessage
, format
, file
);
957 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
958 doc
: /* Return the suffixes that `load' should try if a suffix is \
960 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
963 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
964 while (CONSP (suffixes
))
966 Lisp_Object exts
= Vload_file_rep_suffixes
;
967 suffix
= XCAR (suffixes
);
968 suffixes
= XCDR (suffixes
);
973 lst
= Fcons (concat2 (suffix
, ext
), lst
);
976 return Fnreverse (lst
);
979 /* Returns true if STRING ends with SUFFIX */
981 suffix_p (Lisp_Object string
, const char *suffix
)
983 ptrdiff_t suffix_len
= strlen (suffix
);
984 ptrdiff_t string_len
= SBYTES (string
);
986 return string_len
>= suffix_len
&& !strcmp (SSDATA (string
) + string_len
- suffix_len
, suffix
);
989 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
990 doc
: /* Execute a file of Lisp code named FILE.
991 First try FILE with `.elc' appended, then try with `.el', then try
992 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
993 then try FILE unmodified (the exact suffixes in the exact order are
994 determined by `load-suffixes'). Environment variable references in
995 FILE are replaced with their values by calling `substitute-in-file-name'.
996 This function searches the directories in `load-path'.
998 If optional second arg NOERROR is non-nil,
999 report no error if FILE doesn't exist.
1000 Print messages at start and end of loading unless
1001 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1003 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1004 suffixes to the specified name FILE.
1005 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1006 the suffix `.elc' or `.el' or the module suffix; don't accept just
1007 FILE unless it ends in one of those suffixes or includes a directory name.
1009 If NOSUFFIX is nil, then if a file could not be found, try looking for
1010 a different representation of the file by adding non-empty suffixes to
1011 its name, before trying another file. Emacs uses this feature to find
1012 compressed versions of files when Auto Compression mode is enabled.
1013 If NOSUFFIX is non-nil, disable this feature.
1015 The suffixes that this function tries out, when NOSUFFIX is nil, are
1016 given by the return value of `get-load-suffixes' and the values listed
1017 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1018 return value of `get-load-suffixes' is used, i.e. the file name is
1019 required to have a non-empty suffix.
1021 When searching suffixes, this function normally stops at the first
1022 one that exists. If the option `load-prefer-newer' is non-nil,
1023 however, it tries all suffixes, and uses whichever file is the newest.
1025 Loading a file records its definitions, and its `provide' and
1026 `require' calls, in an element of `load-history' whose
1027 car is the file name loaded. See `load-history'.
1029 While the file is in the process of being loaded, the variable
1030 `load-in-progress' is non-nil and the variable `load-file-name'
1031 is bound to the file's name.
1033 Return t if the file exists and loads successfully. */)
1034 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1035 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1040 ptrdiff_t count
= SPECPDL_INDEX ();
1041 Lisp_Object found
, efound
, hist_file_name
;
1042 /* True means we printed the ".el is newer" message. */
1044 /* True means we are loading a compiled file. */
1046 Lisp_Object handler
;
1048 const char *fmode
= "r" FOPEN_TEXT
;
1051 CHECK_STRING (file
);
1053 /* If file name is magic, call the handler. */
1054 /* This shouldn't be necessary any more now that `openp' handles it right.
1055 handler = Ffind_file_name_handler (file, Qload);
1056 if (!NILP (handler))
1057 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1059 /* The presence of this call is the result of a historical accident:
1060 it used to be in every file-operation and when it got removed
1061 everywhere, it accidentally stayed here. Since then, enough people
1062 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1063 that it seemed risky to remove. */
1064 if (! NILP (noerror
))
1066 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1067 Qt
, load_error_handler
);
1072 file
= Fsubstitute_in_file_name (file
);
1074 /* Avoid weird lossage with null string as arg,
1075 since it would try to load a directory as a Lisp file. */
1076 if (SCHARS (file
) == 0)
1083 Lisp_Object suffixes
;
1086 if (! NILP (must_suffix
))
1088 /* Don't insist on adding a suffix if FILE already ends with one. */
1089 if (suffix_p (file
, ".el")
1090 || suffix_p (file
, ".elc")
1092 || suffix_p (file
, MODULES_SUFFIX
)
1096 /* Don't insist on adding a suffix
1097 if the argument includes a directory name. */
1098 else if (! NILP (Ffile_name_directory (file
)))
1102 if (!NILP (nosuffix
))
1106 suffixes
= Fget_load_suffixes ();
1107 if (NILP (must_suffix
))
1108 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1111 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1117 report_file_error ("Cannot open load file", file
);
1121 /* Tell startup.el whether or not we found the user's init file. */
1122 if (EQ (Qt
, Vuser_init_file
))
1123 Vuser_init_file
= found
;
1125 /* If FD is -2, that means openp found a magic file. */
1128 if (NILP (Fequal (found
, file
)))
1129 /* If FOUND is a different file name from FILE,
1130 find its handler even if we have already inhibited
1131 the `load' operation on FILE. */
1132 handler
= Ffind_file_name_handler (found
, Qt
);
1134 handler
= Ffind_file_name_handler (found
, Qload
);
1135 if (! NILP (handler
))
1136 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1138 /* Tramp has to deal with semi-broken packages that prepend
1139 drive letters to remote files. For that reason, Tramp
1140 catches file operations that test for file existence, which
1141 makes openp think X:/foo.elc files are remote. However,
1142 Tramp does not catch `load' operations for such files, so we
1143 end up with a nil as the `load' handler above. If we would
1144 continue with fd = -2, we will behave wrongly, and in
1145 particular try reading a .elc file in the "rt" mode instead
1146 of "rb". See bug #9311 for the results. To work around
1147 this, we try to open the file locally, and go with that if it
1149 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1157 /* Pacify older GCC with --enable-gcc-warnings. */
1158 IF_LINT (fd_index
= 0);
1162 fd_index
= SPECPDL_INDEX ();
1163 record_unwind_protect_int (close_file_unwind
, fd
);
1167 if (suffix_p (found
, MODULES_SUFFIX
))
1168 return unbind_to (count
, Fmodule_load (found
));
1171 /* Check if we're stuck in a recursive load cycle.
1173 2000-09-21: It's not possible to just check for the file loaded
1174 being a member of Vloads_in_progress. This fails because of the
1175 way the byte compiler currently works; `provide's are not
1176 evaluated, see font-lock.el/jit-lock.el as an example. This
1177 leads to a certain amount of ``normal'' recursion.
1179 Also, just loading a file recursively is not always an error in
1180 the general case; the second load may do something different. */
1184 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1185 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1186 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1187 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1188 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1191 /* All loads are by default dynamic, unless the file itself specifies
1192 otherwise using a file-variable in the first line. This is bound here
1193 so that it takes effect whether or not we use
1194 Vload_source_file_function. */
1195 specbind (Qlexical_binding
, Qnil
);
1197 /* Get the name for load-history. */
1198 hist_file_name
= (! NILP (Vpurify_flag
)
1199 ? concat2 (Ffile_name_directory (file
),
1200 Ffile_name_nondirectory (found
))
1205 /* Check for the presence of old-style quotes and warn about them. */
1206 specbind (Qold_style_backquotes
, Qnil
);
1207 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1209 if (suffix_p (found
, ".elc") || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1210 /* Load .elc files directly, but not when they are
1211 remote and have no handler! */
1219 && ! (version
= safe_to_load_version (fd
)))
1222 if (!load_dangerous_libraries
)
1223 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1224 else if (!NILP (nomessage
) && !force_load_messages
)
1225 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1230 efound
= ENCODE_FILE (found
);
1231 fmode
= "r" FOPEN_BINARY
;
1233 /* openp already checked for newness, no point doing it again.
1234 FIXME would be nice to get a message when openp
1235 ignores suffix order due to load_prefer_newer. */
1236 if (!load_prefer_newer
)
1238 result
= stat (SSDATA (efound
), &s1
);
1241 SSET (efound
, SBYTES (efound
) - 1, 0);
1242 result
= stat (SSDATA (efound
), &s2
);
1243 SSET (efound
, SBYTES (efound
) - 1, 'c');
1247 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1249 /* Make the progress messages mention that source is newer. */
1252 /* If we won't print another message, mention this anyway. */
1253 if (!NILP (nomessage
) && !force_load_messages
)
1255 Lisp_Object msg_file
;
1256 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1257 message_with_string ("Source file `%s' newer than byte-compiled file",
1261 } /* !load_prefer_newer */
1266 /* We are loading a source file (*.el). */
1267 if (!NILP (Vload_source_file_function
))
1274 clear_unwind_protect (fd_index
);
1276 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1277 NILP (noerror
) ? Qnil
: Qt
,
1278 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1279 return unbind_to (count
, val
);
1285 /* We somehow got here with fd == -2, meaning the file is deemed
1286 to be remote. Don't even try to reopen the file locally;
1287 just force a failure. */
1295 clear_unwind_protect (fd_index
);
1296 efound
= ENCODE_FILE (found
);
1297 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1299 stream
= fdopen (fd
, fmode
);
1303 report_file_error ("Opening stdio stream", file
);
1304 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1306 if (! NILP (Vpurify_flag
))
1307 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1309 if (NILP (nomessage
) || force_load_messages
)
1312 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1315 message_with_string ("Loading %s (source)...", file
, 1);
1317 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1319 else /* The typical case; compiled file newer than source file. */
1320 message_with_string ("Loading %s...", file
, 1);
1323 specbind (Qload_file_name
, found
);
1324 specbind (Qinhibit_file_name_operation
, Qnil
);
1325 specbind (Qload_in_progress
, Qt
);
1328 if (lisp_file_lexically_bound_p (Qget_file_char
))
1329 Fset (Qlexical_binding
, Qt
);
1331 if (! version
|| version
>= 22)
1332 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1333 0, Qnil
, Qnil
, Qnil
, Qnil
);
1336 /* We can't handle a file which was compiled with
1337 byte-compile-dynamic by older version of Emacs. */
1338 specbind (Qload_force_doc_strings
, Qt
);
1339 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1340 0, Qnil
, Qnil
, Qnil
, Qnil
);
1342 unbind_to (count
, Qnil
);
1344 /* Run any eval-after-load forms for this file. */
1345 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1346 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1348 xfree (saved_doc_string
);
1349 saved_doc_string
= 0;
1350 saved_doc_string_size
= 0;
1352 xfree (prev_saved_doc_string
);
1353 prev_saved_doc_string
= 0;
1354 prev_saved_doc_string_size
= 0;
1356 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1359 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1362 message_with_string ("Loading %s (source)...done", file
, 1);
1364 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1366 else /* The typical case; compiled file newer than source file. */
1367 message_with_string ("Loading %s...done", file
, 1);
1374 complete_filename_p (Lisp_Object pathname
)
1376 const unsigned char *s
= SDATA (pathname
);
1377 return (IS_DIRECTORY_SEP (s
[0])
1378 || (SCHARS (pathname
) > 2
1379 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1382 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1383 doc
: /* Search for FILENAME through PATH.
1384 Returns the file's name in absolute form, or nil if not found.
1385 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1386 file name when searching.
1387 If non-nil, PREDICATE is used instead of `file-readable-p'.
1388 PREDICATE can also be an integer to pass to the faccessat(2) function,
1389 in which case file-name-handlers are ignored.
1390 This function will normally skip directories, so if you want it to find
1391 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1392 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1395 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1396 if (NILP (predicate
) && fd
>= 0)
1401 /* Search for a file whose name is STR, looking in directories
1402 in the Lisp list PATH, and trying suffixes from SUFFIX.
1403 On success, return a file descriptor (or 1 or -2 as described below).
1404 On failure, return -1 and set errno.
1406 SUFFIXES is a list of strings containing possible suffixes.
1407 The empty suffix is automatically added if the list is empty.
1409 PREDICATE t means the files are binary.
1410 PREDICATE non-nil and non-t means don't open the files,
1411 just look for one that satisfies the predicate. In this case,
1412 return 1 on success. The predicate can be a lisp function or
1413 an integer to pass to `access' (in which case file-name-handlers
1416 If STOREPTR is nonzero, it points to a slot where the name of
1417 the file actually found should be stored as a Lisp string.
1418 nil is stored there on failure.
1420 If the file we find is remote, return -2
1421 but store the found remote file name in *STOREPTR.
1423 If NEWER is true, try all SUFFIXes and return the result for the
1424 newest file that exists. Does not apply to remote files,
1425 or if a non-nil and non-t PREDICATE is specified. */
1428 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1429 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1431 ptrdiff_t fn_size
= 100;
1435 ptrdiff_t want_length
;
1436 Lisp_Object filename
;
1437 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1438 ptrdiff_t max_suffix_len
= 0;
1439 int last_errno
= ENOENT
;
1443 /* The last-modified time of the newest matching file found.
1444 Initialize it to something less than all valid timestamps. */
1445 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1449 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1451 CHECK_STRING_CAR (tail
);
1452 max_suffix_len
= max (max_suffix_len
,
1453 SBYTES (XCAR (tail
)));
1456 string
= filename
= encoded_fn
= save_string
= Qnil
;
1461 absolute
= complete_filename_p (str
);
1463 for (; CONSP (path
); path
= XCDR (path
))
1465 filename
= Fexpand_file_name (str
, XCAR (path
));
1466 if (!complete_filename_p (filename
))
1467 /* If there are non-absolute elts in PATH (eg "."). */
1468 /* Of course, this could conceivably lose if luser sets
1469 default-directory to be something non-absolute... */
1471 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1472 if (!complete_filename_p (filename
))
1473 /* Give up on this path element! */
1477 /* Calculate maximum length of any filename made from
1478 this path element/specified file name and any possible suffix. */
1479 want_length
= max_suffix_len
+ SBYTES (filename
);
1480 if (fn_size
<= want_length
)
1482 fn_size
= 100 + want_length
;
1483 fn
= SAFE_ALLOCA (fn_size
);
1486 /* Loop over suffixes. */
1487 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1488 CONSP (tail
); tail
= XCDR (tail
))
1490 Lisp_Object suffix
= XCAR (tail
);
1491 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1492 Lisp_Object handler
;
1494 /* Concatenate path element/specified name with the suffix.
1495 If the directory starts with /:, remove that. */
1496 int prefixlen
= ((SCHARS (filename
) > 2
1497 && SREF (filename
, 0) == '/'
1498 && SREF (filename
, 1) == ':')
1500 fnlen
= SBYTES (filename
) - prefixlen
;
1501 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1502 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1504 /* Check that the file exists and is not a directory. */
1505 /* We used to only check for handlers on non-absolute file names:
1509 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1510 It's not clear why that was the case and it breaks things like
1511 (load "/bar.el") where the file is actually "/bar.el.gz". */
1512 /* make_string has its own ideas on when to return a unibyte
1513 string and when a multibyte string, but we know better.
1514 We must have a unibyte string when dumping, since
1515 file-name encoding is shaky at best at that time, and in
1516 particular default-file-name-coding-system is reset
1517 several times during loadup. We therefore don't want to
1518 encode the file before passing it to file I/O library
1520 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1521 string
= make_unibyte_string (fn
, fnlen
);
1523 string
= make_string (fn
, fnlen
);
1524 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1525 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1526 && !NATNUMP (predicate
))
1529 if (NILP (predicate
) || EQ (predicate
, Qt
))
1530 exists
= !NILP (Ffile_readable_p (string
));
1533 Lisp_Object tmp
= call1 (predicate
, string
);
1536 else if (EQ (tmp
, Qdir_ok
)
1537 || NILP (Ffile_directory_p (string
)))
1542 last_errno
= EISDIR
;
1548 /* We succeeded; return this descriptor and filename. */
1561 encoded_fn
= ENCODE_FILE (string
);
1562 pfn
= SSDATA (encoded_fn
);
1564 /* Check that we can access or open it. */
1565 if (NATNUMP (predicate
))
1568 if (INT_MAX
< XFASTINT (predicate
))
1569 last_errno
= EINVAL
;
1570 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1574 if (file_directory_p (pfn
))
1575 last_errno
= EISDIR
;
1582 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1585 if (errno
!= ENOENT
)
1590 int err
= (fstat (fd
, &st
) != 0 ? errno
1591 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1603 if (newer
&& !NATNUMP (predicate
))
1605 struct timespec mtime
= get_stat_mtime (&st
);
1607 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1612 emacs_close (save_fd
);
1615 save_string
= string
;
1620 /* We succeeded; return this descriptor and filename. */
1628 /* No more suffixes. Return the newest. */
1629 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1632 *storeptr
= save_string
;
1648 /* Merge the list we've accumulated of globals from the current input source
1649 into the load_history variable. The details depend on whether
1650 the source has an associated file name or not.
1652 FILENAME is the file name that we are loading from.
1654 ENTIRE is true if loading that entire file, false if evaluating
1658 build_load_history (Lisp_Object filename
, bool entire
)
1660 Lisp_Object tail
, prev
, newelt
;
1661 Lisp_Object tem
, tem2
;
1664 tail
= Vload_history
;
1667 while (CONSP (tail
))
1671 /* Find the feature's previous assoc list... */
1672 if (!NILP (Fequal (filename
, Fcar (tem
))))
1676 /* If we're loading the entire file, remove old data. */
1680 Vload_history
= XCDR (tail
);
1682 Fsetcdr (prev
, XCDR (tail
));
1685 /* Otherwise, cons on new symbols that are not already members. */
1688 tem2
= Vcurrent_load_list
;
1690 while (CONSP (tem2
))
1692 newelt
= XCAR (tem2
);
1694 if (NILP (Fmember (newelt
, tem
)))
1695 Fsetcar (tail
, Fcons (XCAR (tem
),
1696 Fcons (newelt
, XCDR (tem
))));
1709 /* If we're loading an entire file, cons the new assoc onto the
1710 front of load-history, the most-recently-loaded position. Also
1711 do this if we didn't find an existing member for the file. */
1712 if (entire
|| !foundit
)
1713 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1718 readevalloop_1 (int old
)
1720 load_convert_to_unibyte
= old
;
1723 /* Signal an `end-of-file' error, if possible with file name
1726 static _Noreturn
void
1727 end_of_file_error (void)
1729 if (STRINGP (Vload_file_name
))
1730 xsignal1 (Qend_of_file
, Vload_file_name
);
1732 xsignal0 (Qend_of_file
);
1736 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1738 /* If we macroexpand the toplevel form non-recursively and it ends
1739 up being a `progn' (or if it was a progn to start), treat each
1740 form in the progn as a top-level form. This way, if one form in
1741 the progn defines a macro, that macro is in effect when we expand
1742 the remaining forms. See similar code in bytecomp.el. */
1743 val
= call2 (macroexpand
, val
, Qnil
);
1744 if (EQ (CAR_SAFE (val
), Qprogn
))
1746 Lisp_Object subforms
= XCDR (val
);
1748 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1749 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1753 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1757 /* UNIBYTE specifies how to set load_convert_to_unibyte
1758 for this invocation.
1759 READFUN, if non-nil, is used instead of `read'.
1761 START, END specify region to read in current buffer (from eval-region).
1762 If the input is not from a buffer, they must be nil. */
1765 readevalloop (Lisp_Object readcharfun
,
1767 Lisp_Object sourcename
,
1769 Lisp_Object unibyte
, Lisp_Object readfun
,
1770 Lisp_Object start
, Lisp_Object end
)
1774 ptrdiff_t count
= SPECPDL_INDEX ();
1775 struct buffer
*b
= 0;
1776 bool continue_reading_p
;
1777 Lisp_Object lex_bound
;
1778 /* True if reading an entire buffer. */
1779 bool whole_buffer
= 0;
1780 /* True on the first time around. */
1781 bool first_sexp
= 1;
1782 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1784 if (NILP (Ffboundp (macroexpand
))
1785 /* Don't macroexpand in .elc files, since it should have been done
1786 already. We actually don't know whether we're in a .elc file or not,
1787 so we use circumstantial evidence: .el files normally go through
1788 Vload_source_file_function -> load-with-code-conversion
1790 || EQ (readcharfun
, Qget_file_char
)
1791 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1794 if (MARKERP (readcharfun
))
1797 start
= readcharfun
;
1800 if (BUFFERP (readcharfun
))
1801 b
= XBUFFER (readcharfun
);
1802 else if (MARKERP (readcharfun
))
1803 b
= XMARKER (readcharfun
)->buffer
;
1805 /* We assume START is nil when input is not from a buffer. */
1806 if (! NILP (start
) && !b
)
1809 specbind (Qstandard_input
, readcharfun
);
1810 specbind (Qcurrent_load_list
, Qnil
);
1811 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1812 load_convert_to_unibyte
= !NILP (unibyte
);
1814 /* If lexical binding is active (either because it was specified in
1815 the file's header, or via a buffer-local variable), create an empty
1816 lexical environment, otherwise, turn off lexical binding. */
1817 lex_bound
= find_symbol_value (Qlexical_binding
);
1818 specbind (Qinternal_interpreter_environment
,
1819 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1820 ? Qnil
: list1 (Qt
)));
1822 /* Try to ensure sourcename is a truename, except whilst preloading. */
1823 if (NILP (Vpurify_flag
)
1824 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1825 && !NILP (Ffboundp (Qfile_truename
)))
1826 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1828 LOADHIST_ATTACH (sourcename
);
1830 continue_reading_p
= 1;
1831 while (continue_reading_p
)
1833 ptrdiff_t count1
= SPECPDL_INDEX ();
1835 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1836 error ("Reading from killed buffer");
1840 /* Switch to the buffer we are reading from. */
1841 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1842 set_buffer_internal (b
);
1844 /* Save point in it. */
1845 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1846 /* Save ZV in it. */
1847 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1848 /* Those get unbound after we read one expression. */
1850 /* Set point and ZV around stuff to be read. */
1853 Fnarrow_to_region (make_number (BEGV
), end
);
1855 /* Just for cleanliness, convert END to a marker
1856 if it is an integer. */
1858 end
= Fpoint_max_marker ();
1861 /* On the first cycle, we can easily test here
1862 whether we are reading the whole buffer. */
1863 if (b
&& first_sexp
)
1864 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1871 while ((c
= READCHAR
) != '\n' && c
!= -1);
1876 unbind_to (count1
, Qnil
);
1880 /* Ignore whitespace here, so we can detect eof. */
1881 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1882 || c
== NO_BREAK_SPACE
)
1885 if (!NILP (Vpurify_flag
) && c
== '(')
1887 val
= read_list (0, readcharfun
);
1892 read_objects
= Qnil
;
1893 if (!NILP (readfun
))
1895 val
= call1 (readfun
, readcharfun
);
1897 /* If READCHARFUN has set point to ZV, we should
1898 stop reading, even if the form read sets point
1899 to a different value when evaluated. */
1900 if (BUFFERP (readcharfun
))
1902 struct buffer
*buf
= XBUFFER (readcharfun
);
1903 if (BUF_PT (buf
) == BUF_ZV (buf
))
1904 continue_reading_p
= 0;
1907 else if (! NILP (Vload_read_function
))
1908 val
= call1 (Vload_read_function
, readcharfun
);
1910 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1913 if (!NILP (start
) && continue_reading_p
)
1914 start
= Fpoint_marker ();
1916 /* Restore saved point and BEGV. */
1917 unbind_to (count1
, Qnil
);
1919 /* Now eval what we just read. */
1920 if (!NILP (macroexpand
))
1921 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1923 val
= eval_sub (val
);
1927 Vvalues
= Fcons (val
, Vvalues
);
1928 if (EQ (Vstandard_output
, Qt
))
1937 build_load_history (sourcename
,
1938 stream
|| whole_buffer
);
1940 unbind_to (count
, Qnil
);
1943 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1944 doc
: /* Execute the accessible portion of current buffer as Lisp code.
1945 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
1946 When called from a Lisp program (i.e., not interactively), this
1947 function accepts up to five optional arguments:
1948 BUFFER is the buffer to evaluate (nil means use current buffer),
1949 or a name of a buffer (a string).
1950 PRINTFLAG controls printing of output by any output functions in the
1951 evaluated code, such as `print', `princ', and `prin1':
1952 a value of nil means discard it; anything else is the stream to print to.
1953 See Info node `(elisp)Output Streams' for details on streams.
1954 FILENAME specifies the file name to use for `load-history'.
1955 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1957 DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
1958 evaluated code should work normally even if PRINTFLAG is nil, in
1959 which case the output is displayed in the echo area.
1961 This function preserves the position of point. */)
1962 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1964 ptrdiff_t count
= SPECPDL_INDEX ();
1965 Lisp_Object tem
, buf
;
1968 buf
= Fcurrent_buffer ();
1970 buf
= Fget_buffer (buffer
);
1972 error ("No such buffer");
1974 if (NILP (printflag
) && NILP (do_allow_print
))
1979 if (NILP (filename
))
1980 filename
= BVAR (XBUFFER (buf
), filename
);
1982 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1983 specbind (Qstandard_output
, tem
);
1984 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1985 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1986 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1987 readevalloop (buf
, 0, filename
,
1988 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1989 unbind_to (count
, Qnil
);
1994 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1995 doc
: /* Execute the region as Lisp code.
1996 When called from programs, expects two arguments,
1997 giving starting and ending indices in the current buffer
1998 of the text to be executed.
1999 Programs can pass third argument PRINTFLAG which controls output:
2000 a value of nil means discard it; anything else is stream for printing it.
2001 See Info node `(elisp)Output Streams' for details on streams.
2002 Also the fourth argument READ-FUNCTION, if non-nil, is used
2003 instead of `read' to read each expression. It gets one argument
2004 which is the input stream for reading characters.
2006 This function does not move point. */)
2007 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2009 /* FIXME: Do the eval-sexp-add-defvars dance! */
2010 ptrdiff_t count
= SPECPDL_INDEX ();
2011 Lisp_Object tem
, cbuf
;
2013 cbuf
= Fcurrent_buffer ();
2015 if (NILP (printflag
))
2019 specbind (Qstandard_output
, tem
);
2020 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2022 /* `readevalloop' calls functions which check the type of start and end. */
2023 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2024 !NILP (printflag
), Qnil
, read_function
,
2027 return unbind_to (count
, Qnil
);
2031 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2032 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2033 If STREAM is nil, use the value of `standard-input' (which see).
2034 STREAM or the value of `standard-input' may be:
2035 a buffer (read from point and advance it)
2036 a marker (read from where it points and advance it)
2037 a function (call it with no arguments for each character,
2038 call it with a char as argument to push a char back)
2039 a string (takes text from string, starting at the beginning)
2040 t (read text line using minibuffer and use it, or read from
2041 standard input in batch mode). */)
2042 (Lisp_Object stream
)
2045 stream
= Vstandard_input
;
2046 if (EQ (stream
, Qt
))
2047 stream
= Qread_char
;
2048 if (EQ (stream
, Qread_char
))
2049 /* FIXME: ?! When is this used !? */
2050 return call1 (intern ("read-minibuffer"),
2051 build_string ("Lisp expression: "));
2053 return read_internal_start (stream
, Qnil
, Qnil
);
2056 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2057 doc
: /* Read one Lisp expression which is represented as text by STRING.
2058 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2059 FINAL-STRING-INDEX is an integer giving the position of the next
2060 remaining character in STRING. START and END optionally delimit
2061 a substring of STRING from which to read; they default to 0 and
2062 \(length STRING) respectively. Negative values are counted from
2063 the end of STRING. */)
2064 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2067 CHECK_STRING (string
);
2068 /* `read_internal_start' sets `read_from_string_index'. */
2069 ret
= read_internal_start (string
, start
, end
);
2070 return Fcons (ret
, make_number (read_from_string_index
));
2073 /* Function to set up the global context we need in toplevel read
2074 calls. START and END only used when STREAM is a string. */
2076 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2081 new_backquote_flag
= 0;
2082 read_objects
= Qnil
;
2083 if (EQ (Vread_with_symbol_positions
, Qt
)
2084 || EQ (Vread_with_symbol_positions
, stream
))
2085 Vread_symbol_positions_list
= Qnil
;
2087 if (STRINGP (stream
)
2088 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2090 ptrdiff_t startval
, endval
;
2093 if (STRINGP (stream
))
2096 string
= XCAR (stream
);
2098 validate_subarray (string
, start
, end
, SCHARS (string
),
2099 &startval
, &endval
);
2101 read_from_string_index
= startval
;
2102 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2103 read_from_string_limit
= endval
;
2106 retval
= read0 (stream
);
2107 if (EQ (Vread_with_symbol_positions
, Qt
)
2108 || EQ (Vread_with_symbol_positions
, stream
))
2109 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2114 /* Signal Qinvalid_read_syntax error.
2115 S is error string of length N (if > 0) */
2117 static _Noreturn
void
2118 invalid_syntax (const char *s
)
2120 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2124 /* Use this for recursive reads, in contexts where internal tokens
2128 read0 (Lisp_Object readcharfun
)
2130 register Lisp_Object val
;
2133 val
= read1 (readcharfun
, &c
, 0);
2137 xsignal1 (Qinvalid_read_syntax
,
2138 Fmake_string (make_number (1), make_number (c
)));
2141 static ptrdiff_t read_buffer_size
;
2142 static char *read_buffer
;
2144 /* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes. */
2147 grow_read_buffer (void)
2149 read_buffer
= xpalloc (read_buffer
, &read_buffer_size
,
2150 MAX_MULTIBYTE_LENGTH
, -1, 1);
2153 /* Hash table that maps Unicode character names to code points. */
2154 static Lisp_Object character_names
;
2156 /* Length of the longest Unicode character name, in bytes. */
2157 static ptrdiff_t max_character_name_length
;
2159 /* Initializes `character_names' and `max_character_name_length'.
2160 Called by `read_escape'. */
2161 void init_character_names (void)
2163 character_names
= CALLN (Fmake_hash_table
,
2165 /* Currently around 100,000 Unicode
2166 characters are defined. */
2167 QCsize
, make_natnum (100000));
2168 Lisp_Object get_property
=
2169 Fsymbol_function (intern_c_string ("get-char-code-property"));
2170 ptrdiff_t length
= 0;
2171 for (int i
= 0; i
<= MAX_UNICODE_CHAR
; ++i
)
2173 Lisp_Object code
= make_natnum (i
);
2174 Lisp_Object name
= call2 (get_property
, code
, Qname
);
2175 if (NILP (name
)) continue;
2176 CHECK_STRING (name
);
2177 length
= max (length
, SBYTES (name
));
2178 Fputhash (name
, code
, character_names
);
2180 max_character_name_length
= length
;
2183 /* Read a \-escape sequence, assuming we already read the `\'.
2184 If the escape sequence forces unibyte, return eight-bit char. */
2187 read_escape (Lisp_Object readcharfun
, bool stringp
)
2190 /* \u allows up to four hex digits, \U up to eight. Default to the
2191 behavior for \u, and change this value in the case that \U is seen. */
2192 int unicode_hex_count
= 4;
2197 end_of_file_error ();
2227 error ("Invalid escape character syntax");
2230 c
= read_escape (readcharfun
, 0);
2231 return c
| meta_modifier
;
2236 error ("Invalid escape character syntax");
2239 c
= read_escape (readcharfun
, 0);
2240 return c
| shift_modifier
;
2245 error ("Invalid escape character syntax");
2248 c
= read_escape (readcharfun
, 0);
2249 return c
| hyper_modifier
;
2254 error ("Invalid escape character syntax");
2257 c
= read_escape (readcharfun
, 0);
2258 return c
| alt_modifier
;
2262 if (stringp
|| c
!= '-')
2269 c
= read_escape (readcharfun
, 0);
2270 return c
| super_modifier
;
2275 error ("Invalid escape character syntax");
2279 c
= read_escape (readcharfun
, 0);
2280 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2281 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2282 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2283 return c
| ctrl_modifier
;
2284 /* ASCII control chars are made from letters (both cases),
2285 as well as the non-letters within 0100...0137. */
2286 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2287 return (c
& (037 | ~0177));
2288 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2289 return (c
& (037 | ~0177));
2291 return c
| ctrl_modifier
;
2301 /* An octal escape, as in ANSI C. */
2303 register int i
= c
- '0';
2304 register int count
= 0;
2307 if ((c
= READCHAR
) >= '0' && c
<= '7')
2319 if (i
>= 0x80 && i
< 0x100)
2320 i
= BYTE8_TO_CHAR (i
);
2325 /* A hex escape, as in ANSI C. */
2332 if (c
>= '0' && c
<= '9')
2337 else if ((c
>= 'a' && c
<= 'f')
2338 || (c
>= 'A' && c
<= 'F'))
2341 if (c
>= 'a' && c
<= 'f')
2351 /* Allow hex escapes as large as ?\xfffffff, because some
2352 packages use them to denote characters with modifiers. */
2353 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2354 error ("Hex character out of range: \\x%x...", i
);
2358 if (count
< 3 && i
>= 0x80)
2359 return BYTE8_TO_CHAR (i
);
2364 /* Post-Unicode-2.0: Up to eight hex chars. */
2365 unicode_hex_count
= 8;
2368 /* A Unicode escape. We only permit them in strings and characters,
2369 not arbitrarily in the source code, as in some other languages. */
2374 while (++count
<= unicode_hex_count
)
2377 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2379 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2380 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2381 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2383 error ("Non-hex digit used for Unicode escape");
2386 error ("Non-Unicode character: 0x%x", i
);
2391 /* Named character. */
2395 invalid_syntax ("Expected opening brace after \\N");
2396 if (NILP (character_names
))
2397 init_character_names ();
2399 char *name
= SAFE_ALLOCA (max_character_name_length
+ 1);
2400 bool whitespace
= false;
2401 ptrdiff_t length
= 0;
2406 end_of_file_error ();
2409 if (! c_isascii (c
))
2410 xsignal1 (Qinvalid_read_syntax
,
2412 build_pure_c_string ("Non-ASCII character U+%04X"
2413 " in character name"),
2415 /* We treat multiple adjacent whitespace characters as a
2416 single space character. This makes it easier to use
2417 character names in e.g. multi-line strings. */
2428 if (length
>= max_character_name_length
)
2429 invalid_syntax ("Character name too long");
2432 invalid_syntax ("Empty character name");
2434 Lisp_Object lisp_name
= make_unibyte_string (name
, length
);
2436 (length
>= 3 && length
<= 10 && name
[0] == 'U' && name
[1] == '+') ?
2437 /* Code point as U+N, where N is between 1 and 8 hexadecimal
2439 string_to_number (name
+ 2, 16, false) :
2440 Fgethash (lisp_name
, character_names
, Qnil
);
2442 if (! RANGED_INTEGERP (0, code
, MAX_UNICODE_CHAR
))
2443 xsignal1 (Qinvalid_read_syntax
,
2445 build_pure_c_string ("\\N{%s}"), lisp_name
));
2454 /* Return the digit that CHARACTER stands for in the given BASE.
2455 Return -1 if CHARACTER is out of range for BASE,
2456 and -2 if CHARACTER is not valid for any supported BASE. */
2458 digit_to_number (int character
, int base
)
2462 if ('0' <= character
&& character
<= '9')
2463 digit
= character
- '0';
2464 else if ('a' <= character
&& character
<= 'z')
2465 digit
= character
- 'a' + 10;
2466 else if ('A' <= character
&& character
<= 'Z')
2467 digit
= character
- 'A' + 10;
2471 return digit
< base
? digit
: -1;
2474 /* Read an integer in radix RADIX using READCHARFUN to read
2475 characters. RADIX must be in the interval [2..36]; if it isn't, a
2476 read error is signaled . Value is the integer read. Signals an
2477 error if encountering invalid read syntax or if RADIX is out of
2481 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2483 /* Room for sign, leading 0, other digits, trailing null byte.
2484 Also, room for invalid syntax diagnostic. */
2485 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2486 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2488 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2490 if (radix
< 2 || radix
> 36)
2498 if (c
== '-' || c
== '+')
2509 /* Ignore redundant leading zeros, so the buffer doesn't
2510 fill up with them. */
2516 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2523 if (p
< buf
+ sizeof buf
- 1)
2537 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2538 invalid_syntax (buf
);
2541 return string_to_number (buf
, radix
, 0);
2545 /* If the next token is ')' or ']' or '.', we store that character
2546 in *PCH and the return value is not interesting. Else, we store
2547 zero in *PCH and we read and return one lisp object.
2549 FIRST_IN_LIST is true if this is the first element of a list. */
2552 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2555 bool uninterned_symbol
= 0;
2562 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2564 end_of_file_error ();
2569 return read_list (0, readcharfun
);
2572 return read_vector (readcharfun
, 0);
2588 /* Accept extended format for hashtables (extensible to
2590 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2591 Lisp_Object tmp
= read_list (0, readcharfun
);
2592 Lisp_Object head
= CAR_SAFE (tmp
);
2593 Lisp_Object data
= Qnil
;
2594 Lisp_Object val
= Qnil
;
2595 /* The size is 2 * number of allowed keywords to
2597 Lisp_Object params
[10];
2599 Lisp_Object key
= Qnil
;
2600 int param_count
= 0;
2602 if (!EQ (head
, Qhash_table
))
2603 error ("Invalid extended read marker at head of #s list "
2604 "(only hash-table allowed)");
2606 tmp
= CDR_SAFE (tmp
);
2608 /* This is repetitive but fast and simple. */
2609 params
[param_count
] = QCsize
;
2610 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2611 if (!NILP (params
[param_count
+ 1]))
2614 params
[param_count
] = QCtest
;
2615 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2616 if (!NILP (params
[param_count
+ 1]))
2619 params
[param_count
] = QCweakness
;
2620 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2621 if (!NILP (params
[param_count
+ 1]))
2624 params
[param_count
] = QCrehash_size
;
2625 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2626 if (!NILP (params
[param_count
+ 1]))
2629 params
[param_count
] = QCrehash_threshold
;
2630 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2631 if (!NILP (params
[param_count
+ 1]))
2634 /* This is the hashtable data. */
2635 data
= Fplist_get (tmp
, Qdata
);
2637 /* Now use params to make a new hashtable and fill it. */
2638 ht
= Fmake_hash_table (param_count
, params
);
2640 while (CONSP (data
))
2645 error ("Odd number of elements in hashtable data");
2648 Fputhash (key
, val
, ht
);
2654 invalid_syntax ("#");
2662 tmp
= read_vector (readcharfun
, 0);
2663 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2664 error ("Invalid size char-table");
2665 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2673 /* Sub char-table can't be read as a regular
2674 vector because of a two C integer fields. */
2675 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2676 ptrdiff_t size
= XINT (Flength (tmp
));
2677 int i
, depth
, min_char
;
2678 struct Lisp_Cons
*cell
;
2681 error ("Zero-sized sub char-table");
2683 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2684 error ("Invalid depth in sub char-table");
2685 depth
= XINT (XCAR (tmp
));
2686 if (chartab_size
[depth
] != size
- 2)
2687 error ("Invalid size in sub char-table");
2688 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2691 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2692 error ("Invalid minimum character in sub-char-table");
2693 min_char
= XINT (XCAR (tmp
));
2694 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2697 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2698 for (i
= 0; i
< size
; i
++)
2700 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2701 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2706 invalid_syntax ("#^^");
2708 invalid_syntax ("#^");
2713 length
= read1 (readcharfun
, pch
, first_in_list
);
2717 Lisp_Object tmp
, val
;
2718 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2719 unsigned char *data
;
2722 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2723 if (STRING_MULTIBYTE (tmp
)
2724 || (size_in_chars
!= SCHARS (tmp
)
2725 /* We used to print 1 char too many
2726 when the number of bits was a multiple of 8.
2727 Accept such input in case it came from an old
2729 && ! (XFASTINT (length
)
2730 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2731 invalid_syntax ("#&...");
2733 val
= make_uninit_bool_vector (XFASTINT (length
));
2734 data
= bool_vector_uchar_data (val
);
2735 memcpy (data
, SDATA (tmp
), size_in_chars
);
2736 /* Clear the extraneous bits in the last byte. */
2737 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2738 data
[size_in_chars
- 1]
2739 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2742 invalid_syntax ("#&...");
2746 /* Accept compiled functions at read-time so that we don't have to
2747 build them using function calls. */
2749 struct Lisp_Vector
*vec
;
2750 tmp
= read_vector (readcharfun
, 1);
2751 vec
= XVECTOR (tmp
);
2752 if (vec
->header
.size
== 0)
2753 invalid_syntax ("Empty byte-code object");
2754 make_byte_code (vec
);
2762 /* Read the string itself. */
2763 tmp
= read1 (readcharfun
, &ch
, 0);
2764 if (ch
!= 0 || !STRINGP (tmp
))
2765 invalid_syntax ("#");
2766 /* Read the intervals and their properties. */
2769 Lisp_Object beg
, end
, plist
;
2771 beg
= read1 (readcharfun
, &ch
, 0);
2776 end
= read1 (readcharfun
, &ch
, 0);
2778 plist
= read1 (readcharfun
, &ch
, 0);
2780 invalid_syntax ("Invalid string property list");
2781 Fset_text_properties (beg
, end
, plist
, tmp
);
2787 /* #@NUMBER is used to skip NUMBER following bytes.
2788 That's used in .elc files to skip over doc strings
2789 and function definitions. */
2792 enum { extra
= 100 };
2793 ptrdiff_t i
, nskip
= 0, digits
= 0;
2795 /* Read a decimal integer. */
2796 while ((c
= READCHAR
) >= 0
2797 && c
>= '0' && c
<= '9')
2799 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2804 if (digits
== 2 && nskip
== 0)
2805 { /* We've just seen #@00, which means "skip to end". */
2806 skip_dyn_eof (readcharfun
);
2811 /* We can't use UNREAD here, because in the code below we side-step
2812 READCHAR. Instead, assume the first char after #@NNN occupies
2813 a single byte, which is the case normally since it's just
2819 if (load_force_doc_strings
2820 && (FROM_FILE_P (readcharfun
)))
2822 /* If we are supposed to force doc strings into core right now,
2823 record the last string that we skipped,
2824 and record where in the file it comes from. */
2826 /* But first exchange saved_doc_string
2827 with prev_saved_doc_string, so we save two strings. */
2829 char *temp
= saved_doc_string
;
2830 ptrdiff_t temp_size
= saved_doc_string_size
;
2831 file_offset temp_pos
= saved_doc_string_position
;
2832 ptrdiff_t temp_len
= saved_doc_string_length
;
2834 saved_doc_string
= prev_saved_doc_string
;
2835 saved_doc_string_size
= prev_saved_doc_string_size
;
2836 saved_doc_string_position
= prev_saved_doc_string_position
;
2837 saved_doc_string_length
= prev_saved_doc_string_length
;
2839 prev_saved_doc_string
= temp
;
2840 prev_saved_doc_string_size
= temp_size
;
2841 prev_saved_doc_string_position
= temp_pos
;
2842 prev_saved_doc_string_length
= temp_len
;
2845 if (saved_doc_string_size
== 0)
2847 saved_doc_string
= xmalloc (nskip
+ extra
);
2848 saved_doc_string_size
= nskip
+ extra
;
2850 if (nskip
> saved_doc_string_size
)
2852 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2853 saved_doc_string_size
= nskip
+ extra
;
2856 saved_doc_string_position
= file_tell (instream
);
2858 /* Copy that many characters into saved_doc_string. */
2860 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2861 saved_doc_string
[i
] = c
= getc (instream
);
2864 saved_doc_string_length
= i
;
2867 /* Skip that many bytes. */
2868 skip_dyn_bytes (readcharfun
, nskip
);
2874 /* #! appears at the beginning of an executable file.
2875 Skip the first line. */
2876 while (c
!= '\n' && c
>= 0)
2881 return Vload_file_name
;
2883 return list2 (Qfunction
, read0 (readcharfun
));
2884 /* #:foo is the uninterned symbol named foo. */
2887 uninterned_symbol
= 1;
2890 && c
!= NO_BREAK_SPACE
2892 || strchr ("\"';()[]#`,", c
) == NULL
)))
2894 /* No symbol character follows, this is the empty
2897 return Fmake_symbol (empty_unibyte_string
);
2901 /* ## is the empty symbol. */
2903 return Fintern (empty_unibyte_string
, Qnil
);
2904 /* Reader forms that can reuse previously read objects. */
2905 if (c
>= '0' && c
<= '9')
2910 /* Read a non-negative integer. */
2911 while (c
>= '0' && c
<= '9')
2913 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2914 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2915 n
= MOST_POSITIVE_FIXNUM
+ 1;
2917 n
= n
* 10 + c
- '0';
2921 if (n
<= MOST_POSITIVE_FIXNUM
)
2923 if (c
== 'r' || c
== 'R')
2924 return read_integer (readcharfun
, n
);
2926 if (! NILP (Vread_circle
))
2928 /* #n=object returns object, but associates it with
2932 /* Make a placeholder for #n# to use temporarily. */
2933 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2934 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2935 read_objects
= Fcons (cell
, read_objects
);
2937 /* Read the object itself. */
2938 tem
= read0 (readcharfun
);
2940 /* Now put it everywhere the placeholder was... */
2941 substitute_object_in_subtree (tem
, placeholder
);
2943 /* ...and #n# will use the real value from now on. */
2944 Fsetcdr (cell
, tem
);
2949 /* #n# returns a previously read object. */
2952 tem
= Fassq (make_number (n
), read_objects
);
2958 /* Fall through to error message. */
2960 else if (c
== 'x' || c
== 'X')
2961 return read_integer (readcharfun
, 16);
2962 else if (c
== 'o' || c
== 'O')
2963 return read_integer (readcharfun
, 8);
2964 else if (c
== 'b' || c
== 'B')
2965 return read_integer (readcharfun
, 2);
2968 invalid_syntax ("#");
2971 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2975 return list2 (Qquote
, read0 (readcharfun
));
2979 int next_char
= READCHAR
;
2981 /* Transition from old-style to new-style:
2982 If we see "(`" it used to mean old-style, which usually works
2983 fine because ` should almost never appear in such a position
2984 for new-style. But occasionally we need "(`" to mean new
2985 style, so we try to distinguish the two by the fact that we
2986 can either write "( `foo" or "(` foo", where the first
2987 intends to use new-style whereas the second intends to use
2988 old-style. For Emacs-25, we should completely remove this
2989 first_in_list exception (old-style can still be obtained via
2991 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2993 Vold_style_backquotes
= Qt
;
2999 bool saved_new_backquote_flag
= new_backquote_flag
;
3001 new_backquote_flag
= 1;
3002 value
= read0 (readcharfun
);
3003 new_backquote_flag
= saved_new_backquote_flag
;
3005 return list2 (Qbackquote
, value
);
3010 int next_char
= READCHAR
;
3012 /* Transition from old-style to new-style:
3013 It used to be impossible to have a new-style , other than within
3014 a new-style `. This is sufficient when ` and , are used in the
3015 normal way, but ` and , can also appear in args to macros that
3016 will not interpret them in the usual way, in which case , may be
3017 used without any ` anywhere near.
3018 So we now use the same heuristic as for backquote: old-style
3019 unquotes are only recognized when first on a list, and when
3020 followed by a space.
3021 Because it's more difficult to peek 2 chars ahead, a new-style
3022 ,@ can still not be used outside of a `, unless it's in the middle
3024 if (new_backquote_flag
3026 || (next_char
!= ' ' && next_char
!= '@'))
3028 Lisp_Object comma_type
= Qnil
;
3033 comma_type
= Qcomma_at
;
3035 comma_type
= Qcomma_dot
;
3038 if (ch
>= 0) UNREAD (ch
);
3039 comma_type
= Qcomma
;
3042 value
= read0 (readcharfun
);
3043 return list2 (comma_type
, value
);
3047 Vold_style_backquotes
= Qt
;
3059 end_of_file_error ();
3061 /* Accept `single space' syntax like (list ? x) where the
3062 whitespace character is SPC or TAB.
3063 Other literal whitespace like NL, CR, and FF are not accepted,
3064 as there are well-established escape sequences for these. */
3065 if (c
== ' ' || c
== '\t')
3066 return make_number (c
);
3069 c
= read_escape (readcharfun
, 0);
3070 modifiers
= c
& CHAR_MODIFIER_MASK
;
3071 c
&= ~CHAR_MODIFIER_MASK
;
3072 if (CHAR_BYTE8_P (c
))
3073 c
= CHAR_TO_BYTE8 (c
);
3076 next_char
= READCHAR
;
3077 ok
= (next_char
<= 040
3078 || (next_char
< 0200
3079 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3082 return make_number (c
);
3084 invalid_syntax ("?");
3089 char *p
= read_buffer
;
3090 char *end
= read_buffer
+ read_buffer_size
;
3092 /* True if we saw an escape sequence specifying
3093 a multibyte character. */
3094 bool force_multibyte
= 0;
3095 /* True if we saw an escape sequence specifying
3096 a single-byte character. */
3097 bool force_singlebyte
= 0;
3099 ptrdiff_t nchars
= 0;
3101 while ((ch
= READCHAR
) >= 0
3104 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3106 ptrdiff_t offset
= p
- read_buffer
;
3107 grow_read_buffer ();
3108 p
= read_buffer
+ offset
;
3109 end
= read_buffer
+ read_buffer_size
;
3116 ch
= read_escape (readcharfun
, 1);
3118 /* CH is -1 if \ newline or \ space has just been seen. */
3121 if (p
== read_buffer
)
3126 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3127 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3129 if (CHAR_BYTE8_P (ch
))
3130 force_singlebyte
= 1;
3131 else if (! ASCII_CHAR_P (ch
))
3132 force_multibyte
= 1;
3133 else /* I.e. ASCII_CHAR_P (ch). */
3135 /* Allow `\C- ' and `\C-?'. */
3136 if (modifiers
== CHAR_CTL
)
3139 ch
= 0, modifiers
= 0;
3141 ch
= 127, modifiers
= 0;
3143 if (modifiers
& CHAR_SHIFT
)
3145 /* Shift modifier is valid only with [A-Za-z]. */
3146 if (ch
>= 'A' && ch
<= 'Z')
3147 modifiers
&= ~CHAR_SHIFT
;
3148 else if (ch
>= 'a' && ch
<= 'z')
3149 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3152 if (modifiers
& CHAR_META
)
3154 /* Move the meta bit to the right place for a
3156 modifiers
&= ~CHAR_META
;
3157 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3158 force_singlebyte
= 1;
3162 /* Any modifiers remaining are invalid. */
3164 error ("Invalid modifier in string");
3165 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3169 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3170 if (CHAR_BYTE8_P (ch
))
3171 force_singlebyte
= 1;
3172 else if (! ASCII_CHAR_P (ch
))
3173 force_multibyte
= 1;
3179 end_of_file_error ();
3181 /* If purifying, and string starts with \ newline,
3182 return zero instead. This is for doc strings
3183 that we are really going to find in etc/DOC.nn.nn. */
3184 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3185 return make_number (0);
3187 if (! force_multibyte
&& force_singlebyte
)
3189 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3190 forms. Convert it to unibyte. */
3191 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3193 p
= read_buffer
+ nchars
;
3196 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3198 || (p
- read_buffer
!= nchars
)));
3203 int next_char
= READCHAR
;
3206 if (next_char
<= 040
3207 || (next_char
< 0200
3208 && strchr ("\"';([#?`,", next_char
) != NULL
))
3214 /* Otherwise, we fall through! Note that the atom-reading loop
3215 below will now loop at least once, assuring that we will not
3216 try to UNREAD two characters in a row. */
3220 if (c
<= 040) goto retry
;
3221 if (c
== NO_BREAK_SPACE
)
3226 char *p
= read_buffer
;
3228 EMACS_INT start_position
= readchar_count
- 1;
3231 char *end
= read_buffer
+ read_buffer_size
;
3235 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3237 ptrdiff_t offset
= p
- read_buffer
;
3238 grow_read_buffer ();
3239 p
= read_buffer
+ offset
;
3240 end
= read_buffer
+ read_buffer_size
;
3247 end_of_file_error ();
3252 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3258 && c
!= NO_BREAK_SPACE
3260 || strchr ("\"';()[]#`,", c
) == NULL
));
3264 ptrdiff_t offset
= p
- read_buffer
;
3265 grow_read_buffer ();
3266 p
= read_buffer
+ offset
;
3267 end
= read_buffer
+ read_buffer_size
;
3273 if (!quoted
&& !uninterned_symbol
)
3275 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3276 if (! NILP (result
))
3280 Lisp_Object name
, result
;
3281 ptrdiff_t nbytes
= p
- read_buffer
;
3284 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3288 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3289 ? make_pure_string
: make_specified_string
)
3290 (read_buffer
, nchars
, nbytes
, multibyte
));
3291 result
= (uninterned_symbol
? Fmake_symbol (name
)
3292 : Fintern (name
, Qnil
));
3294 if (EQ (Vread_with_symbol_positions
, Qt
)
3295 || EQ (Vread_with_symbol_positions
, readcharfun
))
3296 Vread_symbol_positions_list
3297 = Fcons (Fcons (result
, make_number (start_position
)),
3298 Vread_symbol_positions_list
);
3306 /* List of nodes we've seen during substitute_object_in_subtree. */
3307 static Lisp_Object seen_list
;
3310 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3312 Lisp_Object check_object
;
3314 /* We haven't seen any objects when we start. */
3317 /* Make all the substitutions. */
3319 = substitute_object_recurse (object
, placeholder
, object
);
3321 /* Clear seen_list because we're done with it. */
3324 /* The returned object here is expected to always eq the
3326 if (!EQ (check_object
, object
))
3327 error ("Unexpected mutation error in reader");
3330 /* Feval doesn't get called from here, so no gc protection is needed. */
3331 #define SUBSTITUTE(get_val, set_val) \
3333 Lisp_Object old_value = get_val; \
3334 Lisp_Object true_value \
3335 = substitute_object_recurse (object, placeholder, \
3338 if (!EQ (old_value, true_value)) \
3345 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3347 /* If we find the placeholder, return the target object. */
3348 if (EQ (placeholder
, subtree
))
3351 /* If we've been to this node before, don't explore it again. */
3352 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3355 /* If this node can be the entry point to a cycle, remember that
3356 we've seen it. It can only be such an entry point if it was made
3357 by #n=, which means that we can find it as a value in
3359 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3360 seen_list
= Fcons (subtree
, seen_list
);
3362 /* Recurse according to subtree's type.
3363 Every branch must return a Lisp_Object. */
3364 switch (XTYPE (subtree
))
3366 case Lisp_Vectorlike
:
3368 ptrdiff_t i
= 0, length
= 0;
3369 if (BOOL_VECTOR_P (subtree
))
3370 return subtree
; /* No sub-objects anyway. */
3371 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3372 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3373 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3374 else if (VECTORP (subtree
))
3375 length
= ASIZE (subtree
);
3377 /* An unknown pseudovector may contain non-Lisp fields, so we
3378 can't just blindly traverse all its fields. We used to call
3379 `Flength' which signaled `sequencep', so I just preserved this
3381 wrong_type_argument (Qsequencep
, subtree
);
3383 if (SUB_CHAR_TABLE_P (subtree
))
3385 for ( ; i
< length
; i
++)
3386 SUBSTITUTE (AREF (subtree
, i
),
3387 ASET (subtree
, i
, true_value
));
3393 SUBSTITUTE (XCAR (subtree
),
3394 XSETCAR (subtree
, true_value
));
3395 SUBSTITUTE (XCDR (subtree
),
3396 XSETCDR (subtree
, true_value
));
3402 /* Check for text properties in each interval.
3403 substitute_in_interval contains part of the logic. */
3405 INTERVAL root_interval
= string_intervals (subtree
);
3406 AUTO_CONS (arg
, object
, placeholder
);
3408 traverse_intervals_noorder (root_interval
,
3409 &substitute_in_interval
, arg
);
3414 /* Other types don't recurse any further. */
3420 /* Helper function for substitute_object_recurse. */
3422 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3424 Lisp_Object object
= Fcar (arg
);
3425 Lisp_Object placeholder
= Fcdr (arg
);
3427 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3437 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3438 integer syntax and fits in a fixnum, else return the nearest float if CP has
3439 either floating point or integer syntax and BASE is 10, else return nil. If
3440 IGNORE_TRAILING, consider just the longest prefix of CP that has
3441 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3442 number has integer syntax but does not fit. */
3445 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3448 char const *cp
= string
;
3450 bool float_syntax
= 0;
3453 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3454 IEEE floating point hosts, and works around a formerly-common bug where
3455 atof ("-0.0") drops the sign. */
3456 bool negative
= *cp
== '-';
3458 bool signedp
= negative
|| *cp
== '+';
3463 leading_digit
= digit_to_number (*cp
, base
);
3464 if (leading_digit
>= 0)
3469 while (digit_to_number (*cp
, base
) >= 0);
3479 if ('0' <= *cp
&& *cp
<= '9')
3484 while ('0' <= *cp
&& *cp
<= '9');
3486 if (*cp
== 'e' || *cp
== 'E')
3488 char const *ecp
= cp
;
3490 if (*cp
== '+' || *cp
== '-')
3492 if ('0' <= *cp
&& *cp
<= '9')
3497 while ('0' <= *cp
&& *cp
<= '9');
3499 else if (cp
[-1] == '+'
3500 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3506 else if (cp
[-1] == '+'
3507 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3511 /* NAN is a "positive" NaN on all known Emacs hosts. */
3518 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3519 || state
== (LEAD_INT
|E_EXP
));
3522 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3523 any prefix that matches. Otherwise, the entire string must match. */
3524 if (! (ignore_trailing
3525 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3526 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3529 /* If the number uses integer and not float syntax, and is in C-language
3530 range, use its value, preferably as a fixnum. */
3531 if (leading_digit
>= 0 && ! float_syntax
)
3535 /* Fast special case for single-digit integers. This also avoids a
3536 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3537 case some versions of strtoumax accept numbers like "0x1" that Emacs
3539 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3540 return make_number (negative
? -leading_digit
: leading_digit
);
3543 n
= strtoumax (string
+ signedp
, NULL
, base
);
3544 if (errno
== ERANGE
)
3546 /* Unfortunately there's no simple and accurate way to convert
3547 non-base-10 numbers that are out of C-language range. */
3549 xsignal1 (Qoverflow_error
, build_string (string
));
3551 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3553 EMACS_INT signed_n
= n
;
3554 return make_number (negative
? -signed_n
: signed_n
);
3560 /* Either the number uses float syntax, or it does not fit into a fixnum.
3561 Convert it from string to floating point, unless the value is already
3562 known because it is an infinity, a NAN, or its absolute value fits in
3565 value
= atof (string
+ signedp
);
3567 return make_float (negative
? -value
: value
);
3572 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3576 Lisp_Object tem
, item
, vector
;
3577 struct Lisp_Cons
*otem
;
3580 tem
= read_list (1, readcharfun
);
3581 len
= Flength (tem
);
3582 vector
= Fmake_vector (len
, Qnil
);
3584 size
= ASIZE (vector
);
3585 ptr
= XVECTOR (vector
)->contents
;
3586 for (i
= 0; i
< size
; i
++)
3589 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3590 bytecode object, the docstring containing the bytecode and
3591 constants values must be treated as unibyte and passed to
3592 Fread, to get the actual bytecode string and constants vector. */
3593 if (bytecodeflag
&& load_force_doc_strings
)
3595 if (i
== COMPILED_BYTECODE
)
3597 if (!STRINGP (item
))
3598 error ("Invalid byte code");
3600 /* Delay handling the bytecode slot until we know whether
3601 it is lazily-loaded (we can tell by whether the
3602 constants slot is nil). */
3603 ASET (vector
, COMPILED_CONSTANTS
, item
);
3606 else if (i
== COMPILED_CONSTANTS
)
3608 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3612 /* Coerce string to unibyte (like string-as-unibyte,
3613 but without generating extra garbage and
3614 guaranteeing no change in the contents). */
3615 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3616 STRING_SET_UNIBYTE (bytestr
);
3618 item
= Fread (Fcons (bytestr
, readcharfun
));
3620 error ("Invalid byte code");
3622 otem
= XCONS (item
);
3623 bytestr
= XCAR (item
);
3628 /* Now handle the bytecode slot. */
3629 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3631 else if (i
== COMPILED_DOC_STRING
3633 && ! STRING_MULTIBYTE (item
))
3635 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3636 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3638 item
= Fstring_as_multibyte (item
);
3641 ASET (vector
, i
, item
);
3649 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3652 read_list (bool flag
, Lisp_Object readcharfun
)
3654 Lisp_Object val
, tail
;
3655 Lisp_Object elt
, tem
;
3656 /* 0 is the normal case.
3657 1 means this list is a doc reference; replace it with the number 0.
3658 2 means this list is a doc reference; replace it with the doc string. */
3659 int doc_reference
= 0;
3661 /* Initialize this to 1 if we are reading a list. */
3662 bool first_in_list
= flag
<= 0;
3670 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3674 /* While building, if the list starts with #$, treat it specially. */
3675 if (EQ (elt
, Vload_file_name
)
3677 && !NILP (Vpurify_flag
))
3679 if (NILP (Vdoc_file_name
))
3680 /* We have not yet called Snarf-documentation, so assume
3681 this file is described in the DOC file
3682 and Snarf-documentation will fill in the right value later.
3683 For now, replace the whole list with 0. */
3686 /* We have already called Snarf-documentation, so make a relative
3687 file name for this file, so it can be found properly
3688 in the installed Lisp directory.
3689 We don't use Fexpand_file_name because that would make
3690 the directory absolute now. */
3692 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3693 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3696 else if (EQ (elt
, Vload_file_name
)
3698 && load_force_doc_strings
)
3707 invalid_syntax (") or . in a vector");
3714 XSETCDR (tail
, read0 (readcharfun
));
3716 val
= read0 (readcharfun
);
3717 read1 (readcharfun
, &ch
, 0);
3721 if (doc_reference
== 1)
3722 return make_number (0);
3723 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3726 file_offset saved_position
;
3727 /* Get a doc string from the file we are loading.
3728 If it's in saved_doc_string, get it from there.
3730 Here, we don't know if the string is a
3731 bytecode string or a doc string. As a
3732 bytecode string must be unibyte, we always
3733 return a unibyte string. If it is actually a
3734 doc string, caller must make it
3737 /* Position is negative for user variables. */
3738 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3739 if (pos
>= saved_doc_string_position
3740 && pos
< (saved_doc_string_position
3741 + saved_doc_string_length
))
3743 saved
= saved_doc_string
;
3744 saved_position
= saved_doc_string_position
;
3746 /* Look in prev_saved_doc_string the same way. */
3747 else if (pos
>= prev_saved_doc_string_position
3748 && pos
< (prev_saved_doc_string_position
3749 + prev_saved_doc_string_length
))
3751 saved
= prev_saved_doc_string
;
3752 saved_position
= prev_saved_doc_string_position
;
3756 ptrdiff_t start
= pos
- saved_position
;
3759 /* Process quoting with ^A,
3760 and find the end of the string,
3761 which is marked with ^_ (037). */
3762 for (from
= start
, to
= start
;
3763 saved
[from
] != 037;)
3765 int c
= saved
[from
++];
3769 saved
[to
++] = (c
== 1 ? c
3778 return make_unibyte_string (saved
+ start
,
3782 return get_doc_string (val
, 1, 0);
3787 invalid_syntax (". in wrong context");
3789 invalid_syntax ("] in a list");
3793 XSETCDR (tail
, tem
);
3800 static Lisp_Object initial_obarray
;
3802 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3804 static size_t oblookup_last_bucket_number
;
3806 /* Get an error if OBARRAY is not an obarray.
3807 If it is one, return it. */
3810 check_obarray (Lisp_Object obarray
)
3812 /* We don't want to signal a wrong-type-argument error when we are
3813 shutting down due to a fatal error, and we don't want to hit
3814 assertions in VECTORP and ASIZE if the fatal error was during GC. */
3815 if (!fatal_error_in_progress
3816 && (!VECTORP (obarray
) || ASIZE (obarray
) == 0))
3818 /* If Vobarray is now invalid, force it to be valid. */
3819 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3820 wrong_type_argument (Qvectorp
, obarray
);
3825 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3828 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3832 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3833 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3836 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3838 XSYMBOL (sym
)->constant
= 1;
3839 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3840 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3843 ptr
= aref_addr (obarray
, XINT (index
));
3844 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3849 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3852 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3854 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3857 /* Intern the C string STR: return a symbol with that name,
3858 interned in the current obarray. */
3861 intern_1 (const char *str
, ptrdiff_t len
)
3863 Lisp_Object obarray
= check_obarray (Vobarray
);
3864 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3866 return (SYMBOLP (tem
) ? tem
3867 /* The above `oblookup' was done on the basis of nchars==nbytes, so
3868 the string has to be unibyte. */
3869 : intern_driver (make_unibyte_string (str
, len
),
3874 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3876 Lisp_Object obarray
= check_obarray (Vobarray
);
3877 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3881 /* Creating a non-pure string from a string literal not implemented yet.
3882 We could just use make_string here and live with the extra copy. */
3883 eassert (!NILP (Vpurify_flag
));
3884 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3890 define_symbol (Lisp_Object sym
, char const *str
)
3892 ptrdiff_t len
= strlen (str
);
3893 Lisp_Object string
= make_pure_c_string (str
, len
);
3894 init_symbol (sym
, string
);
3896 /* Qunbound is uninterned, so that it's not confused with any symbol
3897 'unbound' created by a Lisp program. */
3898 if (! EQ (sym
, Qunbound
))
3900 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3901 eassert (INTEGERP (bucket
));
3902 intern_sym (sym
, initial_obarray
, bucket
);
3906 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3907 doc
: /* Return the canonical symbol whose name is STRING.
3908 If there is none, one is created by this function and returned.
3909 A second optional argument specifies the obarray to use;
3910 it defaults to the value of `obarray'. */)
3911 (Lisp_Object string
, Lisp_Object obarray
)
3915 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3916 CHECK_STRING (string
);
3918 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3920 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3925 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3926 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3927 NAME may be a string or a symbol. If it is a symbol, that exact
3928 symbol is searched for.
3929 A second optional argument specifies the obarray to use;
3930 it defaults to the value of `obarray'. */)
3931 (Lisp_Object name
, Lisp_Object obarray
)
3933 register Lisp_Object tem
, string
;
3935 if (NILP (obarray
)) obarray
= Vobarray
;
3936 obarray
= check_obarray (obarray
);
3938 if (!SYMBOLP (name
))
3940 CHECK_STRING (name
);
3944 string
= SYMBOL_NAME (name
);
3946 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3947 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3953 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3954 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3955 The value is t if a symbol was found and deleted, nil otherwise.
3956 NAME may be a string or a symbol. If it is a symbol, that symbol
3957 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3958 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3959 usage: (unintern NAME OBARRAY) */)
3960 (Lisp_Object name
, Lisp_Object obarray
)
3962 register Lisp_Object string
, tem
;
3965 if (NILP (obarray
)) obarray
= Vobarray
;
3966 obarray
= check_obarray (obarray
);
3969 string
= SYMBOL_NAME (name
);
3972 CHECK_STRING (name
);
3976 tem
= oblookup (obarray
, SSDATA (string
),
3981 /* If arg was a symbol, don't delete anything but that symbol itself. */
3982 if (SYMBOLP (name
) && !EQ (name
, tem
))
3985 /* There are plenty of other symbols which will screw up the Emacs
3986 session if we unintern them, as well as even more ways to use
3987 `setq' or `fset' or whatnot to make the Emacs session
3988 unusable. Let's not go down this silly road. --Stef */
3989 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3990 error ("Attempt to unintern t or nil"); */
3992 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3994 hash
= oblookup_last_bucket_number
;
3996 if (EQ (AREF (obarray
, hash
), tem
))
3998 if (XSYMBOL (tem
)->next
)
4001 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
4002 ASET (obarray
, hash
, sym
);
4005 ASET (obarray
, hash
, make_number (0));
4009 Lisp_Object tail
, following
;
4011 for (tail
= AREF (obarray
, hash
);
4012 XSYMBOL (tail
)->next
;
4015 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
4016 if (EQ (following
, tem
))
4018 set_symbol_next (tail
, XSYMBOL (following
)->next
);
4027 /* Return the symbol in OBARRAY whose names matches the string
4028 of SIZE characters (SIZE_BYTE bytes) at PTR.
4029 If there is no such symbol, return the integer bucket number of
4030 where the symbol would be if it were present.
4032 Also store the bucket number in oblookup_last_bucket_number. */
4035 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
4039 register Lisp_Object tail
;
4040 Lisp_Object bucket
, tem
;
4042 obarray
= check_obarray (obarray
);
4043 /* This is sometimes needed in the middle of GC. */
4044 obsize
= gc_asize (obarray
);
4045 hash
= hash_string (ptr
, size_byte
) % obsize
;
4046 bucket
= AREF (obarray
, hash
);
4047 oblookup_last_bucket_number
= hash
;
4048 if (EQ (bucket
, make_number (0)))
4050 else if (!SYMBOLP (bucket
))
4051 error ("Bad data in guts of obarray"); /* Like CADR error message. */
4053 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
4055 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
4056 && SCHARS (SYMBOL_NAME (tail
)) == size
4057 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
4059 else if (XSYMBOL (tail
)->next
== 0)
4062 XSETINT (tem
, hash
);
4067 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
4070 register Lisp_Object tail
;
4071 CHECK_VECTOR (obarray
);
4072 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
4074 tail
= AREF (obarray
, i
);
4079 if (XSYMBOL (tail
)->next
== 0)
4081 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4087 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4089 call1 (function
, sym
);
4092 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4093 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4094 OBARRAY defaults to the value of `obarray'. */)
4095 (Lisp_Object function
, Lisp_Object obarray
)
4097 if (NILP (obarray
)) obarray
= Vobarray
;
4098 obarray
= check_obarray (obarray
);
4100 map_obarray (obarray
, mapatoms_1
, function
);
4104 #define OBARRAY_SIZE 1511
4109 Lisp_Object oblength
;
4110 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4112 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4114 Vobarray
= Fmake_vector (oblength
, make_number (0));
4115 initial_obarray
= Vobarray
;
4116 staticpro (&initial_obarray
);
4118 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4119 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4121 DEFSYM (Qunbound
, "unbound");
4123 DEFSYM (Qnil
, "nil");
4124 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4125 XSYMBOL (Qnil
)->constant
= 1;
4126 XSYMBOL (Qnil
)->declared_special
= true;
4129 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4130 XSYMBOL (Qt
)->constant
= 1;
4131 XSYMBOL (Qt
)->declared_special
= true;
4133 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4136 DEFSYM (Qvariable_documentation
, "variable-documentation");
4138 read_buffer
= xmalloc (size
);
4139 read_buffer_size
= size
;
4143 defsubr (struct Lisp_Subr
*sname
)
4145 Lisp_Object sym
, tem
;
4146 sym
= intern_c_string (sname
->symbol_name
);
4147 XSETPVECTYPE (sname
, PVEC_SUBR
);
4148 XSETSUBR (tem
, sname
);
4149 set_symbol_function (sym
, tem
);
4152 #ifdef NOTDEF /* Use fset in subr.el now! */
4154 defalias (struct Lisp_Subr
*sname
, char *string
)
4157 sym
= intern (string
);
4158 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4162 /* Define an "integer variable"; a symbol whose value is forwarded to a
4163 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4164 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4166 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4167 const char *namestring
, EMACS_INT
*address
)
4170 sym
= intern_c_string (namestring
);
4171 i_fwd
->type
= Lisp_Fwd_Int
;
4172 i_fwd
->intvar
= address
;
4173 XSYMBOL (sym
)->declared_special
= 1;
4174 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4175 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4178 /* Similar but define a variable whose value is t if address contains 1,
4179 nil if address contains 0. */
4181 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4182 const char *namestring
, bool *address
)
4185 sym
= intern_c_string (namestring
);
4186 b_fwd
->type
= Lisp_Fwd_Bool
;
4187 b_fwd
->boolvar
= address
;
4188 XSYMBOL (sym
)->declared_special
= 1;
4189 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4190 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4191 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4194 /* Similar but define a variable whose value is the Lisp Object stored
4195 at address. Two versions: with and without gc-marking of the C
4196 variable. The nopro version is used when that variable will be
4197 gc-marked for some other reason, since marking the same slot twice
4198 can cause trouble with strings. */
4200 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4201 const char *namestring
, Lisp_Object
*address
)
4204 sym
= intern_c_string (namestring
);
4205 o_fwd
->type
= Lisp_Fwd_Obj
;
4206 o_fwd
->objvar
= address
;
4207 XSYMBOL (sym
)->declared_special
= 1;
4208 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4209 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4213 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4214 const char *namestring
, Lisp_Object
*address
)
4216 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4217 staticpro (address
);
4220 /* Similar but define a variable whose value is the Lisp Object stored
4221 at a particular offset in the current kboard object. */
4224 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4225 const char *namestring
, int offset
)
4228 sym
= intern_c_string (namestring
);
4229 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4230 ko_fwd
->offset
= offset
;
4231 XSYMBOL (sym
)->declared_special
= 1;
4232 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4233 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4236 /* Check that the elements of lpath exist. */
4239 load_path_check (Lisp_Object lpath
)
4241 Lisp_Object path_tail
;
4243 /* The only elements that might not exist are those from
4244 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4246 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4248 Lisp_Object dirfile
;
4249 dirfile
= Fcar (path_tail
);
4250 if (STRINGP (dirfile
))
4252 dirfile
= Fdirectory_file_name (dirfile
);
4253 if (! file_accessible_directory_p (dirfile
))
4254 dir_warning ("Lisp directory", XCAR (path_tail
));
4259 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4260 This does not include the standard site-lisp directories
4261 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4262 but it does (unless no_site_lisp is set) include site-lisp
4263 directories in the source/build directories if those exist and we
4264 are running uninstalled.
4266 Uses the following logic:
4267 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4268 The remainder is what happens when dumping works:
4269 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4270 Otherwise use PATH_LOADSEARCH.
4272 If !initialized, then just return PATH_DUMPLOADSEARCH.
4274 If Vinstallation_directory is not nil (ie, running uninstalled):
4275 If installation-dir/lisp exists and not already a member,
4276 we must be running uninstalled. Reset the load-path
4277 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4278 refers to the eventual installation directories. Since we
4279 are not yet installed, we should not use them, even if they exist.)
4280 If installation-dir/lisp does not exist, just add
4281 PATH_DUMPLOADSEARCH at the end instead.
4282 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4283 and not already a member) at the front.
4284 If installation-dir != source-dir (ie running an uninstalled,
4285 out-of-tree build) AND install-dir/src/Makefile exists BUT
4286 install-dir/src/Makefile.in does NOT exist (this is a sanity
4287 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4290 load_path_default (void)
4292 Lisp_Object lpath
= Qnil
;
4297 const char *loadpath
= ns_load_path ();
4300 normal
= PATH_LOADSEARCH
;
4302 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4304 lpath
= decode_env_path (0, normal
, 0);
4307 #else /* !CANNOT_DUMP */
4309 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4314 const char *loadpath
= ns_load_path ();
4315 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4317 lpath
= decode_env_path (0, normal
, 0);
4319 if (!NILP (Vinstallation_directory
))
4321 Lisp_Object tem
, tem1
;
4323 /* Add to the path the lisp subdir of the installation
4324 dir, if it is accessible. Note: in out-of-tree builds,
4325 this directory is empty save for Makefile. */
4326 tem
= Fexpand_file_name (build_string ("lisp"),
4327 Vinstallation_directory
);
4328 tem1
= Ffile_accessible_directory_p (tem
);
4331 if (NILP (Fmember (tem
, lpath
)))
4333 /* We are running uninstalled. The default load-path
4334 points to the eventual installed lisp directories.
4335 We should not use those now, even if they exist,
4336 so start over from a clean slate. */
4337 lpath
= list1 (tem
);
4341 /* That dir doesn't exist, so add the build-time
4342 Lisp dirs instead. */
4344 Lisp_Object dump_path
=
4345 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4346 lpath
= nconc2 (lpath
, dump_path
);
4349 /* Add site-lisp under the installation dir, if it exists. */
4352 tem
= Fexpand_file_name (build_string ("site-lisp"),
4353 Vinstallation_directory
);
4354 tem1
= Ffile_accessible_directory_p (tem
);
4357 if (NILP (Fmember (tem
, lpath
)))
4358 lpath
= Fcons (tem
, lpath
);
4362 /* If Emacs was not built in the source directory,
4363 and it is run from where it was built, add to load-path
4364 the lisp and site-lisp dirs under that directory. */
4366 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4370 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4371 Vinstallation_directory
);
4372 tem1
= Ffile_exists_p (tem
);
4374 /* Don't be fooled if they moved the entire source tree
4375 AFTER dumping Emacs. If the build directory is indeed
4376 different from the source dir, src/Makefile.in and
4377 src/Makefile will not be found together. */
4378 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4379 Vinstallation_directory
);
4380 tem2
= Ffile_exists_p (tem
);
4381 if (!NILP (tem1
) && NILP (tem2
))
4383 tem
= Fexpand_file_name (build_string ("lisp"),
4386 if (NILP (Fmember (tem
, lpath
)))
4387 lpath
= Fcons (tem
, lpath
);
4391 tem
= Fexpand_file_name (build_string ("site-lisp"),
4393 tem1
= Ffile_accessible_directory_p (tem
);
4396 if (NILP (Fmember (tem
, lpath
)))
4397 lpath
= Fcons (tem
, lpath
);
4401 } /* Vinstallation_directory != Vsource_directory */
4403 } /* if Vinstallation_directory */
4405 else /* !initialized */
4407 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4408 source directory. We used to add ../lisp (ie the lisp dir in
4409 the build directory) at the front here, but that should not
4410 be necessary, since in out of tree builds lisp/ is empty, save
4412 lpath
= decode_env_path (0, normal
, 0);
4414 #endif /* !CANNOT_DUMP */
4422 /* First, set Vload_path. */
4424 /* Ignore EMACSLOADPATH when dumping. */
4426 bool use_loadpath
= true;
4428 bool use_loadpath
= NILP (Vpurify_flag
);
4431 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4433 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4435 /* Check (non-nil) user-supplied elements. */
4436 load_path_check (Vload_path
);
4438 /* If no nils in the environment variable, use as-is.
4439 Otherwise, replace any nils with the default. */
4440 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4442 Lisp_Object elem
, elpath
= Vload_path
;
4443 Lisp_Object default_lpath
= load_path_default ();
4445 /* Check defaults, before adding site-lisp. */
4446 load_path_check (default_lpath
);
4448 /* Add the site-lisp directories to the front of the default. */
4449 if (!no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4451 Lisp_Object sitelisp
;
4452 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4453 if (! NILP (sitelisp
))
4454 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4459 /* Replace nils from EMACSLOADPATH by default. */
4460 while (CONSP (elpath
))
4462 elem
= XCAR (elpath
);
4463 elpath
= XCDR (elpath
);
4464 Vload_path
= CALLN (Fappend
, Vload_path
,
4465 NILP (elem
) ? default_lpath
: list1 (elem
));
4467 } /* Fmemq (Qnil, Vload_path) */
4471 Vload_path
= load_path_default ();
4473 /* Check before adding site-lisp directories.
4474 The install should have created them, but they are not
4475 required, so no need to warn if they are absent.
4476 Or we might be running before installation. */
4477 load_path_check (Vload_path
);
4479 /* Add the site-lisp directories at the front. */
4480 if (initialized
&& !no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4482 Lisp_Object sitelisp
;
4483 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4484 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4490 load_in_progress
= 0;
4491 Vload_file_name
= Qnil
;
4492 Vstandard_input
= Qt
;
4493 Vloads_in_progress
= Qnil
;
4496 /* Print a warning that directory intended for use USE and with name
4497 DIRNAME cannot be accessed. On entry, errno should correspond to
4498 the access failure. Print the warning on stderr and put it in
4502 dir_warning (char const *use
, Lisp_Object dirname
)
4504 static char const format
[] = "Warning: %s '%s': %s\n";
4505 int access_errno
= errno
;
4506 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)),
4507 strerror (access_errno
));
4509 /* Don't log the warning before we've initialized!! */
4512 char const *diagnostic
= emacs_strerror (access_errno
);
4514 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4515 + strlen (use
) + SBYTES (dirname
)
4516 + strlen (diagnostic
));
4517 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4519 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4525 syms_of_lread (void)
4528 defsubr (&Sread_from_string
);
4530 defsubr (&Sintern_soft
);
4531 defsubr (&Sunintern
);
4532 defsubr (&Sget_load_suffixes
);
4534 defsubr (&Seval_buffer
);
4535 defsubr (&Seval_region
);
4536 defsubr (&Sread_char
);
4537 defsubr (&Sread_char_exclusive
);
4538 defsubr (&Sread_event
);
4539 defsubr (&Sget_file_char
);
4540 defsubr (&Smapatoms
);
4541 defsubr (&Slocate_file_internal
);
4543 DEFVAR_LISP ("obarray", Vobarray
,
4544 doc
: /* Symbol table for use by `intern' and `read'.
4545 It is a vector whose length ought to be prime for best results.
4546 The vector's contents don't make sense if examined from Lisp programs;
4547 to find all the symbols in an obarray, use `mapatoms'. */);
4549 DEFVAR_LISP ("values", Vvalues
,
4550 doc
: /* List of values of all expressions which were read, evaluated and printed.
4551 Order is reverse chronological. */);
4552 XSYMBOL (intern ("values"))->declared_special
= 0;
4554 DEFVAR_LISP ("standard-input", Vstandard_input
,
4555 doc
: /* Stream for read to get input from.
4556 See documentation of `read' for possible values. */);
4557 Vstandard_input
= Qt
;
4559 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4560 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4562 If this variable is a buffer, then only forms read from that buffer
4563 will be added to `read-symbol-positions-list'.
4564 If this variable is t, then all read forms will be added.
4565 The effect of all other values other than nil are not currently
4566 defined, although they may be in the future.
4568 The positions are relative to the last call to `read' or
4569 `read-from-string'. It is probably a bad idea to set this variable at
4570 the toplevel; bind it instead. */);
4571 Vread_with_symbol_positions
= Qnil
;
4573 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4574 doc
: /* A list mapping read symbols to their positions.
4575 This variable is modified during calls to `read' or
4576 `read-from-string', but only when `read-with-symbol-positions' is
4579 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4580 CHAR-POSITION is an integer giving the offset of that occurrence of the
4581 symbol from the position where `read' or `read-from-string' started.
4583 Note that a symbol will appear multiple times in this list, if it was
4584 read multiple times. The list is in the same order as the symbols
4586 Vread_symbol_positions_list
= Qnil
;
4588 DEFVAR_LISP ("read-circle", Vread_circle
,
4589 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4592 DEFVAR_LISP ("load-path", Vload_path
,
4593 doc
: /* List of directories to search for files to load.
4594 Each element is a string (directory file name) or nil (meaning
4595 `default-directory').
4596 Initialized during startup as described in Info node `(elisp)Library Search'.
4597 Use `directory-file-name' when adding items to this path. However, Lisp
4598 programs that process this list should tolerate directories both with
4599 and without trailing slashes. */);
4601 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4602 doc
: /* List of suffixes for Emacs Lisp files and dynamic modules.
4603 This list includes suffixes for both compiled and source Emacs Lisp files.
4604 This list should not include the empty string.
4605 `load' and related functions try to append these suffixes, in order,
4606 to the specified file name if a suffix is allowed or required. */);
4608 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4609 build_pure_c_string (".el"),
4610 build_pure_c_string (MODULES_SUFFIX
));
4612 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4613 build_pure_c_string (".el"));
4615 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix
,
4616 doc
: /* Suffix of loadable module file, or nil of modules are not supported. */);
4618 Vmodule_file_suffix
= build_pure_c_string (MODULES_SUFFIX
);
4620 Vmodule_file_suffix
= Qnil
;
4622 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4623 doc
: /* List of suffixes that indicate representations of \
4625 This list should normally start with the empty string.
4627 Enabling Auto Compression mode appends the suffixes in
4628 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4629 mode removes them again. `load' and related functions use this list to
4630 determine whether they should look for compressed versions of a file
4631 and, if so, which suffixes they should try to append to the file name
4632 in order to do so. However, if you want to customize which suffixes
4633 the loading functions recognize as compression suffixes, you should
4634 customize `jka-compr-load-suffixes' rather than the present variable. */);
4635 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4637 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4638 doc
: /* Non-nil if inside of `load'. */);
4639 DEFSYM (Qload_in_progress
, "load-in-progress");
4641 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4642 doc
: /* An alist of functions to be evalled when particular files are loaded.
4643 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4645 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4646 a symbol (a feature name).
4648 When `load' is run and the file-name argument matches an element's
4649 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4650 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4652 An error in FORMS does not undo the load, but does prevent execution of
4653 the rest of the FORMS. */);
4654 Vafter_load_alist
= Qnil
;
4656 DEFVAR_LISP ("load-history", Vload_history
,
4657 doc
: /* Alist mapping loaded file names to symbols and features.
4658 Each alist element should be a list (FILE-NAME ENTRIES...), where
4659 FILE-NAME is the name of a file that has been loaded into Emacs.
4660 The file name is absolute and true (i.e. it doesn't contain symlinks).
4661 As an exception, one of the alist elements may have FILE-NAME nil,
4662 for symbols and features not associated with any file.
4664 The remaining ENTRIES in the alist element describe the functions and
4665 variables defined in that file, the features provided, and the
4666 features required. Each entry has the form `(provide . FEATURE)',
4667 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4668 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4669 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4670 autoload before this file redefined it as a function. In addition,
4671 entries may also be single symbols, which means that SYMBOL was
4672 defined by `defvar' or `defconst'.
4674 During preloading, the file name recorded is relative to the main Lisp
4675 directory. These file names are converted to absolute at startup. */);
4676 Vload_history
= Qnil
;
4678 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4679 doc
: /* Full name of file being loaded by `load'. */);
4680 Vload_file_name
= Qnil
;
4682 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4683 doc
: /* File name, including directory, of user's initialization file.
4684 If the file loaded had extension `.elc', and the corresponding source file
4685 exists, this variable contains the name of source file, suitable for use
4686 by functions like `custom-save-all' which edit the init file.
4687 While Emacs loads and evaluates the init file, value is the real name
4688 of the file, regardless of whether or not it has the `.elc' extension. */);
4689 Vuser_init_file
= Qnil
;
4691 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4692 doc
: /* Used for internal purposes by `load'. */);
4693 Vcurrent_load_list
= Qnil
;
4695 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4696 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4697 Called with a single argument (the stream from which to read).
4698 The default is to use the function `read'. */);
4699 DEFSYM (Qread
, "read");
4700 Vload_read_function
= Qread
;
4702 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4703 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4704 The value should be a function for doing code conversion before
4705 reading a source file. It can also be nil, in which case loading is
4706 done without any code conversion.
4708 If the value is a function, it is called with four arguments,
4709 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4710 the file to load, FILE is the non-absolute name (for messages etc.),
4711 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4712 `load'. The function should return t if the file was loaded. */);
4713 Vload_source_file_function
= Qnil
;
4715 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4716 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4717 This is useful when the file being loaded is a temporary copy. */);
4718 load_force_doc_strings
= 0;
4720 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4721 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4722 This is normally bound by `load' and `eval-buffer' to control `read',
4723 and is not meant for users to change. */);
4724 load_convert_to_unibyte
= 0;
4726 DEFVAR_LISP ("source-directory", Vsource_directory
,
4727 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4728 You cannot count on them to still be there! */);
4730 = Fexpand_file_name (build_string ("../"),
4731 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4733 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4734 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4735 Vpreloaded_file_list
= Qnil
;
4737 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4738 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4739 Vbyte_boolean_vars
= Qnil
;
4741 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4742 doc
: /* Non-nil means load dangerous compiled Lisp files.
4743 Some versions of XEmacs use different byte codes than Emacs. These
4744 incompatible byte codes can make Emacs crash when it tries to execute
4746 load_dangerous_libraries
= 0;
4748 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4749 doc
: /* Non-nil means force printing messages when loading Lisp files.
4750 This overrides the value of the NOMESSAGE argument to `load'. */);
4751 force_load_messages
= 0;
4753 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4754 doc
: /* Regular expression matching safe to load compiled Lisp files.
4755 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4756 from the file, and matches them against this regular expression.
4757 When the regular expression matches, the file is considered to be safe
4758 to load. See also `load-dangerous-libraries'. */);
4759 Vbytecomp_version_regexp
4760 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4762 DEFSYM (Qlexical_binding
, "lexical-binding");
4763 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4764 doc
: /* Whether to use lexical binding when evaluating code.
4765 Non-nil means that the code in the current buffer should be evaluated
4766 with lexical binding.
4767 This variable is automatically set from the file variables of an
4768 interpreted Lisp file read using `load'. Unlike other file local
4769 variables, this must be set in the first line of a file. */);
4770 Vlexical_binding
= Qnil
;
4771 Fmake_variable_buffer_local (Qlexical_binding
);
4773 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4774 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4775 Veval_buffer_list
= Qnil
;
4777 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4778 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4779 Vold_style_backquotes
= Qnil
;
4780 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4782 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4783 doc
: /* Non-nil means `load' prefers the newest version of a file.
4784 This applies when a filename suffix is not explicitly specified and
4785 `load' is trying various possible suffixes (see `load-suffixes' and
4786 `load-file-rep-suffixes'). Normally, it stops at the first file
4787 that exists unless you explicitly specify one or the other. If this
4788 option is non-nil, it checks all suffixes and uses whichever file is
4790 Note that if you customize this, obviously it will not affect files
4791 that are loaded before your customizations are read! */);
4792 load_prefer_newer
= 0;
4794 /* Vsource_directory was initialized in init_lread. */
4796 DEFSYM (Qcurrent_load_list
, "current-load-list");
4797 DEFSYM (Qstandard_input
, "standard-input");
4798 DEFSYM (Qread_char
, "read-char");
4799 DEFSYM (Qget_file_char
, "get-file-char");
4801 /* Used instead of Qget_file_char while loading *.elc files compiled
4802 by Emacs 21 or older. */
4803 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4805 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4807 DEFSYM (Qbackquote
, "`");
4808 DEFSYM (Qcomma
, ",");
4809 DEFSYM (Qcomma_at
, ",@");
4810 DEFSYM (Qcomma_dot
, ",.");
4812 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4813 DEFSYM (Qascii_character
, "ascii-character");
4814 DEFSYM (Qfunction
, "function");
4815 DEFSYM (Qload
, "load");
4816 DEFSYM (Qload_file_name
, "load-file-name");
4817 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4818 DEFSYM (Qfile_truename
, "file-truename");
4819 DEFSYM (Qdir_ok
, "dir-ok");
4820 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4822 staticpro (&read_objects
);
4823 read_objects
= Qnil
;
4824 staticpro (&seen_list
);
4827 Vloads_in_progress
= Qnil
;
4828 staticpro (&Vloads_in_progress
);
4830 DEFSYM (Qhash_table
, "hash-table");
4831 DEFSYM (Qdata
, "data");
4832 DEFSYM (Qtest
, "test");
4833 DEFSYM (Qsize
, "size");
4834 DEFSYM (Qweakness
, "weakness");
4835 DEFSYM (Qrehash_size
, "rehash-size");
4836 DEFSYM (Qrehash_threshold
, "rehash-threshold");
4838 character_names
= Qnil
;
4839 staticpro (&character_names
);