1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2016 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 /* Tell globals.h to define tables needed by init_obarray. */
22 #define DEFINE_SYMBOLS
26 #include <sys/types.h>
30 #include <limits.h> /* For CHAR_BIT. */
32 #include <stat-time.h>
34 #include "dispextern.h"
35 #include "intervals.h"
36 #include "character.h"
44 #include "termhooks.h"
45 #include "blockinput.h"
61 #endif /* HAVE_SETLOCALE */
66 #define file_offset off_t
67 #define file_tell ftello
69 #define file_offset long
70 #define file_tell ftell
73 /* The association list of objects read with the #n=object form.
74 Each member of the list has the form (n . object), and is used to
75 look up the object for the corresponding #n# construct.
76 It must be set to nil before all top-level calls to read0. */
77 static Lisp_Object read_objects
;
79 /* File for get_file_char to read from. Use by load. */
80 static FILE *instream
;
82 /* For use within read-from-string (this reader is non-reentrant!!) */
83 static ptrdiff_t read_from_string_index
;
84 static ptrdiff_t read_from_string_index_byte
;
85 static ptrdiff_t read_from_string_limit
;
87 /* Number of characters read in the current call to Fread or
89 static EMACS_INT readchar_count
;
91 /* This contains the last string skipped with #@. */
92 static char *saved_doc_string
;
93 /* Length of buffer allocated in saved_doc_string. */
94 static ptrdiff_t saved_doc_string_size
;
95 /* Length of actual data in saved_doc_string. */
96 static ptrdiff_t saved_doc_string_length
;
97 /* This is the file position that string came from. */
98 static file_offset saved_doc_string_position
;
100 /* This contains the previous string skipped with #@.
101 We copy it from saved_doc_string when a new string
102 is put in saved_doc_string. */
103 static char *prev_saved_doc_string
;
104 /* Length of buffer allocated in prev_saved_doc_string. */
105 static ptrdiff_t prev_saved_doc_string_size
;
106 /* Length of actual data in prev_saved_doc_string. */
107 static ptrdiff_t prev_saved_doc_string_length
;
108 /* This is the file position that string came from. */
109 static file_offset prev_saved_doc_string_position
;
111 /* True means inside a new-style backquote
112 with no surrounding parentheses.
113 Fread initializes this to false, so we need not specbind it
114 or worry about what happens to it when there is an error. */
115 static bool new_backquote_flag
;
117 /* A list of file names for files being loaded in Fload. Used to
118 check for recursive loads. */
120 static Lisp_Object Vloads_in_progress
;
122 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
125 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
126 Lisp_Object
, Lisp_Object
,
127 Lisp_Object
, Lisp_Object
);
129 /* Functions that read one byte from the current source READCHARFUN
130 or unreads one byte. If the integer argument C is -1, it returns
131 one read byte, or -1 when there's no more byte in the source. If C
132 is 0 or positive, it unreads C, and the return value is not
135 static int readbyte_for_lambda (int, Lisp_Object
);
136 static int readbyte_from_file (int, Lisp_Object
);
137 static int readbyte_from_string (int, Lisp_Object
);
139 /* Handle unreading and rereading of characters.
140 Write READCHAR to read a character,
141 UNREAD(c) to unread c to be read again.
143 These macros correctly read/unread multibyte characters. */
145 #define READCHAR readchar (readcharfun, NULL)
146 #define UNREAD(c) unreadchar (readcharfun, c)
148 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
149 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
151 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
152 Qlambda, or a cons, we use this to keep an unread character because
153 a file stream can't handle multibyte-char unreading. The value -1
154 means that there's no unread character. */
155 static int unread_char
;
158 readchar (Lisp_Object readcharfun
, bool *multibyte
)
162 int (*readbyte
) (int, Lisp_Object
);
163 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
165 bool emacs_mule_encoding
= 0;
172 if (BUFFERP (readcharfun
))
174 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
176 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
178 if (! BUFFER_LIVE_P (inbuffer
))
181 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
184 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
186 /* Fetch the character code from the buffer. */
187 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
188 BUF_INC_POS (inbuffer
, pt_byte
);
195 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
196 if (! ASCII_CHAR_P (c
))
197 c
= BYTE8_TO_CHAR (c
);
200 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
204 if (MARKERP (readcharfun
))
206 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
208 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
210 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
213 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
215 /* Fetch the character code from the buffer. */
216 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
217 BUF_INC_POS (inbuffer
, bytepos
);
224 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
225 if (! ASCII_CHAR_P (c
))
226 c
= BYTE8_TO_CHAR (c
);
230 XMARKER (readcharfun
)->bytepos
= bytepos
;
231 XMARKER (readcharfun
)->charpos
++;
236 if (EQ (readcharfun
, Qlambda
))
238 readbyte
= readbyte_for_lambda
;
242 if (EQ (readcharfun
, Qget_file_char
))
244 readbyte
= readbyte_from_file
;
248 if (STRINGP (readcharfun
))
250 if (read_from_string_index
>= read_from_string_limit
)
252 else if (STRING_MULTIBYTE (readcharfun
))
256 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
257 read_from_string_index
,
258 read_from_string_index_byte
);
262 c
= SREF (readcharfun
, read_from_string_index_byte
);
263 read_from_string_index
++;
264 read_from_string_index_byte
++;
269 if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
271 /* This is the case that read_vector is reading from a unibyte
272 string that contains a byte sequence previously skipped
273 because of #@NUMBER. The car part of readcharfun is that
274 string, and the cdr part is a value of readcharfun given to
276 readbyte
= readbyte_from_string
;
277 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
278 emacs_mule_encoding
= 1;
282 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
284 readbyte
= readbyte_from_file
;
285 emacs_mule_encoding
= 1;
289 tem
= call0 (readcharfun
);
296 if (unread_char
>= 0)
302 c
= (*readbyte
) (-1, readcharfun
);
307 if (ASCII_CHAR_P (c
))
309 if (emacs_mule_encoding
)
310 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
313 len
= BYTES_BY_CHAR_HEAD (c
);
316 c
= (*readbyte
) (-1, readcharfun
);
317 if (c
< 0 || ! TRAILING_CODE_P (c
))
320 (*readbyte
) (buf
[i
], readcharfun
);
321 return BYTE8_TO_CHAR (buf
[0]);
325 return STRING_CHAR (buf
);
328 #define FROM_FILE_P(readcharfun) \
329 (EQ (readcharfun, Qget_file_char) \
330 || EQ (readcharfun, Qget_emacs_mule_file_char))
333 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
335 if (FROM_FILE_P (readcharfun
))
337 block_input (); /* FIXME: Not sure if it's needed. */
338 fseek (instream
, n
, SEEK_CUR
);
342 { /* We're not reading directly from a file. In that case, it's difficult
343 to reliably count bytes, since these are usually meant for the file's
344 encoding, whereas we're now typically in the internal encoding.
345 But luckily, skip_dyn_bytes is used to skip over a single
346 dynamic-docstring (or dynamic byte-code) which is always quoted such
347 that \037 is the final char. */
351 } while (c
>= 0 && c
!= '\037');
356 skip_dyn_eof (Lisp_Object readcharfun
)
358 if (FROM_FILE_P (readcharfun
))
360 block_input (); /* FIXME: Not sure if it's needed. */
361 fseek (instream
, 0, SEEK_END
);
365 while (READCHAR
>= 0);
368 /* Unread the character C in the way appropriate for the stream READCHARFUN.
369 If the stream is a user function, call it with the char as argument. */
372 unreadchar (Lisp_Object readcharfun
, int c
)
376 /* Don't back up the pointer if we're unreading the end-of-input mark,
377 since readchar didn't advance it when we read it. */
379 else if (BUFFERP (readcharfun
))
381 struct buffer
*b
= XBUFFER (readcharfun
);
382 ptrdiff_t charpos
= BUF_PT (b
);
383 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
385 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
386 BUF_DEC_POS (b
, bytepos
);
390 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
392 else if (MARKERP (readcharfun
))
394 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
395 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
397 XMARKER (readcharfun
)->charpos
--;
398 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
399 BUF_DEC_POS (b
, bytepos
);
403 XMARKER (readcharfun
)->bytepos
= bytepos
;
405 else if (STRINGP (readcharfun
))
407 read_from_string_index
--;
408 read_from_string_index_byte
409 = string_char_to_byte (readcharfun
, read_from_string_index
);
411 else if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
415 else if (EQ (readcharfun
, Qlambda
))
419 else if (FROM_FILE_P (readcharfun
))
424 call1 (readcharfun
, make_number (c
));
428 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
430 return read_bytecode_char (c
>= 0);
435 readbyte_from_file (int c
, Lisp_Object readcharfun
)
440 ungetc (c
, instream
);
448 /* Interrupted reads have been observed while reading over the network. */
449 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
460 return (c
== EOF
? -1 : c
);
464 readbyte_from_string (int c
, Lisp_Object readcharfun
)
466 Lisp_Object string
= XCAR (readcharfun
);
470 read_from_string_index
--;
471 read_from_string_index_byte
472 = string_char_to_byte (string
, read_from_string_index
);
475 if (read_from_string_index
>= read_from_string_limit
)
478 FETCH_STRING_CHAR_ADVANCE (c
, string
,
479 read_from_string_index
,
480 read_from_string_index_byte
);
485 /* Read one non-ASCII character from INSTREAM. The character is
486 encoded in `emacs-mule' and the first byte is already read in
490 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
492 /* Emacs-mule coding uses at most 4-byte for one character. */
493 unsigned char buf
[4];
494 int len
= emacs_mule_bytes
[c
];
495 struct charset
*charset
;
500 /* C is not a valid leading-code of `emacs-mule'. */
501 return BYTE8_TO_CHAR (c
);
507 c
= (*readbyte
) (-1, readcharfun
);
511 (*readbyte
) (buf
[i
], readcharfun
);
512 return BYTE8_TO_CHAR (buf
[0]);
519 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
520 code
= buf
[1] & 0x7F;
524 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
525 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
527 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
528 code
= buf
[2] & 0x7F;
532 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
533 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
538 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
539 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
541 c
= DECODE_CHAR (charset
, code
);
543 Fsignal (Qinvalid_read_syntax
,
544 list1 (build_string ("invalid multibyte form")));
549 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
551 static Lisp_Object
read0 (Lisp_Object
);
552 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
554 static Lisp_Object
read_list (bool, Lisp_Object
);
555 static Lisp_Object
read_vector (Lisp_Object
, bool);
557 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
559 static void substitute_object_in_subtree (Lisp_Object
,
561 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
564 /* Get a character from the tty. */
566 /* Read input events until we get one that's acceptable for our purposes.
568 If NO_SWITCH_FRAME, switch-frame events are stashed
569 until we get a character we like, and then stuffed into
572 If ASCII_REQUIRED, check function key events to see
573 if the unmodified version of the symbol has a Qascii_character
574 property, and use that character, if present.
576 If ERROR_NONASCII, signal an error if the input we
577 get isn't an ASCII character with modifiers. If it's false but
578 ASCII_REQUIRED is true, just re-read until we get an ASCII
581 If INPUT_METHOD, invoke the current input method
582 if the character warrants that.
584 If SECONDS is a number, wait that many seconds for input, and
585 return Qnil if no input arrives within that time. */
588 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
589 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
591 Lisp_Object val
, delayed_switch_frame
;
592 struct timespec end_time
;
594 #ifdef HAVE_WINDOW_SYSTEM
595 if (display_hourglass_p
)
599 delayed_switch_frame
= Qnil
;
601 /* Compute timeout. */
602 if (NUMBERP (seconds
))
604 double duration
= extract_float (seconds
);
605 struct timespec wait_time
= dtotimespec (duration
);
606 end_time
= timespec_add (current_timespec (), wait_time
);
609 /* Read until we get an acceptable event. */
612 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
613 NUMBERP (seconds
) ? &end_time
: NULL
);
614 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
619 /* `switch-frame' events are put off until after the next ASCII
620 character. This is better than signaling an error just because
621 the last characters were typed to a separate minibuffer frame,
622 for example. Eventually, some code which can deal with
623 switch-frame events will read it and process it. */
625 && EVENT_HAS_PARAMETERS (val
)
626 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
628 delayed_switch_frame
= val
;
632 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
634 /* Convert certain symbols to their ASCII equivalents. */
637 Lisp_Object tem
, tem1
;
638 tem
= Fget (val
, Qevent_symbol_element_mask
);
641 tem1
= Fget (Fcar (tem
), Qascii_character
);
642 /* Merge this symbol's modifier bits
643 with the ASCII equivalent of its basic code. */
645 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
649 /* If we don't have a character now, deal with it appropriately. */
654 Vunread_command_events
= list1 (val
);
655 error ("Non-character input-event");
662 if (! NILP (delayed_switch_frame
))
663 unread_switch_frame
= delayed_switch_frame
;
667 #ifdef HAVE_WINDOW_SYSTEM
668 if (display_hourglass_p
)
677 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
678 doc
: /* Read a character from the command input (keyboard or macro).
679 It is returned as a number.
680 If the character has modifiers, they are resolved and reflected to the
681 character code if possible (e.g. C-SPC -> 0).
683 If the user generates an event which is not a character (i.e. a mouse
684 click or function key event), `read-char' signals an error. As an
685 exception, switch-frame events are put off until non-character events
687 If you want to read non-character events, or ignore them, call
688 `read-event' or `read-char-exclusive' instead.
690 If the optional argument PROMPT is non-nil, display that as a prompt.
691 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
692 input method is turned on in the current buffer, that input method
693 is used for reading a character.
694 If the optional argument SECONDS is non-nil, it should be a number
695 specifying the maximum number of seconds to wait for input. If no
696 input arrives in that time, return nil. SECONDS may be a
697 floating-point value. */)
698 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
703 message_with_string ("%s", prompt
, 0);
704 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
706 return (NILP (val
) ? Qnil
707 : make_number (char_resolve_modifier_mask (XINT (val
))));
710 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
711 doc
: /* Read an event object from the input stream.
712 If the optional argument PROMPT is non-nil, display that as a prompt.
713 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
714 input method is turned on in the current buffer, that input method
715 is used for reading a character.
716 If the optional argument SECONDS is non-nil, it should be a number
717 specifying the maximum number of seconds to wait for input. If no
718 input arrives in that time, return nil. SECONDS may be a
719 floating-point value. */)
720 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
723 message_with_string ("%s", prompt
, 0);
724 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
727 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
728 doc
: /* Read a character from the command input (keyboard or macro).
729 It is returned as a number. Non-character events are ignored.
730 If the character has modifiers, they are resolved and reflected to the
731 character code if possible (e.g. C-SPC -> 0).
733 If the optional argument PROMPT is non-nil, display that as a prompt.
734 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
735 input method is turned on in the current buffer, that input method
736 is used for reading a character.
737 If the optional argument SECONDS is non-nil, it should be a number
738 specifying the maximum number of seconds to wait for input. If no
739 input arrives in that time, return nil. SECONDS may be a
740 floating-point value. */)
741 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
746 message_with_string ("%s", prompt
, 0);
748 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
750 return (NILP (val
) ? Qnil
751 : make_number (char_resolve_modifier_mask (XINT (val
))));
754 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
755 doc
: /* Don't use this yourself. */)
758 register Lisp_Object val
;
760 XSETINT (val
, getc (instream
));
768 /* Return true if the lisp code read using READCHARFUN defines a non-nil
769 `lexical-binding' file variable. After returning, the stream is
770 positioned following the first line, if it is a comment or #! line,
771 otherwise nothing is read. */
774 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
787 while (ch
!= '\n' && ch
!= EOF
)
789 if (ch
== '\n') ch
= READCHAR
;
790 /* It is OK to leave the position after a #! line, since
791 that is what read1 does. */
795 /* The first line isn't a comment, just give up. */
801 /* Look for an appropriate file-variable in the first line. */
805 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
806 } beg_end_state
= NOMINAL
;
807 bool in_file_vars
= 0;
809 #define UPDATE_BEG_END_STATE(ch) \
810 if (beg_end_state == NOMINAL) \
811 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
812 else if (beg_end_state == AFTER_FIRST_DASH) \
813 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
814 else if (beg_end_state == AFTER_ASTERIX) \
817 in_file_vars = !in_file_vars; \
818 beg_end_state = NOMINAL; \
821 /* Skip until we get to the file vars, if any. */
825 UPDATE_BEG_END_STATE (ch
);
827 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
831 char var
[100], val
[100];
836 /* Read a variable name. */
837 while (ch
== ' ' || ch
== '\t')
841 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
843 if (i
< sizeof var
- 1)
845 UPDATE_BEG_END_STATE (ch
);
849 /* Stop scanning if no colon was found before end marker. */
850 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
853 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
859 /* Read a variable value. */
862 while (ch
== ' ' || ch
== '\t')
866 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
868 if (i
< sizeof val
- 1)
870 UPDATE_BEG_END_STATE (ch
);
874 /* The value was terminated by an end-marker, which remove. */
876 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
880 if (strcmp (var
, "lexical-binding") == 0)
883 rv
= (strcmp (val
, "nil") != 0);
889 while (ch
!= '\n' && ch
!= EOF
)
896 /* Value is a version number of byte compiled code if the file
897 associated with file descriptor FD is a compiled Lisp file that's
898 safe to load. Only files compiled with Emacs are safe to load.
899 Files compiled with XEmacs can lead to a crash in Fbyte_code
900 because of an incompatible change in the byte compiler. */
903 safe_to_load_version (int fd
)
909 /* Read the first few bytes from the file, and look for a line
910 specifying the byte compiler version used. */
911 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
914 /* Skip to the next newline, skipping over the initial `ELC'
915 with NUL bytes following it, but note the version. */
916 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
921 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
922 buf
+ i
, nbytes
- i
) < 0)
926 lseek (fd
, 0, SEEK_SET
);
931 /* Callback for record_unwind_protect. Restore the old load list OLD,
932 after loading a file successfully. */
935 record_load_unwind (Lisp_Object old
)
937 Vloads_in_progress
= old
;
940 /* This handler function is used via internal_condition_case_1. */
943 load_error_handler (Lisp_Object data
)
949 load_warn_old_style_backquotes (Lisp_Object file
)
951 if (!NILP (Vold_style_backquotes
))
953 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
954 CALLN (Fmessage
, format
, file
);
958 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
959 doc
: /* Return the suffixes that `load' should try if a suffix is \
961 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
964 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
965 while (CONSP (suffixes
))
967 Lisp_Object exts
= Vload_file_rep_suffixes
;
968 suffix
= XCAR (suffixes
);
969 suffixes
= XCDR (suffixes
);
974 lst
= Fcons (concat2 (suffix
, ext
), lst
);
977 return Fnreverse (lst
);
980 /* Returns true if STRING ends with SUFFIX */
982 suffix_p (Lisp_Object string
, const char *suffix
)
984 ptrdiff_t suffix_len
= strlen (suffix
);
985 ptrdiff_t string_len
= SBYTES (string
);
987 return string_len
>= suffix_len
&& !strcmp (SSDATA (string
) + string_len
- suffix_len
, suffix
);
990 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
991 doc
: /* Execute a file of Lisp code named FILE.
992 First try FILE with `.elc' appended, then try with `.el', then try
993 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
994 then try FILE unmodified (the exact suffixes in the exact order are
995 determined by `load-suffixes'). Environment variable references in
996 FILE are replaced with their values by calling `substitute-in-file-name'.
997 This function searches the directories in `load-path'.
999 If optional second arg NOERROR is non-nil,
1000 report no error if FILE doesn't exist.
1001 Print messages at start and end of loading unless
1002 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1004 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1005 suffixes to the specified name FILE.
1006 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1007 the suffix `.elc' or `.el' or the module suffix; don't accept just
1008 FILE unless it ends in one of those suffixes or includes a directory name.
1010 If NOSUFFIX is nil, then if a file could not be found, try looking for
1011 a different representation of the file by adding non-empty suffixes to
1012 its name, before trying another file. Emacs uses this feature to find
1013 compressed versions of files when Auto Compression mode is enabled.
1014 If NOSUFFIX is non-nil, disable this feature.
1016 The suffixes that this function tries out, when NOSUFFIX is nil, are
1017 given by the return value of `get-load-suffixes' and the values listed
1018 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1019 return value of `get-load-suffixes' is used, i.e. the file name is
1020 required to have a non-empty suffix.
1022 When searching suffixes, this function normally stops at the first
1023 one that exists. If the option `load-prefer-newer' is non-nil,
1024 however, it tries all suffixes, and uses whichever file is the newest.
1026 Loading a file records its definitions, and its `provide' and
1027 `require' calls, in an element of `load-history' whose
1028 car is the file name loaded. See `load-history'.
1030 While the file is in the process of being loaded, the variable
1031 `load-in-progress' is non-nil and the variable `load-file-name'
1032 is bound to the file's name.
1034 Return t if the file exists and loads successfully. */)
1035 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1036 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1041 ptrdiff_t count
= SPECPDL_INDEX ();
1042 Lisp_Object found
, efound
, hist_file_name
;
1043 /* True means we printed the ".el is newer" message. */
1045 /* True means we are loading a compiled file. */
1047 Lisp_Object handler
;
1049 const char *fmode
= "r" FOPEN_TEXT
;
1052 CHECK_STRING (file
);
1054 /* If file name is magic, call the handler. */
1055 /* This shouldn't be necessary any more now that `openp' handles it right.
1056 handler = Ffind_file_name_handler (file, Qload);
1057 if (!NILP (handler))
1058 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1060 /* The presence of this call is the result of a historical accident:
1061 it used to be in every file-operation and when it got removed
1062 everywhere, it accidentally stayed here. Since then, enough people
1063 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1064 that it seemed risky to remove. */
1065 if (! NILP (noerror
))
1067 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1068 Qt
, load_error_handler
);
1073 file
= Fsubstitute_in_file_name (file
);
1075 /* Avoid weird lossage with null string as arg,
1076 since it would try to load a directory as a Lisp file. */
1077 if (SCHARS (file
) == 0)
1084 Lisp_Object suffixes
;
1087 if (! NILP (must_suffix
))
1089 /* Don't insist on adding a suffix if FILE already ends with one. */
1090 if (suffix_p (file
, ".el")
1091 || suffix_p (file
, ".elc")
1093 || suffix_p (file
, MODULES_SUFFIX
)
1097 /* Don't insist on adding a suffix
1098 if the argument includes a directory name. */
1099 else if (! NILP (Ffile_name_directory (file
)))
1103 if (!NILP (nosuffix
))
1107 suffixes
= Fget_load_suffixes ();
1108 if (NILP (must_suffix
))
1109 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1112 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1118 report_file_error ("Cannot open load file", file
);
1122 /* Tell startup.el whether or not we found the user's init file. */
1123 if (EQ (Qt
, Vuser_init_file
))
1124 Vuser_init_file
= found
;
1126 /* If FD is -2, that means openp found a magic file. */
1129 if (NILP (Fequal (found
, file
)))
1130 /* If FOUND is a different file name from FILE,
1131 find its handler even if we have already inhibited
1132 the `load' operation on FILE. */
1133 handler
= Ffind_file_name_handler (found
, Qt
);
1135 handler
= Ffind_file_name_handler (found
, Qload
);
1136 if (! NILP (handler
))
1137 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1139 /* Tramp has to deal with semi-broken packages that prepend
1140 drive letters to remote files. For that reason, Tramp
1141 catches file operations that test for file existence, which
1142 makes openp think X:/foo.elc files are remote. However,
1143 Tramp does not catch `load' operations for such files, so we
1144 end up with a nil as the `load' handler above. If we would
1145 continue with fd = -2, we will behave wrongly, and in
1146 particular try reading a .elc file in the "rt" mode instead
1147 of "rb". See bug #9311 for the results. To work around
1148 this, we try to open the file locally, and go with that if it
1150 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1158 /* Pacify older GCC with --enable-gcc-warnings. */
1159 IF_LINT (fd_index
= 0);
1163 fd_index
= SPECPDL_INDEX ();
1164 record_unwind_protect_int (close_file_unwind
, fd
);
1168 if (suffix_p (found
, MODULES_SUFFIX
))
1169 return unbind_to (count
, Fmodule_load (found
));
1172 /* Check if we're stuck in a recursive load cycle.
1174 2000-09-21: It's not possible to just check for the file loaded
1175 being a member of Vloads_in_progress. This fails because of the
1176 way the byte compiler currently works; `provide's are not
1177 evaluated, see font-lock.el/jit-lock.el as an example. This
1178 leads to a certain amount of ``normal'' recursion.
1180 Also, just loading a file recursively is not always an error in
1181 the general case; the second load may do something different. */
1185 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1186 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1187 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1188 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1189 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1192 /* All loads are by default dynamic, unless the file itself specifies
1193 otherwise using a file-variable in the first line. This is bound here
1194 so that it takes effect whether or not we use
1195 Vload_source_file_function. */
1196 specbind (Qlexical_binding
, Qnil
);
1198 /* Get the name for load-history. */
1199 hist_file_name
= (! NILP (Vpurify_flag
)
1200 ? concat2 (Ffile_name_directory (file
),
1201 Ffile_name_nondirectory (found
))
1206 /* Check for the presence of old-style quotes and warn about them. */
1207 specbind (Qold_style_backquotes
, Qnil
);
1208 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1210 if (suffix_p (found
, ".elc") || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1211 /* Load .elc files directly, but not when they are
1212 remote and have no handler! */
1220 && ! (version
= safe_to_load_version (fd
)))
1223 if (!load_dangerous_libraries
)
1224 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1225 else if (!NILP (nomessage
) && !force_load_messages
)
1226 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1231 efound
= ENCODE_FILE (found
);
1232 fmode
= "r" FOPEN_BINARY
;
1234 /* openp already checked for newness, no point doing it again.
1235 FIXME would be nice to get a message when openp
1236 ignores suffix order due to load_prefer_newer. */
1237 if (!load_prefer_newer
)
1239 result
= stat (SSDATA (efound
), &s1
);
1242 SSET (efound
, SBYTES (efound
) - 1, 0);
1243 result
= stat (SSDATA (efound
), &s2
);
1244 SSET (efound
, SBYTES (efound
) - 1, 'c');
1248 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1250 /* Make the progress messages mention that source is newer. */
1253 /* If we won't print another message, mention this anyway. */
1254 if (!NILP (nomessage
) && !force_load_messages
)
1256 Lisp_Object msg_file
;
1257 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1258 message_with_string ("Source file `%s' newer than byte-compiled file",
1262 } /* !load_prefer_newer */
1267 /* We are loading a source file (*.el). */
1268 if (!NILP (Vload_source_file_function
))
1275 clear_unwind_protect (fd_index
);
1277 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1278 NILP (noerror
) ? Qnil
: Qt
,
1279 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1280 return unbind_to (count
, val
);
1286 /* We somehow got here with fd == -2, meaning the file is deemed
1287 to be remote. Don't even try to reopen the file locally;
1288 just force a failure. */
1296 clear_unwind_protect (fd_index
);
1297 efound
= ENCODE_FILE (found
);
1298 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1300 stream
= fdopen (fd
, fmode
);
1304 report_file_error ("Opening stdio stream", file
);
1305 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1307 if (! NILP (Vpurify_flag
))
1308 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1310 if (NILP (nomessage
) || force_load_messages
)
1313 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1316 message_with_string ("Loading %s (source)...", file
, 1);
1318 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1320 else /* The typical case; compiled file newer than source file. */
1321 message_with_string ("Loading %s...", file
, 1);
1324 specbind (Qload_file_name
, found
);
1325 specbind (Qinhibit_file_name_operation
, Qnil
);
1326 specbind (Qload_in_progress
, Qt
);
1329 if (lisp_file_lexically_bound_p (Qget_file_char
))
1330 Fset (Qlexical_binding
, Qt
);
1332 if (! version
|| version
>= 22)
1333 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1334 0, Qnil
, Qnil
, Qnil
, Qnil
);
1337 /* We can't handle a file which was compiled with
1338 byte-compile-dynamic by older version of Emacs. */
1339 specbind (Qload_force_doc_strings
, Qt
);
1340 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1341 0, Qnil
, Qnil
, Qnil
, Qnil
);
1343 unbind_to (count
, Qnil
);
1345 /* Run any eval-after-load forms for this file. */
1346 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1347 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1349 xfree (saved_doc_string
);
1350 saved_doc_string
= 0;
1351 saved_doc_string_size
= 0;
1353 xfree (prev_saved_doc_string
);
1354 prev_saved_doc_string
= 0;
1355 prev_saved_doc_string_size
= 0;
1357 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1360 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1363 message_with_string ("Loading %s (source)...done", file
, 1);
1365 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1367 else /* The typical case; compiled file newer than source file. */
1368 message_with_string ("Loading %s...done", file
, 1);
1375 complete_filename_p (Lisp_Object pathname
)
1377 const unsigned char *s
= SDATA (pathname
);
1378 return (IS_DIRECTORY_SEP (s
[0])
1379 || (SCHARS (pathname
) > 2
1380 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1383 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1384 doc
: /* Search for FILENAME through PATH.
1385 Returns the file's name in absolute form, or nil if not found.
1386 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1387 file name when searching.
1388 If non-nil, PREDICATE is used instead of `file-readable-p'.
1389 PREDICATE can also be an integer to pass to the faccessat(2) function,
1390 in which case file-name-handlers are ignored.
1391 This function will normally skip directories, so if you want it to find
1392 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1393 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1396 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1397 if (NILP (predicate
) && fd
>= 0)
1402 /* Search for a file whose name is STR, looking in directories
1403 in the Lisp list PATH, and trying suffixes from SUFFIX.
1404 On success, return a file descriptor (or 1 or -2 as described below).
1405 On failure, return -1 and set errno.
1407 SUFFIXES is a list of strings containing possible suffixes.
1408 The empty suffix is automatically added if the list is empty.
1410 PREDICATE t means the files are binary.
1411 PREDICATE non-nil and non-t means don't open the files,
1412 just look for one that satisfies the predicate. In this case,
1413 return 1 on success. The predicate can be a lisp function or
1414 an integer to pass to `access' (in which case file-name-handlers
1417 If STOREPTR is nonzero, it points to a slot where the name of
1418 the file actually found should be stored as a Lisp string.
1419 nil is stored there on failure.
1421 If the file we find is remote, return -2
1422 but store the found remote file name in *STOREPTR.
1424 If NEWER is true, try all SUFFIXes and return the result for the
1425 newest file that exists. Does not apply to remote files,
1426 or if a non-nil and non-t PREDICATE is specified. */
1429 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1430 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1432 ptrdiff_t fn_size
= 100;
1436 ptrdiff_t want_length
;
1437 Lisp_Object filename
;
1438 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1439 ptrdiff_t max_suffix_len
= 0;
1440 int last_errno
= ENOENT
;
1444 /* The last-modified time of the newest matching file found.
1445 Initialize it to something less than all valid timestamps. */
1446 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1450 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1452 CHECK_STRING_CAR (tail
);
1453 max_suffix_len
= max (max_suffix_len
,
1454 SBYTES (XCAR (tail
)));
1457 string
= filename
= encoded_fn
= save_string
= Qnil
;
1462 absolute
= complete_filename_p (str
);
1464 for (; CONSP (path
); path
= XCDR (path
))
1466 filename
= Fexpand_file_name (str
, XCAR (path
));
1467 if (!complete_filename_p (filename
))
1468 /* If there are non-absolute elts in PATH (eg "."). */
1469 /* Of course, this could conceivably lose if luser sets
1470 default-directory to be something non-absolute... */
1472 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1473 if (!complete_filename_p (filename
))
1474 /* Give up on this path element! */
1478 /* Calculate maximum length of any filename made from
1479 this path element/specified file name and any possible suffix. */
1480 want_length
= max_suffix_len
+ SBYTES (filename
);
1481 if (fn_size
<= want_length
)
1483 fn_size
= 100 + want_length
;
1484 fn
= SAFE_ALLOCA (fn_size
);
1487 /* Loop over suffixes. */
1488 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1489 CONSP (tail
); tail
= XCDR (tail
))
1491 Lisp_Object suffix
= XCAR (tail
);
1492 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1493 Lisp_Object handler
;
1495 /* Concatenate path element/specified name with the suffix.
1496 If the directory starts with /:, remove that. */
1497 int prefixlen
= ((SCHARS (filename
) > 2
1498 && SREF (filename
, 0) == '/'
1499 && SREF (filename
, 1) == ':')
1501 fnlen
= SBYTES (filename
) - prefixlen
;
1502 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1503 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1505 /* Check that the file exists and is not a directory. */
1506 /* We used to only check for handlers on non-absolute file names:
1510 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1511 It's not clear why that was the case and it breaks things like
1512 (load "/bar.el") where the file is actually "/bar.el.gz". */
1513 /* make_string has its own ideas on when to return a unibyte
1514 string and when a multibyte string, but we know better.
1515 We must have a unibyte string when dumping, since
1516 file-name encoding is shaky at best at that time, and in
1517 particular default-file-name-coding-system is reset
1518 several times during loadup. We therefore don't want to
1519 encode the file before passing it to file I/O library
1521 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1522 string
= make_unibyte_string (fn
, fnlen
);
1524 string
= make_string (fn
, fnlen
);
1525 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1526 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1527 && !NATNUMP (predicate
))
1530 if (NILP (predicate
) || EQ (predicate
, Qt
))
1531 exists
= !NILP (Ffile_readable_p (string
));
1534 Lisp_Object tmp
= call1 (predicate
, string
);
1537 else if (EQ (tmp
, Qdir_ok
)
1538 || NILP (Ffile_directory_p (string
)))
1543 last_errno
= EISDIR
;
1549 /* We succeeded; return this descriptor and filename. */
1562 encoded_fn
= ENCODE_FILE (string
);
1563 pfn
= SSDATA (encoded_fn
);
1565 /* Check that we can access or open it. */
1566 if (NATNUMP (predicate
))
1569 if (INT_MAX
< XFASTINT (predicate
))
1570 last_errno
= EINVAL
;
1571 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1575 if (file_directory_p (pfn
))
1576 last_errno
= EISDIR
;
1583 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1586 if (errno
!= ENOENT
)
1591 int err
= (fstat (fd
, &st
) != 0 ? errno
1592 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1604 if (newer
&& !NATNUMP (predicate
))
1606 struct timespec mtime
= get_stat_mtime (&st
);
1608 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1613 emacs_close (save_fd
);
1616 save_string
= string
;
1621 /* We succeeded; return this descriptor and filename. */
1629 /* No more suffixes. Return the newest. */
1630 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1633 *storeptr
= save_string
;
1649 /* Merge the list we've accumulated of globals from the current input source
1650 into the load_history variable. The details depend on whether
1651 the source has an associated file name or not.
1653 FILENAME is the file name that we are loading from.
1655 ENTIRE is true if loading that entire file, false if evaluating
1659 build_load_history (Lisp_Object filename
, bool entire
)
1661 Lisp_Object tail
, prev
, newelt
;
1662 Lisp_Object tem
, tem2
;
1665 tail
= Vload_history
;
1668 while (CONSP (tail
))
1672 /* Find the feature's previous assoc list... */
1673 if (!NILP (Fequal (filename
, Fcar (tem
))))
1677 /* If we're loading the entire file, remove old data. */
1681 Vload_history
= XCDR (tail
);
1683 Fsetcdr (prev
, XCDR (tail
));
1686 /* Otherwise, cons on new symbols that are not already members. */
1689 tem2
= Vcurrent_load_list
;
1691 while (CONSP (tem2
))
1693 newelt
= XCAR (tem2
);
1695 if (NILP (Fmember (newelt
, tem
)))
1696 Fsetcar (tail
, Fcons (XCAR (tem
),
1697 Fcons (newelt
, XCDR (tem
))));
1710 /* If we're loading an entire file, cons the new assoc onto the
1711 front of load-history, the most-recently-loaded position. Also
1712 do this if we didn't find an existing member for the file. */
1713 if (entire
|| !foundit
)
1714 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1719 readevalloop_1 (int old
)
1721 load_convert_to_unibyte
= old
;
1724 /* Signal an `end-of-file' error, if possible with file name
1727 static _Noreturn
void
1728 end_of_file_error (void)
1730 if (STRINGP (Vload_file_name
))
1731 xsignal1 (Qend_of_file
, Vload_file_name
);
1733 xsignal0 (Qend_of_file
);
1737 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1739 /* If we macroexpand the toplevel form non-recursively and it ends
1740 up being a `progn' (or if it was a progn to start), treat each
1741 form in the progn as a top-level form. This way, if one form in
1742 the progn defines a macro, that macro is in effect when we expand
1743 the remaining forms. See similar code in bytecomp.el. */
1744 val
= call2 (macroexpand
, val
, Qnil
);
1745 if (EQ (CAR_SAFE (val
), Qprogn
))
1747 Lisp_Object subforms
= XCDR (val
);
1749 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1750 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1754 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1758 /* UNIBYTE specifies how to set load_convert_to_unibyte
1759 for this invocation.
1760 READFUN, if non-nil, is used instead of `read'.
1762 START, END specify region to read in current buffer (from eval-region).
1763 If the input is not from a buffer, they must be nil. */
1766 readevalloop (Lisp_Object readcharfun
,
1768 Lisp_Object sourcename
,
1770 Lisp_Object unibyte
, Lisp_Object readfun
,
1771 Lisp_Object start
, Lisp_Object end
)
1775 ptrdiff_t count
= SPECPDL_INDEX ();
1776 struct buffer
*b
= 0;
1777 bool continue_reading_p
;
1778 Lisp_Object lex_bound
;
1779 /* True if reading an entire buffer. */
1780 bool whole_buffer
= 0;
1781 /* True on the first time around. */
1782 bool first_sexp
= 1;
1783 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1785 if (NILP (Ffboundp (macroexpand
))
1786 /* Don't macroexpand in .elc files, since it should have been done
1787 already. We actually don't know whether we're in a .elc file or not,
1788 so we use circumstantial evidence: .el files normally go through
1789 Vload_source_file_function -> load-with-code-conversion
1791 || EQ (readcharfun
, Qget_file_char
)
1792 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1795 if (MARKERP (readcharfun
))
1798 start
= readcharfun
;
1801 if (BUFFERP (readcharfun
))
1802 b
= XBUFFER (readcharfun
);
1803 else if (MARKERP (readcharfun
))
1804 b
= XMARKER (readcharfun
)->buffer
;
1806 /* We assume START is nil when input is not from a buffer. */
1807 if (! NILP (start
) && !b
)
1810 specbind (Qstandard_input
, readcharfun
);
1811 specbind (Qcurrent_load_list
, Qnil
);
1812 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1813 load_convert_to_unibyte
= !NILP (unibyte
);
1815 /* If lexical binding is active (either because it was specified in
1816 the file's header, or via a buffer-local variable), create an empty
1817 lexical environment, otherwise, turn off lexical binding. */
1818 lex_bound
= find_symbol_value (Qlexical_binding
);
1819 specbind (Qinternal_interpreter_environment
,
1820 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1821 ? Qnil
: list1 (Qt
)));
1823 /* Try to ensure sourcename is a truename, except whilst preloading. */
1824 if (NILP (Vpurify_flag
)
1825 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1826 && !NILP (Ffboundp (Qfile_truename
)))
1827 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1829 LOADHIST_ATTACH (sourcename
);
1831 continue_reading_p
= 1;
1832 while (continue_reading_p
)
1834 ptrdiff_t count1
= SPECPDL_INDEX ();
1836 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1837 error ("Reading from killed buffer");
1841 /* Switch to the buffer we are reading from. */
1842 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1843 set_buffer_internal (b
);
1845 /* Save point in it. */
1846 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1847 /* Save ZV in it. */
1848 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1849 /* Those get unbound after we read one expression. */
1851 /* Set point and ZV around stuff to be read. */
1854 Fnarrow_to_region (make_number (BEGV
), end
);
1856 /* Just for cleanliness, convert END to a marker
1857 if it is an integer. */
1859 end
= Fpoint_max_marker ();
1862 /* On the first cycle, we can easily test here
1863 whether we are reading the whole buffer. */
1864 if (b
&& first_sexp
)
1865 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1872 while ((c
= READCHAR
) != '\n' && c
!= -1);
1877 unbind_to (count1
, Qnil
);
1881 /* Ignore whitespace here, so we can detect eof. */
1882 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1883 || c
== NO_BREAK_SPACE
)
1886 if (!NILP (Vpurify_flag
) && c
== '(')
1888 val
= read_list (0, readcharfun
);
1893 read_objects
= Qnil
;
1894 if (!NILP (readfun
))
1896 val
= call1 (readfun
, readcharfun
);
1898 /* If READCHARFUN has set point to ZV, we should
1899 stop reading, even if the form read sets point
1900 to a different value when evaluated. */
1901 if (BUFFERP (readcharfun
))
1903 struct buffer
*buf
= XBUFFER (readcharfun
);
1904 if (BUF_PT (buf
) == BUF_ZV (buf
))
1905 continue_reading_p
= 0;
1908 else if (! NILP (Vload_read_function
))
1909 val
= call1 (Vload_read_function
, readcharfun
);
1911 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1914 if (!NILP (start
) && continue_reading_p
)
1915 start
= Fpoint_marker ();
1917 /* Restore saved point and BEGV. */
1918 unbind_to (count1
, Qnil
);
1920 /* Now eval what we just read. */
1921 if (!NILP (macroexpand
))
1922 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1924 val
= eval_sub (val
);
1928 Vvalues
= Fcons (val
, Vvalues
);
1929 if (EQ (Vstandard_output
, Qt
))
1938 build_load_history (sourcename
,
1939 stream
|| whole_buffer
);
1941 unbind_to (count
, Qnil
);
1944 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1945 doc
: /* Execute the accessible portion of current buffer as Lisp code.
1946 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
1947 When called from a Lisp program (i.e., not interactively), this
1948 function accepts up to five optional arguments:
1949 BUFFER is the buffer to evaluate (nil means use current buffer),
1950 or a name of a buffer (a string).
1951 PRINTFLAG controls printing of output by any output functions in the
1952 evaluated code, such as `print', `princ', and `prin1':
1953 a value of nil means discard it; anything else is the stream to print to.
1954 See Info node `(elisp)Output Streams' for details on streams.
1955 FILENAME specifies the file name to use for `load-history'.
1956 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1958 DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
1959 evaluated code should work normally even if PRINTFLAG is nil, in
1960 which case the output is displayed in the echo area.
1962 This function preserves the position of point. */)
1963 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1965 ptrdiff_t count
= SPECPDL_INDEX ();
1966 Lisp_Object tem
, buf
;
1969 buf
= Fcurrent_buffer ();
1971 buf
= Fget_buffer (buffer
);
1973 error ("No such buffer");
1975 if (NILP (printflag
) && NILP (do_allow_print
))
1980 if (NILP (filename
))
1981 filename
= BVAR (XBUFFER (buf
), filename
);
1983 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1984 specbind (Qstandard_output
, tem
);
1985 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1986 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1987 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1988 readevalloop (buf
, 0, filename
,
1989 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1990 unbind_to (count
, Qnil
);
1995 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1996 doc
: /* Execute the region as Lisp code.
1997 When called from programs, expects two arguments,
1998 giving starting and ending indices in the current buffer
1999 of the text to be executed.
2000 Programs can pass third argument PRINTFLAG which controls output:
2001 a value of nil means discard it; anything else is stream for printing it.
2002 See Info node `(elisp)Output Streams' for details on streams.
2003 Also the fourth argument READ-FUNCTION, if non-nil, is used
2004 instead of `read' to read each expression. It gets one argument
2005 which is the input stream for reading characters.
2007 This function does not move point. */)
2008 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2010 /* FIXME: Do the eval-sexp-add-defvars dance! */
2011 ptrdiff_t count
= SPECPDL_INDEX ();
2012 Lisp_Object tem
, cbuf
;
2014 cbuf
= Fcurrent_buffer ();
2016 if (NILP (printflag
))
2020 specbind (Qstandard_output
, tem
);
2021 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2023 /* `readevalloop' calls functions which check the type of start and end. */
2024 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2025 !NILP (printflag
), Qnil
, read_function
,
2028 return unbind_to (count
, Qnil
);
2032 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2033 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2034 If STREAM is nil, use the value of `standard-input' (which see).
2035 STREAM or the value of `standard-input' may be:
2036 a buffer (read from point and advance it)
2037 a marker (read from where it points and advance it)
2038 a function (call it with no arguments for each character,
2039 call it with a char as argument to push a char back)
2040 a string (takes text from string, starting at the beginning)
2041 t (read text line using minibuffer and use it, or read from
2042 standard input in batch mode). */)
2043 (Lisp_Object stream
)
2046 stream
= Vstandard_input
;
2047 if (EQ (stream
, Qt
))
2048 stream
= Qread_char
;
2049 if (EQ (stream
, Qread_char
))
2050 /* FIXME: ?! When is this used !? */
2051 return call1 (intern ("read-minibuffer"),
2052 build_string ("Lisp expression: "));
2054 return read_internal_start (stream
, Qnil
, Qnil
);
2057 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2058 doc
: /* Read one Lisp expression which is represented as text by STRING.
2059 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2060 FINAL-STRING-INDEX is an integer giving the position of the next
2061 remaining character in STRING. START and END optionally delimit
2062 a substring of STRING from which to read; they default to 0 and
2063 \(length STRING) respectively. Negative values are counted from
2064 the end of STRING. */)
2065 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2068 CHECK_STRING (string
);
2069 /* `read_internal_start' sets `read_from_string_index'. */
2070 ret
= read_internal_start (string
, start
, end
);
2071 return Fcons (ret
, make_number (read_from_string_index
));
2074 /* Function to set up the global context we need in toplevel read
2075 calls. START and END only used when STREAM is a string. */
2077 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2082 new_backquote_flag
= 0;
2083 read_objects
= Qnil
;
2084 if (EQ (Vread_with_symbol_positions
, Qt
)
2085 || EQ (Vread_with_symbol_positions
, stream
))
2086 Vread_symbol_positions_list
= Qnil
;
2088 if (STRINGP (stream
)
2089 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2091 ptrdiff_t startval
, endval
;
2094 if (STRINGP (stream
))
2097 string
= XCAR (stream
);
2099 validate_subarray (string
, start
, end
, SCHARS (string
),
2100 &startval
, &endval
);
2102 read_from_string_index
= startval
;
2103 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2104 read_from_string_limit
= endval
;
2107 retval
= read0 (stream
);
2108 if (EQ (Vread_with_symbol_positions
, Qt
)
2109 || EQ (Vread_with_symbol_positions
, stream
))
2110 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2115 /* Signal Qinvalid_read_syntax error.
2116 S is error string of length N (if > 0) */
2118 static _Noreturn
void
2119 invalid_syntax (const char *s
)
2121 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2125 /* Use this for recursive reads, in contexts where internal tokens
2129 read0 (Lisp_Object readcharfun
)
2131 register Lisp_Object val
;
2134 val
= read1 (readcharfun
, &c
, 0);
2138 xsignal1 (Qinvalid_read_syntax
,
2139 Fmake_string (make_number (1), make_number (c
)));
2142 static ptrdiff_t read_buffer_size
;
2143 static char *read_buffer
;
2145 /* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes. */
2148 grow_read_buffer (void)
2150 read_buffer
= xpalloc (read_buffer
, &read_buffer_size
,
2151 MAX_MULTIBYTE_LENGTH
, -1, 1);
2154 /* Signal an invalid-read-syntax error indicating that the character
2155 name in an \N{…} literal is invalid. */
2156 static _Noreturn
void
2157 invalid_character_name (Lisp_Object name
)
2159 AUTO_STRING (format
, "\\N{%s}");
2160 xsignal1 (Qinvalid_read_syntax
, CALLN (Fformat
, format
, name
));
2163 /* Check that CODE is a valid Unicode scalar value, and return its
2164 value. CODE should be parsed from the character name given by
2165 NAME. NAME is used for error messages. */
2167 check_scalar_value (Lisp_Object code
, Lisp_Object name
)
2169 if (! NUMBERP (code
))
2170 invalid_character_name (name
);
2171 EMACS_INT i
= XINT (code
);
2172 if (! (0 <= i
&& i
<= MAX_UNICODE_CHAR
)
2173 /* Don't allow surrogates. */
2174 || (0xD800 <= code
&& code
<= 0xDFFF))
2175 invalid_character_name (name
);
2179 /* If NAME starts with PREFIX, interpret the rest as a hexadecimal
2180 number and return its value. Raise invalid-read-syntax if the
2181 number is not a valid scalar value. Return −1 if NAME doesn’t
2182 start with PREFIX. */
2184 parse_code_after_prefix (Lisp_Object name
, const char *prefix
)
2186 ptrdiff_t name_len
= SBYTES (name
);
2187 ptrdiff_t prefix_len
= strlen (prefix
);
2188 /* Allow between one and eight hexadecimal digits after the
2190 if (prefix_len
< name_len
&& name_len
<= prefix_len
+ 8
2191 && memcmp (SDATA (name
), prefix
, prefix_len
) == 0)
2193 Lisp_Object code
= string_to_number (SDATA (name
) + prefix_len
, 16, false);
2195 return check_scalar_value (code
, name
);
2200 /* Returns the scalar value that has the Unicode character name NAME.
2201 Raises `invalid-read-syntax' if there is no such character. */
2203 character_name_to_code (Lisp_Object name
)
2205 /* Code point as U+N, where N is between 1 and 8 hexadecimal
2207 int code
= parse_code_after_prefix (name
, "U+");
2211 /* CJK ideographs are not contained in the association list returned
2212 by `ucs-names'. But they follow a predictable naming pattern: a
2213 fixed prefix plus the hexadecimal codepoint value. */
2214 code
= parse_code_after_prefix (name
, "CJK IDEOGRAPH-");
2217 /* Various ranges of CJK characters; see UnicodeData.txt. */
2218 if ((0x3400 <= code
&& code
<= 0x4DB5)
2219 || (0x4E00 <= code
&& code
<= 0x9FD5)
2220 || (0x20000 <= code
&& code
<= 0x2A6D6)
2221 || (0x2A700 <= code
&& code
<= 0x2B734)
2222 || (0x2B740 <= code
&& code
<= 0x2B81D)
2223 || (0x2B820 <= code
&& code
<= 0x2CEA1))
2226 invalid_character_name (name
);
2229 /* Look up the name in the table returned by `ucs-names'. */
2230 Lisp_Object names
= call0 (Qucs_names
);
2231 return check_scalar_value (CDR (Fassoc (name
, names
)), name
);
2234 /* Bound on the length of a Unicode character name. As of
2235 Unicode 9.0.0 the maximum is 83, so this should be safe. */
2236 enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND
= 200 };
2238 /* Read a \-escape sequence, assuming we already read the `\'.
2239 If the escape sequence forces unibyte, return eight-bit char. */
2242 read_escape (Lisp_Object readcharfun
, bool stringp
)
2245 /* \u allows up to four hex digits, \U up to eight. Default to the
2246 behavior for \u, and change this value in the case that \U is seen. */
2247 int unicode_hex_count
= 4;
2252 end_of_file_error ();
2282 error ("Invalid escape character syntax");
2285 c
= read_escape (readcharfun
, 0);
2286 return c
| meta_modifier
;
2291 error ("Invalid escape character syntax");
2294 c
= read_escape (readcharfun
, 0);
2295 return c
| shift_modifier
;
2300 error ("Invalid escape character syntax");
2303 c
= read_escape (readcharfun
, 0);
2304 return c
| hyper_modifier
;
2309 error ("Invalid escape character syntax");
2312 c
= read_escape (readcharfun
, 0);
2313 return c
| alt_modifier
;
2317 if (stringp
|| c
!= '-')
2324 c
= read_escape (readcharfun
, 0);
2325 return c
| super_modifier
;
2330 error ("Invalid escape character syntax");
2334 c
= read_escape (readcharfun
, 0);
2335 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2336 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2337 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2338 return c
| ctrl_modifier
;
2339 /* ASCII control chars are made from letters (both cases),
2340 as well as the non-letters within 0100...0137. */
2341 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2342 return (c
& (037 | ~0177));
2343 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2344 return (c
& (037 | ~0177));
2346 return c
| ctrl_modifier
;
2356 /* An octal escape, as in ANSI C. */
2358 register int i
= c
- '0';
2359 register int count
= 0;
2362 if ((c
= READCHAR
) >= '0' && c
<= '7')
2374 if (i
>= 0x80 && i
< 0x100)
2375 i
= BYTE8_TO_CHAR (i
);
2380 /* A hex escape, as in ANSI C. */
2387 if (c
>= '0' && c
<= '9')
2392 else if ((c
>= 'a' && c
<= 'f')
2393 || (c
>= 'A' && c
<= 'F'))
2396 if (c
>= 'a' && c
<= 'f')
2406 /* Allow hex escapes as large as ?\xfffffff, because some
2407 packages use them to denote characters with modifiers. */
2408 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2409 error ("Hex character out of range: \\x%x...", i
);
2413 if (count
< 3 && i
>= 0x80)
2414 return BYTE8_TO_CHAR (i
);
2419 /* Post-Unicode-2.0: Up to eight hex chars. */
2420 unicode_hex_count
= 8;
2423 /* A Unicode escape. We only permit them in strings and characters,
2424 not arbitrarily in the source code, as in some other languages. */
2429 while (++count
<= unicode_hex_count
)
2432 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2434 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2435 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2436 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2438 error ("Non-hex digit used for Unicode escape");
2441 error ("Non-Unicode character: 0x%x", i
);
2446 /* Named character. */
2450 invalid_syntax ("Expected opening brace after \\N");
2451 char name
[UNICODE_CHARACTER_NAME_LENGTH_BOUND
+ 1];
2452 bool whitespace
= false;
2453 ptrdiff_t length
= 0;
2458 end_of_file_error ();
2461 if (! c_isascii (c
))
2463 AUTO_STRING (format
,
2464 "Non-ASCII character U+%04X in character name");
2465 xsignal1 (Qinvalid_read_syntax
,
2466 CALLN (Fformat
, format
, make_natnum (c
)));
2468 /* We treat multiple adjacent whitespace characters as a
2469 single space character. This makes it easier to use
2470 character names in e.g. multi-line strings. */
2481 if (length
>= sizeof name
)
2482 invalid_syntax ("Character name too long");
2485 invalid_syntax ("Empty character name");
2486 return character_name_to_code (make_unibyte_string (name
, length
));
2494 /* Return the digit that CHARACTER stands for in the given BASE.
2495 Return -1 if CHARACTER is out of range for BASE,
2496 and -2 if CHARACTER is not valid for any supported BASE. */
2498 digit_to_number (int character
, int base
)
2502 if ('0' <= character
&& character
<= '9')
2503 digit
= character
- '0';
2504 else if ('a' <= character
&& character
<= 'z')
2505 digit
= character
- 'a' + 10;
2506 else if ('A' <= character
&& character
<= 'Z')
2507 digit
= character
- 'A' + 10;
2511 return digit
< base
? digit
: -1;
2514 /* Read an integer in radix RADIX using READCHARFUN to read
2515 characters. RADIX must be in the interval [2..36]; if it isn't, a
2516 read error is signaled . Value is the integer read. Signals an
2517 error if encountering invalid read syntax or if RADIX is out of
2521 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2523 /* Room for sign, leading 0, other digits, trailing null byte.
2524 Also, room for invalid syntax diagnostic. */
2525 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2526 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2528 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2530 if (radix
< 2 || radix
> 36)
2538 if (c
== '-' || c
== '+')
2549 /* Ignore redundant leading zeros, so the buffer doesn't
2550 fill up with them. */
2556 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2563 if (p
< buf
+ sizeof buf
- 1)
2577 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2578 invalid_syntax (buf
);
2581 return string_to_number (buf
, radix
, 0);
2585 /* If the next token is ')' or ']' or '.', we store that character
2586 in *PCH and the return value is not interesting. Else, we store
2587 zero in *PCH and we read and return one lisp object.
2589 FIRST_IN_LIST is true if this is the first element of a list. */
2592 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2595 bool uninterned_symbol
= 0;
2602 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2604 end_of_file_error ();
2609 return read_list (0, readcharfun
);
2612 return read_vector (readcharfun
, 0);
2628 /* Accept extended format for hashtables (extensible to
2630 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2631 Lisp_Object tmp
= read_list (0, readcharfun
);
2632 Lisp_Object head
= CAR_SAFE (tmp
);
2633 Lisp_Object data
= Qnil
;
2634 Lisp_Object val
= Qnil
;
2635 /* The size is 2 * number of allowed keywords to
2637 Lisp_Object params
[10];
2639 Lisp_Object key
= Qnil
;
2640 int param_count
= 0;
2642 if (!EQ (head
, Qhash_table
))
2643 error ("Invalid extended read marker at head of #s list "
2644 "(only hash-table allowed)");
2646 tmp
= CDR_SAFE (tmp
);
2648 /* This is repetitive but fast and simple. */
2649 params
[param_count
] = QCsize
;
2650 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2651 if (!NILP (params
[param_count
+ 1]))
2654 params
[param_count
] = QCtest
;
2655 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2656 if (!NILP (params
[param_count
+ 1]))
2659 params
[param_count
] = QCweakness
;
2660 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2661 if (!NILP (params
[param_count
+ 1]))
2664 params
[param_count
] = QCrehash_size
;
2665 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2666 if (!NILP (params
[param_count
+ 1]))
2669 params
[param_count
] = QCrehash_threshold
;
2670 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2671 if (!NILP (params
[param_count
+ 1]))
2674 /* This is the hashtable data. */
2675 data
= Fplist_get (tmp
, Qdata
);
2677 /* Now use params to make a new hashtable and fill it. */
2678 ht
= Fmake_hash_table (param_count
, params
);
2680 while (CONSP (data
))
2685 error ("Odd number of elements in hashtable data");
2688 Fputhash (key
, val
, ht
);
2694 invalid_syntax ("#");
2702 tmp
= read_vector (readcharfun
, 0);
2703 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2704 error ("Invalid size char-table");
2705 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2713 /* Sub char-table can't be read as a regular
2714 vector because of a two C integer fields. */
2715 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2716 ptrdiff_t size
= XINT (Flength (tmp
));
2717 int i
, depth
, min_char
;
2718 struct Lisp_Cons
*cell
;
2721 error ("Zero-sized sub char-table");
2723 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2724 error ("Invalid depth in sub char-table");
2725 depth
= XINT (XCAR (tmp
));
2726 if (chartab_size
[depth
] != size
- 2)
2727 error ("Invalid size in sub char-table");
2728 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2731 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2732 error ("Invalid minimum character in sub-char-table");
2733 min_char
= XINT (XCAR (tmp
));
2734 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2737 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2738 for (i
= 0; i
< size
; i
++)
2740 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2741 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2746 invalid_syntax ("#^^");
2748 invalid_syntax ("#^");
2753 length
= read1 (readcharfun
, pch
, first_in_list
);
2757 Lisp_Object tmp
, val
;
2758 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2759 unsigned char *data
;
2762 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2763 if (STRING_MULTIBYTE (tmp
)
2764 || (size_in_chars
!= SCHARS (tmp
)
2765 /* We used to print 1 char too many
2766 when the number of bits was a multiple of 8.
2767 Accept such input in case it came from an old
2769 && ! (XFASTINT (length
)
2770 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2771 invalid_syntax ("#&...");
2773 val
= make_uninit_bool_vector (XFASTINT (length
));
2774 data
= bool_vector_uchar_data (val
);
2775 memcpy (data
, SDATA (tmp
), size_in_chars
);
2776 /* Clear the extraneous bits in the last byte. */
2777 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2778 data
[size_in_chars
- 1]
2779 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2782 invalid_syntax ("#&...");
2786 /* Accept compiled functions at read-time so that we don't have to
2787 build them using function calls. */
2789 struct Lisp_Vector
*vec
;
2790 tmp
= read_vector (readcharfun
, 1);
2791 vec
= XVECTOR (tmp
);
2792 if (vec
->header
.size
== 0)
2793 invalid_syntax ("Empty byte-code object");
2794 make_byte_code (vec
);
2802 /* Read the string itself. */
2803 tmp
= read1 (readcharfun
, &ch
, 0);
2804 if (ch
!= 0 || !STRINGP (tmp
))
2805 invalid_syntax ("#");
2806 /* Read the intervals and their properties. */
2809 Lisp_Object beg
, end
, plist
;
2811 beg
= read1 (readcharfun
, &ch
, 0);
2816 end
= read1 (readcharfun
, &ch
, 0);
2818 plist
= read1 (readcharfun
, &ch
, 0);
2820 invalid_syntax ("Invalid string property list");
2821 Fset_text_properties (beg
, end
, plist
, tmp
);
2827 /* #@NUMBER is used to skip NUMBER following bytes.
2828 That's used in .elc files to skip over doc strings
2829 and function definitions. */
2832 enum { extra
= 100 };
2833 ptrdiff_t i
, nskip
= 0, digits
= 0;
2835 /* Read a decimal integer. */
2836 while ((c
= READCHAR
) >= 0
2837 && c
>= '0' && c
<= '9')
2839 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2844 if (digits
== 2 && nskip
== 0)
2845 { /* We've just seen #@00, which means "skip to end". */
2846 skip_dyn_eof (readcharfun
);
2851 /* We can't use UNREAD here, because in the code below we side-step
2852 READCHAR. Instead, assume the first char after #@NNN occupies
2853 a single byte, which is the case normally since it's just
2859 if (load_force_doc_strings
2860 && (FROM_FILE_P (readcharfun
)))
2862 /* If we are supposed to force doc strings into core right now,
2863 record the last string that we skipped,
2864 and record where in the file it comes from. */
2866 /* But first exchange saved_doc_string
2867 with prev_saved_doc_string, so we save two strings. */
2869 char *temp
= saved_doc_string
;
2870 ptrdiff_t temp_size
= saved_doc_string_size
;
2871 file_offset temp_pos
= saved_doc_string_position
;
2872 ptrdiff_t temp_len
= saved_doc_string_length
;
2874 saved_doc_string
= prev_saved_doc_string
;
2875 saved_doc_string_size
= prev_saved_doc_string_size
;
2876 saved_doc_string_position
= prev_saved_doc_string_position
;
2877 saved_doc_string_length
= prev_saved_doc_string_length
;
2879 prev_saved_doc_string
= temp
;
2880 prev_saved_doc_string_size
= temp_size
;
2881 prev_saved_doc_string_position
= temp_pos
;
2882 prev_saved_doc_string_length
= temp_len
;
2885 if (saved_doc_string_size
== 0)
2887 saved_doc_string
= xmalloc (nskip
+ extra
);
2888 saved_doc_string_size
= nskip
+ extra
;
2890 if (nskip
> saved_doc_string_size
)
2892 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2893 saved_doc_string_size
= nskip
+ extra
;
2896 saved_doc_string_position
= file_tell (instream
);
2898 /* Copy that many characters into saved_doc_string. */
2900 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2901 saved_doc_string
[i
] = c
= getc (instream
);
2904 saved_doc_string_length
= i
;
2907 /* Skip that many bytes. */
2908 skip_dyn_bytes (readcharfun
, nskip
);
2914 /* #! appears at the beginning of an executable file.
2915 Skip the first line. */
2916 while (c
!= '\n' && c
>= 0)
2921 return Vload_file_name
;
2923 return list2 (Qfunction
, read0 (readcharfun
));
2924 /* #:foo is the uninterned symbol named foo. */
2927 uninterned_symbol
= 1;
2930 && c
!= NO_BREAK_SPACE
2932 || strchr ("\"';()[]#`,", c
) == NULL
)))
2934 /* No symbol character follows, this is the empty
2937 return Fmake_symbol (empty_unibyte_string
);
2941 /* ## is the empty symbol. */
2943 return Fintern (empty_unibyte_string
, Qnil
);
2944 /* Reader forms that can reuse previously read objects. */
2945 if (c
>= '0' && c
<= '9')
2950 /* Read a non-negative integer. */
2951 while (c
>= '0' && c
<= '9')
2953 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2954 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2955 n
= MOST_POSITIVE_FIXNUM
+ 1;
2957 n
= n
* 10 + c
- '0';
2961 if (n
<= MOST_POSITIVE_FIXNUM
)
2963 if (c
== 'r' || c
== 'R')
2964 return read_integer (readcharfun
, n
);
2966 if (! NILP (Vread_circle
))
2968 /* #n=object returns object, but associates it with
2972 /* Make a placeholder for #n# to use temporarily. */
2973 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2974 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2975 read_objects
= Fcons (cell
, read_objects
);
2977 /* Read the object itself. */
2978 tem
= read0 (readcharfun
);
2980 /* Now put it everywhere the placeholder was... */
2981 substitute_object_in_subtree (tem
, placeholder
);
2983 /* ...and #n# will use the real value from now on. */
2984 Fsetcdr (cell
, tem
);
2989 /* #n# returns a previously read object. */
2992 tem
= Fassq (make_number (n
), read_objects
);
2998 /* Fall through to error message. */
3000 else if (c
== 'x' || c
== 'X')
3001 return read_integer (readcharfun
, 16);
3002 else if (c
== 'o' || c
== 'O')
3003 return read_integer (readcharfun
, 8);
3004 else if (c
== 'b' || c
== 'B')
3005 return read_integer (readcharfun
, 2);
3008 invalid_syntax ("#");
3011 while ((c
= READCHAR
) >= 0 && c
!= '\n');
3015 return list2 (Qquote
, read0 (readcharfun
));
3019 int next_char
= READCHAR
;
3021 /* Transition from old-style to new-style:
3022 If we see "(`" it used to mean old-style, which usually works
3023 fine because ` should almost never appear in such a position
3024 for new-style. But occasionally we need "(`" to mean new
3025 style, so we try to distinguish the two by the fact that we
3026 can either write "( `foo" or "(` foo", where the first
3027 intends to use new-style whereas the second intends to use
3028 old-style. For Emacs-25, we should completely remove this
3029 first_in_list exception (old-style can still be obtained via
3031 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
3033 Vold_style_backquotes
= Qt
;
3039 bool saved_new_backquote_flag
= new_backquote_flag
;
3041 new_backquote_flag
= 1;
3042 value
= read0 (readcharfun
);
3043 new_backquote_flag
= saved_new_backquote_flag
;
3045 return list2 (Qbackquote
, value
);
3050 int next_char
= READCHAR
;
3052 /* Transition from old-style to new-style:
3053 It used to be impossible to have a new-style , other than within
3054 a new-style `. This is sufficient when ` and , are used in the
3055 normal way, but ` and , can also appear in args to macros that
3056 will not interpret them in the usual way, in which case , may be
3057 used without any ` anywhere near.
3058 So we now use the same heuristic as for backquote: old-style
3059 unquotes are only recognized when first on a list, and when
3060 followed by a space.
3061 Because it's more difficult to peek 2 chars ahead, a new-style
3062 ,@ can still not be used outside of a `, unless it's in the middle
3064 if (new_backquote_flag
3066 || (next_char
!= ' ' && next_char
!= '@'))
3068 Lisp_Object comma_type
= Qnil
;
3073 comma_type
= Qcomma_at
;
3075 comma_type
= Qcomma_dot
;
3078 if (ch
>= 0) UNREAD (ch
);
3079 comma_type
= Qcomma
;
3082 value
= read0 (readcharfun
);
3083 return list2 (comma_type
, value
);
3087 Vold_style_backquotes
= Qt
;
3099 end_of_file_error ();
3101 /* Accept `single space' syntax like (list ? x) where the
3102 whitespace character is SPC or TAB.
3103 Other literal whitespace like NL, CR, and FF are not accepted,
3104 as there are well-established escape sequences for these. */
3105 if (c
== ' ' || c
== '\t')
3106 return make_number (c
);
3109 c
= read_escape (readcharfun
, 0);
3110 modifiers
= c
& CHAR_MODIFIER_MASK
;
3111 c
&= ~CHAR_MODIFIER_MASK
;
3112 if (CHAR_BYTE8_P (c
))
3113 c
= CHAR_TO_BYTE8 (c
);
3116 next_char
= READCHAR
;
3117 ok
= (next_char
<= 040
3118 || (next_char
< 0200
3119 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3122 return make_number (c
);
3124 invalid_syntax ("?");
3129 char *p
= read_buffer
;
3130 char *end
= read_buffer
+ read_buffer_size
;
3132 /* True if we saw an escape sequence specifying
3133 a multibyte character. */
3134 bool force_multibyte
= 0;
3135 /* True if we saw an escape sequence specifying
3136 a single-byte character. */
3137 bool force_singlebyte
= 0;
3139 ptrdiff_t nchars
= 0;
3141 while ((ch
= READCHAR
) >= 0
3144 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3146 ptrdiff_t offset
= p
- read_buffer
;
3147 grow_read_buffer ();
3148 p
= read_buffer
+ offset
;
3149 end
= read_buffer
+ read_buffer_size
;
3156 ch
= read_escape (readcharfun
, 1);
3158 /* CH is -1 if \ newline or \ space has just been seen. */
3161 if (p
== read_buffer
)
3166 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3167 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3169 if (CHAR_BYTE8_P (ch
))
3170 force_singlebyte
= 1;
3171 else if (! ASCII_CHAR_P (ch
))
3172 force_multibyte
= 1;
3173 else /* I.e. ASCII_CHAR_P (ch). */
3175 /* Allow `\C- ' and `\C-?'. */
3176 if (modifiers
== CHAR_CTL
)
3179 ch
= 0, modifiers
= 0;
3181 ch
= 127, modifiers
= 0;
3183 if (modifiers
& CHAR_SHIFT
)
3185 /* Shift modifier is valid only with [A-Za-z]. */
3186 if (ch
>= 'A' && ch
<= 'Z')
3187 modifiers
&= ~CHAR_SHIFT
;
3188 else if (ch
>= 'a' && ch
<= 'z')
3189 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3192 if (modifiers
& CHAR_META
)
3194 /* Move the meta bit to the right place for a
3196 modifiers
&= ~CHAR_META
;
3197 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3198 force_singlebyte
= 1;
3202 /* Any modifiers remaining are invalid. */
3204 error ("Invalid modifier in string");
3205 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3209 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3210 if (CHAR_BYTE8_P (ch
))
3211 force_singlebyte
= 1;
3212 else if (! ASCII_CHAR_P (ch
))
3213 force_multibyte
= 1;
3219 end_of_file_error ();
3221 /* If purifying, and string starts with \ newline,
3222 return zero instead. This is for doc strings
3223 that we are really going to find in etc/DOC.nn.nn. */
3224 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3225 return make_number (0);
3227 if (! force_multibyte
&& force_singlebyte
)
3229 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3230 forms. Convert it to unibyte. */
3231 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3233 p
= read_buffer
+ nchars
;
3236 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3238 || (p
- read_buffer
!= nchars
)));
3243 int next_char
= READCHAR
;
3246 if (next_char
<= 040
3247 || (next_char
< 0200
3248 && strchr ("\"';([#?`,", next_char
) != NULL
))
3254 /* Otherwise, we fall through! Note that the atom-reading loop
3255 below will now loop at least once, assuring that we will not
3256 try to UNREAD two characters in a row. */
3260 if (c
<= 040) goto retry
;
3261 if (c
== NO_BREAK_SPACE
)
3266 char *p
= read_buffer
;
3268 EMACS_INT start_position
= readchar_count
- 1;
3271 char *end
= read_buffer
+ read_buffer_size
;
3275 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3277 ptrdiff_t offset
= p
- read_buffer
;
3278 grow_read_buffer ();
3279 p
= read_buffer
+ offset
;
3280 end
= read_buffer
+ read_buffer_size
;
3287 end_of_file_error ();
3292 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3298 && c
!= NO_BREAK_SPACE
3300 || strchr ("\"';()[]#`,", c
) == NULL
));
3304 ptrdiff_t offset
= p
- read_buffer
;
3305 grow_read_buffer ();
3306 p
= read_buffer
+ offset
;
3307 end
= read_buffer
+ read_buffer_size
;
3313 if (!quoted
&& !uninterned_symbol
)
3315 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3316 if (! NILP (result
))
3320 Lisp_Object name
, result
;
3321 ptrdiff_t nbytes
= p
- read_buffer
;
3324 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3328 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3329 ? make_pure_string
: make_specified_string
)
3330 (read_buffer
, nchars
, nbytes
, multibyte
));
3331 result
= (uninterned_symbol
? Fmake_symbol (name
)
3332 : Fintern (name
, Qnil
));
3334 if (EQ (Vread_with_symbol_positions
, Qt
)
3335 || EQ (Vread_with_symbol_positions
, readcharfun
))
3336 Vread_symbol_positions_list
3337 = Fcons (Fcons (result
, make_number (start_position
)),
3338 Vread_symbol_positions_list
);
3346 /* List of nodes we've seen during substitute_object_in_subtree. */
3347 static Lisp_Object seen_list
;
3350 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3352 Lisp_Object check_object
;
3354 /* We haven't seen any objects when we start. */
3357 /* Make all the substitutions. */
3359 = substitute_object_recurse (object
, placeholder
, object
);
3361 /* Clear seen_list because we're done with it. */
3364 /* The returned object here is expected to always eq the
3366 if (!EQ (check_object
, object
))
3367 error ("Unexpected mutation error in reader");
3370 /* Feval doesn't get called from here, so no gc protection is needed. */
3371 #define SUBSTITUTE(get_val, set_val) \
3373 Lisp_Object old_value = get_val; \
3374 Lisp_Object true_value \
3375 = substitute_object_recurse (object, placeholder, \
3378 if (!EQ (old_value, true_value)) \
3385 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3387 /* If we find the placeholder, return the target object. */
3388 if (EQ (placeholder
, subtree
))
3391 /* If we've been to this node before, don't explore it again. */
3392 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3395 /* If this node can be the entry point to a cycle, remember that
3396 we've seen it. It can only be such an entry point if it was made
3397 by #n=, which means that we can find it as a value in
3399 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3400 seen_list
= Fcons (subtree
, seen_list
);
3402 /* Recurse according to subtree's type.
3403 Every branch must return a Lisp_Object. */
3404 switch (XTYPE (subtree
))
3406 case Lisp_Vectorlike
:
3408 ptrdiff_t i
= 0, length
= 0;
3409 if (BOOL_VECTOR_P (subtree
))
3410 return subtree
; /* No sub-objects anyway. */
3411 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3412 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3413 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3414 else if (VECTORP (subtree
))
3415 length
= ASIZE (subtree
);
3417 /* An unknown pseudovector may contain non-Lisp fields, so we
3418 can't just blindly traverse all its fields. We used to call
3419 `Flength' which signaled `sequencep', so I just preserved this
3421 wrong_type_argument (Qsequencep
, subtree
);
3423 if (SUB_CHAR_TABLE_P (subtree
))
3425 for ( ; i
< length
; i
++)
3426 SUBSTITUTE (AREF (subtree
, i
),
3427 ASET (subtree
, i
, true_value
));
3433 SUBSTITUTE (XCAR (subtree
),
3434 XSETCAR (subtree
, true_value
));
3435 SUBSTITUTE (XCDR (subtree
),
3436 XSETCDR (subtree
, true_value
));
3442 /* Check for text properties in each interval.
3443 substitute_in_interval contains part of the logic. */
3445 INTERVAL root_interval
= string_intervals (subtree
);
3446 AUTO_CONS (arg
, object
, placeholder
);
3448 traverse_intervals_noorder (root_interval
,
3449 &substitute_in_interval
, arg
);
3454 /* Other types don't recurse any further. */
3460 /* Helper function for substitute_object_recurse. */
3462 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3464 Lisp_Object object
= Fcar (arg
);
3465 Lisp_Object placeholder
= Fcdr (arg
);
3467 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3477 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3478 integer syntax and fits in a fixnum, else return the nearest float if CP has
3479 either floating point or integer syntax and BASE is 10, else return nil. If
3480 IGNORE_TRAILING, consider just the longest prefix of CP that has
3481 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3482 number has integer syntax but does not fit. */
3485 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3488 char const *cp
= string
;
3490 bool float_syntax
= 0;
3493 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3494 IEEE floating point hosts, and works around a formerly-common bug where
3495 atof ("-0.0") drops the sign. */
3496 bool negative
= *cp
== '-';
3498 bool signedp
= negative
|| *cp
== '+';
3503 leading_digit
= digit_to_number (*cp
, base
);
3504 if (leading_digit
>= 0)
3509 while (digit_to_number (*cp
, base
) >= 0);
3519 if ('0' <= *cp
&& *cp
<= '9')
3524 while ('0' <= *cp
&& *cp
<= '9');
3526 if (*cp
== 'e' || *cp
== 'E')
3528 char const *ecp
= cp
;
3530 if (*cp
== '+' || *cp
== '-')
3532 if ('0' <= *cp
&& *cp
<= '9')
3537 while ('0' <= *cp
&& *cp
<= '9');
3539 else if (cp
[-1] == '+'
3540 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3546 else if (cp
[-1] == '+'
3547 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3551 /* NAN is a "positive" NaN on all known Emacs hosts. */
3558 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3559 || state
== (LEAD_INT
|E_EXP
));
3562 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3563 any prefix that matches. Otherwise, the entire string must match. */
3564 if (! (ignore_trailing
3565 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3566 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3569 /* If the number uses integer and not float syntax, and is in C-language
3570 range, use its value, preferably as a fixnum. */
3571 if (leading_digit
>= 0 && ! float_syntax
)
3575 /* Fast special case for single-digit integers. This also avoids a
3576 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3577 case some versions of strtoumax accept numbers like "0x1" that Emacs
3579 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3580 return make_number (negative
? -leading_digit
: leading_digit
);
3583 n
= strtoumax (string
+ signedp
, NULL
, base
);
3584 if (errno
== ERANGE
)
3586 /* Unfortunately there's no simple and accurate way to convert
3587 non-base-10 numbers that are out of C-language range. */
3589 xsignal1 (Qoverflow_error
, build_string (string
));
3591 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3593 EMACS_INT signed_n
= n
;
3594 return make_number (negative
? -signed_n
: signed_n
);
3600 /* Either the number uses float syntax, or it does not fit into a fixnum.
3601 Convert it from string to floating point, unless the value is already
3602 known because it is an infinity, a NAN, or its absolute value fits in
3605 value
= atof (string
+ signedp
);
3607 return make_float (negative
? -value
: value
);
3612 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3616 Lisp_Object tem
, item
, vector
;
3617 struct Lisp_Cons
*otem
;
3620 tem
= read_list (1, readcharfun
);
3621 len
= Flength (tem
);
3622 vector
= Fmake_vector (len
, Qnil
);
3624 size
= ASIZE (vector
);
3625 ptr
= XVECTOR (vector
)->contents
;
3626 for (i
= 0; i
< size
; i
++)
3629 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3630 bytecode object, the docstring containing the bytecode and
3631 constants values must be treated as unibyte and passed to
3632 Fread, to get the actual bytecode string and constants vector. */
3633 if (bytecodeflag
&& load_force_doc_strings
)
3635 if (i
== COMPILED_BYTECODE
)
3637 if (!STRINGP (item
))
3638 error ("Invalid byte code");
3640 /* Delay handling the bytecode slot until we know whether
3641 it is lazily-loaded (we can tell by whether the
3642 constants slot is nil). */
3643 ASET (vector
, COMPILED_CONSTANTS
, item
);
3646 else if (i
== COMPILED_CONSTANTS
)
3648 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3652 /* Coerce string to unibyte (like string-as-unibyte,
3653 but without generating extra garbage and
3654 guaranteeing no change in the contents). */
3655 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3656 STRING_SET_UNIBYTE (bytestr
);
3658 item
= Fread (Fcons (bytestr
, readcharfun
));
3660 error ("Invalid byte code");
3662 otem
= XCONS (item
);
3663 bytestr
= XCAR (item
);
3668 /* Now handle the bytecode slot. */
3669 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3671 else if (i
== COMPILED_DOC_STRING
3673 && ! STRING_MULTIBYTE (item
))
3675 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3676 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3678 item
= Fstring_as_multibyte (item
);
3681 ASET (vector
, i
, item
);
3689 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3692 read_list (bool flag
, Lisp_Object readcharfun
)
3694 Lisp_Object val
, tail
;
3695 Lisp_Object elt
, tem
;
3696 /* 0 is the normal case.
3697 1 means this list is a doc reference; replace it with the number 0.
3698 2 means this list is a doc reference; replace it with the doc string. */
3699 int doc_reference
= 0;
3701 /* Initialize this to 1 if we are reading a list. */
3702 bool first_in_list
= flag
<= 0;
3710 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3714 /* While building, if the list starts with #$, treat it specially. */
3715 if (EQ (elt
, Vload_file_name
)
3717 && !NILP (Vpurify_flag
))
3719 if (NILP (Vdoc_file_name
))
3720 /* We have not yet called Snarf-documentation, so assume
3721 this file is described in the DOC file
3722 and Snarf-documentation will fill in the right value later.
3723 For now, replace the whole list with 0. */
3726 /* We have already called Snarf-documentation, so make a relative
3727 file name for this file, so it can be found properly
3728 in the installed Lisp directory.
3729 We don't use Fexpand_file_name because that would make
3730 the directory absolute now. */
3732 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3733 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3736 else if (EQ (elt
, Vload_file_name
)
3738 && load_force_doc_strings
)
3747 invalid_syntax (") or . in a vector");
3754 XSETCDR (tail
, read0 (readcharfun
));
3756 val
= read0 (readcharfun
);
3757 read1 (readcharfun
, &ch
, 0);
3761 if (doc_reference
== 1)
3762 return make_number (0);
3763 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3766 file_offset saved_position
;
3767 /* Get a doc string from the file we are loading.
3768 If it's in saved_doc_string, get it from there.
3770 Here, we don't know if the string is a
3771 bytecode string or a doc string. As a
3772 bytecode string must be unibyte, we always
3773 return a unibyte string. If it is actually a
3774 doc string, caller must make it
3777 /* Position is negative for user variables. */
3778 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3779 if (pos
>= saved_doc_string_position
3780 && pos
< (saved_doc_string_position
3781 + saved_doc_string_length
))
3783 saved
= saved_doc_string
;
3784 saved_position
= saved_doc_string_position
;
3786 /* Look in prev_saved_doc_string the same way. */
3787 else if (pos
>= prev_saved_doc_string_position
3788 && pos
< (prev_saved_doc_string_position
3789 + prev_saved_doc_string_length
))
3791 saved
= prev_saved_doc_string
;
3792 saved_position
= prev_saved_doc_string_position
;
3796 ptrdiff_t start
= pos
- saved_position
;
3799 /* Process quoting with ^A,
3800 and find the end of the string,
3801 which is marked with ^_ (037). */
3802 for (from
= start
, to
= start
;
3803 saved
[from
] != 037;)
3805 int c
= saved
[from
++];
3809 saved
[to
++] = (c
== 1 ? c
3818 return make_unibyte_string (saved
+ start
,
3822 return get_doc_string (val
, 1, 0);
3827 invalid_syntax (". in wrong context");
3829 invalid_syntax ("] in a list");
3833 XSETCDR (tail
, tem
);
3840 static Lisp_Object initial_obarray
;
3842 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3844 static size_t oblookup_last_bucket_number
;
3846 /* Get an error if OBARRAY is not an obarray.
3847 If it is one, return it. */
3850 check_obarray (Lisp_Object obarray
)
3852 /* We don't want to signal a wrong-type-argument error when we are
3853 shutting down due to a fatal error, and we don't want to hit
3854 assertions in VECTORP and ASIZE if the fatal error was during GC. */
3855 if (!fatal_error_in_progress
3856 && (!VECTORP (obarray
) || ASIZE (obarray
) == 0))
3858 /* If Vobarray is now invalid, force it to be valid. */
3859 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3860 wrong_type_argument (Qvectorp
, obarray
);
3865 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3868 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3872 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3873 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3876 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3878 XSYMBOL (sym
)->constant
= 1;
3879 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3880 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3883 ptr
= aref_addr (obarray
, XINT (index
));
3884 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3889 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3892 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3894 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3897 /* Intern the C string STR: return a symbol with that name,
3898 interned in the current obarray. */
3901 intern_1 (const char *str
, ptrdiff_t len
)
3903 Lisp_Object obarray
= check_obarray (Vobarray
);
3904 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3906 return (SYMBOLP (tem
) ? tem
3907 /* The above `oblookup' was done on the basis of nchars==nbytes, so
3908 the string has to be unibyte. */
3909 : intern_driver (make_unibyte_string (str
, len
),
3914 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3916 Lisp_Object obarray
= check_obarray (Vobarray
);
3917 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3921 /* Creating a non-pure string from a string literal not implemented yet.
3922 We could just use make_string here and live with the extra copy. */
3923 eassert (!NILP (Vpurify_flag
));
3924 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3930 define_symbol (Lisp_Object sym
, char const *str
)
3932 ptrdiff_t len
= strlen (str
);
3933 Lisp_Object string
= make_pure_c_string (str
, len
);
3934 init_symbol (sym
, string
);
3936 /* Qunbound is uninterned, so that it's not confused with any symbol
3937 'unbound' created by a Lisp program. */
3938 if (! EQ (sym
, Qunbound
))
3940 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3941 eassert (INTEGERP (bucket
));
3942 intern_sym (sym
, initial_obarray
, bucket
);
3946 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3947 doc
: /* Return the canonical symbol whose name is STRING.
3948 If there is none, one is created by this function and returned.
3949 A second optional argument specifies the obarray to use;
3950 it defaults to the value of `obarray'. */)
3951 (Lisp_Object string
, Lisp_Object obarray
)
3955 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3956 CHECK_STRING (string
);
3958 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3960 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3965 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3966 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3967 NAME may be a string or a symbol. If it is a symbol, that exact
3968 symbol is searched for.
3969 A second optional argument specifies the obarray to use;
3970 it defaults to the value of `obarray'. */)
3971 (Lisp_Object name
, Lisp_Object obarray
)
3973 register Lisp_Object tem
, string
;
3975 if (NILP (obarray
)) obarray
= Vobarray
;
3976 obarray
= check_obarray (obarray
);
3978 if (!SYMBOLP (name
))
3980 CHECK_STRING (name
);
3984 string
= SYMBOL_NAME (name
);
3986 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3987 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3993 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3994 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3995 The value is t if a symbol was found and deleted, nil otherwise.
3996 NAME may be a string or a symbol. If it is a symbol, that symbol
3997 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3998 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3999 usage: (unintern NAME OBARRAY) */)
4000 (Lisp_Object name
, Lisp_Object obarray
)
4002 register Lisp_Object string
, tem
;
4005 if (NILP (obarray
)) obarray
= Vobarray
;
4006 obarray
= check_obarray (obarray
);
4009 string
= SYMBOL_NAME (name
);
4012 CHECK_STRING (name
);
4016 tem
= oblookup (obarray
, SSDATA (string
),
4021 /* If arg was a symbol, don't delete anything but that symbol itself. */
4022 if (SYMBOLP (name
) && !EQ (name
, tem
))
4025 /* There are plenty of other symbols which will screw up the Emacs
4026 session if we unintern them, as well as even more ways to use
4027 `setq' or `fset' or whatnot to make the Emacs session
4028 unusable. Let's not go down this silly road. --Stef */
4029 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
4030 error ("Attempt to unintern t or nil"); */
4032 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
4034 hash
= oblookup_last_bucket_number
;
4036 if (EQ (AREF (obarray
, hash
), tem
))
4038 if (XSYMBOL (tem
)->next
)
4041 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
4042 ASET (obarray
, hash
, sym
);
4045 ASET (obarray
, hash
, make_number (0));
4049 Lisp_Object tail
, following
;
4051 for (tail
= AREF (obarray
, hash
);
4052 XSYMBOL (tail
)->next
;
4055 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
4056 if (EQ (following
, tem
))
4058 set_symbol_next (tail
, XSYMBOL (following
)->next
);
4067 /* Return the symbol in OBARRAY whose names matches the string
4068 of SIZE characters (SIZE_BYTE bytes) at PTR.
4069 If there is no such symbol, return the integer bucket number of
4070 where the symbol would be if it were present.
4072 Also store the bucket number in oblookup_last_bucket_number. */
4075 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
4079 register Lisp_Object tail
;
4080 Lisp_Object bucket
, tem
;
4082 obarray
= check_obarray (obarray
);
4083 /* This is sometimes needed in the middle of GC. */
4084 obsize
= gc_asize (obarray
);
4085 hash
= hash_string (ptr
, size_byte
) % obsize
;
4086 bucket
= AREF (obarray
, hash
);
4087 oblookup_last_bucket_number
= hash
;
4088 if (EQ (bucket
, make_number (0)))
4090 else if (!SYMBOLP (bucket
))
4091 error ("Bad data in guts of obarray"); /* Like CADR error message. */
4093 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
4095 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
4096 && SCHARS (SYMBOL_NAME (tail
)) == size
4097 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
4099 else if (XSYMBOL (tail
)->next
== 0)
4102 XSETINT (tem
, hash
);
4107 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
4110 register Lisp_Object tail
;
4111 CHECK_VECTOR (obarray
);
4112 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
4114 tail
= AREF (obarray
, i
);
4119 if (XSYMBOL (tail
)->next
== 0)
4121 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4127 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4129 call1 (function
, sym
);
4132 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4133 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4134 OBARRAY defaults to the value of `obarray'. */)
4135 (Lisp_Object function
, Lisp_Object obarray
)
4137 if (NILP (obarray
)) obarray
= Vobarray
;
4138 obarray
= check_obarray (obarray
);
4140 map_obarray (obarray
, mapatoms_1
, function
);
4144 #define OBARRAY_SIZE 1511
4149 Lisp_Object oblength
;
4150 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4152 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4154 Vobarray
= Fmake_vector (oblength
, make_number (0));
4155 initial_obarray
= Vobarray
;
4156 staticpro (&initial_obarray
);
4158 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4159 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4161 DEFSYM (Qunbound
, "unbound");
4163 DEFSYM (Qnil
, "nil");
4164 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4165 XSYMBOL (Qnil
)->constant
= 1;
4166 XSYMBOL (Qnil
)->declared_special
= true;
4169 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4170 XSYMBOL (Qt
)->constant
= 1;
4171 XSYMBOL (Qt
)->declared_special
= true;
4173 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4176 DEFSYM (Qvariable_documentation
, "variable-documentation");
4178 read_buffer
= xmalloc (size
);
4179 read_buffer_size
= size
;
4183 defsubr (struct Lisp_Subr
*sname
)
4185 Lisp_Object sym
, tem
;
4186 sym
= intern_c_string (sname
->symbol_name
);
4187 XSETPVECTYPE (sname
, PVEC_SUBR
);
4188 XSETSUBR (tem
, sname
);
4189 set_symbol_function (sym
, tem
);
4192 #ifdef NOTDEF /* Use fset in subr.el now! */
4194 defalias (struct Lisp_Subr
*sname
, char *string
)
4197 sym
= intern (string
);
4198 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4202 /* Define an "integer variable"; a symbol whose value is forwarded to a
4203 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4204 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4206 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4207 const char *namestring
, EMACS_INT
*address
)
4210 sym
= intern_c_string (namestring
);
4211 i_fwd
->type
= Lisp_Fwd_Int
;
4212 i_fwd
->intvar
= address
;
4213 XSYMBOL (sym
)->declared_special
= 1;
4214 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4215 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4218 /* Similar but define a variable whose value is t if address contains 1,
4219 nil if address contains 0. */
4221 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4222 const char *namestring
, bool *address
)
4225 sym
= intern_c_string (namestring
);
4226 b_fwd
->type
= Lisp_Fwd_Bool
;
4227 b_fwd
->boolvar
= address
;
4228 XSYMBOL (sym
)->declared_special
= 1;
4229 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4230 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4231 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4234 /* Similar but define a variable whose value is the Lisp Object stored
4235 at address. Two versions: with and without gc-marking of the C
4236 variable. The nopro version is used when that variable will be
4237 gc-marked for some other reason, since marking the same slot twice
4238 can cause trouble with strings. */
4240 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4241 const char *namestring
, Lisp_Object
*address
)
4244 sym
= intern_c_string (namestring
);
4245 o_fwd
->type
= Lisp_Fwd_Obj
;
4246 o_fwd
->objvar
= address
;
4247 XSYMBOL (sym
)->declared_special
= 1;
4248 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4249 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4253 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4254 const char *namestring
, Lisp_Object
*address
)
4256 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4257 staticpro (address
);
4260 /* Similar but define a variable whose value is the Lisp Object stored
4261 at a particular offset in the current kboard object. */
4264 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4265 const char *namestring
, int offset
)
4268 sym
= intern_c_string (namestring
);
4269 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4270 ko_fwd
->offset
= offset
;
4271 XSYMBOL (sym
)->declared_special
= 1;
4272 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4273 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4276 /* Check that the elements of lpath exist. */
4279 load_path_check (Lisp_Object lpath
)
4281 Lisp_Object path_tail
;
4283 /* The only elements that might not exist are those from
4284 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4286 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4288 Lisp_Object dirfile
;
4289 dirfile
= Fcar (path_tail
);
4290 if (STRINGP (dirfile
))
4292 dirfile
= Fdirectory_file_name (dirfile
);
4293 if (! file_accessible_directory_p (dirfile
))
4294 dir_warning ("Lisp directory", XCAR (path_tail
));
4299 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4300 This does not include the standard site-lisp directories
4301 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4302 but it does (unless no_site_lisp is set) include site-lisp
4303 directories in the source/build directories if those exist and we
4304 are running uninstalled.
4306 Uses the following logic:
4307 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4308 The remainder is what happens when dumping works:
4309 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4310 Otherwise use PATH_LOADSEARCH.
4312 If !initialized, then just return PATH_DUMPLOADSEARCH.
4314 If Vinstallation_directory is not nil (ie, running uninstalled):
4315 If installation-dir/lisp exists and not already a member,
4316 we must be running uninstalled. Reset the load-path
4317 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4318 refers to the eventual installation directories. Since we
4319 are not yet installed, we should not use them, even if they exist.)
4320 If installation-dir/lisp does not exist, just add
4321 PATH_DUMPLOADSEARCH at the end instead.
4322 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4323 and not already a member) at the front.
4324 If installation-dir != source-dir (ie running an uninstalled,
4325 out-of-tree build) AND install-dir/src/Makefile exists BUT
4326 install-dir/src/Makefile.in does NOT exist (this is a sanity
4327 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4330 load_path_default (void)
4332 Lisp_Object lpath
= Qnil
;
4337 const char *loadpath
= ns_load_path ();
4340 normal
= PATH_LOADSEARCH
;
4342 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4344 lpath
= decode_env_path (0, normal
, 0);
4347 #else /* !CANNOT_DUMP */
4349 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4354 const char *loadpath
= ns_load_path ();
4355 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4357 lpath
= decode_env_path (0, normal
, 0);
4359 if (!NILP (Vinstallation_directory
))
4361 Lisp_Object tem
, tem1
;
4363 /* Add to the path the lisp subdir of the installation
4364 dir, if it is accessible. Note: in out-of-tree builds,
4365 this directory is empty save for Makefile. */
4366 tem
= Fexpand_file_name (build_string ("lisp"),
4367 Vinstallation_directory
);
4368 tem1
= Ffile_accessible_directory_p (tem
);
4371 if (NILP (Fmember (tem
, lpath
)))
4373 /* We are running uninstalled. The default load-path
4374 points to the eventual installed lisp directories.
4375 We should not use those now, even if they exist,
4376 so start over from a clean slate. */
4377 lpath
= list1 (tem
);
4381 /* That dir doesn't exist, so add the build-time
4382 Lisp dirs instead. */
4384 Lisp_Object dump_path
=
4385 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4386 lpath
= nconc2 (lpath
, dump_path
);
4389 /* Add site-lisp under the installation dir, if it exists. */
4392 tem
= Fexpand_file_name (build_string ("site-lisp"),
4393 Vinstallation_directory
);
4394 tem1
= Ffile_accessible_directory_p (tem
);
4397 if (NILP (Fmember (tem
, lpath
)))
4398 lpath
= Fcons (tem
, lpath
);
4402 /* If Emacs was not built in the source directory,
4403 and it is run from where it was built, add to load-path
4404 the lisp and site-lisp dirs under that directory. */
4406 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4410 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4411 Vinstallation_directory
);
4412 tem1
= Ffile_exists_p (tem
);
4414 /* Don't be fooled if they moved the entire source tree
4415 AFTER dumping Emacs. If the build directory is indeed
4416 different from the source dir, src/Makefile.in and
4417 src/Makefile will not be found together. */
4418 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4419 Vinstallation_directory
);
4420 tem2
= Ffile_exists_p (tem
);
4421 if (!NILP (tem1
) && NILP (tem2
))
4423 tem
= Fexpand_file_name (build_string ("lisp"),
4426 if (NILP (Fmember (tem
, lpath
)))
4427 lpath
= Fcons (tem
, lpath
);
4431 tem
= Fexpand_file_name (build_string ("site-lisp"),
4433 tem1
= Ffile_accessible_directory_p (tem
);
4436 if (NILP (Fmember (tem
, lpath
)))
4437 lpath
= Fcons (tem
, lpath
);
4441 } /* Vinstallation_directory != Vsource_directory */
4443 } /* if Vinstallation_directory */
4445 else /* !initialized */
4447 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4448 source directory. We used to add ../lisp (ie the lisp dir in
4449 the build directory) at the front here, but that should not
4450 be necessary, since in out of tree builds lisp/ is empty, save
4452 lpath
= decode_env_path (0, normal
, 0);
4454 #endif /* !CANNOT_DUMP */
4462 /* First, set Vload_path. */
4464 /* Ignore EMACSLOADPATH when dumping. */
4466 bool use_loadpath
= true;
4468 bool use_loadpath
= NILP (Vpurify_flag
);
4471 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4473 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4475 /* Check (non-nil) user-supplied elements. */
4476 load_path_check (Vload_path
);
4478 /* If no nils in the environment variable, use as-is.
4479 Otherwise, replace any nils with the default. */
4480 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4482 Lisp_Object elem
, elpath
= Vload_path
;
4483 Lisp_Object default_lpath
= load_path_default ();
4485 /* Check defaults, before adding site-lisp. */
4486 load_path_check (default_lpath
);
4488 /* Add the site-lisp directories to the front of the default. */
4489 if (!no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4491 Lisp_Object sitelisp
;
4492 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4493 if (! NILP (sitelisp
))
4494 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4499 /* Replace nils from EMACSLOADPATH by default. */
4500 while (CONSP (elpath
))
4502 elem
= XCAR (elpath
);
4503 elpath
= XCDR (elpath
);
4504 Vload_path
= CALLN (Fappend
, Vload_path
,
4505 NILP (elem
) ? default_lpath
: list1 (elem
));
4507 } /* Fmemq (Qnil, Vload_path) */
4511 Vload_path
= load_path_default ();
4513 /* Check before adding site-lisp directories.
4514 The install should have created them, but they are not
4515 required, so no need to warn if they are absent.
4516 Or we might be running before installation. */
4517 load_path_check (Vload_path
);
4519 /* Add the site-lisp directories at the front. */
4520 if (initialized
&& !no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4522 Lisp_Object sitelisp
;
4523 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4524 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4530 load_in_progress
= 0;
4531 Vload_file_name
= Qnil
;
4532 Vstandard_input
= Qt
;
4533 Vloads_in_progress
= Qnil
;
4536 /* Print a warning that directory intended for use USE and with name
4537 DIRNAME cannot be accessed. On entry, errno should correspond to
4538 the access failure. Print the warning on stderr and put it in
4542 dir_warning (char const *use
, Lisp_Object dirname
)
4544 static char const format
[] = "Warning: %s '%s': %s\n";
4545 int access_errno
= errno
;
4546 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)),
4547 strerror (access_errno
));
4549 /* Don't log the warning before we've initialized!! */
4552 char const *diagnostic
= emacs_strerror (access_errno
);
4554 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4555 + strlen (use
) + SBYTES (dirname
)
4556 + strlen (diagnostic
));
4557 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4559 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4565 syms_of_lread (void)
4568 defsubr (&Sread_from_string
);
4570 defsubr (&Sintern_soft
);
4571 defsubr (&Sunintern
);
4572 defsubr (&Sget_load_suffixes
);
4574 defsubr (&Seval_buffer
);
4575 defsubr (&Seval_region
);
4576 defsubr (&Sread_char
);
4577 defsubr (&Sread_char_exclusive
);
4578 defsubr (&Sread_event
);
4579 defsubr (&Sget_file_char
);
4580 defsubr (&Smapatoms
);
4581 defsubr (&Slocate_file_internal
);
4583 DEFVAR_LISP ("obarray", Vobarray
,
4584 doc
: /* Symbol table for use by `intern' and `read'.
4585 It is a vector whose length ought to be prime for best results.
4586 The vector's contents don't make sense if examined from Lisp programs;
4587 to find all the symbols in an obarray, use `mapatoms'. */);
4589 DEFVAR_LISP ("values", Vvalues
,
4590 doc
: /* List of values of all expressions which were read, evaluated and printed.
4591 Order is reverse chronological. */);
4592 XSYMBOL (intern ("values"))->declared_special
= 0;
4594 DEFVAR_LISP ("standard-input", Vstandard_input
,
4595 doc
: /* Stream for read to get input from.
4596 See documentation of `read' for possible values. */);
4597 Vstandard_input
= Qt
;
4599 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4600 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4602 If this variable is a buffer, then only forms read from that buffer
4603 will be added to `read-symbol-positions-list'.
4604 If this variable is t, then all read forms will be added.
4605 The effect of all other values other than nil are not currently
4606 defined, although they may be in the future.
4608 The positions are relative to the last call to `read' or
4609 `read-from-string'. It is probably a bad idea to set this variable at
4610 the toplevel; bind it instead. */);
4611 Vread_with_symbol_positions
= Qnil
;
4613 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4614 doc
: /* A list mapping read symbols to their positions.
4615 This variable is modified during calls to `read' or
4616 `read-from-string', but only when `read-with-symbol-positions' is
4619 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4620 CHAR-POSITION is an integer giving the offset of that occurrence of the
4621 symbol from the position where `read' or `read-from-string' started.
4623 Note that a symbol will appear multiple times in this list, if it was
4624 read multiple times. The list is in the same order as the symbols
4626 Vread_symbol_positions_list
= Qnil
;
4628 DEFVAR_LISP ("read-circle", Vread_circle
,
4629 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4632 DEFVAR_LISP ("load-path", Vload_path
,
4633 doc
: /* List of directories to search for files to load.
4634 Each element is a string (directory file name) or nil (meaning
4635 `default-directory').
4636 Initialized during startup as described in Info node `(elisp)Library Search'.
4637 Use `directory-file-name' when adding items to this path. However, Lisp
4638 programs that process this list should tolerate directories both with
4639 and without trailing slashes. */);
4641 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4642 doc
: /* List of suffixes for Emacs Lisp files and dynamic modules.
4643 This list includes suffixes for both compiled and source Emacs Lisp files.
4644 This list should not include the empty string.
4645 `load' and related functions try to append these suffixes, in order,
4646 to the specified file name if a suffix is allowed or required. */);
4648 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4649 build_pure_c_string (".el"),
4650 build_pure_c_string (MODULES_SUFFIX
));
4652 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4653 build_pure_c_string (".el"));
4655 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix
,
4656 doc
: /* Suffix of loadable module file, or nil of modules are not supported. */);
4658 Vmodule_file_suffix
= build_pure_c_string (MODULES_SUFFIX
);
4660 Vmodule_file_suffix
= Qnil
;
4662 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4663 doc
: /* List of suffixes that indicate representations of \
4665 This list should normally start with the empty string.
4667 Enabling Auto Compression mode appends the suffixes in
4668 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4669 mode removes them again. `load' and related functions use this list to
4670 determine whether they should look for compressed versions of a file
4671 and, if so, which suffixes they should try to append to the file name
4672 in order to do so. However, if you want to customize which suffixes
4673 the loading functions recognize as compression suffixes, you should
4674 customize `jka-compr-load-suffixes' rather than the present variable. */);
4675 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4677 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4678 doc
: /* Non-nil if inside of `load'. */);
4679 DEFSYM (Qload_in_progress
, "load-in-progress");
4681 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4682 doc
: /* An alist of functions to be evalled when particular files are loaded.
4683 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4685 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4686 a symbol (a feature name).
4688 When `load' is run and the file-name argument matches an element's
4689 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4690 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4692 An error in FORMS does not undo the load, but does prevent execution of
4693 the rest of the FORMS. */);
4694 Vafter_load_alist
= Qnil
;
4696 DEFVAR_LISP ("load-history", Vload_history
,
4697 doc
: /* Alist mapping loaded file names to symbols and features.
4698 Each alist element should be a list (FILE-NAME ENTRIES...), where
4699 FILE-NAME is the name of a file that has been loaded into Emacs.
4700 The file name is absolute and true (i.e. it doesn't contain symlinks).
4701 As an exception, one of the alist elements may have FILE-NAME nil,
4702 for symbols and features not associated with any file.
4704 The remaining ENTRIES in the alist element describe the functions and
4705 variables defined in that file, the features provided, and the
4706 features required. Each entry has the form `(provide . FEATURE)',
4707 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4708 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4709 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4710 autoload before this file redefined it as a function. In addition,
4711 entries may also be single symbols, which means that SYMBOL was
4712 defined by `defvar' or `defconst'.
4714 During preloading, the file name recorded is relative to the main Lisp
4715 directory. These file names are converted to absolute at startup. */);
4716 Vload_history
= Qnil
;
4718 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4719 doc
: /* Full name of file being loaded by `load'. */);
4720 Vload_file_name
= Qnil
;
4722 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4723 doc
: /* File name, including directory, of user's initialization file.
4724 If the file loaded had extension `.elc', and the corresponding source file
4725 exists, this variable contains the name of source file, suitable for use
4726 by functions like `custom-save-all' which edit the init file.
4727 While Emacs loads and evaluates the init file, value is the real name
4728 of the file, regardless of whether or not it has the `.elc' extension. */);
4729 Vuser_init_file
= Qnil
;
4731 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4732 doc
: /* Used for internal purposes by `load'. */);
4733 Vcurrent_load_list
= Qnil
;
4735 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4736 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4737 Called with a single argument (the stream from which to read).
4738 The default is to use the function `read'. */);
4739 DEFSYM (Qread
, "read");
4740 Vload_read_function
= Qread
;
4742 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4743 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4744 The value should be a function for doing code conversion before
4745 reading a source file. It can also be nil, in which case loading is
4746 done without any code conversion.
4748 If the value is a function, it is called with four arguments,
4749 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4750 the file to load, FILE is the non-absolute name (for messages etc.),
4751 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4752 `load'. The function should return t if the file was loaded. */);
4753 Vload_source_file_function
= Qnil
;
4755 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4756 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4757 This is useful when the file being loaded is a temporary copy. */);
4758 load_force_doc_strings
= 0;
4760 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4761 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4762 This is normally bound by `load' and `eval-buffer' to control `read',
4763 and is not meant for users to change. */);
4764 load_convert_to_unibyte
= 0;
4766 DEFVAR_LISP ("source-directory", Vsource_directory
,
4767 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4768 You cannot count on them to still be there! */);
4770 = Fexpand_file_name (build_string ("../"),
4771 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4773 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4774 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4775 Vpreloaded_file_list
= Qnil
;
4777 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4778 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4779 Vbyte_boolean_vars
= Qnil
;
4781 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4782 doc
: /* Non-nil means load dangerous compiled Lisp files.
4783 Some versions of XEmacs use different byte codes than Emacs. These
4784 incompatible byte codes can make Emacs crash when it tries to execute
4786 load_dangerous_libraries
= 0;
4788 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4789 doc
: /* Non-nil means force printing messages when loading Lisp files.
4790 This overrides the value of the NOMESSAGE argument to `load'. */);
4791 force_load_messages
= 0;
4793 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4794 doc
: /* Regular expression matching safe to load compiled Lisp files.
4795 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4796 from the file, and matches them against this regular expression.
4797 When the regular expression matches, the file is considered to be safe
4798 to load. See also `load-dangerous-libraries'. */);
4799 Vbytecomp_version_regexp
4800 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4802 DEFSYM (Qlexical_binding
, "lexical-binding");
4803 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4804 doc
: /* Whether to use lexical binding when evaluating code.
4805 Non-nil means that the code in the current buffer should be evaluated
4806 with lexical binding.
4807 This variable is automatically set from the file variables of an
4808 interpreted Lisp file read using `load'. Unlike other file local
4809 variables, this must be set in the first line of a file. */);
4810 Vlexical_binding
= Qnil
;
4811 Fmake_variable_buffer_local (Qlexical_binding
);
4813 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4814 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4815 Veval_buffer_list
= Qnil
;
4817 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4818 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4819 Vold_style_backquotes
= Qnil
;
4820 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4822 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4823 doc
: /* Non-nil means `load' prefers the newest version of a file.
4824 This applies when a filename suffix is not explicitly specified and
4825 `load' is trying various possible suffixes (see `load-suffixes' and
4826 `load-file-rep-suffixes'). Normally, it stops at the first file
4827 that exists unless you explicitly specify one or the other. If this
4828 option is non-nil, it checks all suffixes and uses whichever file is
4830 Note that if you customize this, obviously it will not affect files
4831 that are loaded before your customizations are read! */);
4832 load_prefer_newer
= 0;
4834 /* Vsource_directory was initialized in init_lread. */
4836 DEFSYM (Qcurrent_load_list
, "current-load-list");
4837 DEFSYM (Qstandard_input
, "standard-input");
4838 DEFSYM (Qread_char
, "read-char");
4839 DEFSYM (Qget_file_char
, "get-file-char");
4841 /* Used instead of Qget_file_char while loading *.elc files compiled
4842 by Emacs 21 or older. */
4843 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4845 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4847 DEFSYM (Qbackquote
, "`");
4848 DEFSYM (Qcomma
, ",");
4849 DEFSYM (Qcomma_at
, ",@");
4850 DEFSYM (Qcomma_dot
, ",.");
4852 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4853 DEFSYM (Qascii_character
, "ascii-character");
4854 DEFSYM (Qfunction
, "function");
4855 DEFSYM (Qload
, "load");
4856 DEFSYM (Qload_file_name
, "load-file-name");
4857 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4858 DEFSYM (Qfile_truename
, "file-truename");
4859 DEFSYM (Qdir_ok
, "dir-ok");
4860 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4862 staticpro (&read_objects
);
4863 read_objects
= Qnil
;
4864 staticpro (&seen_list
);
4867 Vloads_in_progress
= Qnil
;
4868 staticpro (&Vloads_in_progress
);
4870 DEFSYM (Qhash_table
, "hash-table");
4871 DEFSYM (Qdata
, "data");
4872 DEFSYM (Qtest
, "test");
4873 DEFSYM (Qsize
, "size");
4874 DEFSYM (Qweakness
, "weakness");
4875 DEFSYM (Qrehash_size
, "rehash-size");
4876 DEFSYM (Qrehash_threshold
, "rehash-threshold");
4878 DEFSYM (Qucs_names
, "ucs-names");