1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2015 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
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 "intervals.h"
35 #include "character.h"
43 #include "termhooks.h"
44 #include "blockinput.h"
58 #endif /* HAVE_SETLOCALE */
63 #define file_offset off_t
64 #define file_tell ftello
66 #define file_offset long
67 #define file_tell ftell
70 /* The association list of objects read with the #n=object form.
71 Each member of the list has the form (n . object), and is used to
72 look up the object for the corresponding #n# construct.
73 It must be set to nil before all top-level calls to read0. */
74 static Lisp_Object read_objects
;
76 /* File for get_file_char to read from. Use by load. */
77 static FILE *instream
;
79 /* For use within read-from-string (this reader is non-reentrant!!) */
80 static ptrdiff_t read_from_string_index
;
81 static ptrdiff_t read_from_string_index_byte
;
82 static ptrdiff_t read_from_string_limit
;
84 /* Number of characters read in the current call to Fread or
86 static EMACS_INT readchar_count
;
88 /* This contains the last string skipped with #@. */
89 static char *saved_doc_string
;
90 /* Length of buffer allocated in saved_doc_string. */
91 static ptrdiff_t saved_doc_string_size
;
92 /* Length of actual data in saved_doc_string. */
93 static ptrdiff_t saved_doc_string_length
;
94 /* This is the file position that string came from. */
95 static file_offset saved_doc_string_position
;
97 /* This contains the previous string skipped with #@.
98 We copy it from saved_doc_string when a new string
99 is put in saved_doc_string. */
100 static char *prev_saved_doc_string
;
101 /* Length of buffer allocated in prev_saved_doc_string. */
102 static ptrdiff_t prev_saved_doc_string_size
;
103 /* Length of actual data in prev_saved_doc_string. */
104 static ptrdiff_t prev_saved_doc_string_length
;
105 /* This is the file position that string came from. */
106 static file_offset prev_saved_doc_string_position
;
108 /* True means inside a new-style backquote
109 with no surrounding parentheses.
110 Fread initializes this to false, so we need not specbind it
111 or worry about what happens to it when there is an error. */
112 static bool new_backquote_flag
;
114 /* A list of file names for files being loaded in Fload. Used to
115 check for recursive loads. */
117 static Lisp_Object Vloads_in_progress
;
119 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
122 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
123 Lisp_Object
, Lisp_Object
,
124 Lisp_Object
, Lisp_Object
);
126 /* Functions that read one byte from the current source READCHARFUN
127 or unreads one byte. If the integer argument C is -1, it returns
128 one read byte, or -1 when there's no more byte in the source. If C
129 is 0 or positive, it unreads C, and the return value is not
132 static int readbyte_for_lambda (int, Lisp_Object
);
133 static int readbyte_from_file (int, Lisp_Object
);
134 static int readbyte_from_string (int, Lisp_Object
);
136 /* Handle unreading and rereading of characters.
137 Write READCHAR to read a character,
138 UNREAD(c) to unread c to be read again.
140 These macros correctly read/unread multibyte characters. */
142 #define READCHAR readchar (readcharfun, NULL)
143 #define UNREAD(c) unreadchar (readcharfun, c)
145 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
146 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
148 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
149 Qlambda, or a cons, we use this to keep an unread character because
150 a file stream can't handle multibyte-char unreading. The value -1
151 means that there's no unread character. */
152 static int unread_char
;
155 readchar (Lisp_Object readcharfun
, bool *multibyte
)
159 int (*readbyte
) (int, Lisp_Object
);
160 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
162 bool emacs_mule_encoding
= 0;
169 if (BUFFERP (readcharfun
))
171 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
173 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
175 if (! BUFFER_LIVE_P (inbuffer
))
178 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
181 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
183 /* Fetch the character code from the buffer. */
184 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
185 BUF_INC_POS (inbuffer
, pt_byte
);
192 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
193 if (! ASCII_CHAR_P (c
))
194 c
= BYTE8_TO_CHAR (c
);
197 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
201 if (MARKERP (readcharfun
))
203 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
205 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
207 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
210 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
212 /* Fetch the character code from the buffer. */
213 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
214 BUF_INC_POS (inbuffer
, bytepos
);
221 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
222 if (! ASCII_CHAR_P (c
))
223 c
= BYTE8_TO_CHAR (c
);
227 XMARKER (readcharfun
)->bytepos
= bytepos
;
228 XMARKER (readcharfun
)->charpos
++;
233 if (EQ (readcharfun
, Qlambda
))
235 readbyte
= readbyte_for_lambda
;
239 if (EQ (readcharfun
, Qget_file_char
))
241 readbyte
= readbyte_from_file
;
245 if (STRINGP (readcharfun
))
247 if (read_from_string_index
>= read_from_string_limit
)
249 else if (STRING_MULTIBYTE (readcharfun
))
253 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
254 read_from_string_index
,
255 read_from_string_index_byte
);
259 c
= SREF (readcharfun
, read_from_string_index_byte
);
260 read_from_string_index
++;
261 read_from_string_index_byte
++;
266 if (CONSP (readcharfun
))
268 /* This is the case that read_vector is reading from a unibyte
269 string that contains a byte sequence previously skipped
270 because of #@NUMBER. The car part of readcharfun is that
271 string, and the cdr part is a value of readcharfun given to
273 readbyte
= readbyte_from_string
;
274 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
275 emacs_mule_encoding
= 1;
279 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
281 readbyte
= readbyte_from_file
;
282 emacs_mule_encoding
= 1;
286 tem
= call0 (readcharfun
);
293 if (unread_char
>= 0)
299 c
= (*readbyte
) (-1, readcharfun
);
304 if (ASCII_CHAR_P (c
))
306 if (emacs_mule_encoding
)
307 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
310 len
= BYTES_BY_CHAR_HEAD (c
);
313 c
= (*readbyte
) (-1, readcharfun
);
314 if (c
< 0 || ! TRAILING_CODE_P (c
))
317 (*readbyte
) (buf
[i
], readcharfun
);
318 return BYTE8_TO_CHAR (buf
[0]);
322 return STRING_CHAR (buf
);
325 #define FROM_FILE_P(readcharfun) \
326 (EQ (readcharfun, Qget_file_char) \
327 || EQ (readcharfun, Qget_emacs_mule_file_char))
330 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
332 if (FROM_FILE_P (readcharfun
))
334 block_input (); /* FIXME: Not sure if it's needed. */
335 fseek (instream
, n
, SEEK_CUR
);
339 { /* We're not reading directly from a file. In that case, it's difficult
340 to reliably count bytes, since these are usually meant for the file's
341 encoding, whereas we're now typically in the internal encoding.
342 But luckily, skip_dyn_bytes is used to skip over a single
343 dynamic-docstring (or dynamic byte-code) which is always quoted such
344 that \037 is the final char. */
348 } while (c
>= 0 && c
!= '\037');
353 skip_dyn_eof (Lisp_Object readcharfun
)
355 if (FROM_FILE_P (readcharfun
))
357 block_input (); /* FIXME: Not sure if it's needed. */
358 fseek (instream
, 0, SEEK_END
);
362 while (READCHAR
>= 0);
365 /* Unread the character C in the way appropriate for the stream READCHARFUN.
366 If the stream is a user function, call it with the char as argument. */
369 unreadchar (Lisp_Object readcharfun
, int c
)
373 /* Don't back up the pointer if we're unreading the end-of-input mark,
374 since readchar didn't advance it when we read it. */
376 else if (BUFFERP (readcharfun
))
378 struct buffer
*b
= XBUFFER (readcharfun
);
379 ptrdiff_t charpos
= BUF_PT (b
);
380 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
382 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
383 BUF_DEC_POS (b
, bytepos
);
387 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
389 else if (MARKERP (readcharfun
))
391 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
392 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
394 XMARKER (readcharfun
)->charpos
--;
395 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
396 BUF_DEC_POS (b
, bytepos
);
400 XMARKER (readcharfun
)->bytepos
= bytepos
;
402 else if (STRINGP (readcharfun
))
404 read_from_string_index
--;
405 read_from_string_index_byte
406 = string_char_to_byte (readcharfun
, read_from_string_index
);
408 else if (CONSP (readcharfun
))
412 else if (EQ (readcharfun
, Qlambda
))
416 else if (FROM_FILE_P (readcharfun
))
421 call1 (readcharfun
, make_number (c
));
425 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
427 return read_bytecode_char (c
>= 0);
432 readbyte_from_file (int c
, Lisp_Object readcharfun
)
437 ungetc (c
, instream
);
445 /* Interrupted reads have been observed while reading over the network. */
446 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
457 return (c
== EOF
? -1 : c
);
461 readbyte_from_string (int c
, Lisp_Object readcharfun
)
463 Lisp_Object string
= XCAR (readcharfun
);
467 read_from_string_index
--;
468 read_from_string_index_byte
469 = string_char_to_byte (string
, read_from_string_index
);
472 if (read_from_string_index
>= read_from_string_limit
)
475 FETCH_STRING_CHAR_ADVANCE (c
, string
,
476 read_from_string_index
,
477 read_from_string_index_byte
);
482 /* Read one non-ASCII character from INSTREAM. The character is
483 encoded in `emacs-mule' and the first byte is already read in
487 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
489 /* Emacs-mule coding uses at most 4-byte for one character. */
490 unsigned char buf
[4];
491 int len
= emacs_mule_bytes
[c
];
492 struct charset
*charset
;
497 /* C is not a valid leading-code of `emacs-mule'. */
498 return BYTE8_TO_CHAR (c
);
504 c
= (*readbyte
) (-1, readcharfun
);
508 (*readbyte
) (buf
[i
], readcharfun
);
509 return BYTE8_TO_CHAR (buf
[0]);
516 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
517 code
= buf
[1] & 0x7F;
521 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
522 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
524 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
525 code
= buf
[2] & 0x7F;
529 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
530 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
535 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
536 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
538 c
= DECODE_CHAR (charset
, code
);
540 Fsignal (Qinvalid_read_syntax
,
541 list1 (build_string ("invalid multibyte form")));
546 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
548 static Lisp_Object
read0 (Lisp_Object
);
549 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
551 static Lisp_Object
read_list (bool, Lisp_Object
);
552 static Lisp_Object
read_vector (Lisp_Object
, bool);
554 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
556 static void substitute_object_in_subtree (Lisp_Object
,
558 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
561 /* Get a character from the tty. */
563 /* Read input events until we get one that's acceptable for our purposes.
565 If NO_SWITCH_FRAME, switch-frame events are stashed
566 until we get a character we like, and then stuffed into
569 If ASCII_REQUIRED, check function key events to see
570 if the unmodified version of the symbol has a Qascii_character
571 property, and use that character, if present.
573 If ERROR_NONASCII, signal an error if the input we
574 get isn't an ASCII character with modifiers. If it's false but
575 ASCII_REQUIRED is true, just re-read until we get an ASCII
578 If INPUT_METHOD, invoke the current input method
579 if the character warrants that.
581 If SECONDS is a number, wait that many seconds for input, and
582 return Qnil if no input arrives within that time. */
585 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
586 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
588 Lisp_Object val
, delayed_switch_frame
;
589 struct timespec end_time
;
591 #ifdef HAVE_WINDOW_SYSTEM
592 if (display_hourglass_p
)
596 delayed_switch_frame
= Qnil
;
598 /* Compute timeout. */
599 if (NUMBERP (seconds
))
601 double duration
= extract_float (seconds
);
602 struct timespec wait_time
= dtotimespec (duration
);
603 end_time
= timespec_add (current_timespec (), wait_time
);
606 /* Read until we get an acceptable event. */
609 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
610 NUMBERP (seconds
) ? &end_time
: NULL
);
611 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
616 /* `switch-frame' events are put off until after the next ASCII
617 character. This is better than signaling an error just because
618 the last characters were typed to a separate minibuffer frame,
619 for example. Eventually, some code which can deal with
620 switch-frame events will read it and process it. */
622 && EVENT_HAS_PARAMETERS (val
)
623 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
625 delayed_switch_frame
= val
;
629 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
631 /* Convert certain symbols to their ASCII equivalents. */
634 Lisp_Object tem
, tem1
;
635 tem
= Fget (val
, Qevent_symbol_element_mask
);
638 tem1
= Fget (Fcar (tem
), Qascii_character
);
639 /* Merge this symbol's modifier bits
640 with the ASCII equivalent of its basic code. */
642 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
646 /* If we don't have a character now, deal with it appropriately. */
651 Vunread_command_events
= list1 (val
);
652 error ("Non-character input-event");
659 if (! NILP (delayed_switch_frame
))
660 unread_switch_frame
= delayed_switch_frame
;
664 #ifdef HAVE_WINDOW_SYSTEM
665 if (display_hourglass_p
)
674 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
675 doc
: /* Read a character from the command input (keyboard or macro).
676 It is returned as a number.
677 If the character has modifiers, they are resolved and reflected to the
678 character code if possible (e.g. C-SPC -> 0).
680 If the user generates an event which is not a character (i.e. a mouse
681 click or function key event), `read-char' signals an error. As an
682 exception, switch-frame events are put off until non-character events
684 If you want to read non-character events, or ignore them, call
685 `read-event' or `read-char-exclusive' instead.
687 If the optional argument PROMPT is non-nil, display that as a prompt.
688 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
689 input method is turned on in the current buffer, that input method
690 is used for reading a character.
691 If the optional argument SECONDS is non-nil, it should be a number
692 specifying the maximum number of seconds to wait for input. If no
693 input arrives in that time, return nil. SECONDS may be a
694 floating-point value. */)
695 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
700 message_with_string ("%s", prompt
, 0);
701 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
703 return (NILP (val
) ? Qnil
704 : make_number (char_resolve_modifier_mask (XINT (val
))));
707 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
708 doc
: /* Read an event object from the input stream.
709 If the optional argument PROMPT is non-nil, display that as a prompt.
710 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
711 input method is turned on in the current buffer, that input method
712 is used for reading a character.
713 If the optional argument SECONDS is non-nil, it should be a number
714 specifying the maximum number of seconds to wait for input. If no
715 input arrives in that time, return nil. SECONDS may be a
716 floating-point value. */)
717 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
720 message_with_string ("%s", prompt
, 0);
721 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
724 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
725 doc
: /* Read a character from the command input (keyboard or macro).
726 It is returned as a number. Non-character events are ignored.
727 If the character has modifiers, they are resolved and reflected to the
728 character code if possible (e.g. C-SPC -> 0).
730 If the optional argument PROMPT is non-nil, display that as a prompt.
731 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
732 input method is turned on in the current buffer, that input method
733 is used for reading a character.
734 If the optional argument SECONDS is non-nil, it should be a number
735 specifying the maximum number of seconds to wait for input. If no
736 input arrives in that time, return nil. SECONDS may be a
737 floating-point value. */)
738 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
743 message_with_string ("%s", prompt
, 0);
745 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
747 return (NILP (val
) ? Qnil
748 : make_number (char_resolve_modifier_mask (XINT (val
))));
751 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
752 doc
: /* Don't use this yourself. */)
755 register Lisp_Object val
;
757 XSETINT (val
, getc (instream
));
765 /* Return true if the lisp code read using READCHARFUN defines a non-nil
766 `lexical-binding' file variable. After returning, the stream is
767 positioned following the first line, if it is a comment or #! line,
768 otherwise nothing is read. */
771 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
784 while (ch
!= '\n' && ch
!= EOF
)
786 if (ch
== '\n') ch
= READCHAR
;
787 /* It is OK to leave the position after a #! line, since
788 that is what read1 does. */
792 /* The first line isn't a comment, just give up. */
798 /* Look for an appropriate file-variable in the first line. */
802 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
803 } beg_end_state
= NOMINAL
;
804 bool in_file_vars
= 0;
806 #define UPDATE_BEG_END_STATE(ch) \
807 if (beg_end_state == NOMINAL) \
808 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
809 else if (beg_end_state == AFTER_FIRST_DASH) \
810 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
811 else if (beg_end_state == AFTER_ASTERIX) \
814 in_file_vars = !in_file_vars; \
815 beg_end_state = NOMINAL; \
818 /* Skip until we get to the file vars, if any. */
822 UPDATE_BEG_END_STATE (ch
);
824 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
828 char var
[100], val
[100];
833 /* Read a variable name. */
834 while (ch
== ' ' || ch
== '\t')
838 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
840 if (i
< sizeof var
- 1)
842 UPDATE_BEG_END_STATE (ch
);
846 /* Stop scanning if no colon was found before end marker. */
847 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
850 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
856 /* Read a variable value. */
859 while (ch
== ' ' || ch
== '\t')
863 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
865 if (i
< sizeof val
- 1)
867 UPDATE_BEG_END_STATE (ch
);
871 /* The value was terminated by an end-marker, which remove. */
873 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
877 if (strcmp (var
, "lexical-binding") == 0)
880 rv
= (strcmp (val
, "nil") != 0);
886 while (ch
!= '\n' && ch
!= EOF
)
893 /* Value is a version number of byte compiled code if the file
894 associated with file descriptor FD is a compiled Lisp file that's
895 safe to load. Only files compiled with Emacs are safe to load.
896 Files compiled with XEmacs can lead to a crash in Fbyte_code
897 because of an incompatible change in the byte compiler. */
900 safe_to_load_version (int fd
)
906 /* Read the first few bytes from the file, and look for a line
907 specifying the byte compiler version used. */
908 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
911 /* Skip to the next newline, skipping over the initial `ELC'
912 with NUL bytes following it, but note the version. */
913 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
918 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
919 buf
+ i
, nbytes
- i
) < 0)
923 lseek (fd
, 0, SEEK_SET
);
928 /* Callback for record_unwind_protect. Restore the old load list OLD,
929 after loading a file successfully. */
932 record_load_unwind (Lisp_Object old
)
934 Vloads_in_progress
= old
;
937 /* This handler function is used via internal_condition_case_1. */
940 load_error_handler (Lisp_Object data
)
946 load_warn_old_style_backquotes (Lisp_Object file
)
948 if (!NILP (Vold_style_backquotes
))
950 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
951 CALLN (Fmessage
, format
, file
);
955 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
956 doc
: /* Return the suffixes that `load' should try if a suffix is \
958 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
961 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
962 while (CONSP (suffixes
))
964 Lisp_Object exts
= Vload_file_rep_suffixes
;
965 suffix
= XCAR (suffixes
);
966 suffixes
= XCDR (suffixes
);
971 lst
= Fcons (concat2 (suffix
, ext
), lst
);
974 return Fnreverse (lst
);
977 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
978 doc
: /* Execute a file of Lisp code named FILE.
979 First try FILE with `.elc' appended, then try with `.el',
980 then try FILE unmodified (the exact suffixes in the exact order are
981 determined by `load-suffixes'). Environment variable references in
982 FILE are replaced with their values by calling `substitute-in-file-name'.
983 This function searches the directories in `load-path'.
985 If optional second arg NOERROR is non-nil,
986 report no error if FILE doesn't exist.
987 Print messages at start and end of loading unless
988 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
990 If optional fourth arg NOSUFFIX is non-nil, don't try adding
991 suffixes `.elc' or `.el' to the specified name FILE.
992 If optional fifth arg MUST-SUFFIX is non-nil, insist on
993 the suffix `.elc' or `.el'; don't accept just FILE unless
994 it ends in one of those suffixes or includes a directory name.
996 If NOSUFFIX is nil, then if a file could not be found, try looking for
997 a different representation of the file by adding non-empty suffixes to
998 its name, before trying another file. Emacs uses this feature to find
999 compressed versions of files when Auto Compression mode is enabled.
1000 If NOSUFFIX is non-nil, disable this feature.
1002 The suffixes that this function tries out, when NOSUFFIX is nil, are
1003 given by the return value of `get-load-suffixes' and the values listed
1004 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1005 return value of `get-load-suffixes' is used, i.e. the file name is
1006 required to have a non-empty suffix.
1008 When searching suffixes, this function normally stops at the first
1009 one that exists. If the option `load-prefer-newer' is non-nil,
1010 however, it tries all suffixes, and uses whichever file is the newest.
1012 Loading a file records its definitions, and its `provide' and
1013 `require' calls, in an element of `load-history' whose
1014 car is the file name loaded. See `load-history'.
1016 While the file is in the process of being loaded, the variable
1017 `load-in-progress' is non-nil and the variable `load-file-name'
1018 is bound to the file's name.
1020 Return t if the file exists and loads successfully. */)
1021 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1022 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1027 ptrdiff_t count
= SPECPDL_INDEX ();
1028 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1029 Lisp_Object found
, efound
, hist_file_name
;
1030 /* True means we printed the ".el is newer" message. */
1032 /* True means we are loading a compiled file. */
1034 Lisp_Object handler
;
1036 const char *fmode
= "r";
1043 CHECK_STRING (file
);
1045 /* If file name is magic, call the handler. */
1046 /* This shouldn't be necessary any more now that `openp' handles it right.
1047 handler = Ffind_file_name_handler (file, Qload);
1048 if (!NILP (handler))
1049 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1051 /* Do this after the handler to avoid
1052 the need to gcpro noerror, nomessage and nosuffix.
1053 (Below here, we care only whether they are nil or not.)
1054 The presence of this call is the result of a historical accident:
1055 it used to be in every file-operation and when it got removed
1056 everywhere, it accidentally stayed here. Since then, enough people
1057 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1058 that it seemed risky to remove. */
1059 if (! NILP (noerror
))
1061 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1062 Qt
, load_error_handler
);
1067 file
= Fsubstitute_in_file_name (file
);
1069 /* Avoid weird lossage with null string as arg,
1070 since it would try to load a directory as a Lisp file. */
1071 if (SCHARS (file
) == 0)
1078 Lisp_Object suffixes
;
1080 GCPRO2 (file
, found
);
1082 if (! NILP (must_suffix
))
1084 /* Don't insist on adding a suffix if FILE already ends with one. */
1085 ptrdiff_t size
= SBYTES (file
);
1087 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1090 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1092 /* Don't insist on adding a suffix
1093 if the argument includes a directory name. */
1094 else if (! NILP (Ffile_name_directory (file
)))
1098 if (!NILP (nosuffix
))
1102 suffixes
= Fget_load_suffixes ();
1103 if (NILP (must_suffix
))
1104 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1107 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1114 report_file_error ("Cannot open load file", file
);
1118 /* Tell startup.el whether or not we found the user's init file. */
1119 if (EQ (Qt
, Vuser_init_file
))
1120 Vuser_init_file
= found
;
1122 /* If FD is -2, that means openp found a magic file. */
1125 if (NILP (Fequal (found
, file
)))
1126 /* If FOUND is a different file name from FILE,
1127 find its handler even if we have already inhibited
1128 the `load' operation on FILE. */
1129 handler
= Ffind_file_name_handler (found
, Qt
);
1131 handler
= Ffind_file_name_handler (found
, Qload
);
1132 if (! NILP (handler
))
1133 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1135 /* Tramp has to deal with semi-broken packages that prepend
1136 drive letters to remote files. For that reason, Tramp
1137 catches file operations that test for file existence, which
1138 makes openp think X:/foo.elc files are remote. However,
1139 Tramp does not catch `load' operations for such files, so we
1140 end up with a nil as the `load' handler above. If we would
1141 continue with fd = -2, we will behave wrongly, and in
1142 particular try reading a .elc file in the "rt" mode instead
1143 of "rb". See bug #9311 for the results. To work around
1144 this, we try to open the file locally, and go with that if it
1146 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1154 /* Pacify older GCC with --enable-gcc-warnings. */
1155 IF_LINT (fd_index
= 0);
1159 fd_index
= SPECPDL_INDEX ();
1160 record_unwind_protect_int (close_file_unwind
, fd
);
1163 /* Check if we're stuck in a recursive load cycle.
1165 2000-09-21: It's not possible to just check for the file loaded
1166 being a member of Vloads_in_progress. This fails because of the
1167 way the byte compiler currently works; `provide's are not
1168 evaluated, see font-lock.el/jit-lock.el as an example. This
1169 leads to a certain amount of ``normal'' recursion.
1171 Also, just loading a file recursively is not always an error in
1172 the general case; the second load may do something different. */
1176 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1177 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1178 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1179 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1180 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1183 /* All loads are by default dynamic, unless the file itself specifies
1184 otherwise using a file-variable in the first line. This is bound here
1185 so that it takes effect whether or not we use
1186 Vload_source_file_function. */
1187 specbind (Qlexical_binding
, Qnil
);
1189 /* Get the name for load-history. */
1190 hist_file_name
= (! NILP (Vpurify_flag
)
1191 ? concat2 (Ffile_name_directory (file
),
1192 Ffile_name_nondirectory (found
))
1197 /* Check for the presence of old-style quotes and warn about them. */
1198 specbind (Qold_style_backquotes
, Qnil
);
1199 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1201 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1202 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1203 /* Load .elc files directly, but not when they are
1204 remote and have no handler! */
1211 GCPRO3 (file
, found
, hist_file_name
);
1214 && ! (version
= safe_to_load_version (fd
)))
1217 if (!load_dangerous_libraries
)
1218 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1219 else if (!NILP (nomessage
) && !force_load_messages
)
1220 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1225 efound
= ENCODE_FILE (found
);
1231 /* openp already checked for newness, no point doing it again.
1232 FIXME would be nice to get a message when openp
1233 ignores suffix order due to load_prefer_newer. */
1234 if (!load_prefer_newer
)
1236 result
= stat (SSDATA (efound
), &s1
);
1239 SSET (efound
, SBYTES (efound
) - 1, 0);
1240 result
= stat (SSDATA (efound
), &s2
);
1241 SSET (efound
, SBYTES (efound
) - 1, 'c');
1245 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1247 /* Make the progress messages mention that source is newer. */
1250 /* If we won't print another message, mention this anyway. */
1251 if (!NILP (nomessage
) && !force_load_messages
)
1253 Lisp_Object msg_file
;
1254 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1255 message_with_string ("Source file `%s' newer than byte-compiled file",
1259 } /* !load_prefer_newer */
1265 /* We are loading a source file (*.el). */
1266 if (!NILP (Vload_source_file_function
))
1273 clear_unwind_protect (fd_index
);
1275 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1276 NILP (noerror
) ? Qnil
: Qt
,
1277 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1278 return unbind_to (count
, val
);
1282 GCPRO3 (file
, found
, hist_file_name
);
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
) ;
1351 xfree (saved_doc_string
);
1352 saved_doc_string
= 0;
1353 saved_doc_string_size
= 0;
1355 xfree (prev_saved_doc_string
);
1356 prev_saved_doc_string
= 0;
1357 prev_saved_doc_string_size
= 0;
1359 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1362 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1365 message_with_string ("Loading %s (source)...done", file
, 1);
1367 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1369 else /* The typical case; compiled file newer than source file. */
1370 message_with_string ("Loading %s...done", file
, 1);
1377 complete_filename_p (Lisp_Object pathname
)
1379 const unsigned char *s
= SDATA (pathname
);
1380 return (IS_DIRECTORY_SEP (s
[0])
1381 || (SCHARS (pathname
) > 2
1382 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1385 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1386 doc
: /* Search for FILENAME through PATH.
1387 Returns the file's name in absolute form, or nil if not found.
1388 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1389 file name when searching.
1390 If non-nil, PREDICATE is used instead of `file-readable-p'.
1391 PREDICATE can also be an integer to pass to the faccessat(2) function,
1392 in which case file-name-handlers are ignored.
1393 This function will normally skip directories, so if you want it to find
1394 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1395 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1398 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1399 if (NILP (predicate
) && fd
>= 0)
1404 /* Search for a file whose name is STR, looking in directories
1405 in the Lisp list PATH, and trying suffixes from SUFFIX.
1406 On success, return a file descriptor (or 1 or -2 as described below).
1407 On failure, return -1 and set errno.
1409 SUFFIXES is a list of strings containing possible suffixes.
1410 The empty suffix is automatically added if the list is empty.
1412 PREDICATE non-nil means don't open the files,
1413 just look for one that satisfies the predicate. In this case,
1414 return 1 on success. The predicate can be a lisp function or
1415 an integer to pass to `access' (in which case file-name-handlers
1418 If STOREPTR is nonzero, it points to a slot where the name of
1419 the file actually found should be stored as a Lisp string.
1420 nil is stored there on failure.
1422 If the file we find is remote, return -2
1423 but store the found remote file name in *STOREPTR.
1425 If NEWER is true, try all SUFFIXes and return the result for the
1426 newest file that exists. Does not apply to remote files,
1427 or if PREDICATE is specified. */
1430 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1431 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1433 ptrdiff_t fn_size
= 100;
1437 ptrdiff_t want_length
;
1438 Lisp_Object filename
;
1439 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
, gcpro7
;
1440 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1441 ptrdiff_t max_suffix_len
= 0;
1442 int last_errno
= ENOENT
;
1446 /* The last-modified time of the newest matching file found.
1447 Initialize it to something less than all valid timestamps. */
1448 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1452 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1454 CHECK_STRING_CAR (tail
);
1455 max_suffix_len
= max (max_suffix_len
,
1456 SBYTES (XCAR (tail
)));
1459 string
= filename
= encoded_fn
= save_string
= Qnil
;
1460 GCPRO7 (str
, string
, save_string
, filename
, path
, suffixes
, encoded_fn
);
1465 absolute
= complete_filename_p (str
);
1467 for (; CONSP (path
); path
= XCDR (path
))
1469 filename
= Fexpand_file_name (str
, XCAR (path
));
1470 if (!complete_filename_p (filename
))
1471 /* If there are non-absolute elts in PATH (eg "."). */
1472 /* Of course, this could conceivably lose if luser sets
1473 default-directory to be something non-absolute... */
1475 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1476 if (!complete_filename_p (filename
))
1477 /* Give up on this path element! */
1481 /* Calculate maximum length of any filename made from
1482 this path element/specified file name and any possible suffix. */
1483 want_length
= max_suffix_len
+ SBYTES (filename
);
1484 if (fn_size
<= want_length
)
1486 fn_size
= 100 + want_length
;
1487 fn
= SAFE_ALLOCA (fn_size
);
1490 /* Loop over suffixes. */
1491 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1492 CONSP (tail
); tail
= XCDR (tail
))
1494 Lisp_Object suffix
= XCAR (tail
);
1495 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1496 Lisp_Object handler
;
1498 /* Concatenate path element/specified name with the suffix.
1499 If the directory starts with /:, remove that. */
1500 int prefixlen
= ((SCHARS (filename
) > 2
1501 && SREF (filename
, 0) == '/'
1502 && SREF (filename
, 1) == ':')
1504 fnlen
= SBYTES (filename
) - prefixlen
;
1505 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1506 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1508 /* Check that the file exists and is not a directory. */
1509 /* We used to only check for handlers on non-absolute file names:
1513 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1514 It's not clear why that was the case and it breaks things like
1515 (load "/bar.el") where the file is actually "/bar.el.gz". */
1516 /* make_string has its own ideas on when to return a unibyte
1517 string and when a multibyte string, but we know better.
1518 We must have a unibyte string when dumping, since
1519 file-name encoding is shaky at best at that time, and in
1520 particular default-file-name-coding-system is reset
1521 several times during loadup. We therefore don't want to
1522 encode the file before passing it to file I/O library
1524 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1525 string
= make_unibyte_string (fn
, fnlen
);
1527 string
= make_string (fn
, fnlen
);
1528 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1529 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1532 if (NILP (predicate
))
1533 exists
= !NILP (Ffile_readable_p (string
));
1536 Lisp_Object tmp
= call1 (predicate
, string
);
1539 else if (EQ (tmp
, Qdir_ok
)
1540 || NILP (Ffile_directory_p (string
)))
1545 last_errno
= EISDIR
;
1551 /* We succeeded; return this descriptor and filename. */
1565 encoded_fn
= ENCODE_FILE (string
);
1566 pfn
= SSDATA (encoded_fn
);
1568 /* Check that we can access or open it. */
1569 if (NATNUMP (predicate
))
1572 if (INT_MAX
< XFASTINT (predicate
))
1573 last_errno
= EINVAL
;
1574 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1578 if (file_directory_p (pfn
))
1579 last_errno
= EISDIR
;
1586 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1589 if (errno
!= ENOENT
)
1594 int err
= (fstat (fd
, &st
) != 0 ? errno
1595 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1607 if (newer
&& !NATNUMP (predicate
))
1609 struct timespec mtime
= get_stat_mtime (&st
);
1611 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1616 emacs_close (save_fd
);
1619 save_string
= string
;
1624 /* We succeeded; return this descriptor and filename. */
1633 /* No more suffixes. Return the newest. */
1634 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1637 *storeptr
= save_string
;
1655 /* Merge the list we've accumulated of globals from the current input source
1656 into the load_history variable. The details depend on whether
1657 the source has an associated file name or not.
1659 FILENAME is the file name that we are loading from.
1661 ENTIRE is true if loading that entire file, false if evaluating
1665 build_load_history (Lisp_Object filename
, bool entire
)
1667 Lisp_Object tail
, prev
, newelt
;
1668 Lisp_Object tem
, tem2
;
1671 tail
= Vload_history
;
1674 while (CONSP (tail
))
1678 /* Find the feature's previous assoc list... */
1679 if (!NILP (Fequal (filename
, Fcar (tem
))))
1683 /* If we're loading the entire file, remove old data. */
1687 Vload_history
= XCDR (tail
);
1689 Fsetcdr (prev
, XCDR (tail
));
1692 /* Otherwise, cons on new symbols that are not already members. */
1695 tem2
= Vcurrent_load_list
;
1697 while (CONSP (tem2
))
1699 newelt
= XCAR (tem2
);
1701 if (NILP (Fmember (newelt
, tem
)))
1702 Fsetcar (tail
, Fcons (XCAR (tem
),
1703 Fcons (newelt
, XCDR (tem
))));
1716 /* If we're loading an entire file, cons the new assoc onto the
1717 front of load-history, the most-recently-loaded position. Also
1718 do this if we didn't find an existing member for the file. */
1719 if (entire
|| !foundit
)
1720 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1725 readevalloop_1 (int old
)
1727 load_convert_to_unibyte
= old
;
1730 /* Signal an `end-of-file' error, if possible with file name
1733 static _Noreturn
void
1734 end_of_file_error (void)
1736 if (STRINGP (Vload_file_name
))
1737 xsignal1 (Qend_of_file
, Vload_file_name
);
1739 xsignal0 (Qend_of_file
);
1743 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1745 /* If we macroexpand the toplevel form non-recursively and it ends
1746 up being a `progn' (or if it was a progn to start), treat each
1747 form in the progn as a top-level form. This way, if one form in
1748 the progn defines a macro, that macro is in effect when we expand
1749 the remaining forms. See similar code in bytecomp.el. */
1750 val
= call2 (macroexpand
, val
, Qnil
);
1751 if (EQ (CAR_SAFE (val
), Qprogn
))
1753 struct gcpro gcpro1
;
1754 Lisp_Object subforms
= XCDR (val
);
1757 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1758 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1763 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1767 /* UNIBYTE specifies how to set load_convert_to_unibyte
1768 for this invocation.
1769 READFUN, if non-nil, is used instead of `read'.
1771 START, END specify region to read in current buffer (from eval-region).
1772 If the input is not from a buffer, they must be nil. */
1775 readevalloop (Lisp_Object readcharfun
,
1777 Lisp_Object sourcename
,
1779 Lisp_Object unibyte
, Lisp_Object readfun
,
1780 Lisp_Object start
, Lisp_Object end
)
1783 register Lisp_Object val
;
1784 ptrdiff_t count
= SPECPDL_INDEX ();
1785 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1786 struct buffer
*b
= 0;
1787 bool continue_reading_p
;
1788 Lisp_Object lex_bound
;
1789 /* True if reading an entire buffer. */
1790 bool whole_buffer
= 0;
1791 /* True on the first time around. */
1792 bool first_sexp
= 1;
1793 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1795 if (NILP (Ffboundp (macroexpand
))
1796 /* Don't macroexpand in .elc files, since it should have been done
1797 already. We actually don't know whether we're in a .elc file or not,
1798 so we use circumstantial evidence: .el files normally go through
1799 Vload_source_file_function -> load-with-code-conversion
1801 || EQ (readcharfun
, Qget_file_char
)
1802 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1805 if (MARKERP (readcharfun
))
1808 start
= readcharfun
;
1811 if (BUFFERP (readcharfun
))
1812 b
= XBUFFER (readcharfun
);
1813 else if (MARKERP (readcharfun
))
1814 b
= XMARKER (readcharfun
)->buffer
;
1816 /* We assume START is nil when input is not from a buffer. */
1817 if (! NILP (start
) && !b
)
1820 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1821 specbind (Qcurrent_load_list
, Qnil
);
1822 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1823 load_convert_to_unibyte
= !NILP (unibyte
);
1825 /* If lexical binding is active (either because it was specified in
1826 the file's header, or via a buffer-local variable), create an empty
1827 lexical environment, otherwise, turn off lexical binding. */
1828 lex_bound
= find_symbol_value (Qlexical_binding
);
1829 specbind (Qinternal_interpreter_environment
,
1830 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1831 ? Qnil
: list1 (Qt
)));
1833 GCPRO4 (sourcename
, readfun
, start
, end
);
1835 /* Try to ensure sourcename is a truename, except whilst preloading. */
1836 if (NILP (Vpurify_flag
)
1837 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1838 && !NILP (Ffboundp (Qfile_truename
)))
1839 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1841 LOADHIST_ATTACH (sourcename
);
1843 continue_reading_p
= 1;
1844 while (continue_reading_p
)
1846 ptrdiff_t count1
= SPECPDL_INDEX ();
1848 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1849 error ("Reading from killed buffer");
1853 /* Switch to the buffer we are reading from. */
1854 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1855 set_buffer_internal (b
);
1857 /* Save point in it. */
1858 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1859 /* Save ZV in it. */
1860 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1861 /* Those get unbound after we read one expression. */
1863 /* Set point and ZV around stuff to be read. */
1866 Fnarrow_to_region (make_number (BEGV
), end
);
1868 /* Just for cleanliness, convert END to a marker
1869 if it is an integer. */
1871 end
= Fpoint_max_marker ();
1874 /* On the first cycle, we can easily test here
1875 whether we are reading the whole buffer. */
1876 if (b
&& first_sexp
)
1877 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1884 while ((c
= READCHAR
) != '\n' && c
!= -1);
1889 unbind_to (count1
, Qnil
);
1893 /* Ignore whitespace here, so we can detect eof. */
1894 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1895 || c
== 0xa0) /* NBSP */
1898 if (!NILP (Vpurify_flag
) && c
== '(')
1900 val
= read_list (0, readcharfun
);
1905 read_objects
= Qnil
;
1906 if (!NILP (readfun
))
1908 val
= call1 (readfun
, readcharfun
);
1910 /* If READCHARFUN has set point to ZV, we should
1911 stop reading, even if the form read sets point
1912 to a different value when evaluated. */
1913 if (BUFFERP (readcharfun
))
1915 struct buffer
*buf
= XBUFFER (readcharfun
);
1916 if (BUF_PT (buf
) == BUF_ZV (buf
))
1917 continue_reading_p
= 0;
1920 else if (! NILP (Vload_read_function
))
1921 val
= call1 (Vload_read_function
, readcharfun
);
1923 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1926 if (!NILP (start
) && continue_reading_p
)
1927 start
= Fpoint_marker ();
1929 /* Restore saved point and BEGV. */
1930 unbind_to (count1
, Qnil
);
1932 /* Now eval what we just read. */
1933 if (!NILP (macroexpand
))
1934 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1936 val
= eval_sub (val
);
1940 Vvalues
= Fcons (val
, Vvalues
);
1941 if (EQ (Vstandard_output
, Qt
))
1950 build_load_history (sourcename
,
1951 stream
|| whole_buffer
);
1955 unbind_to (count
, Qnil
);
1958 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1959 doc
: /* Execute the current buffer as Lisp code.
1960 When called from a Lisp program (i.e., not interactively), this
1961 function accepts up to five optional arguments:
1962 BUFFER is the buffer to evaluate (nil means use current buffer).
1963 PRINTFLAG controls printing of output:
1964 A value of nil means discard it; anything else is stream for print.
1965 FILENAME specifies the file name to use for `load-history'.
1966 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1968 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1969 functions should work normally even if PRINTFLAG is nil.
1971 This function preserves the position of point. */)
1972 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1974 ptrdiff_t count
= SPECPDL_INDEX ();
1975 Lisp_Object tem
, buf
;
1978 buf
= Fcurrent_buffer ();
1980 buf
= Fget_buffer (buffer
);
1982 error ("No such buffer");
1984 if (NILP (printflag
) && NILP (do_allow_print
))
1989 if (NILP (filename
))
1990 filename
= BVAR (XBUFFER (buf
), filename
);
1992 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1993 specbind (Qstandard_output
, tem
);
1994 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1995 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1996 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1997 readevalloop (buf
, 0, filename
,
1998 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1999 unbind_to (count
, Qnil
);
2004 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2005 doc
: /* Execute the region as Lisp code.
2006 When called from programs, expects two arguments,
2007 giving starting and ending indices in the current buffer
2008 of the text to be executed.
2009 Programs can pass third argument PRINTFLAG which controls output:
2010 A value of nil means discard it; anything else is stream for printing it.
2011 Also the fourth argument READ-FUNCTION, if non-nil, is used
2012 instead of `read' to read each expression. It gets one argument
2013 which is the input stream for reading characters.
2015 This function does not move point. */)
2016 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2018 /* FIXME: Do the eval-sexp-add-defvars dance! */
2019 ptrdiff_t count
= SPECPDL_INDEX ();
2020 Lisp_Object tem
, cbuf
;
2022 cbuf
= Fcurrent_buffer ();
2024 if (NILP (printflag
))
2028 specbind (Qstandard_output
, tem
);
2029 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2031 /* `readevalloop' calls functions which check the type of start and end. */
2032 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2033 !NILP (printflag
), Qnil
, read_function
,
2036 return unbind_to (count
, Qnil
);
2040 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2041 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2042 If STREAM is nil, use the value of `standard-input' (which see).
2043 STREAM or the value of `standard-input' may be:
2044 a buffer (read from point and advance it)
2045 a marker (read from where it points and advance it)
2046 a function (call it with no arguments for each character,
2047 call it with a char as argument to push a char back)
2048 a string (takes text from string, starting at the beginning)
2049 t (read text line using minibuffer and use it, or read from
2050 standard input in batch mode). */)
2051 (Lisp_Object stream
)
2054 stream
= Vstandard_input
;
2055 if (EQ (stream
, Qt
))
2056 stream
= Qread_char
;
2057 if (EQ (stream
, Qread_char
))
2058 /* FIXME: ?! When is this used !? */
2059 return call1 (intern ("read-minibuffer"),
2060 build_string ("Lisp expression: "));
2062 return read_internal_start (stream
, Qnil
, Qnil
);
2065 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2066 doc
: /* Read one Lisp expression which is represented as text by STRING.
2067 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2068 FINAL-STRING-INDEX is an integer giving the position of the next
2069 remaining character in STRING. START and END optionally delimit
2070 a substring of STRING from which to read; they default to 0 and
2071 (length STRING) respectively. Negative values are counted from
2072 the end of STRING. */)
2073 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2076 CHECK_STRING (string
);
2077 /* `read_internal_start' sets `read_from_string_index'. */
2078 ret
= read_internal_start (string
, start
, end
);
2079 return Fcons (ret
, make_number (read_from_string_index
));
2082 /* Function to set up the global context we need in toplevel read
2083 calls. START and END only used when STREAM is a string. */
2085 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2090 new_backquote_flag
= 0;
2091 read_objects
= Qnil
;
2092 if (EQ (Vread_with_symbol_positions
, Qt
)
2093 || EQ (Vread_with_symbol_positions
, stream
))
2094 Vread_symbol_positions_list
= Qnil
;
2096 if (STRINGP (stream
)
2097 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2099 ptrdiff_t startval
, endval
;
2102 if (STRINGP (stream
))
2105 string
= XCAR (stream
);
2107 validate_subarray (string
, start
, end
, SCHARS (string
),
2108 &startval
, &endval
);
2110 read_from_string_index
= startval
;
2111 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2112 read_from_string_limit
= endval
;
2115 retval
= read0 (stream
);
2116 if (EQ (Vread_with_symbol_positions
, Qt
)
2117 || EQ (Vread_with_symbol_positions
, stream
))
2118 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2123 /* Signal Qinvalid_read_syntax error.
2124 S is error string of length N (if > 0) */
2126 static _Noreturn
void
2127 invalid_syntax (const char *s
)
2129 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2133 /* Use this for recursive reads, in contexts where internal tokens
2137 read0 (Lisp_Object readcharfun
)
2139 register Lisp_Object val
;
2142 val
= read1 (readcharfun
, &c
, 0);
2146 xsignal1 (Qinvalid_read_syntax
,
2147 Fmake_string (make_number (1), make_number (c
)));
2150 static ptrdiff_t read_buffer_size
;
2151 static char *read_buffer
;
2153 /* Read a \-escape sequence, assuming we already read the `\'.
2154 If the escape sequence forces unibyte, return eight-bit char. */
2157 read_escape (Lisp_Object readcharfun
, bool stringp
)
2160 /* \u allows up to four hex digits, \U up to eight. Default to the
2161 behavior for \u, and change this value in the case that \U is seen. */
2162 int unicode_hex_count
= 4;
2167 end_of_file_error ();
2197 error ("Invalid escape character syntax");
2200 c
= read_escape (readcharfun
, 0);
2201 return c
| meta_modifier
;
2206 error ("Invalid escape character syntax");
2209 c
= read_escape (readcharfun
, 0);
2210 return c
| shift_modifier
;
2215 error ("Invalid escape character syntax");
2218 c
= read_escape (readcharfun
, 0);
2219 return c
| hyper_modifier
;
2224 error ("Invalid escape character syntax");
2227 c
= read_escape (readcharfun
, 0);
2228 return c
| alt_modifier
;
2232 if (stringp
|| c
!= '-')
2239 c
= read_escape (readcharfun
, 0);
2240 return c
| super_modifier
;
2245 error ("Invalid escape character syntax");
2249 c
= read_escape (readcharfun
, 0);
2250 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2251 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2252 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2253 return c
| ctrl_modifier
;
2254 /* ASCII control chars are made from letters (both cases),
2255 as well as the non-letters within 0100...0137. */
2256 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2257 return (c
& (037 | ~0177));
2258 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2259 return (c
& (037 | ~0177));
2261 return c
| ctrl_modifier
;
2271 /* An octal escape, as in ANSI C. */
2273 register int i
= c
- '0';
2274 register int count
= 0;
2277 if ((c
= READCHAR
) >= '0' && c
<= '7')
2289 if (i
>= 0x80 && i
< 0x100)
2290 i
= BYTE8_TO_CHAR (i
);
2295 /* A hex escape, as in ANSI C. */
2302 if (c
>= '0' && c
<= '9')
2307 else if ((c
>= 'a' && c
<= 'f')
2308 || (c
>= 'A' && c
<= 'F'))
2311 if (c
>= 'a' && c
<= 'f')
2321 /* Allow hex escapes as large as ?\xfffffff, because some
2322 packages use them to denote characters with modifiers. */
2323 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2324 error ("Hex character out of range: \\x%x...", i
);
2328 if (count
< 3 && i
>= 0x80)
2329 return BYTE8_TO_CHAR (i
);
2334 /* Post-Unicode-2.0: Up to eight hex chars. */
2335 unicode_hex_count
= 8;
2338 /* A Unicode escape. We only permit them in strings and characters,
2339 not arbitrarily in the source code, as in some other languages. */
2344 while (++count
<= unicode_hex_count
)
2347 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2349 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2350 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2351 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2353 error ("Non-hex digit used for Unicode escape");
2356 error ("Non-Unicode character: 0x%x", i
);
2365 /* Return the digit that CHARACTER stands for in the given BASE.
2366 Return -1 if CHARACTER is out of range for BASE,
2367 and -2 if CHARACTER is not valid for any supported BASE. */
2369 digit_to_number (int character
, int base
)
2373 if ('0' <= character
&& character
<= '9')
2374 digit
= character
- '0';
2375 else if ('a' <= character
&& character
<= 'z')
2376 digit
= character
- 'a' + 10;
2377 else if ('A' <= character
&& character
<= 'Z')
2378 digit
= character
- 'A' + 10;
2382 return digit
< base
? digit
: -1;
2385 /* Read an integer in radix RADIX using READCHARFUN to read
2386 characters. RADIX must be in the interval [2..36]; if it isn't, a
2387 read error is signaled . Value is the integer read. Signals an
2388 error if encountering invalid read syntax or if RADIX is out of
2392 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2394 /* Room for sign, leading 0, other digits, trailing null byte.
2395 Also, room for invalid syntax diagnostic. */
2396 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2397 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2399 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2401 if (radix
< 2 || radix
> 36)
2409 if (c
== '-' || c
== '+')
2420 /* Ignore redundant leading zeros, so the buffer doesn't
2421 fill up with them. */
2427 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2434 if (p
< buf
+ sizeof buf
- 1)
2448 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2449 invalid_syntax (buf
);
2452 return string_to_number (buf
, radix
, 0);
2456 /* If the next token is ')' or ']' or '.', we store that character
2457 in *PCH and the return value is not interesting. Else, we store
2458 zero in *PCH and we read and return one lisp object.
2460 FIRST_IN_LIST is true if this is the first element of a list. */
2463 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2466 bool uninterned_symbol
= 0;
2473 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2475 end_of_file_error ();
2480 return read_list (0, readcharfun
);
2483 return read_vector (readcharfun
, 0);
2499 /* Accept extended format for hashtables (extensible to
2501 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2502 Lisp_Object tmp
= read_list (0, readcharfun
);
2503 Lisp_Object head
= CAR_SAFE (tmp
);
2504 Lisp_Object data
= Qnil
;
2505 Lisp_Object val
= Qnil
;
2506 /* The size is 2 * number of allowed keywords to
2508 Lisp_Object params
[10];
2510 Lisp_Object key
= Qnil
;
2511 int param_count
= 0;
2513 if (!EQ (head
, Qhash_table
))
2514 error ("Invalid extended read marker at head of #s list "
2515 "(only hash-table allowed)");
2517 tmp
= CDR_SAFE (tmp
);
2519 /* This is repetitive but fast and simple. */
2520 params
[param_count
] = QCsize
;
2521 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2522 if (!NILP (params
[param_count
+ 1]))
2525 params
[param_count
] = QCtest
;
2526 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2527 if (!NILP (params
[param_count
+ 1]))
2530 params
[param_count
] = QCweakness
;
2531 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2532 if (!NILP (params
[param_count
+ 1]))
2535 params
[param_count
] = QCrehash_size
;
2536 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2537 if (!NILP (params
[param_count
+ 1]))
2540 params
[param_count
] = QCrehash_threshold
;
2541 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2542 if (!NILP (params
[param_count
+ 1]))
2545 /* This is the hashtable data. */
2546 data
= Fplist_get (tmp
, Qdata
);
2548 /* Now use params to make a new hashtable and fill it. */
2549 ht
= Fmake_hash_table (param_count
, params
);
2551 while (CONSP (data
))
2556 error ("Odd number of elements in hashtable data");
2559 Fputhash (key
, val
, ht
);
2565 invalid_syntax ("#");
2573 tmp
= read_vector (readcharfun
, 0);
2574 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2575 error ("Invalid size char-table");
2576 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2584 /* Sub char-table can't be read as a regular
2585 vector because of a two C integer fields. */
2586 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2587 ptrdiff_t size
= XINT (Flength (tmp
));
2588 int i
, depth
, min_char
;
2589 struct Lisp_Cons
*cell
;
2592 error ("Zero-sized sub char-table");
2594 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2595 error ("Invalid depth in sub char-table");
2596 depth
= XINT (XCAR (tmp
));
2597 if (chartab_size
[depth
] != size
- 2)
2598 error ("Invalid size in sub char-table");
2599 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2602 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2603 error ("Invalid minimum character in sub-char-table");
2604 min_char
= XINT (XCAR (tmp
));
2605 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2608 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2609 for (i
= 0; i
< size
; i
++)
2611 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2612 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2617 invalid_syntax ("#^^");
2619 invalid_syntax ("#^");
2624 length
= read1 (readcharfun
, pch
, first_in_list
);
2628 Lisp_Object tmp
, val
;
2629 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2630 unsigned char *data
;
2633 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2634 if (STRING_MULTIBYTE (tmp
)
2635 || (size_in_chars
!= SCHARS (tmp
)
2636 /* We used to print 1 char too many
2637 when the number of bits was a multiple of 8.
2638 Accept such input in case it came from an old
2640 && ! (XFASTINT (length
)
2641 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2642 invalid_syntax ("#&...");
2644 val
= make_uninit_bool_vector (XFASTINT (length
));
2645 data
= bool_vector_uchar_data (val
);
2646 memcpy (data
, SDATA (tmp
), size_in_chars
);
2647 /* Clear the extraneous bits in the last byte. */
2648 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2649 data
[size_in_chars
- 1]
2650 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2653 invalid_syntax ("#&...");
2657 /* Accept compiled functions at read-time so that we don't have to
2658 build them using function calls. */
2660 struct Lisp_Vector
*vec
;
2661 tmp
= read_vector (readcharfun
, 1);
2662 vec
= XVECTOR (tmp
);
2663 if (vec
->header
.size
== 0)
2664 invalid_syntax ("Empty byte-code object");
2665 make_byte_code (vec
);
2671 struct gcpro gcpro1
;
2674 /* Read the string itself. */
2675 tmp
= read1 (readcharfun
, &ch
, 0);
2676 if (ch
!= 0 || !STRINGP (tmp
))
2677 invalid_syntax ("#");
2679 /* Read the intervals and their properties. */
2682 Lisp_Object beg
, end
, plist
;
2684 beg
= read1 (readcharfun
, &ch
, 0);
2689 end
= read1 (readcharfun
, &ch
, 0);
2691 plist
= read1 (readcharfun
, &ch
, 0);
2693 invalid_syntax ("Invalid string property list");
2694 Fset_text_properties (beg
, end
, plist
, tmp
);
2700 /* #@NUMBER is used to skip NUMBER following bytes.
2701 That's used in .elc files to skip over doc strings
2702 and function definitions. */
2705 enum { extra
= 100 };
2706 ptrdiff_t i
, nskip
= 0, digits
= 0;
2708 /* Read a decimal integer. */
2709 while ((c
= READCHAR
) >= 0
2710 && c
>= '0' && c
<= '9')
2712 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2717 if (digits
== 2 && nskip
== 0)
2718 { /* We've just seen #@00, which means "skip to end". */
2719 skip_dyn_eof (readcharfun
);
2724 /* We can't use UNREAD here, because in the code below we side-step
2725 READCHAR. Instead, assume the first char after #@NNN occupies
2726 a single byte, which is the case normally since it's just
2732 if (load_force_doc_strings
2733 && (FROM_FILE_P (readcharfun
)))
2735 /* If we are supposed to force doc strings into core right now,
2736 record the last string that we skipped,
2737 and record where in the file it comes from. */
2739 /* But first exchange saved_doc_string
2740 with prev_saved_doc_string, so we save two strings. */
2742 char *temp
= saved_doc_string
;
2743 ptrdiff_t temp_size
= saved_doc_string_size
;
2744 file_offset temp_pos
= saved_doc_string_position
;
2745 ptrdiff_t temp_len
= saved_doc_string_length
;
2747 saved_doc_string
= prev_saved_doc_string
;
2748 saved_doc_string_size
= prev_saved_doc_string_size
;
2749 saved_doc_string_position
= prev_saved_doc_string_position
;
2750 saved_doc_string_length
= prev_saved_doc_string_length
;
2752 prev_saved_doc_string
= temp
;
2753 prev_saved_doc_string_size
= temp_size
;
2754 prev_saved_doc_string_position
= temp_pos
;
2755 prev_saved_doc_string_length
= temp_len
;
2758 if (saved_doc_string_size
== 0)
2760 saved_doc_string
= xmalloc (nskip
+ extra
);
2761 saved_doc_string_size
= nskip
+ extra
;
2763 if (nskip
> saved_doc_string_size
)
2765 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2766 saved_doc_string_size
= nskip
+ extra
;
2769 saved_doc_string_position
= file_tell (instream
);
2771 /* Copy that many characters into saved_doc_string. */
2773 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2774 saved_doc_string
[i
] = c
= getc (instream
);
2777 saved_doc_string_length
= i
;
2780 /* Skip that many bytes. */
2781 skip_dyn_bytes (readcharfun
, nskip
);
2787 /* #! appears at the beginning of an executable file.
2788 Skip the first line. */
2789 while (c
!= '\n' && c
>= 0)
2794 return Vload_file_name
;
2796 return list2 (Qfunction
, read0 (readcharfun
));
2797 /* #:foo is the uninterned symbol named foo. */
2800 uninterned_symbol
= 1;
2803 && c
!= 0xa0 /* NBSP */
2805 || strchr ("\"';()[]#`,", c
) == NULL
)))
2807 /* No symbol character follows, this is the empty
2810 return Fmake_symbol (empty_unibyte_string
);
2814 /* ## is the empty symbol. */
2816 return Fintern (empty_unibyte_string
, Qnil
);
2817 /* Reader forms that can reuse previously read objects. */
2818 if (c
>= '0' && c
<= '9')
2823 /* Read a non-negative integer. */
2824 while (c
>= '0' && c
<= '9')
2826 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2827 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2828 n
= MOST_POSITIVE_FIXNUM
+ 1;
2830 n
= n
* 10 + c
- '0';
2834 if (n
<= MOST_POSITIVE_FIXNUM
)
2836 if (c
== 'r' || c
== 'R')
2837 return read_integer (readcharfun
, n
);
2839 if (! NILP (Vread_circle
))
2841 /* #n=object returns object, but associates it with
2845 /* Make a placeholder for #n# to use temporarily. */
2846 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2847 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2848 read_objects
= Fcons (cell
, read_objects
);
2850 /* Read the object itself. */
2851 tem
= read0 (readcharfun
);
2853 /* Now put it everywhere the placeholder was... */
2854 substitute_object_in_subtree (tem
, placeholder
);
2856 /* ...and #n# will use the real value from now on. */
2857 Fsetcdr (cell
, tem
);
2862 /* #n# returns a previously read object. */
2865 tem
= Fassq (make_number (n
), read_objects
);
2871 /* Fall through to error message. */
2873 else if (c
== 'x' || c
== 'X')
2874 return read_integer (readcharfun
, 16);
2875 else if (c
== 'o' || c
== 'O')
2876 return read_integer (readcharfun
, 8);
2877 else if (c
== 'b' || c
== 'B')
2878 return read_integer (readcharfun
, 2);
2881 invalid_syntax ("#");
2884 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2888 return list2 (Qquote
, read0 (readcharfun
));
2892 int next_char
= READCHAR
;
2894 /* Transition from old-style to new-style:
2895 If we see "(`" it used to mean old-style, which usually works
2896 fine because ` should almost never appear in such a position
2897 for new-style. But occasionally we need "(`" to mean new
2898 style, so we try to distinguish the two by the fact that we
2899 can either write "( `foo" or "(` foo", where the first
2900 intends to use new-style whereas the second intends to use
2901 old-style. For Emacs-25, we should completely remove this
2902 first_in_list exception (old-style can still be obtained via
2904 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2906 Vold_style_backquotes
= Qt
;
2912 bool saved_new_backquote_flag
= new_backquote_flag
;
2914 new_backquote_flag
= 1;
2915 value
= read0 (readcharfun
);
2916 new_backquote_flag
= saved_new_backquote_flag
;
2918 return list2 (Qbackquote
, value
);
2923 int next_char
= READCHAR
;
2925 /* Transition from old-style to new-style:
2926 It used to be impossible to have a new-style , other than within
2927 a new-style `. This is sufficient when ` and , are used in the
2928 normal way, but ` and , can also appear in args to macros that
2929 will not interpret them in the usual way, in which case , may be
2930 used without any ` anywhere near.
2931 So we now use the same heuristic as for backquote: old-style
2932 unquotes are only recognized when first on a list, and when
2933 followed by a space.
2934 Because it's more difficult to peek 2 chars ahead, a new-style
2935 ,@ can still not be used outside of a `, unless it's in the middle
2937 if (new_backquote_flag
2939 || (next_char
!= ' ' && next_char
!= '@'))
2941 Lisp_Object comma_type
= Qnil
;
2946 comma_type
= Qcomma_at
;
2948 comma_type
= Qcomma_dot
;
2951 if (ch
>= 0) UNREAD (ch
);
2952 comma_type
= Qcomma
;
2955 value
= read0 (readcharfun
);
2956 return list2 (comma_type
, value
);
2960 Vold_style_backquotes
= Qt
;
2972 end_of_file_error ();
2974 /* Accept `single space' syntax like (list ? x) where the
2975 whitespace character is SPC or TAB.
2976 Other literal whitespace like NL, CR, and FF are not accepted,
2977 as there are well-established escape sequences for these. */
2978 if (c
== ' ' || c
== '\t')
2979 return make_number (c
);
2982 c
= read_escape (readcharfun
, 0);
2983 modifiers
= c
& CHAR_MODIFIER_MASK
;
2984 c
&= ~CHAR_MODIFIER_MASK
;
2985 if (CHAR_BYTE8_P (c
))
2986 c
= CHAR_TO_BYTE8 (c
);
2989 next_char
= READCHAR
;
2990 ok
= (next_char
<= 040
2991 || (next_char
< 0200
2992 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2995 return make_number (c
);
2997 invalid_syntax ("?");
3002 char *p
= read_buffer
;
3003 char *end
= read_buffer
+ read_buffer_size
;
3005 /* True if we saw an escape sequence specifying
3006 a multibyte character. */
3007 bool force_multibyte
= 0;
3008 /* True if we saw an escape sequence specifying
3009 a single-byte character. */
3010 bool force_singlebyte
= 0;
3012 ptrdiff_t nchars
= 0;
3014 while ((ch
= READCHAR
) >= 0
3017 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3019 ptrdiff_t offset
= p
- read_buffer
;
3020 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3021 memory_full (SIZE_MAX
);
3022 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3023 read_buffer_size
*= 2;
3024 p
= read_buffer
+ offset
;
3025 end
= read_buffer
+ read_buffer_size
;
3032 ch
= read_escape (readcharfun
, 1);
3034 /* CH is -1 if \ newline has just been seen. */
3037 if (p
== read_buffer
)
3042 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3043 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3045 if (CHAR_BYTE8_P (ch
))
3046 force_singlebyte
= 1;
3047 else if (! ASCII_CHAR_P (ch
))
3048 force_multibyte
= 1;
3049 else /* I.e. ASCII_CHAR_P (ch). */
3051 /* Allow `\C- ' and `\C-?'. */
3052 if (modifiers
== CHAR_CTL
)
3055 ch
= 0, modifiers
= 0;
3057 ch
= 127, modifiers
= 0;
3059 if (modifiers
& CHAR_SHIFT
)
3061 /* Shift modifier is valid only with [A-Za-z]. */
3062 if (ch
>= 'A' && ch
<= 'Z')
3063 modifiers
&= ~CHAR_SHIFT
;
3064 else if (ch
>= 'a' && ch
<= 'z')
3065 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3068 if (modifiers
& CHAR_META
)
3070 /* Move the meta bit to the right place for a
3072 modifiers
&= ~CHAR_META
;
3073 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3074 force_singlebyte
= 1;
3078 /* Any modifiers remaining are invalid. */
3080 error ("Invalid modifier in string");
3081 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3085 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3086 if (CHAR_BYTE8_P (ch
))
3087 force_singlebyte
= 1;
3088 else if (! ASCII_CHAR_P (ch
))
3089 force_multibyte
= 1;
3095 end_of_file_error ();
3097 /* If purifying, and string starts with \ newline,
3098 return zero instead. This is for doc strings
3099 that we are really going to find in etc/DOC.nn.nn. */
3100 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3101 return make_number (0);
3103 if (! force_multibyte
&& force_singlebyte
)
3105 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3106 forms. Convert it to unibyte. */
3107 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3109 p
= read_buffer
+ nchars
;
3112 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3114 || (p
- read_buffer
!= nchars
)));
3119 int next_char
= READCHAR
;
3122 if (next_char
<= 040
3123 || (next_char
< 0200
3124 && strchr ("\"';([#?`,", next_char
) != NULL
))
3130 /* Otherwise, we fall through! Note that the atom-reading loop
3131 below will now loop at least once, assuring that we will not
3132 try to UNREAD two characters in a row. */
3136 if (c
<= 040) goto retry
;
3137 if (c
== 0xa0) /* NBSP */
3142 char *p
= read_buffer
;
3144 EMACS_INT start_position
= readchar_count
- 1;
3147 char *end
= read_buffer
+ read_buffer_size
;
3151 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3153 ptrdiff_t offset
= p
- read_buffer
;
3154 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3155 memory_full (SIZE_MAX
);
3156 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3157 read_buffer_size
*= 2;
3158 p
= read_buffer
+ offset
;
3159 end
= read_buffer
+ read_buffer_size
;
3166 end_of_file_error ();
3171 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3177 && c
!= 0xa0 /* NBSP */
3179 || strchr ("\"';()[]#`,", c
) == NULL
));
3183 ptrdiff_t offset
= p
- read_buffer
;
3184 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3185 memory_full (SIZE_MAX
);
3186 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3187 read_buffer_size
*= 2;
3188 p
= read_buffer
+ offset
;
3189 end
= read_buffer
+ read_buffer_size
;
3195 if (!quoted
&& !uninterned_symbol
)
3197 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3198 if (! NILP (result
))
3202 Lisp_Object name
, result
;
3203 ptrdiff_t nbytes
= p
- read_buffer
;
3206 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3210 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3211 ? make_pure_string
: make_specified_string
)
3212 (read_buffer
, nchars
, nbytes
, multibyte
));
3213 result
= (uninterned_symbol
? Fmake_symbol (name
)
3214 : Fintern (name
, Qnil
));
3216 if (EQ (Vread_with_symbol_positions
, Qt
)
3217 || EQ (Vread_with_symbol_positions
, readcharfun
))
3218 Vread_symbol_positions_list
3219 = Fcons (Fcons (result
, make_number (start_position
)),
3220 Vread_symbol_positions_list
);
3228 /* List of nodes we've seen during substitute_object_in_subtree. */
3229 static Lisp_Object seen_list
;
3232 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3234 Lisp_Object check_object
;
3236 /* We haven't seen any objects when we start. */
3239 /* Make all the substitutions. */
3241 = substitute_object_recurse (object
, placeholder
, object
);
3243 /* Clear seen_list because we're done with it. */
3246 /* The returned object here is expected to always eq the
3248 if (!EQ (check_object
, object
))
3249 error ("Unexpected mutation error in reader");
3252 /* Feval doesn't get called from here, so no gc protection is needed. */
3253 #define SUBSTITUTE(get_val, set_val) \
3255 Lisp_Object old_value = get_val; \
3256 Lisp_Object true_value \
3257 = substitute_object_recurse (object, placeholder, \
3260 if (!EQ (old_value, true_value)) \
3267 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3269 /* If we find the placeholder, return the target object. */
3270 if (EQ (placeholder
, subtree
))
3273 /* If we've been to this node before, don't explore it again. */
3274 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3277 /* If this node can be the entry point to a cycle, remember that
3278 we've seen it. It can only be such an entry point if it was made
3279 by #n=, which means that we can find it as a value in
3281 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3282 seen_list
= Fcons (subtree
, seen_list
);
3284 /* Recurse according to subtree's type.
3285 Every branch must return a Lisp_Object. */
3286 switch (XTYPE (subtree
))
3288 case Lisp_Vectorlike
:
3290 ptrdiff_t i
, length
= 0;
3291 if (BOOL_VECTOR_P (subtree
))
3292 return subtree
; /* No sub-objects anyway. */
3293 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3294 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3295 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3296 else if (VECTORP (subtree
))
3297 length
= ASIZE (subtree
);
3299 /* An unknown pseudovector may contain non-Lisp fields, so we
3300 can't just blindly traverse all its fields. We used to call
3301 `Flength' which signaled `sequencep', so I just preserved this
3303 wrong_type_argument (Qsequencep
, subtree
);
3305 for (i
= 0; i
< length
; i
++)
3306 SUBSTITUTE (AREF (subtree
, i
),
3307 ASET (subtree
, i
, true_value
));
3313 SUBSTITUTE (XCAR (subtree
),
3314 XSETCAR (subtree
, true_value
));
3315 SUBSTITUTE (XCDR (subtree
),
3316 XSETCDR (subtree
, true_value
));
3322 /* Check for text properties in each interval.
3323 substitute_in_interval contains part of the logic. */
3325 INTERVAL root_interval
= string_intervals (subtree
);
3326 AUTO_CONS (arg
, object
, placeholder
);
3328 traverse_intervals_noorder (root_interval
,
3329 &substitute_in_interval
, arg
);
3334 /* Other types don't recurse any further. */
3340 /* Helper function for substitute_object_recurse. */
3342 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3344 Lisp_Object object
= Fcar (arg
);
3345 Lisp_Object placeholder
= Fcdr (arg
);
3347 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3357 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3358 integer syntax and fits in a fixnum, else return the nearest float if CP has
3359 either floating point or integer syntax and BASE is 10, else return nil. If
3360 IGNORE_TRAILING, consider just the longest prefix of CP that has
3361 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3362 number has integer syntax but does not fit. */
3365 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3368 char const *cp
= string
;
3370 bool float_syntax
= 0;
3373 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3374 IEEE floating point hosts, and works around a formerly-common bug where
3375 atof ("-0.0") drops the sign. */
3376 bool negative
= *cp
== '-';
3378 bool signedp
= negative
|| *cp
== '+';
3383 leading_digit
= digit_to_number (*cp
, base
);
3384 if (leading_digit
>= 0)
3389 while (digit_to_number (*cp
, base
) >= 0);
3399 if ('0' <= *cp
&& *cp
<= '9')
3404 while ('0' <= *cp
&& *cp
<= '9');
3406 if (*cp
== 'e' || *cp
== 'E')
3408 char const *ecp
= cp
;
3410 if (*cp
== '+' || *cp
== '-')
3412 if ('0' <= *cp
&& *cp
<= '9')
3417 while ('0' <= *cp
&& *cp
<= '9');
3419 else if (cp
[-1] == '+'
3420 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3426 else if (cp
[-1] == '+'
3427 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3431 /* NAN is a "positive" NaN on all known Emacs hosts. */
3438 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3439 || state
== (LEAD_INT
|E_EXP
));
3442 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3443 any prefix that matches. Otherwise, the entire string must match. */
3444 if (! (ignore_trailing
3445 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3446 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3449 /* If the number uses integer and not float syntax, and is in C-language
3450 range, use its value, preferably as a fixnum. */
3451 if (leading_digit
>= 0 && ! float_syntax
)
3455 /* Fast special case for single-digit integers. This also avoids a
3456 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3457 case some versions of strtoumax accept numbers like "0x1" that Emacs
3459 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3460 return make_number (negative
? -leading_digit
: leading_digit
);
3463 n
= strtoumax (string
+ signedp
, NULL
, base
);
3464 if (errno
== ERANGE
)
3466 /* Unfortunately there's no simple and accurate way to convert
3467 non-base-10 numbers that are out of C-language range. */
3469 xsignal1 (Qoverflow_error
, build_string (string
));
3471 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3473 EMACS_INT signed_n
= n
;
3474 return make_number (negative
? -signed_n
: signed_n
);
3480 /* Either the number uses float syntax, or it does not fit into a fixnum.
3481 Convert it from string to floating point, unless the value is already
3482 known because it is an infinity, a NAN, or its absolute value fits in
3485 value
= atof (string
+ signedp
);
3487 return make_float (negative
? -value
: value
);
3492 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3496 Lisp_Object tem
, item
, vector
;
3497 struct Lisp_Cons
*otem
;
3500 tem
= read_list (1, readcharfun
);
3501 len
= Flength (tem
);
3502 vector
= Fmake_vector (len
, Qnil
);
3504 size
= ASIZE (vector
);
3505 ptr
= XVECTOR (vector
)->contents
;
3506 for (i
= 0; i
< size
; i
++)
3509 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3510 bytecode object, the docstring containing the bytecode and
3511 constants values must be treated as unibyte and passed to
3512 Fread, to get the actual bytecode string and constants vector. */
3513 if (bytecodeflag
&& load_force_doc_strings
)
3515 if (i
== COMPILED_BYTECODE
)
3517 if (!STRINGP (item
))
3518 error ("Invalid byte code");
3520 /* Delay handling the bytecode slot until we know whether
3521 it is lazily-loaded (we can tell by whether the
3522 constants slot is nil). */
3523 ASET (vector
, COMPILED_CONSTANTS
, item
);
3526 else if (i
== COMPILED_CONSTANTS
)
3528 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3532 /* Coerce string to unibyte (like string-as-unibyte,
3533 but without generating extra garbage and
3534 guaranteeing no change in the contents). */
3535 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3536 STRING_SET_UNIBYTE (bytestr
);
3538 item
= Fread (Fcons (bytestr
, readcharfun
));
3540 error ("Invalid byte code");
3542 otem
= XCONS (item
);
3543 bytestr
= XCAR (item
);
3548 /* Now handle the bytecode slot. */
3549 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3551 else if (i
== COMPILED_DOC_STRING
3553 && ! STRING_MULTIBYTE (item
))
3555 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3556 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3558 item
= Fstring_as_multibyte (item
);
3561 ASET (vector
, i
, item
);
3569 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3572 read_list (bool flag
, Lisp_Object readcharfun
)
3574 Lisp_Object val
, tail
;
3575 Lisp_Object elt
, tem
;
3576 struct gcpro gcpro1
, gcpro2
;
3577 /* 0 is the normal case.
3578 1 means this list is a doc reference; replace it with the number 0.
3579 2 means this list is a doc reference; replace it with the doc string. */
3580 int doc_reference
= 0;
3582 /* Initialize this to 1 if we are reading a list. */
3583 bool first_in_list
= flag
<= 0;
3592 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3597 /* While building, if the list starts with #$, treat it specially. */
3598 if (EQ (elt
, Vload_file_name
)
3600 && !NILP (Vpurify_flag
))
3602 if (NILP (Vdoc_file_name
))
3603 /* We have not yet called Snarf-documentation, so assume
3604 this file is described in the DOC file
3605 and Snarf-documentation will fill in the right value later.
3606 For now, replace the whole list with 0. */
3609 /* We have already called Snarf-documentation, so make a relative
3610 file name for this file, so it can be found properly
3611 in the installed Lisp directory.
3612 We don't use Fexpand_file_name because that would make
3613 the directory absolute now. */
3615 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3616 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3619 else if (EQ (elt
, Vload_file_name
)
3621 && load_force_doc_strings
)
3630 invalid_syntax (") or . in a vector");
3638 XSETCDR (tail
, read0 (readcharfun
));
3640 val
= read0 (readcharfun
);
3641 read1 (readcharfun
, &ch
, 0);
3645 if (doc_reference
== 1)
3646 return make_number (0);
3647 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3650 file_offset saved_position
;
3651 /* Get a doc string from the file we are loading.
3652 If it's in saved_doc_string, get it from there.
3654 Here, we don't know if the string is a
3655 bytecode string or a doc string. As a
3656 bytecode string must be unibyte, we always
3657 return a unibyte string. If it is actually a
3658 doc string, caller must make it
3661 /* Position is negative for user variables. */
3662 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3663 if (pos
>= saved_doc_string_position
3664 && pos
< (saved_doc_string_position
3665 + saved_doc_string_length
))
3667 saved
= saved_doc_string
;
3668 saved_position
= saved_doc_string_position
;
3670 /* Look in prev_saved_doc_string the same way. */
3671 else if (pos
>= prev_saved_doc_string_position
3672 && pos
< (prev_saved_doc_string_position
3673 + prev_saved_doc_string_length
))
3675 saved
= prev_saved_doc_string
;
3676 saved_position
= prev_saved_doc_string_position
;
3680 ptrdiff_t start
= pos
- saved_position
;
3683 /* Process quoting with ^A,
3684 and find the end of the string,
3685 which is marked with ^_ (037). */
3686 for (from
= start
, to
= start
;
3687 saved
[from
] != 037;)
3689 int c
= saved
[from
++];
3693 saved
[to
++] = (c
== 1 ? c
3702 return make_unibyte_string (saved
+ start
,
3706 return get_doc_string (val
, 1, 0);
3711 invalid_syntax (". in wrong context");
3713 invalid_syntax ("] in a list");
3717 XSETCDR (tail
, tem
);
3724 static Lisp_Object initial_obarray
;
3726 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3728 static size_t oblookup_last_bucket_number
;
3730 /* Get an error if OBARRAY is not an obarray.
3731 If it is one, return it. */
3734 check_obarray (Lisp_Object obarray
)
3736 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3738 /* If Vobarray is now invalid, force it to be valid. */
3739 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3740 wrong_type_argument (Qvectorp
, obarray
);
3745 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3748 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3752 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3753 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3756 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3758 XSYMBOL (sym
)->constant
= 1;
3759 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3760 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3763 ptr
= aref_addr (obarray
, XINT (index
));
3764 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3769 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3772 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3774 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3777 /* Intern the C string STR: return a symbol with that name,
3778 interned in the current obarray. */
3781 intern_1 (const char *str
, ptrdiff_t len
)
3783 Lisp_Object obarray
= check_obarray (Vobarray
);
3784 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3786 return SYMBOLP (tem
) ? tem
: intern_driver (make_string (str
, len
),
3791 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3793 Lisp_Object obarray
= check_obarray (Vobarray
);
3794 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3798 /* Creating a non-pure string from a string literal not implemented yet.
3799 We could just use make_string here and live with the extra copy. */
3800 eassert (!NILP (Vpurify_flag
));
3801 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3807 define_symbol (Lisp_Object sym
, char const *str
)
3809 ptrdiff_t len
= strlen (str
);
3810 Lisp_Object string
= make_pure_c_string (str
, len
);
3811 init_symbol (sym
, string
);
3813 /* Qunbound is uninterned, so that it's not confused with any symbol
3814 'unbound' created by a Lisp program. */
3815 if (! EQ (sym
, Qunbound
))
3817 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3818 eassert (INTEGERP (bucket
));
3819 intern_sym (sym
, initial_obarray
, bucket
);
3823 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3824 doc
: /* Return the canonical symbol whose name is STRING.
3825 If there is none, one is created by this function and returned.
3826 A second optional argument specifies the obarray to use;
3827 it defaults to the value of `obarray'. */)
3828 (Lisp_Object string
, Lisp_Object obarray
)
3832 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3833 CHECK_STRING (string
);
3835 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3837 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3842 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3843 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3844 NAME may be a string or a symbol. If it is a symbol, that exact
3845 symbol is searched for.
3846 A second optional argument specifies the obarray to use;
3847 it defaults to the value of `obarray'. */)
3848 (Lisp_Object name
, Lisp_Object obarray
)
3850 register Lisp_Object tem
, string
;
3852 if (NILP (obarray
)) obarray
= Vobarray
;
3853 obarray
= check_obarray (obarray
);
3855 if (!SYMBOLP (name
))
3857 CHECK_STRING (name
);
3861 string
= SYMBOL_NAME (name
);
3863 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3864 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3870 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3871 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3872 The value is t if a symbol was found and deleted, nil otherwise.
3873 NAME may be a string or a symbol. If it is a symbol, that symbol
3874 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3875 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3876 usage: (unintern NAME OBARRAY) */)
3877 (Lisp_Object name
, Lisp_Object obarray
)
3879 register Lisp_Object string
, tem
;
3882 if (NILP (obarray
)) obarray
= Vobarray
;
3883 obarray
= check_obarray (obarray
);
3886 string
= SYMBOL_NAME (name
);
3889 CHECK_STRING (name
);
3893 tem
= oblookup (obarray
, SSDATA (string
),
3898 /* If arg was a symbol, don't delete anything but that symbol itself. */
3899 if (SYMBOLP (name
) && !EQ (name
, tem
))
3902 /* There are plenty of other symbols which will screw up the Emacs
3903 session if we unintern them, as well as even more ways to use
3904 `setq' or `fset' or whatnot to make the Emacs session
3905 unusable. Let's not go down this silly road. --Stef */
3906 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3907 error ("Attempt to unintern t or nil"); */
3909 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3911 hash
= oblookup_last_bucket_number
;
3913 if (EQ (AREF (obarray
, hash
), tem
))
3915 if (XSYMBOL (tem
)->next
)
3918 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3919 ASET (obarray
, hash
, sym
);
3922 ASET (obarray
, hash
, make_number (0));
3926 Lisp_Object tail
, following
;
3928 for (tail
= AREF (obarray
, hash
);
3929 XSYMBOL (tail
)->next
;
3932 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3933 if (EQ (following
, tem
))
3935 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3944 /* Return the symbol in OBARRAY whose names matches the string
3945 of SIZE characters (SIZE_BYTE bytes) at PTR.
3946 If there is no such symbol, return the integer bucket number of
3947 where the symbol would be if it were present.
3949 Also store the bucket number in oblookup_last_bucket_number. */
3952 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3956 register Lisp_Object tail
;
3957 Lisp_Object bucket
, tem
;
3959 obarray
= check_obarray (obarray
);
3960 obsize
= ASIZE (obarray
);
3962 /* This is sometimes needed in the middle of GC. */
3963 obsize
&= ~ARRAY_MARK_FLAG
;
3964 hash
= hash_string (ptr
, size_byte
) % obsize
;
3965 bucket
= AREF (obarray
, hash
);
3966 oblookup_last_bucket_number
= hash
;
3967 if (EQ (bucket
, make_number (0)))
3969 else if (!SYMBOLP (bucket
))
3970 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3972 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3974 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3975 && SCHARS (SYMBOL_NAME (tail
)) == size
3976 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3978 else if (XSYMBOL (tail
)->next
== 0)
3981 XSETINT (tem
, hash
);
3986 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3989 register Lisp_Object tail
;
3990 CHECK_VECTOR (obarray
);
3991 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3993 tail
= AREF (obarray
, i
);
3998 if (XSYMBOL (tail
)->next
== 0)
4000 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4006 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4008 call1 (function
, sym
);
4011 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4012 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4013 OBARRAY defaults to the value of `obarray'. */)
4014 (Lisp_Object function
, Lisp_Object obarray
)
4016 if (NILP (obarray
)) obarray
= Vobarray
;
4017 obarray
= check_obarray (obarray
);
4019 map_obarray (obarray
, mapatoms_1
, function
);
4023 #define OBARRAY_SIZE 1511
4028 Lisp_Object oblength
;
4029 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4031 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4033 Vobarray
= Fmake_vector (oblength
, make_number (0));
4034 initial_obarray
= Vobarray
;
4035 staticpro (&initial_obarray
);
4037 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4038 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4040 DEFSYM (Qunbound
, "unbound");
4042 DEFSYM (Qnil
, "nil");
4043 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4044 XSYMBOL (Qnil
)->constant
= 1;
4045 XSYMBOL (Qnil
)->declared_special
= true;
4048 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4049 XSYMBOL (Qt
)->constant
= 1;
4050 XSYMBOL (Qt
)->declared_special
= true;
4052 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4055 DEFSYM (Qvariable_documentation
, "variable-documentation");
4057 read_buffer
= xmalloc (size
);
4058 read_buffer_size
= size
;
4062 defsubr (struct Lisp_Subr
*sname
)
4064 Lisp_Object sym
, tem
;
4065 sym
= intern_c_string (sname
->symbol_name
);
4066 XSETPVECTYPE (sname
, PVEC_SUBR
);
4067 XSETSUBR (tem
, sname
);
4068 set_symbol_function (sym
, tem
);
4071 #ifdef NOTDEF /* Use fset in subr.el now! */
4073 defalias (struct Lisp_Subr
*sname
, char *string
)
4076 sym
= intern (string
);
4077 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4081 /* Define an "integer variable"; a symbol whose value is forwarded to a
4082 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4083 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4085 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4086 const char *namestring
, EMACS_INT
*address
)
4089 sym
= intern_c_string (namestring
);
4090 i_fwd
->type
= Lisp_Fwd_Int
;
4091 i_fwd
->intvar
= address
;
4092 XSYMBOL (sym
)->declared_special
= 1;
4093 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4094 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4097 /* Similar but define a variable whose value is t if address contains 1,
4098 nil if address contains 0. */
4100 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4101 const char *namestring
, bool *address
)
4104 sym
= intern_c_string (namestring
);
4105 b_fwd
->type
= Lisp_Fwd_Bool
;
4106 b_fwd
->boolvar
= address
;
4107 XSYMBOL (sym
)->declared_special
= 1;
4108 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4109 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4110 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4113 /* Similar but define a variable whose value is the Lisp Object stored
4114 at address. Two versions: with and without gc-marking of the C
4115 variable. The nopro version is used when that variable will be
4116 gc-marked for some other reason, since marking the same slot twice
4117 can cause trouble with strings. */
4119 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4120 const char *namestring
, Lisp_Object
*address
)
4123 sym
= intern_c_string (namestring
);
4124 o_fwd
->type
= Lisp_Fwd_Obj
;
4125 o_fwd
->objvar
= address
;
4126 XSYMBOL (sym
)->declared_special
= 1;
4127 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4128 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4132 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4133 const char *namestring
, Lisp_Object
*address
)
4135 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4136 staticpro (address
);
4139 /* Similar but define a variable whose value is the Lisp Object stored
4140 at a particular offset in the current kboard object. */
4143 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4144 const char *namestring
, int offset
)
4147 sym
= intern_c_string (namestring
);
4148 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4149 ko_fwd
->offset
= offset
;
4150 XSYMBOL (sym
)->declared_special
= 1;
4151 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4152 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4155 /* Check that the elements of lpath exist. */
4158 load_path_check (Lisp_Object lpath
)
4160 Lisp_Object path_tail
;
4162 /* The only elements that might not exist are those from
4163 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4165 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4167 Lisp_Object dirfile
;
4168 dirfile
= Fcar (path_tail
);
4169 if (STRINGP (dirfile
))
4171 dirfile
= Fdirectory_file_name (dirfile
);
4172 if (! file_accessible_directory_p (dirfile
))
4173 dir_warning ("Lisp directory", XCAR (path_tail
));
4178 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4179 This does not include the standard site-lisp directories
4180 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4181 but it does (unless no_site_lisp is set) include site-lisp
4182 directories in the source/build directories if those exist and we
4183 are running uninstalled.
4185 Uses the following logic:
4186 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4187 The remainder is what happens when dumping works:
4188 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4189 Otherwise use PATH_LOADSEARCH.
4191 If !initialized, then just return PATH_DUMPLOADSEARCH.
4193 If Vinstallation_directory is not nil (ie, running uninstalled):
4194 If installation-dir/lisp exists and not already a member,
4195 we must be running uninstalled. Reset the load-path
4196 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4197 refers to the eventual installation directories. Since we
4198 are not yet installed, we should not use them, even if they exist.)
4199 If installation-dir/lisp does not exist, just add
4200 PATH_DUMPLOADSEARCH at the end instead.
4201 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4202 and not already a member) at the front.
4203 If installation-dir != source-dir (ie running an uninstalled,
4204 out-of-tree build) AND install-dir/src/Makefile exists BUT
4205 install-dir/src/Makefile.in does NOT exist (this is a sanity
4206 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4209 load_path_default (void)
4211 Lisp_Object lpath
= Qnil
;
4216 const char *loadpath
= ns_load_path ();
4219 normal
= PATH_LOADSEARCH
;
4221 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4223 lpath
= decode_env_path (0, normal
, 0);
4226 #else /* !CANNOT_DUMP */
4228 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4233 const char *loadpath
= ns_load_path ();
4234 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4236 lpath
= decode_env_path (0, normal
, 0);
4238 if (!NILP (Vinstallation_directory
))
4240 Lisp_Object tem
, tem1
;
4242 /* Add to the path the lisp subdir of the installation
4243 dir, if it is accessible. Note: in out-of-tree builds,
4244 this directory is empty save for Makefile. */
4245 tem
= Fexpand_file_name (build_string ("lisp"),
4246 Vinstallation_directory
);
4247 tem1
= Ffile_accessible_directory_p (tem
);
4250 if (NILP (Fmember (tem
, lpath
)))
4252 /* We are running uninstalled. The default load-path
4253 points to the eventual installed lisp directories.
4254 We should not use those now, even if they exist,
4255 so start over from a clean slate. */
4256 lpath
= list1 (tem
);
4260 /* That dir doesn't exist, so add the build-time
4261 Lisp dirs instead. */
4263 Lisp_Object dump_path
=
4264 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4265 lpath
= nconc2 (lpath
, dump_path
);
4268 /* Add site-lisp under the installation dir, if it exists. */
4271 tem
= Fexpand_file_name (build_string ("site-lisp"),
4272 Vinstallation_directory
);
4273 tem1
= Ffile_accessible_directory_p (tem
);
4276 if (NILP (Fmember (tem
, lpath
)))
4277 lpath
= Fcons (tem
, lpath
);
4281 /* If Emacs was not built in the source directory,
4282 and it is run from where it was built, add to load-path
4283 the lisp and site-lisp dirs under that directory. */
4285 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4289 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4290 Vinstallation_directory
);
4291 tem1
= Ffile_exists_p (tem
);
4293 /* Don't be fooled if they moved the entire source tree
4294 AFTER dumping Emacs. If the build directory is indeed
4295 different from the source dir, src/Makefile.in and
4296 src/Makefile will not be found together. */
4297 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4298 Vinstallation_directory
);
4299 tem2
= Ffile_exists_p (tem
);
4300 if (!NILP (tem1
) && NILP (tem2
))
4302 tem
= Fexpand_file_name (build_string ("lisp"),
4305 if (NILP (Fmember (tem
, lpath
)))
4306 lpath
= Fcons (tem
, lpath
);
4310 tem
= Fexpand_file_name (build_string ("site-lisp"),
4312 tem1
= Ffile_accessible_directory_p (tem
);
4315 if (NILP (Fmember (tem
, lpath
)))
4316 lpath
= Fcons (tem
, lpath
);
4320 } /* Vinstallation_directory != Vsource_directory */
4322 } /* if Vinstallation_directory */
4324 else /* !initialized */
4326 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4327 source directory. We used to add ../lisp (ie the lisp dir in
4328 the build directory) at the front here, but that should not
4329 be necessary, since in out of tree builds lisp/ is empty, save
4331 lpath
= decode_env_path (0, normal
, 0);
4333 #endif /* !CANNOT_DUMP */
4341 /* First, set Vload_path. */
4343 /* Ignore EMACSLOADPATH when dumping. */
4345 bool use_loadpath
= true;
4347 bool use_loadpath
= NILP (Vpurify_flag
);
4350 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4352 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4354 /* Check (non-nil) user-supplied elements. */
4355 load_path_check (Vload_path
);
4357 /* If no nils in the environment variable, use as-is.
4358 Otherwise, replace any nils with the default. */
4359 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4361 Lisp_Object elem
, elpath
= Vload_path
;
4362 Lisp_Object default_lpath
= load_path_default ();
4364 /* Check defaults, before adding site-lisp. */
4365 load_path_check (default_lpath
);
4367 /* Add the site-lisp directories to the front of the default. */
4370 Lisp_Object sitelisp
;
4371 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4372 if (! NILP (sitelisp
))
4373 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4378 /* Replace nils from EMACSLOADPATH by default. */
4379 while (CONSP (elpath
))
4381 elem
= XCAR (elpath
);
4382 elpath
= XCDR (elpath
);
4383 Vload_path
= CALLN (Fappend
, Vload_path
,
4384 NILP (elem
) ? default_lpath
: list1 (elem
));
4386 } /* Fmemq (Qnil, Vload_path) */
4390 Vload_path
= load_path_default ();
4392 /* Check before adding site-lisp directories.
4393 The install should have created them, but they are not
4394 required, so no need to warn if they are absent.
4395 Or we might be running before installation. */
4396 load_path_check (Vload_path
);
4398 /* Add the site-lisp directories at the front. */
4399 if (initialized
&& !no_site_lisp
)
4401 Lisp_Object sitelisp
;
4402 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4403 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4409 load_in_progress
= 0;
4410 Vload_file_name
= Qnil
;
4411 Vstandard_input
= Qt
;
4412 Vloads_in_progress
= Qnil
;
4415 /* Print a warning that directory intended for use USE and with name
4416 DIRNAME cannot be accessed. On entry, errno should correspond to
4417 the access failure. Print the warning on stderr and put it in
4421 dir_warning (char const *use
, Lisp_Object dirname
)
4423 static char const format
[] = "Warning: %s `%s': %s\n";
4424 int access_errno
= errno
;
4425 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4427 /* Don't log the warning before we've initialized!! */
4430 char const *diagnostic
= emacs_strerror (access_errno
);
4432 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4433 + strlen (use
) + SBYTES (dirname
)
4434 + strlen (diagnostic
));
4435 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4437 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4443 syms_of_lread (void)
4446 defsubr (&Sread_from_string
);
4448 defsubr (&Sintern_soft
);
4449 defsubr (&Sunintern
);
4450 defsubr (&Sget_load_suffixes
);
4452 defsubr (&Seval_buffer
);
4453 defsubr (&Seval_region
);
4454 defsubr (&Sread_char
);
4455 defsubr (&Sread_char_exclusive
);
4456 defsubr (&Sread_event
);
4457 defsubr (&Sget_file_char
);
4458 defsubr (&Smapatoms
);
4459 defsubr (&Slocate_file_internal
);
4461 DEFVAR_LISP ("obarray", Vobarray
,
4462 doc
: /* Symbol table for use by `intern' and `read'.
4463 It is a vector whose length ought to be prime for best results.
4464 The vector's contents don't make sense if examined from Lisp programs;
4465 to find all the symbols in an obarray, use `mapatoms'. */);
4467 DEFVAR_LISP ("values", Vvalues
,
4468 doc
: /* List of values of all expressions which were read, evaluated and printed.
4469 Order is reverse chronological. */);
4470 XSYMBOL (intern ("values"))->declared_special
= 0;
4472 DEFVAR_LISP ("standard-input", Vstandard_input
,
4473 doc
: /* Stream for read to get input from.
4474 See documentation of `read' for possible values. */);
4475 Vstandard_input
= Qt
;
4477 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4478 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4480 If this variable is a buffer, then only forms read from that buffer
4481 will be added to `read-symbol-positions-list'.
4482 If this variable is t, then all read forms will be added.
4483 The effect of all other values other than nil are not currently
4484 defined, although they may be in the future.
4486 The positions are relative to the last call to `read' or
4487 `read-from-string'. It is probably a bad idea to set this variable at
4488 the toplevel; bind it instead. */);
4489 Vread_with_symbol_positions
= Qnil
;
4491 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4492 doc
: /* A list mapping read symbols to their positions.
4493 This variable is modified during calls to `read' or
4494 `read-from-string', but only when `read-with-symbol-positions' is
4497 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4498 CHAR-POSITION is an integer giving the offset of that occurrence of the
4499 symbol from the position where `read' or `read-from-string' started.
4501 Note that a symbol will appear multiple times in this list, if it was
4502 read multiple times. The list is in the same order as the symbols
4504 Vread_symbol_positions_list
= Qnil
;
4506 DEFVAR_LISP ("read-circle", Vread_circle
,
4507 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4510 DEFVAR_LISP ("load-path", Vload_path
,
4511 doc
: /* List of directories to search for files to load.
4512 Each element is a string (directory name) or nil (meaning `default-directory').
4513 Initialized during startup as described in Info node `(elisp)Library Search'. */);
4515 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4516 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4517 This list should not include the empty string.
4518 `load' and related functions try to append these suffixes, in order,
4519 to the specified file name if a Lisp suffix is allowed or required. */);
4520 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4521 build_pure_c_string (".el"));
4522 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4523 doc
: /* List of suffixes that indicate representations of \
4525 This list should normally start with the empty string.
4527 Enabling Auto Compression mode appends the suffixes in
4528 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4529 mode removes them again. `load' and related functions use this list to
4530 determine whether they should look for compressed versions of a file
4531 and, if so, which suffixes they should try to append to the file name
4532 in order to do so. However, if you want to customize which suffixes
4533 the loading functions recognize as compression suffixes, you should
4534 customize `jka-compr-load-suffixes' rather than the present variable. */);
4535 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4537 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4538 doc
: /* Non-nil if inside of `load'. */);
4539 DEFSYM (Qload_in_progress
, "load-in-progress");
4541 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4542 doc
: /* An alist of functions to be evalled when particular files are loaded.
4543 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4545 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4546 a symbol \(a feature name).
4548 When `load' is run and the file-name argument matches an element's
4549 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4550 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4552 An error in FORMS does not undo the load, but does prevent execution of
4553 the rest of the FORMS. */);
4554 Vafter_load_alist
= Qnil
;
4556 DEFVAR_LISP ("load-history", Vload_history
,
4557 doc
: /* Alist mapping loaded file names to symbols and features.
4558 Each alist element should be a list (FILE-NAME ENTRIES...), where
4559 FILE-NAME is the name of a file that has been loaded into Emacs.
4560 The file name is absolute and true (i.e. it doesn't contain symlinks).
4561 As an exception, one of the alist elements may have FILE-NAME nil,
4562 for symbols and features not associated with any file.
4564 The remaining ENTRIES in the alist element describe the functions and
4565 variables defined in that file, the features provided, and the
4566 features required. Each entry has the form `(provide . FEATURE)',
4567 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4568 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4569 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4570 autoload before this file redefined it as a function. In addition,
4571 entries may also be single symbols, which means that SYMBOL was
4572 defined by `defvar' or `defconst'.
4574 During preloading, the file name recorded is relative to the main Lisp
4575 directory. These file names are converted to absolute at startup. */);
4576 Vload_history
= Qnil
;
4578 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4579 doc
: /* Full name of file being loaded by `load'. */);
4580 Vload_file_name
= Qnil
;
4582 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4583 doc
: /* File name, including directory, of user's initialization file.
4584 If the file loaded had extension `.elc', and the corresponding source file
4585 exists, this variable contains the name of source file, suitable for use
4586 by functions like `custom-save-all' which edit the init file.
4587 While Emacs loads and evaluates the init file, value is the real name
4588 of the file, regardless of whether or not it has the `.elc' extension. */);
4589 Vuser_init_file
= Qnil
;
4591 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4592 doc
: /* Used for internal purposes by `load'. */);
4593 Vcurrent_load_list
= Qnil
;
4595 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4596 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4597 The default is nil, which means use the function `read'. */);
4598 Vload_read_function
= Qnil
;
4600 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4601 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4602 The value should be a function for doing code conversion before
4603 reading a source file. It can also be nil, in which case loading is
4604 done without any code conversion.
4606 If the value is a function, it is called with four arguments,
4607 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4608 the file to load, FILE is the non-absolute name (for messages etc.),
4609 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4610 `load'. The function should return t if the file was loaded. */);
4611 Vload_source_file_function
= Qnil
;
4613 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4614 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4615 This is useful when the file being loaded is a temporary copy. */);
4616 load_force_doc_strings
= 0;
4618 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4619 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4620 This is normally bound by `load' and `eval-buffer' to control `read',
4621 and is not meant for users to change. */);
4622 load_convert_to_unibyte
= 0;
4624 DEFVAR_LISP ("source-directory", Vsource_directory
,
4625 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4626 You cannot count on them to still be there! */);
4628 = Fexpand_file_name (build_string ("../"),
4629 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4631 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4632 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4633 Vpreloaded_file_list
= Qnil
;
4635 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4636 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4637 Vbyte_boolean_vars
= Qnil
;
4639 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4640 doc
: /* Non-nil means load dangerous compiled Lisp files.
4641 Some versions of XEmacs use different byte codes than Emacs. These
4642 incompatible byte codes can make Emacs crash when it tries to execute
4644 load_dangerous_libraries
= 0;
4646 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4647 doc
: /* Non-nil means force printing messages when loading Lisp files.
4648 This overrides the value of the NOMESSAGE argument to `load'. */);
4649 force_load_messages
= 0;
4651 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4652 doc
: /* Regular expression matching safe to load compiled Lisp files.
4653 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4654 from the file, and matches them against this regular expression.
4655 When the regular expression matches, the file is considered to be safe
4656 to load. See also `load-dangerous-libraries'. */);
4657 Vbytecomp_version_regexp
4658 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4660 DEFSYM (Qlexical_binding
, "lexical-binding");
4661 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4662 doc
: /* Whether to use lexical binding when evaluating code.
4663 Non-nil means that the code in the current buffer should be evaluated
4664 with lexical binding.
4665 This variable is automatically set from the file variables of an
4666 interpreted Lisp file read using `load'. Unlike other file local
4667 variables, this must be set in the first line of a file. */);
4668 Vlexical_binding
= Qnil
;
4669 Fmake_variable_buffer_local (Qlexical_binding
);
4671 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4672 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4673 Veval_buffer_list
= Qnil
;
4675 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4676 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4677 Vold_style_backquotes
= Qnil
;
4678 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4680 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4681 doc
: /* Non-nil means `load' prefers the newest version of a file.
4682 This applies when a filename suffix is not explicitly specified and
4683 `load' is trying various possible suffixes (see `load-suffixes' and
4684 `load-file-rep-suffixes'). Normally, it stops at the first file
4685 that exists unless you explicitly specify one or the other. If this
4686 option is non-nil, it checks all suffixes and uses whichever file is
4688 Note that if you customize this, obviously it will not affect files
4689 that are loaded before your customizations are read! */);
4690 load_prefer_newer
= 0;
4692 /* Vsource_directory was initialized in init_lread. */
4694 DEFSYM (Qcurrent_load_list
, "current-load-list");
4695 DEFSYM (Qstandard_input
, "standard-input");
4696 DEFSYM (Qread_char
, "read-char");
4697 DEFSYM (Qget_file_char
, "get-file-char");
4699 /* Used instead of Qget_file_char while loading *.elc files compiled
4700 by Emacs 21 or older. */
4701 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4703 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4705 DEFSYM (Qbackquote
, "`");
4706 DEFSYM (Qcomma
, ",");
4707 DEFSYM (Qcomma_at
, ",@");
4708 DEFSYM (Qcomma_dot
, ",.");
4710 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4711 DEFSYM (Qascii_character
, "ascii-character");
4712 DEFSYM (Qfunction
, "function");
4713 DEFSYM (Qload
, "load");
4714 DEFSYM (Qload_file_name
, "load-file-name");
4715 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4716 DEFSYM (Qfile_truename
, "file-truename");
4717 DEFSYM (Qdir_ok
, "dir-ok");
4718 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4720 staticpro (&read_objects
);
4721 read_objects
= Qnil
;
4722 staticpro (&seen_list
);
4725 Vloads_in_progress
= Qnil
;
4726 staticpro (&Vloads_in_progress
);
4728 DEFSYM (Qhash_table
, "hash-table");
4729 DEFSYM (Qdata
, "data");
4730 DEFSYM (Qtest
, "test");
4731 DEFSYM (Qsize
, "size");
4732 DEFSYM (Qweakness
, "weakness");
4733 DEFSYM (Qrehash_size
, "rehash-size");
4734 DEFSYM (Qrehash_threshold
, "rehash-threshold");