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"
43 #include "termhooks.h"
44 #include "blockinput.h"
49 #if __DJGPP__ == 2 && __DJGPP_MINOR__ < 5
50 # define INFINITY __builtin_inf()
51 # define NAN __builtin_nan("")
63 #endif /* HAVE_SETLOCALE */
68 #define file_offset off_t
69 #define file_tell ftello
71 #define file_offset long
72 #define file_tell ftell
75 /* The association list of objects read with the #n=object form.
76 Each member of the list has the form (n . object), and is used to
77 look up the object for the corresponding #n# construct.
78 It must be set to nil before all top-level calls to read0. */
79 static Lisp_Object read_objects
;
81 /* File for get_file_char to read from. Use by load. */
82 static FILE *instream
;
84 /* For use within read-from-string (this reader is non-reentrant!!) */
85 static ptrdiff_t read_from_string_index
;
86 static ptrdiff_t read_from_string_index_byte
;
87 static ptrdiff_t read_from_string_limit
;
89 /* Number of characters read in the current call to Fread or
91 static EMACS_INT readchar_count
;
93 /* This contains the last string skipped with #@. */
94 static char *saved_doc_string
;
95 /* Length of buffer allocated in saved_doc_string. */
96 static ptrdiff_t saved_doc_string_size
;
97 /* Length of actual data in saved_doc_string. */
98 static ptrdiff_t saved_doc_string_length
;
99 /* This is the file position that string came from. */
100 static file_offset saved_doc_string_position
;
102 /* This contains the previous string skipped with #@.
103 We copy it from saved_doc_string when a new string
104 is put in saved_doc_string. */
105 static char *prev_saved_doc_string
;
106 /* Length of buffer allocated in prev_saved_doc_string. */
107 static ptrdiff_t prev_saved_doc_string_size
;
108 /* Length of actual data in prev_saved_doc_string. */
109 static ptrdiff_t prev_saved_doc_string_length
;
110 /* This is the file position that string came from. */
111 static file_offset prev_saved_doc_string_position
;
113 /* True means inside a new-style backquote
114 with no surrounding parentheses.
115 Fread initializes this to false, so we need not specbind it
116 or worry about what happens to it when there is an error. */
117 static bool new_backquote_flag
;
119 /* A list of file names for files being loaded in Fload. Used to
120 check for recursive loads. */
122 static Lisp_Object Vloads_in_progress
;
124 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
127 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
128 Lisp_Object
, Lisp_Object
,
129 Lisp_Object
, Lisp_Object
);
131 /* Functions that read one byte from the current source READCHARFUN
132 or unreads one byte. If the integer argument C is -1, it returns
133 one read byte, or -1 when there's no more byte in the source. If C
134 is 0 or positive, it unreads C, and the return value is not
137 static int readbyte_for_lambda (int, Lisp_Object
);
138 static int readbyte_from_file (int, Lisp_Object
);
139 static int readbyte_from_string (int, Lisp_Object
);
141 /* Handle unreading and rereading of characters.
142 Write READCHAR to read a character,
143 UNREAD(c) to unread c to be read again.
145 These macros correctly read/unread multibyte characters. */
147 #define READCHAR readchar (readcharfun, NULL)
148 #define UNREAD(c) unreadchar (readcharfun, c)
150 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
151 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
153 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
154 Qlambda, or a cons, we use this to keep an unread character because
155 a file stream can't handle multibyte-char unreading. The value -1
156 means that there's no unread character. */
157 static int unread_char
;
160 readchar (Lisp_Object readcharfun
, bool *multibyte
)
164 int (*readbyte
) (int, Lisp_Object
);
165 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
167 bool emacs_mule_encoding
= 0;
174 if (BUFFERP (readcharfun
))
176 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
178 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
180 if (! BUFFER_LIVE_P (inbuffer
))
183 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
186 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
188 /* Fetch the character code from the buffer. */
189 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
190 BUF_INC_POS (inbuffer
, pt_byte
);
197 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
198 if (! ASCII_CHAR_P (c
))
199 c
= BYTE8_TO_CHAR (c
);
202 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
206 if (MARKERP (readcharfun
))
208 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
210 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
212 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
215 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
217 /* Fetch the character code from the buffer. */
218 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
219 BUF_INC_POS (inbuffer
, bytepos
);
226 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
227 if (! ASCII_CHAR_P (c
))
228 c
= BYTE8_TO_CHAR (c
);
232 XMARKER (readcharfun
)->bytepos
= bytepos
;
233 XMARKER (readcharfun
)->charpos
++;
238 if (EQ (readcharfun
, Qlambda
))
240 readbyte
= readbyte_for_lambda
;
244 if (EQ (readcharfun
, Qget_file_char
))
246 readbyte
= readbyte_from_file
;
250 if (STRINGP (readcharfun
))
252 if (read_from_string_index
>= read_from_string_limit
)
254 else if (STRING_MULTIBYTE (readcharfun
))
258 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
259 read_from_string_index
,
260 read_from_string_index_byte
);
264 c
= SREF (readcharfun
, read_from_string_index_byte
);
265 read_from_string_index
++;
266 read_from_string_index_byte
++;
271 if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
273 /* This is the case that read_vector is reading from a unibyte
274 string that contains a byte sequence previously skipped
275 because of #@NUMBER. The car part of readcharfun is that
276 string, and the cdr part is a value of readcharfun given to
278 readbyte
= readbyte_from_string
;
279 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
280 emacs_mule_encoding
= 1;
284 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
286 readbyte
= readbyte_from_file
;
287 emacs_mule_encoding
= 1;
291 tem
= call0 (readcharfun
);
298 if (unread_char
>= 0)
304 c
= (*readbyte
) (-1, readcharfun
);
309 if (ASCII_CHAR_P (c
))
311 if (emacs_mule_encoding
)
312 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
315 len
= BYTES_BY_CHAR_HEAD (c
);
318 c
= (*readbyte
) (-1, readcharfun
);
319 if (c
< 0 || ! TRAILING_CODE_P (c
))
322 (*readbyte
) (buf
[i
], readcharfun
);
323 return BYTE8_TO_CHAR (buf
[0]);
327 return STRING_CHAR (buf
);
330 #define FROM_FILE_P(readcharfun) \
331 (EQ (readcharfun, Qget_file_char) \
332 || EQ (readcharfun, Qget_emacs_mule_file_char))
335 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
337 if (FROM_FILE_P (readcharfun
))
339 block_input (); /* FIXME: Not sure if it's needed. */
340 fseek (instream
, n
, SEEK_CUR
);
344 { /* We're not reading directly from a file. In that case, it's difficult
345 to reliably count bytes, since these are usually meant for the file's
346 encoding, whereas we're now typically in the internal encoding.
347 But luckily, skip_dyn_bytes is used to skip over a single
348 dynamic-docstring (or dynamic byte-code) which is always quoted such
349 that \037 is the final char. */
353 } while (c
>= 0 && c
!= '\037');
358 skip_dyn_eof (Lisp_Object readcharfun
)
360 if (FROM_FILE_P (readcharfun
))
362 block_input (); /* FIXME: Not sure if it's needed. */
363 fseek (instream
, 0, SEEK_END
);
367 while (READCHAR
>= 0);
370 /* Unread the character C in the way appropriate for the stream READCHARFUN.
371 If the stream is a user function, call it with the char as argument. */
374 unreadchar (Lisp_Object readcharfun
, int c
)
378 /* Don't back up the pointer if we're unreading the end-of-input mark,
379 since readchar didn't advance it when we read it. */
381 else if (BUFFERP (readcharfun
))
383 struct buffer
*b
= XBUFFER (readcharfun
);
384 ptrdiff_t charpos
= BUF_PT (b
);
385 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
387 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
388 BUF_DEC_POS (b
, bytepos
);
392 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
394 else if (MARKERP (readcharfun
))
396 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
397 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
399 XMARKER (readcharfun
)->charpos
--;
400 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
401 BUF_DEC_POS (b
, bytepos
);
405 XMARKER (readcharfun
)->bytepos
= bytepos
;
407 else if (STRINGP (readcharfun
))
409 read_from_string_index
--;
410 read_from_string_index_byte
411 = string_char_to_byte (readcharfun
, read_from_string_index
);
413 else if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
417 else if (EQ (readcharfun
, Qlambda
))
421 else if (FROM_FILE_P (readcharfun
))
426 call1 (readcharfun
, make_number (c
));
430 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
432 return read_bytecode_char (c
>= 0);
437 readbyte_from_file (int c
, Lisp_Object readcharfun
)
442 ungetc (c
, instream
);
450 /* Interrupted reads have been observed while reading over the network. */
451 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
462 return (c
== EOF
? -1 : c
);
466 readbyte_from_string (int c
, Lisp_Object readcharfun
)
468 Lisp_Object string
= XCAR (readcharfun
);
472 read_from_string_index
--;
473 read_from_string_index_byte
474 = string_char_to_byte (string
, read_from_string_index
);
477 if (read_from_string_index
>= read_from_string_limit
)
480 FETCH_STRING_CHAR_ADVANCE (c
, string
,
481 read_from_string_index
,
482 read_from_string_index_byte
);
487 /* Read one non-ASCII character from INSTREAM. The character is
488 encoded in `emacs-mule' and the first byte is already read in
492 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
494 /* Emacs-mule coding uses at most 4-byte for one character. */
495 unsigned char buf
[4];
496 int len
= emacs_mule_bytes
[c
];
497 struct charset
*charset
;
502 /* C is not a valid leading-code of `emacs-mule'. */
503 return BYTE8_TO_CHAR (c
);
509 c
= (*readbyte
) (-1, readcharfun
);
513 (*readbyte
) (buf
[i
], readcharfun
);
514 return BYTE8_TO_CHAR (buf
[0]);
521 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
522 code
= buf
[1] & 0x7F;
526 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
527 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
529 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
530 code
= buf
[2] & 0x7F;
534 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
535 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
540 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
541 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
543 c
= DECODE_CHAR (charset
, code
);
545 Fsignal (Qinvalid_read_syntax
,
546 list1 (build_string ("invalid multibyte form")));
551 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
553 static Lisp_Object
read0 (Lisp_Object
);
554 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
556 static Lisp_Object
read_list (bool, Lisp_Object
);
557 static Lisp_Object
read_vector (Lisp_Object
, bool);
559 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
561 static void substitute_object_in_subtree (Lisp_Object
,
563 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
566 /* Get a character from the tty. */
568 /* Read input events until we get one that's acceptable for our purposes.
570 If NO_SWITCH_FRAME, switch-frame events are stashed
571 until we get a character we like, and then stuffed into
574 If ASCII_REQUIRED, check function key events to see
575 if the unmodified version of the symbol has a Qascii_character
576 property, and use that character, if present.
578 If ERROR_NONASCII, signal an error if the input we
579 get isn't an ASCII character with modifiers. If it's false but
580 ASCII_REQUIRED is true, just re-read until we get an ASCII
583 If INPUT_METHOD, invoke the current input method
584 if the character warrants that.
586 If SECONDS is a number, wait that many seconds for input, and
587 return Qnil if no input arrives within that time. */
590 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
591 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
593 Lisp_Object val
, delayed_switch_frame
;
594 struct timespec end_time
;
596 #ifdef HAVE_WINDOW_SYSTEM
597 if (display_hourglass_p
)
601 delayed_switch_frame
= Qnil
;
603 /* Compute timeout. */
604 if (NUMBERP (seconds
))
606 double duration
= extract_float (seconds
);
607 struct timespec wait_time
= dtotimespec (duration
);
608 end_time
= timespec_add (current_timespec (), wait_time
);
611 /* Read until we get an acceptable event. */
614 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
615 NUMBERP (seconds
) ? &end_time
: NULL
);
616 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
621 /* `switch-frame' events are put off until after the next ASCII
622 character. This is better than signaling an error just because
623 the last characters were typed to a separate minibuffer frame,
624 for example. Eventually, some code which can deal with
625 switch-frame events will read it and process it. */
627 && EVENT_HAS_PARAMETERS (val
)
628 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
630 delayed_switch_frame
= val
;
634 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
636 /* Convert certain symbols to their ASCII equivalents. */
639 Lisp_Object tem
, tem1
;
640 tem
= Fget (val
, Qevent_symbol_element_mask
);
643 tem1
= Fget (Fcar (tem
), Qascii_character
);
644 /* Merge this symbol's modifier bits
645 with the ASCII equivalent of its basic code. */
647 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
651 /* If we don't have a character now, deal with it appropriately. */
656 Vunread_command_events
= list1 (val
);
657 error ("Non-character input-event");
664 if (! NILP (delayed_switch_frame
))
665 unread_switch_frame
= delayed_switch_frame
;
669 #ifdef HAVE_WINDOW_SYSTEM
670 if (display_hourglass_p
)
679 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
680 doc
: /* Read a character from the command input (keyboard or macro).
681 It is returned as a number.
682 If the character has modifiers, they are resolved and reflected to the
683 character code if possible (e.g. C-SPC -> 0).
685 If the user generates an event which is not a character (i.e. a mouse
686 click or function key event), `read-char' signals an error. As an
687 exception, switch-frame events are put off until non-character events
689 If you want to read non-character events, or ignore them, call
690 `read-event' or `read-char-exclusive' instead.
692 If the optional argument PROMPT is non-nil, display that as a prompt.
693 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
694 input method is turned on in the current buffer, that input method
695 is used for reading a character.
696 If the optional argument SECONDS is non-nil, it should be a number
697 specifying the maximum number of seconds to wait for input. If no
698 input arrives in that time, return nil. SECONDS may be a
699 floating-point value. */)
700 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
705 message_with_string ("%s", prompt
, 0);
706 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
708 return (NILP (val
) ? Qnil
709 : make_number (char_resolve_modifier_mask (XINT (val
))));
712 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
713 doc
: /* Read an event object from the input stream.
714 If the optional argument PROMPT is non-nil, display that as a prompt.
715 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
716 input method is turned on in the current buffer, that input method
717 is used for reading a character.
718 If the optional argument SECONDS is non-nil, it should be a number
719 specifying the maximum number of seconds to wait for input. If no
720 input arrives in that time, return nil. SECONDS may be a
721 floating-point value. */)
722 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
725 message_with_string ("%s", prompt
, 0);
726 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
729 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
730 doc
: /* Read a character from the command input (keyboard or macro).
731 It is returned as a number. Non-character events are ignored.
732 If the character has modifiers, they are resolved and reflected to the
733 character code if possible (e.g. C-SPC -> 0).
735 If the optional argument PROMPT is non-nil, display that as a prompt.
736 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
737 input method is turned on in the current buffer, that input method
738 is used for reading a character.
739 If the optional argument SECONDS is non-nil, it should be a number
740 specifying the maximum number of seconds to wait for input. If no
741 input arrives in that time, return nil. SECONDS may be a
742 floating-point value. */)
743 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
748 message_with_string ("%s", prompt
, 0);
750 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
752 return (NILP (val
) ? Qnil
753 : make_number (char_resolve_modifier_mask (XINT (val
))));
756 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
757 doc
: /* Don't use this yourself. */)
760 register Lisp_Object val
;
762 XSETINT (val
, getc (instream
));
770 /* Return true if the lisp code read using READCHARFUN defines a non-nil
771 `lexical-binding' file variable. After returning, the stream is
772 positioned following the first line, if it is a comment or #! line,
773 otherwise nothing is read. */
776 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
789 while (ch
!= '\n' && ch
!= EOF
)
791 if (ch
== '\n') ch
= READCHAR
;
792 /* It is OK to leave the position after a #! line, since
793 that is what read1 does. */
797 /* The first line isn't a comment, just give up. */
803 /* Look for an appropriate file-variable in the first line. */
807 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
808 } beg_end_state
= NOMINAL
;
809 bool in_file_vars
= 0;
811 #define UPDATE_BEG_END_STATE(ch) \
812 if (beg_end_state == NOMINAL) \
813 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
814 else if (beg_end_state == AFTER_FIRST_DASH) \
815 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
816 else if (beg_end_state == AFTER_ASTERIX) \
819 in_file_vars = !in_file_vars; \
820 beg_end_state = NOMINAL; \
823 /* Skip until we get to the file vars, if any. */
827 UPDATE_BEG_END_STATE (ch
);
829 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
833 char var
[100], val
[100];
838 /* Read a variable name. */
839 while (ch
== ' ' || ch
== '\t')
843 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
845 if (i
< sizeof var
- 1)
847 UPDATE_BEG_END_STATE (ch
);
851 /* Stop scanning if no colon was found before end marker. */
852 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
855 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
861 /* Read a variable value. */
864 while (ch
== ' ' || ch
== '\t')
868 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
870 if (i
< sizeof val
- 1)
872 UPDATE_BEG_END_STATE (ch
);
876 /* The value was terminated by an end-marker, which remove. */
878 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
882 if (strcmp (var
, "lexical-binding") == 0)
885 rv
= (strcmp (val
, "nil") != 0);
891 while (ch
!= '\n' && ch
!= EOF
)
898 /* Value is a version number of byte compiled code if the file
899 associated with file descriptor FD is a compiled Lisp file that's
900 safe to load. Only files compiled with Emacs are safe to load.
901 Files compiled with XEmacs can lead to a crash in Fbyte_code
902 because of an incompatible change in the byte compiler. */
905 safe_to_load_version (int fd
)
911 /* Read the first few bytes from the file, and look for a line
912 specifying the byte compiler version used. */
913 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
916 /* Skip to the next newline, skipping over the initial `ELC'
917 with NUL bytes following it, but note the version. */
918 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
923 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
924 buf
+ i
, nbytes
- i
) < 0)
928 lseek (fd
, 0, SEEK_SET
);
933 /* Callback for record_unwind_protect. Restore the old load list OLD,
934 after loading a file successfully. */
937 record_load_unwind (Lisp_Object old
)
939 Vloads_in_progress
= old
;
942 /* This handler function is used via internal_condition_case_1. */
945 load_error_handler (Lisp_Object data
)
951 load_warn_old_style_backquotes (Lisp_Object file
)
953 if (!NILP (Vold_style_backquotes
))
955 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
956 CALLN (Fmessage
, format
, file
);
960 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
961 doc
: /* Return the suffixes that `load' should try if a suffix is \
963 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
966 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
967 while (CONSP (suffixes
))
969 Lisp_Object exts
= Vload_file_rep_suffixes
;
970 suffix
= XCAR (suffixes
);
971 suffixes
= XCDR (suffixes
);
976 lst
= Fcons (concat2 (suffix
, ext
), lst
);
979 return Fnreverse (lst
);
982 /* Returns true if STRING ends with SUFFIX */
984 suffix_p (Lisp_Object string
, const char *suffix
)
986 ptrdiff_t suffix_len
= strlen (suffix
);
987 ptrdiff_t string_len
= SBYTES (string
);
989 return string_len
>= suffix_len
&& !strcmp (SSDATA (string
) + string_len
- suffix_len
, suffix
);
992 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
993 doc
: /* Execute a file of Lisp code named FILE.
994 First try FILE with `.elc' appended, then try with `.el', then try
995 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
996 then try FILE unmodified (the exact suffixes in the exact order are
997 determined by `load-suffixes'). Environment variable references in
998 FILE are replaced with their values by calling `substitute-in-file-name'.
999 This function searches the directories in `load-path'.
1001 If optional second arg NOERROR is non-nil,
1002 report no error if FILE doesn't exist.
1003 Print messages at start and end of loading unless
1004 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1006 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1007 suffixes to the specified name FILE.
1008 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1009 the suffix `.elc' or `.el' or the module suffix; don't accept just
1010 FILE unless it ends in one of those suffixes or includes a directory name.
1012 If NOSUFFIX is nil, then if a file could not be found, try looking for
1013 a different representation of the file by adding non-empty suffixes to
1014 its name, before trying another file. Emacs uses this feature to find
1015 compressed versions of files when Auto Compression mode is enabled.
1016 If NOSUFFIX is non-nil, disable this feature.
1018 The suffixes that this function tries out, when NOSUFFIX is nil, are
1019 given by the return value of `get-load-suffixes' and the values listed
1020 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1021 return value of `get-load-suffixes' is used, i.e. the file name is
1022 required to have a non-empty suffix.
1024 When searching suffixes, this function normally stops at the first
1025 one that exists. If the option `load-prefer-newer' is non-nil,
1026 however, it tries all suffixes, and uses whichever file is the newest.
1028 Loading a file records its definitions, and its `provide' and
1029 `require' calls, in an element of `load-history' whose
1030 car is the file name loaded. See `load-history'.
1032 While the file is in the process of being loaded, the variable
1033 `load-in-progress' is non-nil and the variable `load-file-name'
1034 is bound to the file's name.
1036 Return t if the file exists and loads successfully. */)
1037 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1038 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1042 int fd_index UNINIT
;
1043 ptrdiff_t count
= SPECPDL_INDEX ();
1044 Lisp_Object found
, efound
, hist_file_name
;
1045 /* True means we printed the ".el is newer" message. */
1047 /* True means we are loading a compiled file. */
1049 Lisp_Object handler
;
1051 const char *fmode
= "r" FOPEN_TEXT
;
1054 CHECK_STRING (file
);
1056 /* If file name is magic, call the handler. */
1057 /* This shouldn't be necessary any more now that `openp' handles it right.
1058 handler = Ffind_file_name_handler (file, Qload);
1059 if (!NILP (handler))
1060 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1062 /* The presence of this call is the result of a historical accident:
1063 it used to be in every file-operation and when it got removed
1064 everywhere, it accidentally stayed here. Since then, enough people
1065 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1066 that it seemed risky to remove. */
1067 if (! NILP (noerror
))
1069 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1070 Qt
, load_error_handler
);
1075 file
= Fsubstitute_in_file_name (file
);
1077 /* Avoid weird lossage with null string as arg,
1078 since it would try to load a directory as a Lisp file. */
1079 if (SCHARS (file
) == 0)
1086 Lisp_Object suffixes
;
1089 if (! NILP (must_suffix
))
1091 /* Don't insist on adding a suffix if FILE already ends with one. */
1092 if (suffix_p (file
, ".el")
1093 || suffix_p (file
, ".elc")
1095 || suffix_p (file
, MODULES_SUFFIX
)
1099 /* Don't insist on adding a suffix
1100 if the argument includes a directory name. */
1101 else if (! NILP (Ffile_name_directory (file
)))
1105 if (!NILP (nosuffix
))
1109 suffixes
= Fget_load_suffixes ();
1110 if (NILP (must_suffix
))
1111 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1114 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1120 report_file_error ("Cannot open load file", file
);
1124 /* Tell startup.el whether or not we found the user's init file. */
1125 if (EQ (Qt
, Vuser_init_file
))
1126 Vuser_init_file
= found
;
1128 /* If FD is -2, that means openp found a magic file. */
1131 if (NILP (Fequal (found
, file
)))
1132 /* If FOUND is a different file name from FILE,
1133 find its handler even if we have already inhibited
1134 the `load' operation on FILE. */
1135 handler
= Ffind_file_name_handler (found
, Qt
);
1137 handler
= Ffind_file_name_handler (found
, Qload
);
1138 if (! NILP (handler
))
1139 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1141 /* Tramp has to deal with semi-broken packages that prepend
1142 drive letters to remote files. For that reason, Tramp
1143 catches file operations that test for file existence, which
1144 makes openp think X:/foo.elc files are remote. However,
1145 Tramp does not catch `load' operations for such files, so we
1146 end up with a nil as the `load' handler above. If we would
1147 continue with fd = -2, we will behave wrongly, and in
1148 particular try reading a .elc file in the "rt" mode instead
1149 of "rb". See bug #9311 for the results. To work around
1150 this, we try to open the file locally, and go with that if it
1152 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1160 fd_index
= SPECPDL_INDEX ();
1161 record_unwind_protect_int (close_file_unwind
, fd
);
1165 if (suffix_p (found
, MODULES_SUFFIX
))
1166 return unbind_to (count
, Fmodule_load (found
));
1169 /* Check if we're stuck in a recursive load cycle.
1171 2000-09-21: It's not possible to just check for the file loaded
1172 being a member of Vloads_in_progress. This fails because of the
1173 way the byte compiler currently works; `provide's are not
1174 evaluated, see font-lock.el/jit-lock.el as an example. This
1175 leads to a certain amount of ``normal'' recursion.
1177 Also, just loading a file recursively is not always an error in
1178 the general case; the second load may do something different. */
1182 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1183 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1184 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1185 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1186 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1189 /* All loads are by default dynamic, unless the file itself specifies
1190 otherwise using a file-variable in the first line. This is bound here
1191 so that it takes effect whether or not we use
1192 Vload_source_file_function. */
1193 specbind (Qlexical_binding
, Qnil
);
1195 /* Get the name for load-history. */
1196 hist_file_name
= (! NILP (Vpurify_flag
)
1197 ? concat2 (Ffile_name_directory (file
),
1198 Ffile_name_nondirectory (found
))
1203 /* Check for the presence of old-style quotes and warn about them. */
1204 specbind (Qold_style_backquotes
, Qnil
);
1205 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1208 if ((is_elc
= suffix_p (found
, ".elc")) != 0
1209 /* version = 1 means the file is empty, in which case we can
1210 treat it as not byte-compiled. */
1211 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 1))
1212 /* Load .elc files directly, but not when they are
1213 remote and have no handler! */
1221 && ! (version
= safe_to_load_version (fd
)))
1224 if (!load_dangerous_libraries
)
1225 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1226 else if (!NILP (nomessage
) && !force_load_messages
)
1227 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1232 efound
= ENCODE_FILE (found
);
1233 fmode
= "r" FOPEN_BINARY
;
1235 /* openp already checked for newness, no point doing it again.
1236 FIXME would be nice to get a message when openp
1237 ignores suffix order due to load_prefer_newer. */
1238 if (!load_prefer_newer
&& is_elc
)
1240 result
= stat (SSDATA (efound
), &s1
);
1243 SSET (efound
, SBYTES (efound
) - 1, 0);
1244 result
= stat (SSDATA (efound
), &s2
);
1245 SSET (efound
, SBYTES (efound
) - 1, 'c');
1249 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1251 /* Make the progress messages mention that source is newer. */
1254 /* If we won't print another message, mention this anyway. */
1255 if (!NILP (nomessage
) && !force_load_messages
)
1257 Lisp_Object msg_file
;
1258 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1259 message_with_string ("Source file `%s' newer than byte-compiled file",
1263 } /* !load_prefer_newer */
1268 /* We are loading a source file (*.el). */
1269 if (!NILP (Vload_source_file_function
))
1276 clear_unwind_protect (fd_index
);
1278 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1279 NILP (noerror
) ? Qnil
: Qt
,
1280 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1281 return unbind_to (count
, val
);
1287 /* We somehow got here with fd == -2, meaning the file is deemed
1288 to be remote. Don't even try to reopen the file locally;
1289 just force a failure. */
1297 clear_unwind_protect (fd_index
);
1298 efound
= ENCODE_FILE (found
);
1299 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1301 stream
= fdopen (fd
, fmode
);
1305 report_file_error ("Opening stdio stream", file
);
1306 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1308 if (! NILP (Vpurify_flag
))
1309 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1311 if (NILP (nomessage
) || force_load_messages
)
1314 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1317 message_with_string ("Loading %s (source)...", file
, 1);
1319 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1321 else /* The typical case; compiled file newer than source file. */
1322 message_with_string ("Loading %s...", file
, 1);
1325 specbind (Qload_file_name
, found
);
1326 specbind (Qinhibit_file_name_operation
, Qnil
);
1327 specbind (Qload_in_progress
, Qt
);
1330 if (lisp_file_lexically_bound_p (Qget_file_char
))
1331 Fset (Qlexical_binding
, Qt
);
1333 if (! version
|| version
>= 22)
1334 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1335 0, Qnil
, Qnil
, Qnil
, Qnil
);
1338 /* We can't handle a file which was compiled with
1339 byte-compile-dynamic by older version of Emacs. */
1340 specbind (Qload_force_doc_strings
, Qt
);
1341 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1342 0, Qnil
, Qnil
, Qnil
, Qnil
);
1344 unbind_to (count
, Qnil
);
1346 /* Run any eval-after-load forms for this file. */
1347 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1348 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1350 xfree (saved_doc_string
);
1351 saved_doc_string
= 0;
1352 saved_doc_string_size
= 0;
1354 xfree (prev_saved_doc_string
);
1355 prev_saved_doc_string
= 0;
1356 prev_saved_doc_string_size
= 0;
1358 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1361 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1364 message_with_string ("Loading %s (source)...done", file
, 1);
1366 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1368 else /* The typical case; compiled file newer than source file. */
1369 message_with_string ("Loading %s...done", file
, 1);
1376 complete_filename_p (Lisp_Object pathname
)
1378 const unsigned char *s
= SDATA (pathname
);
1379 return (IS_DIRECTORY_SEP (s
[0])
1380 || (SCHARS (pathname
) > 2
1381 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1384 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1385 doc
: /* Search for FILENAME through PATH.
1386 Returns the file's name in absolute form, or nil if not found.
1387 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1388 file name when searching.
1389 If non-nil, PREDICATE is used instead of `file-readable-p'.
1390 PREDICATE can also be an integer to pass to the faccessat(2) function,
1391 in which case file-name-handlers are ignored.
1392 This function will normally skip directories, so if you want it to find
1393 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1394 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1397 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1398 if (NILP (predicate
) && fd
>= 0)
1403 /* Search for a file whose name is STR, looking in directories
1404 in the Lisp list PATH, and trying suffixes from SUFFIX.
1405 On success, return a file descriptor (or 1 or -2 as described below).
1406 On failure, return -1 and set errno.
1408 SUFFIXES is a list of strings containing possible suffixes.
1409 The empty suffix is automatically added if the list is empty.
1411 PREDICATE t means the files are binary.
1412 PREDICATE non-nil and non-t means don't open the files,
1413 just look for one that satisfies the predicate. In this case,
1414 return 1 on success. The predicate can be a lisp function or
1415 an integer to pass to `access' (in which case file-name-handlers
1418 If STOREPTR is nonzero, it points to a slot where the name of
1419 the file actually found should be stored as a Lisp string.
1420 nil is stored there on failure.
1422 If the file we find is remote, return -2
1423 but store the found remote file name in *STOREPTR.
1425 If NEWER is true, try all SUFFIXes and return the result for the
1426 newest file that exists. Does not apply to remote files,
1427 or if a non-nil and non-t PREDICATE is specified. */
1430 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1431 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1433 ptrdiff_t fn_size
= 100;
1437 ptrdiff_t want_length
;
1438 Lisp_Object filename
;
1439 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1440 ptrdiff_t max_suffix_len
= 0;
1441 int last_errno
= ENOENT
;
1445 /* The last-modified time of the newest matching file found.
1446 Initialize it to something less than all valid timestamps. */
1447 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1451 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1453 CHECK_STRING_CAR (tail
);
1454 max_suffix_len
= max (max_suffix_len
,
1455 SBYTES (XCAR (tail
)));
1458 string
= filename
= encoded_fn
= save_string
= Qnil
;
1463 absolute
= complete_filename_p (str
);
1465 for (; CONSP (path
); path
= XCDR (path
))
1467 filename
= Fexpand_file_name (str
, XCAR (path
));
1468 if (!complete_filename_p (filename
))
1469 /* If there are non-absolute elts in PATH (eg "."). */
1470 /* Of course, this could conceivably lose if luser sets
1471 default-directory to be something non-absolute... */
1473 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1474 if (!complete_filename_p (filename
))
1475 /* Give up on this path element! */
1479 /* Calculate maximum length of any filename made from
1480 this path element/specified file name and any possible suffix. */
1481 want_length
= max_suffix_len
+ SBYTES (filename
);
1482 if (fn_size
<= want_length
)
1484 fn_size
= 100 + want_length
;
1485 fn
= SAFE_ALLOCA (fn_size
);
1488 /* Loop over suffixes. */
1489 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1490 CONSP (tail
); tail
= XCDR (tail
))
1492 Lisp_Object suffix
= XCAR (tail
);
1493 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1494 Lisp_Object handler
;
1496 /* Concatenate path element/specified name with the suffix.
1497 If the directory starts with /:, remove that. */
1498 int prefixlen
= ((SCHARS (filename
) > 2
1499 && SREF (filename
, 0) == '/'
1500 && SREF (filename
, 1) == ':')
1502 fnlen
= SBYTES (filename
) - prefixlen
;
1503 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1504 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1506 /* Check that the file exists and is not a directory. */
1507 /* We used to only check for handlers on non-absolute file names:
1511 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1512 It's not clear why that was the case and it breaks things like
1513 (load "/bar.el") where the file is actually "/bar.el.gz". */
1514 /* make_string has its own ideas on when to return a unibyte
1515 string and when a multibyte string, but we know better.
1516 We must have a unibyte string when dumping, since
1517 file-name encoding is shaky at best at that time, and in
1518 particular default-file-name-coding-system is reset
1519 several times during loadup. We therefore don't want to
1520 encode the file before passing it to file I/O library
1522 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1523 string
= make_unibyte_string (fn
, fnlen
);
1525 string
= make_string (fn
, fnlen
);
1526 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1527 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1528 && !NATNUMP (predicate
))
1531 if (NILP (predicate
) || EQ (predicate
, Qt
))
1532 exists
= !NILP (Ffile_readable_p (string
));
1535 Lisp_Object tmp
= call1 (predicate
, string
);
1538 else if (EQ (tmp
, Qdir_ok
)
1539 || NILP (Ffile_directory_p (string
)))
1544 last_errno
= EISDIR
;
1550 /* We succeeded; return this descriptor and filename. */
1563 encoded_fn
= ENCODE_FILE (string
);
1564 pfn
= SSDATA (encoded_fn
);
1566 /* Check that we can access or open it. */
1567 if (NATNUMP (predicate
))
1570 if (INT_MAX
< XFASTINT (predicate
))
1571 last_errno
= EINVAL
;
1572 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1576 if (file_directory_p (pfn
))
1577 last_errno
= EISDIR
;
1584 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1587 if (errno
!= ENOENT
)
1592 int err
= (fstat (fd
, &st
) != 0 ? errno
1593 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1605 if (newer
&& !NATNUMP (predicate
))
1607 struct timespec mtime
= get_stat_mtime (&st
);
1609 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1614 emacs_close (save_fd
);
1617 save_string
= string
;
1622 /* We succeeded; return this descriptor and filename. */
1630 /* No more suffixes. Return the newest. */
1631 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1634 *storeptr
= save_string
;
1650 /* Merge the list we've accumulated of globals from the current input source
1651 into the load_history variable. The details depend on whether
1652 the source has an associated file name or not.
1654 FILENAME is the file name that we are loading from.
1656 ENTIRE is true if loading that entire file, false if evaluating
1660 build_load_history (Lisp_Object filename
, bool entire
)
1662 Lisp_Object tail
, prev
, newelt
;
1663 Lisp_Object tem
, tem2
;
1666 tail
= Vload_history
;
1669 while (CONSP (tail
))
1673 /* Find the feature's previous assoc list... */
1674 if (!NILP (Fequal (filename
, Fcar (tem
))))
1678 /* If we're loading the entire file, remove old data. */
1682 Vload_history
= XCDR (tail
);
1684 Fsetcdr (prev
, XCDR (tail
));
1687 /* Otherwise, cons on new symbols that are not already members. */
1690 tem2
= Vcurrent_load_list
;
1692 while (CONSP (tem2
))
1694 newelt
= XCAR (tem2
);
1696 if (NILP (Fmember (newelt
, tem
)))
1697 Fsetcar (tail
, Fcons (XCAR (tem
),
1698 Fcons (newelt
, XCDR (tem
))));
1711 /* If we're loading an entire file, cons the new assoc onto the
1712 front of load-history, the most-recently-loaded position. Also
1713 do this if we didn't find an existing member for the file. */
1714 if (entire
|| !foundit
)
1715 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1720 readevalloop_1 (int old
)
1722 load_convert_to_unibyte
= old
;
1725 /* Signal an `end-of-file' error, if possible with file name
1728 static _Noreturn
void
1729 end_of_file_error (void)
1731 if (STRINGP (Vload_file_name
))
1732 xsignal1 (Qend_of_file
, Vload_file_name
);
1734 xsignal0 (Qend_of_file
);
1738 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1740 /* If we macroexpand the toplevel form non-recursively and it ends
1741 up being a `progn' (or if it was a progn to start), treat each
1742 form in the progn as a top-level form. This way, if one form in
1743 the progn defines a macro, that macro is in effect when we expand
1744 the remaining forms. See similar code in bytecomp.el. */
1745 val
= call2 (macroexpand
, val
, Qnil
);
1746 if (EQ (CAR_SAFE (val
), Qprogn
))
1748 Lisp_Object subforms
= XCDR (val
);
1750 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1751 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1755 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1759 /* UNIBYTE specifies how to set load_convert_to_unibyte
1760 for this invocation.
1761 READFUN, if non-nil, is used instead of `read'.
1763 START, END specify region to read in current buffer (from eval-region).
1764 If the input is not from a buffer, they must be nil. */
1767 readevalloop (Lisp_Object readcharfun
,
1769 Lisp_Object sourcename
,
1771 Lisp_Object unibyte
, Lisp_Object readfun
,
1772 Lisp_Object start
, Lisp_Object end
)
1776 ptrdiff_t count
= SPECPDL_INDEX ();
1777 struct buffer
*b
= 0;
1778 bool continue_reading_p
;
1779 Lisp_Object lex_bound
;
1780 /* True if reading an entire buffer. */
1781 bool whole_buffer
= 0;
1782 /* True on the first time around. */
1783 bool first_sexp
= 1;
1784 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1786 if (NILP (Ffboundp (macroexpand
))
1787 /* Don't macroexpand in .elc files, since it should have been done
1788 already. We actually don't know whether we're in a .elc file or not,
1789 so we use circumstantial evidence: .el files normally go through
1790 Vload_source_file_function -> load-with-code-conversion
1792 || EQ (readcharfun
, Qget_file_char
)
1793 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1796 if (MARKERP (readcharfun
))
1799 start
= readcharfun
;
1802 if (BUFFERP (readcharfun
))
1803 b
= XBUFFER (readcharfun
);
1804 else if (MARKERP (readcharfun
))
1805 b
= XMARKER (readcharfun
)->buffer
;
1807 /* We assume START is nil when input is not from a buffer. */
1808 if (! NILP (start
) && !b
)
1811 specbind (Qstandard_input
, readcharfun
);
1812 specbind (Qcurrent_load_list
, Qnil
);
1813 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1814 load_convert_to_unibyte
= !NILP (unibyte
);
1816 /* If lexical binding is active (either because it was specified in
1817 the file's header, or via a buffer-local variable), create an empty
1818 lexical environment, otherwise, turn off lexical binding. */
1819 lex_bound
= find_symbol_value (Qlexical_binding
);
1820 specbind (Qinternal_interpreter_environment
,
1821 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1822 ? Qnil
: list1 (Qt
)));
1824 /* Try to ensure sourcename is a truename, except whilst preloading. */
1825 if (NILP (Vpurify_flag
)
1826 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1827 && !NILP (Ffboundp (Qfile_truename
)))
1828 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1830 LOADHIST_ATTACH (sourcename
);
1832 continue_reading_p
= 1;
1833 while (continue_reading_p
)
1835 ptrdiff_t count1
= SPECPDL_INDEX ();
1837 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1838 error ("Reading from killed buffer");
1842 /* Switch to the buffer we are reading from. */
1843 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1844 set_buffer_internal (b
);
1846 /* Save point in it. */
1847 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1848 /* Save ZV in it. */
1849 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1850 /* Those get unbound after we read one expression. */
1852 /* Set point and ZV around stuff to be read. */
1855 Fnarrow_to_region (make_number (BEGV
), end
);
1857 /* Just for cleanliness, convert END to a marker
1858 if it is an integer. */
1860 end
= Fpoint_max_marker ();
1863 /* On the first cycle, we can easily test here
1864 whether we are reading the whole buffer. */
1865 if (b
&& first_sexp
)
1866 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1873 while ((c
= READCHAR
) != '\n' && c
!= -1);
1878 unbind_to (count1
, Qnil
);
1882 /* Ignore whitespace here, so we can detect eof. */
1883 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1884 || c
== NO_BREAK_SPACE
)
1887 if (!NILP (Vpurify_flag
) && c
== '(')
1889 val
= read_list (0, readcharfun
);
1894 read_objects
= Qnil
;
1895 if (!NILP (readfun
))
1897 val
= call1 (readfun
, readcharfun
);
1899 /* If READCHARFUN has set point to ZV, we should
1900 stop reading, even if the form read sets point
1901 to a different value when evaluated. */
1902 if (BUFFERP (readcharfun
))
1904 struct buffer
*buf
= XBUFFER (readcharfun
);
1905 if (BUF_PT (buf
) == BUF_ZV (buf
))
1906 continue_reading_p
= 0;
1909 else if (! NILP (Vload_read_function
))
1910 val
= call1 (Vload_read_function
, readcharfun
);
1912 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1915 if (!NILP (start
) && continue_reading_p
)
1916 start
= Fpoint_marker ();
1918 /* Restore saved point and BEGV. */
1919 unbind_to (count1
, Qnil
);
1921 /* Now eval what we just read. */
1922 if (!NILP (macroexpand
))
1923 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1925 val
= eval_sub (val
);
1929 Vvalues
= Fcons (val
, Vvalues
);
1930 if (EQ (Vstandard_output
, Qt
))
1939 build_load_history (sourcename
,
1940 stream
|| whole_buffer
);
1942 unbind_to (count
, Qnil
);
1945 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1946 doc
: /* Execute the accessible portion of current buffer as Lisp code.
1947 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
1948 When called from a Lisp program (i.e., not interactively), this
1949 function accepts up to five optional arguments:
1950 BUFFER is the buffer to evaluate (nil means use current buffer),
1951 or a name of a buffer (a string).
1952 PRINTFLAG controls printing of output by any output functions in the
1953 evaluated code, such as `print', `princ', and `prin1':
1954 a value of nil means discard it; anything else is the stream to print to.
1955 See Info node `(elisp)Output Streams' for details on streams.
1956 FILENAME specifies the file name to use for `load-history'.
1957 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1959 DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
1960 evaluated code should work normally even if PRINTFLAG is nil, in
1961 which case the output is displayed in the echo area.
1963 This function preserves the position of point. */)
1964 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1966 ptrdiff_t count
= SPECPDL_INDEX ();
1967 Lisp_Object tem
, buf
;
1970 buf
= Fcurrent_buffer ();
1972 buf
= Fget_buffer (buffer
);
1974 error ("No such buffer");
1976 if (NILP (printflag
) && NILP (do_allow_print
))
1981 if (NILP (filename
))
1982 filename
= BVAR (XBUFFER (buf
), filename
);
1984 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1985 specbind (Qstandard_output
, tem
);
1986 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1987 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1988 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1989 readevalloop (buf
, 0, filename
,
1990 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1991 unbind_to (count
, Qnil
);
1996 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1997 doc
: /* Execute the region as Lisp code.
1998 When called from programs, expects two arguments,
1999 giving starting and ending indices in the current buffer
2000 of the text to be executed.
2001 Programs can pass third argument PRINTFLAG which controls output:
2002 a value of nil means discard it; anything else is stream for printing it.
2003 See Info node `(elisp)Output Streams' for details on streams.
2004 Also the fourth argument READ-FUNCTION, if non-nil, is used
2005 instead of `read' to read each expression. It gets one argument
2006 which is the input stream for reading characters.
2008 This function does not move point. */)
2009 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2011 /* FIXME: Do the eval-sexp-add-defvars dance! */
2012 ptrdiff_t count
= SPECPDL_INDEX ();
2013 Lisp_Object tem
, cbuf
;
2015 cbuf
= Fcurrent_buffer ();
2017 if (NILP (printflag
))
2021 specbind (Qstandard_output
, tem
);
2022 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2024 /* `readevalloop' calls functions which check the type of start and end. */
2025 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2026 !NILP (printflag
), Qnil
, read_function
,
2029 return unbind_to (count
, Qnil
);
2033 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2034 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2035 If STREAM is nil, use the value of `standard-input' (which see).
2036 STREAM or the value of `standard-input' may be:
2037 a buffer (read from point and advance it)
2038 a marker (read from where it points and advance it)
2039 a function (call it with no arguments for each character,
2040 call it with a char as argument to push a char back)
2041 a string (takes text from string, starting at the beginning)
2042 t (read text line using minibuffer and use it, or read from
2043 standard input in batch mode). */)
2044 (Lisp_Object stream
)
2047 stream
= Vstandard_input
;
2048 if (EQ (stream
, Qt
))
2049 stream
= Qread_char
;
2050 if (EQ (stream
, Qread_char
))
2051 /* FIXME: ?! When is this used !? */
2052 return call1 (intern ("read-minibuffer"),
2053 build_string ("Lisp expression: "));
2055 return read_internal_start (stream
, Qnil
, Qnil
);
2058 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2059 doc
: /* Read one Lisp expression which is represented as text by STRING.
2060 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2061 FINAL-STRING-INDEX is an integer giving the position of the next
2062 remaining character in STRING. START and END optionally delimit
2063 a substring of STRING from which to read; they default to 0 and
2064 \(length STRING) respectively. Negative values are counted from
2065 the end of STRING. */)
2066 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2069 CHECK_STRING (string
);
2070 /* `read_internal_start' sets `read_from_string_index'. */
2071 ret
= read_internal_start (string
, start
, end
);
2072 return Fcons (ret
, make_number (read_from_string_index
));
2075 /* Function to set up the global context we need in toplevel read
2076 calls. START and END only used when STREAM is a string. */
2078 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2083 new_backquote_flag
= 0;
2084 read_objects
= Qnil
;
2085 if (EQ (Vread_with_symbol_positions
, Qt
)
2086 || EQ (Vread_with_symbol_positions
, stream
))
2087 Vread_symbol_positions_list
= Qnil
;
2089 if (STRINGP (stream
)
2090 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2092 ptrdiff_t startval
, endval
;
2095 if (STRINGP (stream
))
2098 string
= XCAR (stream
);
2100 validate_subarray (string
, start
, end
, SCHARS (string
),
2101 &startval
, &endval
);
2103 read_from_string_index
= startval
;
2104 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2105 read_from_string_limit
= endval
;
2108 retval
= read0 (stream
);
2109 if (EQ (Vread_with_symbol_positions
, Qt
)
2110 || EQ (Vread_with_symbol_positions
, stream
))
2111 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2116 /* Signal Qinvalid_read_syntax error.
2117 S is error string of length N (if > 0) */
2119 static _Noreturn
void
2120 invalid_syntax (const char *s
)
2122 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2126 /* Use this for recursive reads, in contexts where internal tokens
2130 read0 (Lisp_Object readcharfun
)
2132 register Lisp_Object val
;
2135 val
= read1 (readcharfun
, &c
, 0);
2139 xsignal1 (Qinvalid_read_syntax
,
2140 Fmake_string (make_number (1), make_number (c
)));
2143 static ptrdiff_t read_buffer_size
;
2144 static char *read_buffer
;
2146 /* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes. */
2149 grow_read_buffer (void)
2151 read_buffer
= xpalloc (read_buffer
, &read_buffer_size
,
2152 MAX_MULTIBYTE_LENGTH
, -1, 1);
2155 /* Return the scalar value that has the Unicode character name NAME.
2156 Raise 'invalid-read-syntax' if there is no such character. */
2158 character_name_to_code (char const *name
, ptrdiff_t name_len
)
2160 /* For "U+XXXX", pass the leading '+' to string_to_number to reject
2161 monstrosities like "U+-0000". */
2163 = (name
[0] == 'U' && name
[1] == '+'
2164 ? string_to_number (name
+ 1, 16, false)
2165 : call2 (Qchar_from_name
, make_unibyte_string (name
, name_len
), Qt
));
2167 if (! RANGED_INTEGERP (0, code
, MAX_UNICODE_CHAR
)
2168 || char_surrogate_p (XINT (code
)))
2170 AUTO_STRING (format
, "\\N{%s}");
2171 AUTO_STRING_WITH_LEN (namestr
, name
, name_len
);
2172 xsignal1 (Qinvalid_read_syntax
, CALLN (Fformat
, format
, namestr
));
2178 /* Bound on the length of a Unicode character name. As of
2179 Unicode 9.0.0 the maximum is 83, so this should be safe. */
2180 enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND
= 200 };
2182 /* Read a \-escape sequence, assuming we already read the `\'.
2183 If the escape sequence forces unibyte, return eight-bit char. */
2186 read_escape (Lisp_Object readcharfun
, bool stringp
)
2189 /* \u allows up to four hex digits, \U up to eight. Default to the
2190 behavior for \u, and change this value in the case that \U is seen. */
2191 int unicode_hex_count
= 4;
2196 end_of_file_error ();
2226 error ("Invalid escape character syntax");
2229 c
= read_escape (readcharfun
, 0);
2230 return c
| meta_modifier
;
2235 error ("Invalid escape character syntax");
2238 c
= read_escape (readcharfun
, 0);
2239 return c
| shift_modifier
;
2244 error ("Invalid escape character syntax");
2247 c
= read_escape (readcharfun
, 0);
2248 return c
| hyper_modifier
;
2253 error ("Invalid escape character syntax");
2256 c
= read_escape (readcharfun
, 0);
2257 return c
| alt_modifier
;
2261 if (stringp
|| c
!= '-')
2268 c
= read_escape (readcharfun
, 0);
2269 return c
| super_modifier
;
2274 error ("Invalid escape character syntax");
2278 c
= read_escape (readcharfun
, 0);
2279 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2280 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2281 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2282 return c
| ctrl_modifier
;
2283 /* ASCII control chars are made from letters (both cases),
2284 as well as the non-letters within 0100...0137. */
2285 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2286 return (c
& (037 | ~0177));
2287 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2288 return (c
& (037 | ~0177));
2290 return c
| ctrl_modifier
;
2300 /* An octal escape, as in ANSI C. */
2302 register int i
= c
- '0';
2303 register int count
= 0;
2306 if ((c
= READCHAR
) >= '0' && c
<= '7')
2318 if (i
>= 0x80 && i
< 0x100)
2319 i
= BYTE8_TO_CHAR (i
);
2324 /* A hex escape, as in ANSI C. */
2331 if (c
>= '0' && c
<= '9')
2336 else if ((c
>= 'a' && c
<= 'f')
2337 || (c
>= 'A' && c
<= 'F'))
2340 if (c
>= 'a' && c
<= 'f')
2350 /* Allow hex escapes as large as ?\xfffffff, because some
2351 packages use them to denote characters with modifiers. */
2352 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2353 error ("Hex character out of range: \\x%x...", i
);
2357 if (count
< 3 && i
>= 0x80)
2358 return BYTE8_TO_CHAR (i
);
2363 /* Post-Unicode-2.0: Up to eight hex chars. */
2364 unicode_hex_count
= 8;
2367 /* A Unicode escape. We only permit them in strings and characters,
2368 not arbitrarily in the source code, as in some other languages. */
2373 while (++count
<= unicode_hex_count
)
2376 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2378 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2379 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2380 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2382 error ("Non-hex digit used for Unicode escape");
2385 error ("Non-Unicode character: 0x%x", i
);
2390 /* Named character. */
2394 invalid_syntax ("Expected opening brace after \\N");
2395 char name
[UNICODE_CHARACTER_NAME_LENGTH_BOUND
+ 1];
2396 bool whitespace
= false;
2397 ptrdiff_t length
= 0;
2402 end_of_file_error ();
2405 if (! (0 < c
&& c
< 0x80))
2407 AUTO_STRING (format
,
2408 "Invalid character U+%04X in character name");
2409 xsignal1 (Qinvalid_read_syntax
,
2410 CALLN (Fformat
, format
, make_natnum (c
)));
2412 /* Treat multiple adjacent whitespace characters as a
2413 single space character. This makes it easier to use
2414 character names in e.g. multi-line strings. */
2425 if (length
>= sizeof name
)
2426 invalid_syntax ("Character name too long");
2429 invalid_syntax ("Empty character name");
2430 name
[length
] = '\0';
2431 return character_name_to_code (name
, length
);
2439 /* Return the digit that CHARACTER stands for in the given BASE.
2440 Return -1 if CHARACTER is out of range for BASE,
2441 and -2 if CHARACTER is not valid for any supported BASE. */
2443 digit_to_number (int character
, int base
)
2447 if ('0' <= character
&& character
<= '9')
2448 digit
= character
- '0';
2449 else if ('a' <= character
&& character
<= 'z')
2450 digit
= character
- 'a' + 10;
2451 else if ('A' <= character
&& character
<= 'Z')
2452 digit
= character
- 'A' + 10;
2456 return digit
< base
? digit
: -1;
2459 /* Read an integer in radix RADIX using READCHARFUN to read
2460 characters. RADIX must be in the interval [2..36]; if it isn't, a
2461 read error is signaled . Value is the integer read. Signals an
2462 error if encountering invalid read syntax or if RADIX is out of
2466 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2468 /* Room for sign, leading 0, other digits, trailing null byte.
2469 Also, room for invalid syntax diagnostic. */
2470 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2471 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2473 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2475 if (radix
< 2 || radix
> 36)
2483 if (c
== '-' || c
== '+')
2494 /* Ignore redundant leading zeros, so the buffer doesn't
2495 fill up with them. */
2501 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2508 if (p
< buf
+ sizeof buf
- 1)
2522 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2523 invalid_syntax (buf
);
2526 return string_to_number (buf
, radix
, 0);
2530 /* If the next token is ')' or ']' or '.', we store that character
2531 in *PCH and the return value is not interesting. Else, we store
2532 zero in *PCH and we read and return one lisp object.
2534 FIRST_IN_LIST is true if this is the first element of a list. */
2537 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2540 bool uninterned_symbol
= 0;
2547 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2549 end_of_file_error ();
2554 return read_list (0, readcharfun
);
2557 return read_vector (readcharfun
, 0);
2573 /* Accept extended format for hashtables (extensible to
2575 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2576 Lisp_Object tmp
= read_list (0, readcharfun
);
2577 Lisp_Object head
= CAR_SAFE (tmp
);
2578 Lisp_Object data
= Qnil
;
2579 Lisp_Object val
= Qnil
;
2580 /* The size is 2 * number of allowed keywords to
2582 Lisp_Object params
[10];
2584 Lisp_Object key
= Qnil
;
2585 int param_count
= 0;
2587 if (!EQ (head
, Qhash_table
))
2588 error ("Invalid extended read marker at head of #s list "
2589 "(only hash-table allowed)");
2591 tmp
= CDR_SAFE (tmp
);
2593 /* This is repetitive but fast and simple. */
2594 params
[param_count
] = QCsize
;
2595 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2596 if (!NILP (params
[param_count
+ 1]))
2599 params
[param_count
] = QCtest
;
2600 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2601 if (!NILP (params
[param_count
+ 1]))
2604 params
[param_count
] = QCweakness
;
2605 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2606 if (!NILP (params
[param_count
+ 1]))
2609 params
[param_count
] = QCrehash_size
;
2610 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2611 if (!NILP (params
[param_count
+ 1]))
2614 params
[param_count
] = QCrehash_threshold
;
2615 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2616 if (!NILP (params
[param_count
+ 1]))
2619 /* This is the hashtable data. */
2620 data
= Fplist_get (tmp
, Qdata
);
2622 /* Now use params to make a new hashtable and fill it. */
2623 ht
= Fmake_hash_table (param_count
, params
);
2625 while (CONSP (data
))
2630 error ("Odd number of elements in hashtable data");
2633 Fputhash (key
, val
, ht
);
2639 invalid_syntax ("#");
2647 tmp
= read_vector (readcharfun
, 0);
2648 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2649 error ("Invalid size char-table");
2650 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2658 /* Sub char-table can't be read as a regular
2659 vector because of a two C integer fields. */
2660 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2661 ptrdiff_t size
= XINT (Flength (tmp
));
2662 int i
, depth
, min_char
;
2663 struct Lisp_Cons
*cell
;
2666 error ("Zero-sized sub char-table");
2668 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2669 error ("Invalid depth in sub char-table");
2670 depth
= XINT (XCAR (tmp
));
2671 if (chartab_size
[depth
] != size
- 2)
2672 error ("Invalid size in sub char-table");
2673 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2676 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2677 error ("Invalid minimum character in sub-char-table");
2678 min_char
= XINT (XCAR (tmp
));
2679 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2682 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2683 for (i
= 0; i
< size
; i
++)
2685 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2686 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2691 invalid_syntax ("#^^");
2693 invalid_syntax ("#^");
2698 length
= read1 (readcharfun
, pch
, first_in_list
);
2702 Lisp_Object tmp
, val
;
2703 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2704 unsigned char *data
;
2707 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2708 if (STRING_MULTIBYTE (tmp
)
2709 || (size_in_chars
!= SCHARS (tmp
)
2710 /* We used to print 1 char too many
2711 when the number of bits was a multiple of 8.
2712 Accept such input in case it came from an old
2714 && ! (XFASTINT (length
)
2715 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2716 invalid_syntax ("#&...");
2718 val
= make_uninit_bool_vector (XFASTINT (length
));
2719 data
= bool_vector_uchar_data (val
);
2720 memcpy (data
, SDATA (tmp
), size_in_chars
);
2721 /* Clear the extraneous bits in the last byte. */
2722 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2723 data
[size_in_chars
- 1]
2724 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2727 invalid_syntax ("#&...");
2731 /* Accept compiled functions at read-time so that we don't have to
2732 build them using function calls. */
2734 struct Lisp_Vector
*vec
;
2735 tmp
= read_vector (readcharfun
, 1);
2736 vec
= XVECTOR (tmp
);
2737 if (vec
->header
.size
== 0)
2738 invalid_syntax ("Empty byte-code object");
2739 make_byte_code (vec
);
2747 /* Read the string itself. */
2748 tmp
= read1 (readcharfun
, &ch
, 0);
2749 if (ch
!= 0 || !STRINGP (tmp
))
2750 invalid_syntax ("#");
2751 /* Read the intervals and their properties. */
2754 Lisp_Object beg
, end
, plist
;
2756 beg
= read1 (readcharfun
, &ch
, 0);
2761 end
= read1 (readcharfun
, &ch
, 0);
2763 plist
= read1 (readcharfun
, &ch
, 0);
2765 invalid_syntax ("Invalid string property list");
2766 Fset_text_properties (beg
, end
, plist
, tmp
);
2772 /* #@NUMBER is used to skip NUMBER following bytes.
2773 That's used in .elc files to skip over doc strings
2774 and function definitions. */
2777 enum { extra
= 100 };
2778 ptrdiff_t i
, nskip
= 0, digits
= 0;
2780 /* Read a decimal integer. */
2781 while ((c
= READCHAR
) >= 0
2782 && c
>= '0' && c
<= '9')
2784 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2789 if (digits
== 2 && nskip
== 0)
2790 { /* We've just seen #@00, which means "skip to end". */
2791 skip_dyn_eof (readcharfun
);
2796 /* We can't use UNREAD here, because in the code below we side-step
2797 READCHAR. Instead, assume the first char after #@NNN occupies
2798 a single byte, which is the case normally since it's just
2804 if (load_force_doc_strings
2805 && (FROM_FILE_P (readcharfun
)))
2807 /* If we are supposed to force doc strings into core right now,
2808 record the last string that we skipped,
2809 and record where in the file it comes from. */
2811 /* But first exchange saved_doc_string
2812 with prev_saved_doc_string, so we save two strings. */
2814 char *temp
= saved_doc_string
;
2815 ptrdiff_t temp_size
= saved_doc_string_size
;
2816 file_offset temp_pos
= saved_doc_string_position
;
2817 ptrdiff_t temp_len
= saved_doc_string_length
;
2819 saved_doc_string
= prev_saved_doc_string
;
2820 saved_doc_string_size
= prev_saved_doc_string_size
;
2821 saved_doc_string_position
= prev_saved_doc_string_position
;
2822 saved_doc_string_length
= prev_saved_doc_string_length
;
2824 prev_saved_doc_string
= temp
;
2825 prev_saved_doc_string_size
= temp_size
;
2826 prev_saved_doc_string_position
= temp_pos
;
2827 prev_saved_doc_string_length
= temp_len
;
2830 if (saved_doc_string_size
== 0)
2832 saved_doc_string
= xmalloc (nskip
+ extra
);
2833 saved_doc_string_size
= nskip
+ extra
;
2835 if (nskip
> saved_doc_string_size
)
2837 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2838 saved_doc_string_size
= nskip
+ extra
;
2841 saved_doc_string_position
= file_tell (instream
);
2843 /* Copy that many characters into saved_doc_string. */
2845 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2846 saved_doc_string
[i
] = c
= getc (instream
);
2849 saved_doc_string_length
= i
;
2852 /* Skip that many bytes. */
2853 skip_dyn_bytes (readcharfun
, nskip
);
2859 /* #! appears at the beginning of an executable file.
2860 Skip the first line. */
2861 while (c
!= '\n' && c
>= 0)
2866 return Vload_file_name
;
2868 return list2 (Qfunction
, read0 (readcharfun
));
2869 /* #:foo is the uninterned symbol named foo. */
2872 uninterned_symbol
= 1;
2875 && c
!= NO_BREAK_SPACE
2877 || strchr ("\"';()[]#`,", c
) == NULL
)))
2879 /* No symbol character follows, this is the empty
2882 return Fmake_symbol (empty_unibyte_string
);
2886 /* ## is the empty symbol. */
2888 return Fintern (empty_unibyte_string
, Qnil
);
2889 /* Reader forms that can reuse previously read objects. */
2890 if (c
>= '0' && c
<= '9')
2895 /* Read a non-negative integer. */
2896 while (c
>= '0' && c
<= '9')
2898 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2899 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2900 n
= MOST_POSITIVE_FIXNUM
+ 1;
2902 n
= n
* 10 + c
- '0';
2906 if (n
<= MOST_POSITIVE_FIXNUM
)
2908 if (c
== 'r' || c
== 'R')
2909 return read_integer (readcharfun
, n
);
2911 if (! NILP (Vread_circle
))
2913 /* #n=object returns object, but associates it with
2917 /* Make a placeholder for #n# to use temporarily. */
2918 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2919 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2920 read_objects
= Fcons (cell
, read_objects
);
2922 /* Read the object itself. */
2923 tem
= read0 (readcharfun
);
2925 /* Now put it everywhere the placeholder was... */
2926 substitute_object_in_subtree (tem
, placeholder
);
2928 /* ...and #n# will use the real value from now on. */
2929 Fsetcdr (cell
, tem
);
2934 /* #n# returns a previously read object. */
2937 tem
= Fassq (make_number (n
), read_objects
);
2943 /* Fall through to error message. */
2945 else if (c
== 'x' || c
== 'X')
2946 return read_integer (readcharfun
, 16);
2947 else if (c
== 'o' || c
== 'O')
2948 return read_integer (readcharfun
, 8);
2949 else if (c
== 'b' || c
== 'B')
2950 return read_integer (readcharfun
, 2);
2953 invalid_syntax ("#");
2956 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2960 return list2 (Qquote
, read0 (readcharfun
));
2964 int next_char
= READCHAR
;
2966 /* Transition from old-style to new-style:
2967 If we see "(`" it used to mean old-style, which usually works
2968 fine because ` should almost never appear in such a position
2969 for new-style. But occasionally we need "(`" to mean new
2970 style, so we try to distinguish the two by the fact that we
2971 can either write "( `foo" or "(` foo", where the first
2972 intends to use new-style whereas the second intends to use
2973 old-style. For Emacs-25, we should completely remove this
2974 first_in_list exception (old-style can still be obtained via
2976 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2978 Vold_style_backquotes
= Qt
;
2984 bool saved_new_backquote_flag
= new_backquote_flag
;
2986 new_backquote_flag
= 1;
2987 value
= read0 (readcharfun
);
2988 new_backquote_flag
= saved_new_backquote_flag
;
2990 return list2 (Qbackquote
, value
);
2995 int next_char
= READCHAR
;
2997 /* Transition from old-style to new-style:
2998 It used to be impossible to have a new-style , other than within
2999 a new-style `. This is sufficient when ` and , are used in the
3000 normal way, but ` and , can also appear in args to macros that
3001 will not interpret them in the usual way, in which case , may be
3002 used without any ` anywhere near.
3003 So we now use the same heuristic as for backquote: old-style
3004 unquotes are only recognized when first on a list, and when
3005 followed by a space.
3006 Because it's more difficult to peek 2 chars ahead, a new-style
3007 ,@ can still not be used outside of a `, unless it's in the middle
3009 if (new_backquote_flag
3011 || (next_char
!= ' ' && next_char
!= '@'))
3013 Lisp_Object comma_type
= Qnil
;
3018 comma_type
= Qcomma_at
;
3020 comma_type
= Qcomma_dot
;
3023 if (ch
>= 0) UNREAD (ch
);
3024 comma_type
= Qcomma
;
3027 value
= read0 (readcharfun
);
3028 return list2 (comma_type
, value
);
3032 Vold_style_backquotes
= Qt
;
3044 end_of_file_error ();
3046 /* Accept `single space' syntax like (list ? x) where the
3047 whitespace character is SPC or TAB.
3048 Other literal whitespace like NL, CR, and FF are not accepted,
3049 as there are well-established escape sequences for these. */
3050 if (c
== ' ' || c
== '\t')
3051 return make_number (c
);
3054 c
= read_escape (readcharfun
, 0);
3055 modifiers
= c
& CHAR_MODIFIER_MASK
;
3056 c
&= ~CHAR_MODIFIER_MASK
;
3057 if (CHAR_BYTE8_P (c
))
3058 c
= CHAR_TO_BYTE8 (c
);
3061 next_char
= READCHAR
;
3062 ok
= (next_char
<= 040
3063 || (next_char
< 0200
3064 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3067 return make_number (c
);
3069 invalid_syntax ("?");
3074 char *p
= read_buffer
;
3075 char *end
= read_buffer
+ read_buffer_size
;
3077 /* True if we saw an escape sequence specifying
3078 a multibyte character. */
3079 bool force_multibyte
= 0;
3080 /* True if we saw an escape sequence specifying
3081 a single-byte character. */
3082 bool force_singlebyte
= 0;
3084 ptrdiff_t nchars
= 0;
3086 while ((ch
= READCHAR
) >= 0
3089 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3091 ptrdiff_t offset
= p
- read_buffer
;
3092 grow_read_buffer ();
3093 p
= read_buffer
+ offset
;
3094 end
= read_buffer
+ read_buffer_size
;
3101 ch
= read_escape (readcharfun
, 1);
3103 /* CH is -1 if \ newline or \ space has just been seen. */
3106 if (p
== read_buffer
)
3111 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3112 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3114 if (CHAR_BYTE8_P (ch
))
3115 force_singlebyte
= 1;
3116 else if (! ASCII_CHAR_P (ch
))
3117 force_multibyte
= 1;
3118 else /* I.e. ASCII_CHAR_P (ch). */
3120 /* Allow `\C- ' and `\C-?'. */
3121 if (modifiers
== CHAR_CTL
)
3124 ch
= 0, modifiers
= 0;
3126 ch
= 127, modifiers
= 0;
3128 if (modifiers
& CHAR_SHIFT
)
3130 /* Shift modifier is valid only with [A-Za-z]. */
3131 if (ch
>= 'A' && ch
<= 'Z')
3132 modifiers
&= ~CHAR_SHIFT
;
3133 else if (ch
>= 'a' && ch
<= 'z')
3134 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3137 if (modifiers
& CHAR_META
)
3139 /* Move the meta bit to the right place for a
3141 modifiers
&= ~CHAR_META
;
3142 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3143 force_singlebyte
= 1;
3147 /* Any modifiers remaining are invalid. */
3149 error ("Invalid modifier in string");
3150 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3154 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3155 if (CHAR_BYTE8_P (ch
))
3156 force_singlebyte
= 1;
3157 else if (! ASCII_CHAR_P (ch
))
3158 force_multibyte
= 1;
3164 end_of_file_error ();
3166 /* If purifying, and string starts with \ newline,
3167 return zero instead. This is for doc strings
3168 that we are really going to find in etc/DOC.nn.nn. */
3169 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3170 return make_number (0);
3172 if (! force_multibyte
&& force_singlebyte
)
3174 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3175 forms. Convert it to unibyte. */
3176 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3178 p
= read_buffer
+ nchars
;
3181 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3183 || (p
- read_buffer
!= nchars
)));
3188 int next_char
= READCHAR
;
3191 if (next_char
<= 040
3192 || (next_char
< 0200
3193 && strchr ("\"';([#?`,", next_char
) != NULL
))
3199 /* Otherwise, we fall through! Note that the atom-reading loop
3200 below will now loop at least once, assuring that we will not
3201 try to UNREAD two characters in a row. */
3205 if (c
<= 040) goto retry
;
3206 if (c
== NO_BREAK_SPACE
)
3211 char *p
= read_buffer
;
3213 EMACS_INT start_position
= readchar_count
- 1;
3216 char *end
= read_buffer
+ read_buffer_size
;
3220 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3222 ptrdiff_t offset
= p
- read_buffer
;
3223 grow_read_buffer ();
3224 p
= read_buffer
+ offset
;
3225 end
= read_buffer
+ read_buffer_size
;
3232 end_of_file_error ();
3237 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3243 && c
!= NO_BREAK_SPACE
3245 || strchr ("\"';()[]#`,", c
) == NULL
));
3249 ptrdiff_t offset
= p
- read_buffer
;
3250 grow_read_buffer ();
3251 p
= read_buffer
+ offset
;
3252 end
= read_buffer
+ read_buffer_size
;
3258 if (!quoted
&& !uninterned_symbol
)
3260 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3261 if (! NILP (result
))
3265 Lisp_Object name
, result
;
3266 ptrdiff_t nbytes
= p
- read_buffer
;
3269 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3273 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3274 ? make_pure_string
: make_specified_string
)
3275 (read_buffer
, nchars
, nbytes
, multibyte
));
3276 result
= (uninterned_symbol
? Fmake_symbol (name
)
3277 : Fintern (name
, Qnil
));
3279 if (EQ (Vread_with_symbol_positions
, Qt
)
3280 || EQ (Vread_with_symbol_positions
, readcharfun
))
3281 Vread_symbol_positions_list
3282 = Fcons (Fcons (result
, make_number (start_position
)),
3283 Vread_symbol_positions_list
);
3291 /* List of nodes we've seen during substitute_object_in_subtree. */
3292 static Lisp_Object seen_list
;
3295 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3297 Lisp_Object check_object
;
3299 /* We haven't seen any objects when we start. */
3302 /* Make all the substitutions. */
3304 = substitute_object_recurse (object
, placeholder
, object
);
3306 /* Clear seen_list because we're done with it. */
3309 /* The returned object here is expected to always eq the
3311 if (!EQ (check_object
, object
))
3312 error ("Unexpected mutation error in reader");
3315 /* Feval doesn't get called from here, so no gc protection is needed. */
3316 #define SUBSTITUTE(get_val, set_val) \
3318 Lisp_Object old_value = get_val; \
3319 Lisp_Object true_value \
3320 = substitute_object_recurse (object, placeholder, \
3323 if (!EQ (old_value, true_value)) \
3330 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3332 /* If we find the placeholder, return the target object. */
3333 if (EQ (placeholder
, subtree
))
3336 /* If we've been to this node before, don't explore it again. */
3337 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3340 /* If this node can be the entry point to a cycle, remember that
3341 we've seen it. It can only be such an entry point if it was made
3342 by #n=, which means that we can find it as a value in
3344 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3345 seen_list
= Fcons (subtree
, seen_list
);
3347 /* Recurse according to subtree's type.
3348 Every branch must return a Lisp_Object. */
3349 switch (XTYPE (subtree
))
3351 case Lisp_Vectorlike
:
3353 ptrdiff_t i
= 0, length
= 0;
3354 if (BOOL_VECTOR_P (subtree
))
3355 return subtree
; /* No sub-objects anyway. */
3356 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3357 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3358 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3359 else if (VECTORP (subtree
))
3360 length
= ASIZE (subtree
);
3362 /* An unknown pseudovector may contain non-Lisp fields, so we
3363 can't just blindly traverse all its fields. We used to call
3364 `Flength' which signaled `sequencep', so I just preserved this
3366 wrong_type_argument (Qsequencep
, subtree
);
3368 if (SUB_CHAR_TABLE_P (subtree
))
3370 for ( ; i
< length
; i
++)
3371 SUBSTITUTE (AREF (subtree
, i
),
3372 ASET (subtree
, i
, true_value
));
3378 SUBSTITUTE (XCAR (subtree
),
3379 XSETCAR (subtree
, true_value
));
3380 SUBSTITUTE (XCDR (subtree
),
3381 XSETCDR (subtree
, true_value
));
3387 /* Check for text properties in each interval.
3388 substitute_in_interval contains part of the logic. */
3390 INTERVAL root_interval
= string_intervals (subtree
);
3391 AUTO_CONS (arg
, object
, placeholder
);
3393 traverse_intervals_noorder (root_interval
,
3394 &substitute_in_interval
, arg
);
3399 /* Other types don't recurse any further. */
3405 /* Helper function for substitute_object_recurse. */
3407 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3409 Lisp_Object object
= Fcar (arg
);
3410 Lisp_Object placeholder
= Fcdr (arg
);
3412 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3422 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3423 integer syntax and fits in a fixnum, else return the nearest float if CP has
3424 either floating point or integer syntax and BASE is 10, else return nil. If
3425 IGNORE_TRAILING, consider just the longest prefix of CP that has
3426 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3427 number has integer syntax but does not fit. */
3430 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3433 char const *cp
= string
;
3435 bool float_syntax
= 0;
3438 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3439 IEEE floating point hosts, and works around a formerly-common bug where
3440 atof ("-0.0") drops the sign. */
3441 bool negative
= *cp
== '-';
3443 bool signedp
= negative
|| *cp
== '+';
3448 leading_digit
= digit_to_number (*cp
, base
);
3449 if (leading_digit
>= 0)
3454 while (digit_to_number (*cp
, base
) >= 0);
3464 if ('0' <= *cp
&& *cp
<= '9')
3469 while ('0' <= *cp
&& *cp
<= '9');
3471 if (*cp
== 'e' || *cp
== 'E')
3473 char const *ecp
= cp
;
3475 if (*cp
== '+' || *cp
== '-')
3477 if ('0' <= *cp
&& *cp
<= '9')
3482 while ('0' <= *cp
&& *cp
<= '9');
3484 else if (cp
[-1] == '+'
3485 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3491 else if (cp
[-1] == '+'
3492 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3496 /* NAN is a "positive" NaN on all known Emacs hosts. */
3503 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3504 || state
== (LEAD_INT
|E_EXP
));
3507 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3508 any prefix that matches. Otherwise, the entire string must match. */
3509 if (! (ignore_trailing
3510 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3511 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3514 /* If the number uses integer and not float syntax, and is in C-language
3515 range, use its value, preferably as a fixnum. */
3516 if (leading_digit
>= 0 && ! float_syntax
)
3520 /* Fast special case for single-digit integers. This also avoids a
3521 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3522 case some versions of strtoumax accept numbers like "0x1" that Emacs
3524 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3525 return make_number (negative
? -leading_digit
: leading_digit
);
3528 n
= strtoumax (string
+ signedp
, NULL
, base
);
3529 if (errno
== ERANGE
)
3531 /* Unfortunately there's no simple and accurate way to convert
3532 non-base-10 numbers that are out of C-language range. */
3534 xsignal1 (Qoverflow_error
, build_string (string
));
3536 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3538 EMACS_INT signed_n
= n
;
3539 return make_number (negative
? -signed_n
: signed_n
);
3545 /* Either the number uses float syntax, or it does not fit into a fixnum.
3546 Convert it from string to floating point, unless the value is already
3547 known because it is an infinity, a NAN, or its absolute value fits in
3550 value
= atof (string
+ signedp
);
3552 return make_float (negative
? -value
: value
);
3557 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3561 Lisp_Object tem
, item
, vector
;
3562 struct Lisp_Cons
*otem
;
3565 tem
= read_list (1, readcharfun
);
3566 len
= Flength (tem
);
3567 vector
= Fmake_vector (len
, Qnil
);
3569 size
= ASIZE (vector
);
3570 ptr
= XVECTOR (vector
)->contents
;
3571 for (i
= 0; i
< size
; i
++)
3574 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3575 bytecode object, the docstring containing the bytecode and
3576 constants values must be treated as unibyte and passed to
3577 Fread, to get the actual bytecode string and constants vector. */
3578 if (bytecodeflag
&& load_force_doc_strings
)
3580 if (i
== COMPILED_BYTECODE
)
3582 if (!STRINGP (item
))
3583 error ("Invalid byte code");
3585 /* Delay handling the bytecode slot until we know whether
3586 it is lazily-loaded (we can tell by whether the
3587 constants slot is nil). */
3588 ASET (vector
, COMPILED_CONSTANTS
, item
);
3591 else if (i
== COMPILED_CONSTANTS
)
3593 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3597 /* Coerce string to unibyte (like string-as-unibyte,
3598 but without generating extra garbage and
3599 guaranteeing no change in the contents). */
3600 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3601 STRING_SET_UNIBYTE (bytestr
);
3603 item
= Fread (Fcons (bytestr
, readcharfun
));
3605 error ("Invalid byte code");
3607 otem
= XCONS (item
);
3608 bytestr
= XCAR (item
);
3613 /* Now handle the bytecode slot. */
3614 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3616 else if (i
== COMPILED_DOC_STRING
3618 && ! STRING_MULTIBYTE (item
))
3620 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3621 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3623 item
= Fstring_as_multibyte (item
);
3626 ASET (vector
, i
, item
);
3634 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3637 read_list (bool flag
, Lisp_Object readcharfun
)
3639 Lisp_Object val
, tail
;
3640 Lisp_Object elt
, tem
;
3641 /* 0 is the normal case.
3642 1 means this list is a doc reference; replace it with the number 0.
3643 2 means this list is a doc reference; replace it with the doc string. */
3644 int doc_reference
= 0;
3646 /* Initialize this to 1 if we are reading a list. */
3647 bool first_in_list
= flag
<= 0;
3655 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3659 /* While building, if the list starts with #$, treat it specially. */
3660 if (EQ (elt
, Vload_file_name
)
3662 && !NILP (Vpurify_flag
))
3664 if (NILP (Vdoc_file_name
))
3665 /* We have not yet called Snarf-documentation, so assume
3666 this file is described in the DOC file
3667 and Snarf-documentation will fill in the right value later.
3668 For now, replace the whole list with 0. */
3671 /* We have already called Snarf-documentation, so make a relative
3672 file name for this file, so it can be found properly
3673 in the installed Lisp directory.
3674 We don't use Fexpand_file_name because that would make
3675 the directory absolute now. */
3677 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3678 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3681 else if (EQ (elt
, Vload_file_name
)
3683 && load_force_doc_strings
)
3692 invalid_syntax (") or . in a vector");
3699 XSETCDR (tail
, read0 (readcharfun
));
3701 val
= read0 (readcharfun
);
3702 read1 (readcharfun
, &ch
, 0);
3706 if (doc_reference
== 1)
3707 return make_number (0);
3708 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3711 file_offset saved_position
;
3712 /* Get a doc string from the file we are loading.
3713 If it's in saved_doc_string, get it from there.
3715 Here, we don't know if the string is a
3716 bytecode string or a doc string. As a
3717 bytecode string must be unibyte, we always
3718 return a unibyte string. If it is actually a
3719 doc string, caller must make it
3722 /* Position is negative for user variables. */
3723 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3724 if (pos
>= saved_doc_string_position
3725 && pos
< (saved_doc_string_position
3726 + saved_doc_string_length
))
3728 saved
= saved_doc_string
;
3729 saved_position
= saved_doc_string_position
;
3731 /* Look in prev_saved_doc_string the same way. */
3732 else if (pos
>= prev_saved_doc_string_position
3733 && pos
< (prev_saved_doc_string_position
3734 + prev_saved_doc_string_length
))
3736 saved
= prev_saved_doc_string
;
3737 saved_position
= prev_saved_doc_string_position
;
3741 ptrdiff_t start
= pos
- saved_position
;
3744 /* Process quoting with ^A,
3745 and find the end of the string,
3746 which is marked with ^_ (037). */
3747 for (from
= start
, to
= start
;
3748 saved
[from
] != 037;)
3750 int c
= saved
[from
++];
3754 saved
[to
++] = (c
== 1 ? c
3763 return make_unibyte_string (saved
+ start
,
3767 return get_doc_string (val
, 1, 0);
3772 invalid_syntax (". in wrong context");
3774 invalid_syntax ("] in a list");
3778 XSETCDR (tail
, tem
);
3785 static Lisp_Object initial_obarray
;
3787 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3789 static size_t oblookup_last_bucket_number
;
3791 /* Get an error if OBARRAY is not an obarray.
3792 If it is one, return it. */
3795 check_obarray (Lisp_Object obarray
)
3797 /* We don't want to signal a wrong-type-argument error when we are
3798 shutting down due to a fatal error, and we don't want to hit
3799 assertions in VECTORP and ASIZE if the fatal error was during GC. */
3800 if (!fatal_error_in_progress
3801 && (!VECTORP (obarray
) || ASIZE (obarray
) == 0))
3803 /* If Vobarray is now invalid, force it to be valid. */
3804 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3805 wrong_type_argument (Qvectorp
, obarray
);
3810 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3813 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3817 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3818 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3821 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3823 XSYMBOL (sym
)->constant
= 1;
3824 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3825 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3828 ptr
= aref_addr (obarray
, XINT (index
));
3829 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3834 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3837 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3839 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3842 /* Intern the C string STR: return a symbol with that name,
3843 interned in the current obarray. */
3846 intern_1 (const char *str
, ptrdiff_t len
)
3848 Lisp_Object obarray
= check_obarray (Vobarray
);
3849 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3851 return (SYMBOLP (tem
) ? tem
3852 /* The above `oblookup' was done on the basis of nchars==nbytes, so
3853 the string has to be unibyte. */
3854 : intern_driver (make_unibyte_string (str
, len
),
3859 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3861 Lisp_Object obarray
= check_obarray (Vobarray
);
3862 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3866 /* Creating a non-pure string from a string literal not implemented yet.
3867 We could just use make_string here and live with the extra copy. */
3868 eassert (!NILP (Vpurify_flag
));
3869 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3875 define_symbol (Lisp_Object sym
, char const *str
)
3877 ptrdiff_t len
= strlen (str
);
3878 Lisp_Object string
= make_pure_c_string (str
, len
);
3879 init_symbol (sym
, string
);
3881 /* Qunbound is uninterned, so that it's not confused with any symbol
3882 'unbound' created by a Lisp program. */
3883 if (! EQ (sym
, Qunbound
))
3885 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3886 eassert (INTEGERP (bucket
));
3887 intern_sym (sym
, initial_obarray
, bucket
);
3891 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3892 doc
: /* Return the canonical symbol whose name is STRING.
3893 If there is none, one is created by this function and returned.
3894 A second optional argument specifies the obarray to use;
3895 it defaults to the value of `obarray'. */)
3896 (Lisp_Object string
, Lisp_Object obarray
)
3900 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3901 CHECK_STRING (string
);
3903 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3905 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3910 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3911 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3912 NAME may be a string or a symbol. If it is a symbol, that exact
3913 symbol is searched for.
3914 A second optional argument specifies the obarray to use;
3915 it defaults to the value of `obarray'. */)
3916 (Lisp_Object name
, Lisp_Object obarray
)
3918 register Lisp_Object tem
, string
;
3920 if (NILP (obarray
)) obarray
= Vobarray
;
3921 obarray
= check_obarray (obarray
);
3923 if (!SYMBOLP (name
))
3925 CHECK_STRING (name
);
3929 string
= SYMBOL_NAME (name
);
3931 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3932 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3938 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3939 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3940 The value is t if a symbol was found and deleted, nil otherwise.
3941 NAME may be a string or a symbol. If it is a symbol, that symbol
3942 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3943 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3944 usage: (unintern NAME OBARRAY) */)
3945 (Lisp_Object name
, Lisp_Object obarray
)
3947 register Lisp_Object string
, tem
;
3950 if (NILP (obarray
)) obarray
= Vobarray
;
3951 obarray
= check_obarray (obarray
);
3954 string
= SYMBOL_NAME (name
);
3957 CHECK_STRING (name
);
3961 tem
= oblookup (obarray
, SSDATA (string
),
3966 /* If arg was a symbol, don't delete anything but that symbol itself. */
3967 if (SYMBOLP (name
) && !EQ (name
, tem
))
3970 /* There are plenty of other symbols which will screw up the Emacs
3971 session if we unintern them, as well as even more ways to use
3972 `setq' or `fset' or whatnot to make the Emacs session
3973 unusable. Let's not go down this silly road. --Stef */
3974 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3975 error ("Attempt to unintern t or nil"); */
3977 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3979 hash
= oblookup_last_bucket_number
;
3981 if (EQ (AREF (obarray
, hash
), tem
))
3983 if (XSYMBOL (tem
)->next
)
3986 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3987 ASET (obarray
, hash
, sym
);
3990 ASET (obarray
, hash
, make_number (0));
3994 Lisp_Object tail
, following
;
3996 for (tail
= AREF (obarray
, hash
);
3997 XSYMBOL (tail
)->next
;
4000 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
4001 if (EQ (following
, tem
))
4003 set_symbol_next (tail
, XSYMBOL (following
)->next
);
4012 /* Return the symbol in OBARRAY whose names matches the string
4013 of SIZE characters (SIZE_BYTE bytes) at PTR.
4014 If there is no such symbol, return the integer bucket number of
4015 where the symbol would be if it were present.
4017 Also store the bucket number in oblookup_last_bucket_number. */
4020 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
4024 register Lisp_Object tail
;
4025 Lisp_Object bucket
, tem
;
4027 obarray
= check_obarray (obarray
);
4028 /* This is sometimes needed in the middle of GC. */
4029 obsize
= gc_asize (obarray
);
4030 hash
= hash_string (ptr
, size_byte
) % obsize
;
4031 bucket
= AREF (obarray
, hash
);
4032 oblookup_last_bucket_number
= hash
;
4033 if (EQ (bucket
, make_number (0)))
4035 else if (!SYMBOLP (bucket
))
4036 error ("Bad data in guts of obarray"); /* Like CADR error message. */
4038 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
4040 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
4041 && SCHARS (SYMBOL_NAME (tail
)) == size
4042 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
4044 else if (XSYMBOL (tail
)->next
== 0)
4047 XSETINT (tem
, hash
);
4052 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
4055 register Lisp_Object tail
;
4056 CHECK_VECTOR (obarray
);
4057 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
4059 tail
= AREF (obarray
, i
);
4064 if (XSYMBOL (tail
)->next
== 0)
4066 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4072 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4074 call1 (function
, sym
);
4077 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4078 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4079 OBARRAY defaults to the value of `obarray'. */)
4080 (Lisp_Object function
, Lisp_Object obarray
)
4082 if (NILP (obarray
)) obarray
= Vobarray
;
4083 obarray
= check_obarray (obarray
);
4085 map_obarray (obarray
, mapatoms_1
, function
);
4089 #define OBARRAY_SIZE 1511
4094 Lisp_Object oblength
;
4095 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4097 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4099 Vobarray
= Fmake_vector (oblength
, make_number (0));
4100 initial_obarray
= Vobarray
;
4101 staticpro (&initial_obarray
);
4103 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4104 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4106 DEFSYM (Qunbound
, "unbound");
4108 DEFSYM (Qnil
, "nil");
4109 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4110 XSYMBOL (Qnil
)->constant
= 1;
4111 XSYMBOL (Qnil
)->declared_special
= true;
4114 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4115 XSYMBOL (Qt
)->constant
= 1;
4116 XSYMBOL (Qt
)->declared_special
= true;
4118 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4121 DEFSYM (Qvariable_documentation
, "variable-documentation");
4123 read_buffer
= xmalloc (size
);
4124 read_buffer_size
= size
;
4128 defsubr (struct Lisp_Subr
*sname
)
4130 Lisp_Object sym
, tem
;
4131 sym
= intern_c_string (sname
->symbol_name
);
4132 XSETPVECTYPE (sname
, PVEC_SUBR
);
4133 XSETSUBR (tem
, sname
);
4134 set_symbol_function (sym
, tem
);
4137 #ifdef NOTDEF /* Use fset in subr.el now! */
4139 defalias (struct Lisp_Subr
*sname
, char *string
)
4142 sym
= intern (string
);
4143 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4147 /* Define an "integer variable"; a symbol whose value is forwarded to a
4148 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4149 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4151 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4152 const char *namestring
, EMACS_INT
*address
)
4155 sym
= intern_c_string (namestring
);
4156 i_fwd
->type
= Lisp_Fwd_Int
;
4157 i_fwd
->intvar
= address
;
4158 XSYMBOL (sym
)->declared_special
= 1;
4159 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4160 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4163 /* Similar but define a variable whose value is t if address contains 1,
4164 nil if address contains 0. */
4166 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4167 const char *namestring
, bool *address
)
4170 sym
= intern_c_string (namestring
);
4171 b_fwd
->type
= Lisp_Fwd_Bool
;
4172 b_fwd
->boolvar
= address
;
4173 XSYMBOL (sym
)->declared_special
= 1;
4174 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4175 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4176 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4179 /* Similar but define a variable whose value is the Lisp Object stored
4180 at address. Two versions: with and without gc-marking of the C
4181 variable. The nopro version is used when that variable will be
4182 gc-marked for some other reason, since marking the same slot twice
4183 can cause trouble with strings. */
4185 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4186 const char *namestring
, Lisp_Object
*address
)
4189 sym
= intern_c_string (namestring
);
4190 o_fwd
->type
= Lisp_Fwd_Obj
;
4191 o_fwd
->objvar
= address
;
4192 XSYMBOL (sym
)->declared_special
= 1;
4193 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4194 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4198 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4199 const char *namestring
, Lisp_Object
*address
)
4201 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4202 staticpro (address
);
4205 /* Similar but define a variable whose value is the Lisp Object stored
4206 at a particular offset in the current kboard object. */
4209 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4210 const char *namestring
, int offset
)
4213 sym
= intern_c_string (namestring
);
4214 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4215 ko_fwd
->offset
= offset
;
4216 XSYMBOL (sym
)->declared_special
= 1;
4217 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4218 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4221 /* Check that the elements of lpath exist. */
4224 load_path_check (Lisp_Object lpath
)
4226 Lisp_Object path_tail
;
4228 /* The only elements that might not exist are those from
4229 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4231 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4233 Lisp_Object dirfile
;
4234 dirfile
= Fcar (path_tail
);
4235 if (STRINGP (dirfile
))
4237 dirfile
= Fdirectory_file_name (dirfile
);
4238 if (! file_accessible_directory_p (dirfile
))
4239 dir_warning ("Lisp directory", XCAR (path_tail
));
4244 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4245 This does not include the standard site-lisp directories
4246 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4247 but it does (unless no_site_lisp is set) include site-lisp
4248 directories in the source/build directories if those exist and we
4249 are running uninstalled.
4251 Uses the following logic:
4252 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4253 The remainder is what happens when dumping works:
4254 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4255 Otherwise use PATH_LOADSEARCH.
4257 If !initialized, then just return PATH_DUMPLOADSEARCH.
4259 If Vinstallation_directory is not nil (ie, running uninstalled):
4260 If installation-dir/lisp exists and not already a member,
4261 we must be running uninstalled. Reset the load-path
4262 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4263 refers to the eventual installation directories. Since we
4264 are not yet installed, we should not use them, even if they exist.)
4265 If installation-dir/lisp does not exist, just add
4266 PATH_DUMPLOADSEARCH at the end instead.
4267 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4268 and not already a member) at the front.
4269 If installation-dir != source-dir (ie running an uninstalled,
4270 out-of-tree build) AND install-dir/src/Makefile exists BUT
4271 install-dir/src/Makefile.in does NOT exist (this is a sanity
4272 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4275 load_path_default (void)
4277 Lisp_Object lpath
= Qnil
;
4282 const char *loadpath
= ns_load_path ();
4285 normal
= PATH_LOADSEARCH
;
4287 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4289 lpath
= decode_env_path (0, normal
, 0);
4292 #else /* !CANNOT_DUMP */
4294 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4299 const char *loadpath
= ns_load_path ();
4300 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4302 lpath
= decode_env_path (0, normal
, 0);
4304 if (!NILP (Vinstallation_directory
))
4306 Lisp_Object tem
, tem1
;
4308 /* Add to the path the lisp subdir of the installation
4309 dir, if it is accessible. Note: in out-of-tree builds,
4310 this directory is empty save for Makefile. */
4311 tem
= Fexpand_file_name (build_string ("lisp"),
4312 Vinstallation_directory
);
4313 tem1
= Ffile_accessible_directory_p (tem
);
4316 if (NILP (Fmember (tem
, lpath
)))
4318 /* We are running uninstalled. The default load-path
4319 points to the eventual installed lisp directories.
4320 We should not use those now, even if they exist,
4321 so start over from a clean slate. */
4322 lpath
= list1 (tem
);
4326 /* That dir doesn't exist, so add the build-time
4327 Lisp dirs instead. */
4329 Lisp_Object dump_path
=
4330 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4331 lpath
= nconc2 (lpath
, dump_path
);
4334 /* Add site-lisp under the installation dir, if it exists. */
4337 tem
= Fexpand_file_name (build_string ("site-lisp"),
4338 Vinstallation_directory
);
4339 tem1
= Ffile_accessible_directory_p (tem
);
4342 if (NILP (Fmember (tem
, lpath
)))
4343 lpath
= Fcons (tem
, lpath
);
4347 /* If Emacs was not built in the source directory,
4348 and it is run from where it was built, add to load-path
4349 the lisp and site-lisp dirs under that directory. */
4351 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4355 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4356 Vinstallation_directory
);
4357 tem1
= Ffile_exists_p (tem
);
4359 /* Don't be fooled if they moved the entire source tree
4360 AFTER dumping Emacs. If the build directory is indeed
4361 different from the source dir, src/Makefile.in and
4362 src/Makefile will not be found together. */
4363 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4364 Vinstallation_directory
);
4365 tem2
= Ffile_exists_p (tem
);
4366 if (!NILP (tem1
) && NILP (tem2
))
4368 tem
= Fexpand_file_name (build_string ("lisp"),
4371 if (NILP (Fmember (tem
, lpath
)))
4372 lpath
= Fcons (tem
, lpath
);
4376 tem
= Fexpand_file_name (build_string ("site-lisp"),
4378 tem1
= Ffile_accessible_directory_p (tem
);
4381 if (NILP (Fmember (tem
, lpath
)))
4382 lpath
= Fcons (tem
, lpath
);
4386 } /* Vinstallation_directory != Vsource_directory */
4388 } /* if Vinstallation_directory */
4390 else /* !initialized */
4392 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4393 source directory. We used to add ../lisp (ie the lisp dir in
4394 the build directory) at the front here, but that should not
4395 be necessary, since in out of tree builds lisp/ is empty, save
4397 lpath
= decode_env_path (0, normal
, 0);
4399 #endif /* !CANNOT_DUMP */
4407 /* First, set Vload_path. */
4409 /* Ignore EMACSLOADPATH when dumping. */
4411 bool use_loadpath
= true;
4413 bool use_loadpath
= NILP (Vpurify_flag
);
4416 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4418 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4420 /* Check (non-nil) user-supplied elements. */
4421 load_path_check (Vload_path
);
4423 /* If no nils in the environment variable, use as-is.
4424 Otherwise, replace any nils with the default. */
4425 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4427 Lisp_Object elem
, elpath
= Vload_path
;
4428 Lisp_Object default_lpath
= load_path_default ();
4430 /* Check defaults, before adding site-lisp. */
4431 load_path_check (default_lpath
);
4433 /* Add the site-lisp directories to the front of the default. */
4434 if (!no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4436 Lisp_Object sitelisp
;
4437 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4438 if (! NILP (sitelisp
))
4439 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4444 /* Replace nils from EMACSLOADPATH by default. */
4445 while (CONSP (elpath
))
4447 elem
= XCAR (elpath
);
4448 elpath
= XCDR (elpath
);
4449 Vload_path
= CALLN (Fappend
, Vload_path
,
4450 NILP (elem
) ? default_lpath
: list1 (elem
));
4452 } /* Fmemq (Qnil, Vload_path) */
4456 Vload_path
= load_path_default ();
4458 /* Check before adding site-lisp directories.
4459 The install should have created them, but they are not
4460 required, so no need to warn if they are absent.
4461 Or we might be running before installation. */
4462 load_path_check (Vload_path
);
4464 /* Add the site-lisp directories at the front. */
4465 if (initialized
&& !no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4467 Lisp_Object sitelisp
;
4468 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4469 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4475 load_in_progress
= 0;
4476 Vload_file_name
= Qnil
;
4477 Vstandard_input
= Qt
;
4478 Vloads_in_progress
= Qnil
;
4481 /* Print a warning that directory intended for use USE and with name
4482 DIRNAME cannot be accessed. On entry, errno should correspond to
4483 the access failure. Print the warning on stderr and put it in
4487 dir_warning (char const *use
, Lisp_Object dirname
)
4489 static char const format
[] = "Warning: %s '%s': %s\n";
4490 char *diagnostic
= emacs_strerror (errno
);
4491 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)), diagnostic
);
4493 /* Don't log the warning before we've initialized!! */
4496 ptrdiff_t diaglen
= strlen (diagnostic
);
4497 AUTO_STRING_WITH_LEN (diag
, diagnostic
, diaglen
);
4498 if (! NILP (Vlocale_coding_system
))
4501 = code_convert_string_norecord (diag
, Vlocale_coding_system
, false);
4502 diagnostic
= SSDATA (s
);
4503 diaglen
= SBYTES (s
);
4506 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4507 + strlen (use
) + SBYTES (dirname
) + diaglen
);
4508 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4510 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4516 syms_of_lread (void)
4519 defsubr (&Sread_from_string
);
4521 defsubr (&Sintern_soft
);
4522 defsubr (&Sunintern
);
4523 defsubr (&Sget_load_suffixes
);
4525 defsubr (&Seval_buffer
);
4526 defsubr (&Seval_region
);
4527 defsubr (&Sread_char
);
4528 defsubr (&Sread_char_exclusive
);
4529 defsubr (&Sread_event
);
4530 defsubr (&Sget_file_char
);
4531 defsubr (&Smapatoms
);
4532 defsubr (&Slocate_file_internal
);
4534 DEFVAR_LISP ("obarray", Vobarray
,
4535 doc
: /* Symbol table for use by `intern' and `read'.
4536 It is a vector whose length ought to be prime for best results.
4537 The vector's contents don't make sense if examined from Lisp programs;
4538 to find all the symbols in an obarray, use `mapatoms'. */);
4540 DEFVAR_LISP ("values", Vvalues
,
4541 doc
: /* List of values of all expressions which were read, evaluated and printed.
4542 Order is reverse chronological. */);
4543 XSYMBOL (intern ("values"))->declared_special
= 0;
4545 DEFVAR_LISP ("standard-input", Vstandard_input
,
4546 doc
: /* Stream for read to get input from.
4547 See documentation of `read' for possible values. */);
4548 Vstandard_input
= Qt
;
4550 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4551 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4553 If this variable is a buffer, then only forms read from that buffer
4554 will be added to `read-symbol-positions-list'.
4555 If this variable is t, then all read forms will be added.
4556 The effect of all other values other than nil are not currently
4557 defined, although they may be in the future.
4559 The positions are relative to the last call to `read' or
4560 `read-from-string'. It is probably a bad idea to set this variable at
4561 the toplevel; bind it instead. */);
4562 Vread_with_symbol_positions
= Qnil
;
4564 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4565 doc
: /* A list mapping read symbols to their positions.
4566 This variable is modified during calls to `read' or
4567 `read-from-string', but only when `read-with-symbol-positions' is
4570 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4571 CHAR-POSITION is an integer giving the offset of that occurrence of the
4572 symbol from the position where `read' or `read-from-string' started.
4574 Note that a symbol will appear multiple times in this list, if it was
4575 read multiple times. The list is in the same order as the symbols
4577 Vread_symbol_positions_list
= Qnil
;
4579 DEFVAR_LISP ("read-circle", Vread_circle
,
4580 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4583 DEFVAR_LISP ("load-path", Vload_path
,
4584 doc
: /* List of directories to search for files to load.
4585 Each element is a string (directory file name) or nil (meaning
4586 `default-directory').
4587 This list is consulted by the `require' function.
4588 Initialized during startup as described in Info node `(elisp)Library Search'.
4589 Use `directory-file-name' when adding items to this path. However, Lisp
4590 programs that process this list should tolerate directories both with
4591 and without trailing slashes. */);
4593 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4594 doc
: /* List of suffixes for Emacs Lisp files and dynamic modules.
4595 This list includes suffixes for both compiled and source Emacs Lisp files.
4596 This list should not include the empty string.
4597 `load' and related functions try to append these suffixes, in order,
4598 to the specified file name if a suffix is allowed or required. */);
4600 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4601 build_pure_c_string (".el"),
4602 build_pure_c_string (MODULES_SUFFIX
));
4604 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4605 build_pure_c_string (".el"));
4607 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix
,
4608 doc
: /* Suffix of loadable module file, or nil of modules are not supported. */);
4610 Vmodule_file_suffix
= build_pure_c_string (MODULES_SUFFIX
);
4612 Vmodule_file_suffix
= Qnil
;
4614 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4615 doc
: /* List of suffixes that indicate representations of \
4617 This list should normally start with the empty string.
4619 Enabling Auto Compression mode appends the suffixes in
4620 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4621 mode removes them again. `load' and related functions use this list to
4622 determine whether they should look for compressed versions of a file
4623 and, if so, which suffixes they should try to append to the file name
4624 in order to do so. However, if you want to customize which suffixes
4625 the loading functions recognize as compression suffixes, you should
4626 customize `jka-compr-load-suffixes' rather than the present variable. */);
4627 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4629 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4630 doc
: /* Non-nil if inside of `load'. */);
4631 DEFSYM (Qload_in_progress
, "load-in-progress");
4633 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4634 doc
: /* An alist of functions to be evalled when particular files are loaded.
4635 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4637 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4638 a symbol (a feature name).
4640 When `load' is run and the file-name argument matches an element's
4641 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4642 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4644 An error in FORMS does not undo the load, but does prevent execution of
4645 the rest of the FORMS. */);
4646 Vafter_load_alist
= Qnil
;
4648 DEFVAR_LISP ("load-history", Vload_history
,
4649 doc
: /* Alist mapping loaded file names to symbols and features.
4650 Each alist element should be a list (FILE-NAME ENTRIES...), where
4651 FILE-NAME is the name of a file that has been loaded into Emacs.
4652 The file name is absolute and true (i.e. it doesn't contain symlinks).
4653 As an exception, one of the alist elements may have FILE-NAME nil,
4654 for symbols and features not associated with any file.
4656 The remaining ENTRIES in the alist element describe the functions and
4657 variables defined in that file, the features provided, and the
4658 features required. Each entry has the form `(provide . FEATURE)',
4659 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4660 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4661 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4662 autoload before this file redefined it as a function. In addition,
4663 entries may also be single symbols, which means that SYMBOL was
4664 defined by `defvar' or `defconst'.
4666 During preloading, the file name recorded is relative to the main Lisp
4667 directory. These file names are converted to absolute at startup. */);
4668 Vload_history
= Qnil
;
4670 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4671 doc
: /* Full name of file being loaded by `load'. */);
4672 Vload_file_name
= Qnil
;
4674 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4675 doc
: /* File name, including directory, of user's initialization file.
4676 If the file loaded had extension `.elc', and the corresponding source file
4677 exists, this variable contains the name of source file, suitable for use
4678 by functions like `custom-save-all' which edit the init file.
4679 While Emacs loads and evaluates the init file, value is the real name
4680 of the file, regardless of whether or not it has the `.elc' extension. */);
4681 Vuser_init_file
= Qnil
;
4683 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4684 doc
: /* Used for internal purposes by `load'. */);
4685 Vcurrent_load_list
= Qnil
;
4687 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4688 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4689 Called with a single argument (the stream from which to read).
4690 The default is to use the function `read'. */);
4691 DEFSYM (Qread
, "read");
4692 Vload_read_function
= Qread
;
4694 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4695 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4696 The value should be a function for doing code conversion before
4697 reading a source file. It can also be nil, in which case loading is
4698 done without any code conversion.
4700 If the value is a function, it is called with four arguments,
4701 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4702 the file to load, FILE is the non-absolute name (for messages etc.),
4703 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4704 `load'. The function should return t if the file was loaded. */);
4705 Vload_source_file_function
= Qnil
;
4707 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4708 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4709 This is useful when the file being loaded is a temporary copy. */);
4710 load_force_doc_strings
= 0;
4712 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4713 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4714 This is normally bound by `load' and `eval-buffer' to control `read',
4715 and is not meant for users to change. */);
4716 load_convert_to_unibyte
= 0;
4718 DEFVAR_LISP ("source-directory", Vsource_directory
,
4719 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4720 You cannot count on them to still be there! */);
4722 = Fexpand_file_name (build_string ("../"),
4723 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4725 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4726 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4727 Vpreloaded_file_list
= Qnil
;
4729 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4730 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4731 Vbyte_boolean_vars
= Qnil
;
4733 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4734 doc
: /* Non-nil means load dangerous compiled Lisp files.
4735 Some versions of XEmacs use different byte codes than Emacs. These
4736 incompatible byte codes can make Emacs crash when it tries to execute
4738 load_dangerous_libraries
= 0;
4740 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4741 doc
: /* Non-nil means force printing messages when loading Lisp files.
4742 This overrides the value of the NOMESSAGE argument to `load'. */);
4743 force_load_messages
= 0;
4745 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4746 doc
: /* Regular expression matching safe to load compiled Lisp files.
4747 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4748 from the file, and matches them against this regular expression.
4749 When the regular expression matches, the file is considered to be safe
4750 to load. See also `load-dangerous-libraries'. */);
4751 Vbytecomp_version_regexp
4752 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4754 DEFSYM (Qlexical_binding
, "lexical-binding");
4755 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4756 doc
: /* Whether to use lexical binding when evaluating code.
4757 Non-nil means that the code in the current buffer should be evaluated
4758 with lexical binding.
4759 This variable is automatically set from the file variables of an
4760 interpreted Lisp file read using `load'. Unlike other file local
4761 variables, this must be set in the first line of a file. */);
4762 Vlexical_binding
= Qnil
;
4763 Fmake_variable_buffer_local (Qlexical_binding
);
4765 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4766 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4767 Veval_buffer_list
= Qnil
;
4769 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4770 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4771 Vold_style_backquotes
= Qnil
;
4772 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4774 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4775 doc
: /* Non-nil means `load' prefers the newest version of a file.
4776 This applies when a filename suffix is not explicitly specified and
4777 `load' is trying various possible suffixes (see `load-suffixes' and
4778 `load-file-rep-suffixes'). Normally, it stops at the first file
4779 that exists unless you explicitly specify one or the other. If this
4780 option is non-nil, it checks all suffixes and uses whichever file is
4782 Note that if you customize this, obviously it will not affect files
4783 that are loaded before your customizations are read! */);
4784 load_prefer_newer
= 0;
4786 /* Vsource_directory was initialized in init_lread. */
4788 DEFSYM (Qcurrent_load_list
, "current-load-list");
4789 DEFSYM (Qstandard_input
, "standard-input");
4790 DEFSYM (Qread_char
, "read-char");
4791 DEFSYM (Qget_file_char
, "get-file-char");
4793 /* Used instead of Qget_file_char while loading *.elc files compiled
4794 by Emacs 21 or older. */
4795 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4797 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4799 DEFSYM (Qbackquote
, "`");
4800 DEFSYM (Qcomma
, ",");
4801 DEFSYM (Qcomma_at
, ",@");
4802 DEFSYM (Qcomma_dot
, ",.");
4804 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4805 DEFSYM (Qascii_character
, "ascii-character");
4806 DEFSYM (Qfunction
, "function");
4807 DEFSYM (Qload
, "load");
4808 DEFSYM (Qload_file_name
, "load-file-name");
4809 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4810 DEFSYM (Qfile_truename
, "file-truename");
4811 DEFSYM (Qdir_ok
, "dir-ok");
4812 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4814 staticpro (&read_objects
);
4815 read_objects
= Qnil
;
4816 staticpro (&seen_list
);
4819 Vloads_in_progress
= Qnil
;
4820 staticpro (&Vloads_in_progress
);
4822 DEFSYM (Qhash_table
, "hash-table");
4823 DEFSYM (Qdata
, "data");
4824 DEFSYM (Qtest
, "test");
4825 DEFSYM (Qsize
, "size");
4826 DEFSYM (Qweakness
, "weakness");
4827 DEFSYM (Qrehash_size
, "rehash-size");
4828 DEFSYM (Qrehash_threshold
, "rehash-threshold");
4830 DEFSYM (Qchar_from_name
, "char-from-name");