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 %qs: 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" FOPEN_TEXT
;
1039 CHECK_STRING (file
);
1041 /* If file name is magic, call the handler. */
1042 /* This shouldn't be necessary any more now that `openp' handles it right.
1043 handler = Ffind_file_name_handler (file, Qload);
1044 if (!NILP (handler))
1045 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1047 /* Do this after the handler to avoid
1048 the need to gcpro noerror, nomessage and nosuffix.
1049 (Below here, we care only whether they are nil or not.)
1050 The presence of this call is the result of a historical accident:
1051 it used to be in every file-operation and when it got removed
1052 everywhere, it accidentally stayed here. Since then, enough people
1053 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1054 that it seemed risky to remove. */
1055 if (! NILP (noerror
))
1057 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1058 Qt
, load_error_handler
);
1063 file
= Fsubstitute_in_file_name (file
);
1065 /* Avoid weird lossage with null string as arg,
1066 since it would try to load a directory as a Lisp file. */
1067 if (SCHARS (file
) == 0)
1074 Lisp_Object suffixes
;
1076 GCPRO2 (file
, found
);
1078 if (! NILP (must_suffix
))
1080 /* Don't insist on adding a suffix if FILE already ends with one. */
1081 ptrdiff_t size
= SBYTES (file
);
1083 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1086 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1088 /* Don't insist on adding a suffix
1089 if the argument includes a directory name. */
1090 else if (! NILP (Ffile_name_directory (file
)))
1094 if (!NILP (nosuffix
))
1098 suffixes
= Fget_load_suffixes ();
1099 if (NILP (must_suffix
))
1100 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1103 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1110 report_file_error ("Cannot open load file", file
);
1114 /* Tell startup.el whether or not we found the user's init file. */
1115 if (EQ (Qt
, Vuser_init_file
))
1116 Vuser_init_file
= found
;
1118 /* If FD is -2, that means openp found a magic file. */
1121 if (NILP (Fequal (found
, file
)))
1122 /* If FOUND is a different file name from FILE,
1123 find its handler even if we have already inhibited
1124 the `load' operation on FILE. */
1125 handler
= Ffind_file_name_handler (found
, Qt
);
1127 handler
= Ffind_file_name_handler (found
, Qload
);
1128 if (! NILP (handler
))
1129 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1131 /* Tramp has to deal with semi-broken packages that prepend
1132 drive letters to remote files. For that reason, Tramp
1133 catches file operations that test for file existence, which
1134 makes openp think X:/foo.elc files are remote. However,
1135 Tramp does not catch `load' operations for such files, so we
1136 end up with a nil as the `load' handler above. If we would
1137 continue with fd = -2, we will behave wrongly, and in
1138 particular try reading a .elc file in the "rt" mode instead
1139 of "rb". See bug #9311 for the results. To work around
1140 this, we try to open the file locally, and go with that if it
1142 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1150 /* Pacify older GCC with --enable-gcc-warnings. */
1151 IF_LINT (fd_index
= 0);
1155 fd_index
= SPECPDL_INDEX ();
1156 record_unwind_protect_int (close_file_unwind
, fd
);
1159 /* Check if we're stuck in a recursive load cycle.
1161 2000-09-21: It's not possible to just check for the file loaded
1162 being a member of Vloads_in_progress. This fails because of the
1163 way the byte compiler currently works; `provide's are not
1164 evaluated, see font-lock.el/jit-lock.el as an example. This
1165 leads to a certain amount of ``normal'' recursion.
1167 Also, just loading a file recursively is not always an error in
1168 the general case; the second load may do something different. */
1172 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1173 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1174 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1175 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1176 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1179 /* All loads are by default dynamic, unless the file itself specifies
1180 otherwise using a file-variable in the first line. This is bound here
1181 so that it takes effect whether or not we use
1182 Vload_source_file_function. */
1183 specbind (Qlexical_binding
, Qnil
);
1185 /* Get the name for load-history. */
1186 hist_file_name
= (! NILP (Vpurify_flag
)
1187 ? concat2 (Ffile_name_directory (file
),
1188 Ffile_name_nondirectory (found
))
1193 /* Check for the presence of old-style quotes and warn about them. */
1194 specbind (Qold_style_backquotes
, Qnil
);
1195 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1197 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1198 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1199 /* Load .elc files directly, but not when they are
1200 remote and have no handler! */
1207 GCPRO3 (file
, found
, hist_file_name
);
1210 && ! (version
= safe_to_load_version (fd
)))
1213 if (!load_dangerous_libraries
)
1214 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1215 else if (!NILP (nomessage
) && !force_load_messages
)
1216 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1221 efound
= ENCODE_FILE (found
);
1222 fmode
= "r" FOPEN_BINARY
;
1224 /* openp already checked for newness, no point doing it again.
1225 FIXME would be nice to get a message when openp
1226 ignores suffix order due to load_prefer_newer. */
1227 if (!load_prefer_newer
)
1229 result
= stat (SSDATA (efound
), &s1
);
1232 SSET (efound
, SBYTES (efound
) - 1, 0);
1233 result
= stat (SSDATA (efound
), &s2
);
1234 SSET (efound
, SBYTES (efound
) - 1, 'c');
1238 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1240 /* Make the progress messages mention that source is newer. */
1243 /* If we won't print another message, mention this anyway. */
1244 if (!NILP (nomessage
) && !force_load_messages
)
1246 Lisp_Object msg_file
;
1247 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1248 message_with_string ("Source file `%s' newer than byte-compiled file",
1252 } /* !load_prefer_newer */
1258 /* We are loading a source file (*.el). */
1259 if (!NILP (Vload_source_file_function
))
1266 clear_unwind_protect (fd_index
);
1268 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1269 NILP (noerror
) ? Qnil
: Qt
,
1270 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1271 return unbind_to (count
, val
);
1275 GCPRO3 (file
, found
, hist_file_name
);
1279 /* We somehow got here with fd == -2, meaning the file is deemed
1280 to be remote. Don't even try to reopen the file locally;
1281 just force a failure. */
1289 clear_unwind_protect (fd_index
);
1290 efound
= ENCODE_FILE (found
);
1291 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1293 stream
= fdopen (fd
, fmode
);
1297 report_file_error ("Opening stdio stream", file
);
1298 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1300 if (! NILP (Vpurify_flag
))
1301 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1303 if (NILP (nomessage
) || force_load_messages
)
1306 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1309 message_with_string ("Loading %s (source)...", file
, 1);
1311 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1313 else /* The typical case; compiled file newer than source file. */
1314 message_with_string ("Loading %s...", file
, 1);
1317 specbind (Qload_file_name
, found
);
1318 specbind (Qinhibit_file_name_operation
, Qnil
);
1319 specbind (Qload_in_progress
, Qt
);
1322 if (lisp_file_lexically_bound_p (Qget_file_char
))
1323 Fset (Qlexical_binding
, Qt
);
1325 if (! version
|| version
>= 22)
1326 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1327 0, Qnil
, Qnil
, Qnil
, Qnil
);
1330 /* We can't handle a file which was compiled with
1331 byte-compile-dynamic by older version of Emacs. */
1332 specbind (Qload_force_doc_strings
, Qt
);
1333 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1334 0, Qnil
, Qnil
, Qnil
, Qnil
);
1336 unbind_to (count
, Qnil
);
1338 /* Run any eval-after-load forms for this file. */
1339 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1340 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1344 xfree (saved_doc_string
);
1345 saved_doc_string
= 0;
1346 saved_doc_string_size
= 0;
1348 xfree (prev_saved_doc_string
);
1349 prev_saved_doc_string
= 0;
1350 prev_saved_doc_string_size
= 0;
1352 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1355 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1358 message_with_string ("Loading %s (source)...done", file
, 1);
1360 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1362 else /* The typical case; compiled file newer than source file. */
1363 message_with_string ("Loading %s...done", file
, 1);
1370 complete_filename_p (Lisp_Object pathname
)
1372 const unsigned char *s
= SDATA (pathname
);
1373 return (IS_DIRECTORY_SEP (s
[0])
1374 || (SCHARS (pathname
) > 2
1375 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1378 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1379 doc
: /* Search for FILENAME through PATH.
1380 Returns the file's name in absolute form, or nil if not found.
1381 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1382 file name when searching.
1383 If non-nil, PREDICATE is used instead of `file-readable-p'.
1384 PREDICATE can also be an integer to pass to the faccessat(2) function,
1385 in which case file-name-handlers are ignored.
1386 This function will normally skip directories, so if you want it to find
1387 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1388 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1391 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1392 if (NILP (predicate
) && fd
>= 0)
1397 /* Search for a file whose name is STR, looking in directories
1398 in the Lisp list PATH, and trying suffixes from SUFFIX.
1399 On success, return a file descriptor (or 1 or -2 as described below).
1400 On failure, return -1 and set errno.
1402 SUFFIXES is a list of strings containing possible suffixes.
1403 The empty suffix is automatically added if the list is empty.
1405 PREDICATE t means the files are binary.
1406 PREDICATE non-nil and non-t means don't open the files,
1407 just look for one that satisfies the predicate. In this case,
1408 return 1 on success. The predicate can be a lisp function or
1409 an integer to pass to `access' (in which case file-name-handlers
1412 If STOREPTR is nonzero, it points to a slot where the name of
1413 the file actually found should be stored as a Lisp string.
1414 nil is stored there on failure.
1416 If the file we find is remote, return -2
1417 but store the found remote file name in *STOREPTR.
1419 If NEWER is true, try all SUFFIXes and return the result for the
1420 newest file that exists. Does not apply to remote files,
1421 or if a non-nil and non-t PREDICATE is specified. */
1424 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1425 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1427 ptrdiff_t fn_size
= 100;
1431 ptrdiff_t want_length
;
1432 Lisp_Object filename
;
1433 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
, gcpro7
;
1434 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1435 ptrdiff_t max_suffix_len
= 0;
1436 int last_errno
= ENOENT
;
1440 /* The last-modified time of the newest matching file found.
1441 Initialize it to something less than all valid timestamps. */
1442 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1446 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1448 CHECK_STRING_CAR (tail
);
1449 max_suffix_len
= max (max_suffix_len
,
1450 SBYTES (XCAR (tail
)));
1453 string
= filename
= encoded_fn
= save_string
= Qnil
;
1454 GCPRO7 (str
, string
, save_string
, filename
, path
, suffixes
, encoded_fn
);
1459 absolute
= complete_filename_p (str
);
1461 for (; CONSP (path
); path
= XCDR (path
))
1463 filename
= Fexpand_file_name (str
, XCAR (path
));
1464 if (!complete_filename_p (filename
))
1465 /* If there are non-absolute elts in PATH (eg "."). */
1466 /* Of course, this could conceivably lose if luser sets
1467 default-directory to be something non-absolute... */
1469 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1470 if (!complete_filename_p (filename
))
1471 /* Give up on this path element! */
1475 /* Calculate maximum length of any filename made from
1476 this path element/specified file name and any possible suffix. */
1477 want_length
= max_suffix_len
+ SBYTES (filename
);
1478 if (fn_size
<= want_length
)
1480 fn_size
= 100 + want_length
;
1481 fn
= SAFE_ALLOCA (fn_size
);
1484 /* Loop over suffixes. */
1485 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1486 CONSP (tail
); tail
= XCDR (tail
))
1488 Lisp_Object suffix
= XCAR (tail
);
1489 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1490 Lisp_Object handler
;
1492 /* Concatenate path element/specified name with the suffix.
1493 If the directory starts with /:, remove that. */
1494 int prefixlen
= ((SCHARS (filename
) > 2
1495 && SREF (filename
, 0) == '/'
1496 && SREF (filename
, 1) == ':')
1498 fnlen
= SBYTES (filename
) - prefixlen
;
1499 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1500 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1502 /* Check that the file exists and is not a directory. */
1503 /* We used to only check for handlers on non-absolute file names:
1507 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1508 It's not clear why that was the case and it breaks things like
1509 (load "/bar.el") where the file is actually "/bar.el.gz". */
1510 /* make_string has its own ideas on when to return a unibyte
1511 string and when a multibyte string, but we know better.
1512 We must have a unibyte string when dumping, since
1513 file-name encoding is shaky at best at that time, and in
1514 particular default-file-name-coding-system is reset
1515 several times during loadup. We therefore don't want to
1516 encode the file before passing it to file I/O library
1518 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1519 string
= make_unibyte_string (fn
, fnlen
);
1521 string
= make_string (fn
, fnlen
);
1522 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1523 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1524 && !NATNUMP (predicate
))
1527 if (NILP (predicate
) || EQ (predicate
, Qt
))
1528 exists
= !NILP (Ffile_readable_p (string
));
1531 Lisp_Object tmp
= call1 (predicate
, string
);
1534 else if (EQ (tmp
, Qdir_ok
)
1535 || NILP (Ffile_directory_p (string
)))
1540 last_errno
= EISDIR
;
1546 /* We succeeded; return this descriptor and filename. */
1560 encoded_fn
= ENCODE_FILE (string
);
1561 pfn
= SSDATA (encoded_fn
);
1563 /* Check that we can access or open it. */
1564 if (NATNUMP (predicate
))
1567 if (INT_MAX
< XFASTINT (predicate
))
1568 last_errno
= EINVAL
;
1569 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1573 if (file_directory_p (pfn
))
1574 last_errno
= EISDIR
;
1581 int oflags
= O_RDONLY
+ (NILP (predicate
) ? 0 : O_BINARY
);
1582 fd
= emacs_open (pfn
, oflags
, 0);
1585 if (errno
!= ENOENT
)
1590 int err
= (fstat (fd
, &st
) != 0 ? errno
1591 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1603 if (newer
&& !NATNUMP (predicate
))
1605 struct timespec mtime
= get_stat_mtime (&st
);
1607 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1612 emacs_close (save_fd
);
1615 save_string
= string
;
1620 /* We succeeded; return this descriptor and filename. */
1629 /* No more suffixes. Return the newest. */
1630 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1633 *storeptr
= save_string
;
1651 /* Merge the list we've accumulated of globals from the current input source
1652 into the load_history variable. The details depend on whether
1653 the source has an associated file name or not.
1655 FILENAME is the file name that we are loading from.
1657 ENTIRE is true if loading that entire file, false if evaluating
1661 build_load_history (Lisp_Object filename
, bool entire
)
1663 Lisp_Object tail
, prev
, newelt
;
1664 Lisp_Object tem
, tem2
;
1667 tail
= Vload_history
;
1670 while (CONSP (tail
))
1674 /* Find the feature's previous assoc list... */
1675 if (!NILP (Fequal (filename
, Fcar (tem
))))
1679 /* If we're loading the entire file, remove old data. */
1683 Vload_history
= XCDR (tail
);
1685 Fsetcdr (prev
, XCDR (tail
));
1688 /* Otherwise, cons on new symbols that are not already members. */
1691 tem2
= Vcurrent_load_list
;
1693 while (CONSP (tem2
))
1695 newelt
= XCAR (tem2
);
1697 if (NILP (Fmember (newelt
, tem
)))
1698 Fsetcar (tail
, Fcons (XCAR (tem
),
1699 Fcons (newelt
, XCDR (tem
))));
1712 /* If we're loading an entire file, cons the new assoc onto the
1713 front of load-history, the most-recently-loaded position. Also
1714 do this if we didn't find an existing member for the file. */
1715 if (entire
|| !foundit
)
1716 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1721 readevalloop_1 (int old
)
1723 load_convert_to_unibyte
= old
;
1726 /* Signal an `end-of-file' error, if possible with file name
1729 static _Noreturn
void
1730 end_of_file_error (void)
1732 if (STRINGP (Vload_file_name
))
1733 xsignal1 (Qend_of_file
, Vload_file_name
);
1735 xsignal0 (Qend_of_file
);
1739 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1741 /* If we macroexpand the toplevel form non-recursively and it ends
1742 up being a `progn' (or if it was a progn to start), treat each
1743 form in the progn as a top-level form. This way, if one form in
1744 the progn defines a macro, that macro is in effect when we expand
1745 the remaining forms. See similar code in bytecomp.el. */
1746 val
= call2 (macroexpand
, val
, Qnil
);
1747 if (EQ (CAR_SAFE (val
), Qprogn
))
1749 struct gcpro gcpro1
;
1750 Lisp_Object subforms
= XCDR (val
);
1753 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1754 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1759 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1763 /* UNIBYTE specifies how to set load_convert_to_unibyte
1764 for this invocation.
1765 READFUN, if non-nil, is used instead of `read'.
1767 START, END specify region to read in current buffer (from eval-region).
1768 If the input is not from a buffer, they must be nil. */
1771 readevalloop (Lisp_Object readcharfun
,
1773 Lisp_Object sourcename
,
1775 Lisp_Object unibyte
, Lisp_Object readfun
,
1776 Lisp_Object start
, Lisp_Object end
)
1779 register Lisp_Object val
;
1780 ptrdiff_t count
= SPECPDL_INDEX ();
1781 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1782 struct buffer
*b
= 0;
1783 bool continue_reading_p
;
1784 Lisp_Object lex_bound
;
1785 /* True if reading an entire buffer. */
1786 bool whole_buffer
= 0;
1787 /* True on the first time around. */
1788 bool first_sexp
= 1;
1789 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1791 if (NILP (Ffboundp (macroexpand
))
1792 /* Don't macroexpand in .elc files, since it should have been done
1793 already. We actually don't know whether we're in a .elc file or not,
1794 so we use circumstantial evidence: .el files normally go through
1795 Vload_source_file_function -> load-with-code-conversion
1797 || EQ (readcharfun
, Qget_file_char
)
1798 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1801 if (MARKERP (readcharfun
))
1804 start
= readcharfun
;
1807 if (BUFFERP (readcharfun
))
1808 b
= XBUFFER (readcharfun
);
1809 else if (MARKERP (readcharfun
))
1810 b
= XMARKER (readcharfun
)->buffer
;
1812 /* We assume START is nil when input is not from a buffer. */
1813 if (! NILP (start
) && !b
)
1816 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1817 specbind (Qcurrent_load_list
, Qnil
);
1818 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1819 load_convert_to_unibyte
= !NILP (unibyte
);
1821 /* If lexical binding is active (either because it was specified in
1822 the file's header, or via a buffer-local variable), create an empty
1823 lexical environment, otherwise, turn off lexical binding. */
1824 lex_bound
= find_symbol_value (Qlexical_binding
);
1825 specbind (Qinternal_interpreter_environment
,
1826 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1827 ? Qnil
: list1 (Qt
)));
1829 GCPRO4 (sourcename
, readfun
, start
, end
);
1831 /* Try to ensure sourcename is a truename, except whilst preloading. */
1832 if (NILP (Vpurify_flag
)
1833 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1834 && !NILP (Ffboundp (Qfile_truename
)))
1835 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1837 LOADHIST_ATTACH (sourcename
);
1839 continue_reading_p
= 1;
1840 while (continue_reading_p
)
1842 ptrdiff_t count1
= SPECPDL_INDEX ();
1844 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1845 error ("Reading from killed buffer");
1849 /* Switch to the buffer we are reading from. */
1850 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1851 set_buffer_internal (b
);
1853 /* Save point in it. */
1854 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1855 /* Save ZV in it. */
1856 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1857 /* Those get unbound after we read one expression. */
1859 /* Set point and ZV around stuff to be read. */
1862 Fnarrow_to_region (make_number (BEGV
), end
);
1864 /* Just for cleanliness, convert END to a marker
1865 if it is an integer. */
1867 end
= Fpoint_max_marker ();
1870 /* On the first cycle, we can easily test here
1871 whether we are reading the whole buffer. */
1872 if (b
&& first_sexp
)
1873 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1880 while ((c
= READCHAR
) != '\n' && c
!= -1);
1885 unbind_to (count1
, Qnil
);
1889 /* Ignore whitespace here, so we can detect eof. */
1890 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1891 || c
== NO_BREAK_SPACE
)
1894 if (!NILP (Vpurify_flag
) && c
== '(')
1896 val
= read_list (0, readcharfun
);
1901 read_objects
= Qnil
;
1902 if (!NILP (readfun
))
1904 val
= call1 (readfun
, readcharfun
);
1906 /* If READCHARFUN has set point to ZV, we should
1907 stop reading, even if the form read sets point
1908 to a different value when evaluated. */
1909 if (BUFFERP (readcharfun
))
1911 struct buffer
*buf
= XBUFFER (readcharfun
);
1912 if (BUF_PT (buf
) == BUF_ZV (buf
))
1913 continue_reading_p
= 0;
1916 else if (! NILP (Vload_read_function
))
1917 val
= call1 (Vload_read_function
, readcharfun
);
1919 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1922 if (!NILP (start
) && continue_reading_p
)
1923 start
= Fpoint_marker ();
1925 /* Restore saved point and BEGV. */
1926 unbind_to (count1
, Qnil
);
1928 /* Now eval what we just read. */
1929 if (!NILP (macroexpand
))
1930 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1932 val
= eval_sub (val
);
1936 Vvalues
= Fcons (val
, Vvalues
);
1937 if (EQ (Vstandard_output
, Qt
))
1946 build_load_history (sourcename
,
1947 stream
|| whole_buffer
);
1951 unbind_to (count
, Qnil
);
1954 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1955 doc
: /* Execute the current buffer as Lisp code.
1956 When called from a Lisp program (i.e., not interactively), this
1957 function accepts up to five optional arguments:
1958 BUFFER is the buffer to evaluate (nil means use current buffer).
1959 PRINTFLAG controls printing of output:
1960 A value of nil means discard it; anything else is stream for print.
1961 FILENAME specifies the file name to use for `load-history'.
1962 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1964 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1965 functions should work normally even if PRINTFLAG is nil.
1967 This function preserves the position of point. */)
1968 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1970 ptrdiff_t count
= SPECPDL_INDEX ();
1971 Lisp_Object tem
, buf
;
1974 buf
= Fcurrent_buffer ();
1976 buf
= Fget_buffer (buffer
);
1978 error ("No such buffer");
1980 if (NILP (printflag
) && NILP (do_allow_print
))
1985 if (NILP (filename
))
1986 filename
= BVAR (XBUFFER (buf
), filename
);
1988 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1989 specbind (Qstandard_output
, tem
);
1990 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1991 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1992 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1993 readevalloop (buf
, 0, filename
,
1994 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1995 unbind_to (count
, Qnil
);
2000 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2001 doc
: /* Execute the region as Lisp code.
2002 When called from programs, expects two arguments,
2003 giving starting and ending indices in the current buffer
2004 of the text to be executed.
2005 Programs can pass third argument PRINTFLAG which controls output:
2006 A value of nil means discard it; anything else is stream for printing it.
2007 Also the fourth argument READ-FUNCTION, if non-nil, is used
2008 instead of `read' to read each expression. It gets one argument
2009 which is the input stream for reading characters.
2011 This function does not move point. */)
2012 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2014 /* FIXME: Do the eval-sexp-add-defvars dance! */
2015 ptrdiff_t count
= SPECPDL_INDEX ();
2016 Lisp_Object tem
, cbuf
;
2018 cbuf
= Fcurrent_buffer ();
2020 if (NILP (printflag
))
2024 specbind (Qstandard_output
, tem
);
2025 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2027 /* `readevalloop' calls functions which check the type of start and end. */
2028 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2029 !NILP (printflag
), Qnil
, read_function
,
2032 return unbind_to (count
, Qnil
);
2036 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2037 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2038 If STREAM is nil, use the value of `standard-input' (which see).
2039 STREAM or the value of `standard-input' may be:
2040 a buffer (read from point and advance it)
2041 a marker (read from where it points and advance it)
2042 a function (call it with no arguments for each character,
2043 call it with a char as argument to push a char back)
2044 a string (takes text from string, starting at the beginning)
2045 t (read text line using minibuffer and use it, or read from
2046 standard input in batch mode). */)
2047 (Lisp_Object stream
)
2050 stream
= Vstandard_input
;
2051 if (EQ (stream
, Qt
))
2052 stream
= Qread_char
;
2053 if (EQ (stream
, Qread_char
))
2054 /* FIXME: ?! When is this used !? */
2055 return call1 (intern ("read-minibuffer"),
2056 build_string ("Lisp expression: "));
2058 return read_internal_start (stream
, Qnil
, Qnil
);
2061 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2062 doc
: /* Read one Lisp expression which is represented as text by STRING.
2063 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2064 FINAL-STRING-INDEX is an integer giving the position of the next
2065 remaining character in STRING. START and END optionally delimit
2066 a substring of STRING from which to read; they default to 0 and
2067 (length STRING) respectively. Negative values are counted from
2068 the end of STRING. */)
2069 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2072 CHECK_STRING (string
);
2073 /* `read_internal_start' sets `read_from_string_index'. */
2074 ret
= read_internal_start (string
, start
, end
);
2075 return Fcons (ret
, make_number (read_from_string_index
));
2078 /* Function to set up the global context we need in toplevel read
2079 calls. START and END only used when STREAM is a string. */
2081 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2086 new_backquote_flag
= 0;
2087 read_objects
= Qnil
;
2088 if (EQ (Vread_with_symbol_positions
, Qt
)
2089 || EQ (Vread_with_symbol_positions
, stream
))
2090 Vread_symbol_positions_list
= Qnil
;
2092 if (STRINGP (stream
)
2093 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2095 ptrdiff_t startval
, endval
;
2098 if (STRINGP (stream
))
2101 string
= XCAR (stream
);
2103 validate_subarray (string
, start
, end
, SCHARS (string
),
2104 &startval
, &endval
);
2106 read_from_string_index
= startval
;
2107 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2108 read_from_string_limit
= endval
;
2111 retval
= read0 (stream
);
2112 if (EQ (Vread_with_symbol_positions
, Qt
)
2113 || EQ (Vread_with_symbol_positions
, stream
))
2114 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2119 /* Signal Qinvalid_read_syntax error.
2120 S is error string of length N (if > 0) */
2122 static _Noreturn
void
2123 invalid_syntax (const char *s
)
2125 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2129 /* Use this for recursive reads, in contexts where internal tokens
2133 read0 (Lisp_Object readcharfun
)
2135 register Lisp_Object val
;
2138 val
= read1 (readcharfun
, &c
, 0);
2142 xsignal1 (Qinvalid_read_syntax
,
2143 Fmake_string (make_number (1), make_number (c
)));
2146 static ptrdiff_t read_buffer_size
;
2147 static char *read_buffer
;
2149 /* Read a \-escape sequence, assuming we already read the `\'.
2150 If the escape sequence forces unibyte, return eight-bit char. */
2153 read_escape (Lisp_Object readcharfun
, bool stringp
)
2156 /* \u allows up to four hex digits, \U up to eight. Default to the
2157 behavior for \u, and change this value in the case that \U is seen. */
2158 int unicode_hex_count
= 4;
2163 end_of_file_error ();
2193 error ("Invalid escape character syntax");
2196 c
= read_escape (readcharfun
, 0);
2197 return c
| meta_modifier
;
2202 error ("Invalid escape character syntax");
2205 c
= read_escape (readcharfun
, 0);
2206 return c
| shift_modifier
;
2211 error ("Invalid escape character syntax");
2214 c
= read_escape (readcharfun
, 0);
2215 return c
| hyper_modifier
;
2220 error ("Invalid escape character syntax");
2223 c
= read_escape (readcharfun
, 0);
2224 return c
| alt_modifier
;
2228 if (stringp
|| c
!= '-')
2235 c
= read_escape (readcharfun
, 0);
2236 return c
| super_modifier
;
2241 error ("Invalid escape character syntax");
2245 c
= read_escape (readcharfun
, 0);
2246 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2247 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2248 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2249 return c
| ctrl_modifier
;
2250 /* ASCII control chars are made from letters (both cases),
2251 as well as the non-letters within 0100...0137. */
2252 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2253 return (c
& (037 | ~0177));
2254 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2255 return (c
& (037 | ~0177));
2257 return c
| ctrl_modifier
;
2267 /* An octal escape, as in ANSI C. */
2269 register int i
= c
- '0';
2270 register int count
= 0;
2273 if ((c
= READCHAR
) >= '0' && c
<= '7')
2285 if (i
>= 0x80 && i
< 0x100)
2286 i
= BYTE8_TO_CHAR (i
);
2291 /* A hex escape, as in ANSI C. */
2298 if (c
>= '0' && c
<= '9')
2303 else if ((c
>= 'a' && c
<= 'f')
2304 || (c
>= 'A' && c
<= 'F'))
2307 if (c
>= 'a' && c
<= 'f')
2317 /* Allow hex escapes as large as ?\xfffffff, because some
2318 packages use them to denote characters with modifiers. */
2319 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2320 error ("Hex character out of range: \\x%x...", i
);
2324 if (count
< 3 && i
>= 0x80)
2325 return BYTE8_TO_CHAR (i
);
2330 /* Post-Unicode-2.0: Up to eight hex chars. */
2331 unicode_hex_count
= 8;
2334 /* A Unicode escape. We only permit them in strings and characters,
2335 not arbitrarily in the source code, as in some other languages. */
2340 while (++count
<= unicode_hex_count
)
2343 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2345 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2346 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2347 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2349 error ("Non-hex digit used for Unicode escape");
2352 error ("Non-Unicode character: 0x%x", i
);
2361 /* Return the digit that CHARACTER stands for in the given BASE.
2362 Return -1 if CHARACTER is out of range for BASE,
2363 and -2 if CHARACTER is not valid for any supported BASE. */
2365 digit_to_number (int character
, int base
)
2369 if ('0' <= character
&& character
<= '9')
2370 digit
= character
- '0';
2371 else if ('a' <= character
&& character
<= 'z')
2372 digit
= character
- 'a' + 10;
2373 else if ('A' <= character
&& character
<= 'Z')
2374 digit
= character
- 'A' + 10;
2378 return digit
< base
? digit
: -1;
2381 /* Read an integer in radix RADIX using READCHARFUN to read
2382 characters. RADIX must be in the interval [2..36]; if it isn't, a
2383 read error is signaled . Value is the integer read. Signals an
2384 error if encountering invalid read syntax or if RADIX is out of
2388 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2390 /* Room for sign, leading 0, other digits, trailing null byte.
2391 Also, room for invalid syntax diagnostic. */
2392 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2393 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2395 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2397 if (radix
< 2 || radix
> 36)
2405 if (c
== '-' || c
== '+')
2416 /* Ignore redundant leading zeros, so the buffer doesn't
2417 fill up with them. */
2423 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2430 if (p
< buf
+ sizeof buf
- 1)
2444 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2445 invalid_syntax (buf
);
2448 return string_to_number (buf
, radix
, 0);
2452 /* If the next token is ')' or ']' or '.', we store that character
2453 in *PCH and the return value is not interesting. Else, we store
2454 zero in *PCH and we read and return one lisp object.
2456 FIRST_IN_LIST is true if this is the first element of a list. */
2459 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2462 bool uninterned_symbol
= 0;
2469 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2471 end_of_file_error ();
2476 return read_list (0, readcharfun
);
2479 return read_vector (readcharfun
, 0);
2495 /* Accept extended format for hashtables (extensible to
2497 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2498 Lisp_Object tmp
= read_list (0, readcharfun
);
2499 Lisp_Object head
= CAR_SAFE (tmp
);
2500 Lisp_Object data
= Qnil
;
2501 Lisp_Object val
= Qnil
;
2502 /* The size is 2 * number of allowed keywords to
2504 Lisp_Object params
[10];
2506 Lisp_Object key
= Qnil
;
2507 int param_count
= 0;
2509 if (!EQ (head
, Qhash_table
))
2510 error ("Invalid extended read marker at head of #s list "
2511 "(only hash-table allowed)");
2513 tmp
= CDR_SAFE (tmp
);
2515 /* This is repetitive but fast and simple. */
2516 params
[param_count
] = QCsize
;
2517 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2518 if (!NILP (params
[param_count
+ 1]))
2521 params
[param_count
] = QCtest
;
2522 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2523 if (!NILP (params
[param_count
+ 1]))
2526 params
[param_count
] = QCweakness
;
2527 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2528 if (!NILP (params
[param_count
+ 1]))
2531 params
[param_count
] = QCrehash_size
;
2532 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2533 if (!NILP (params
[param_count
+ 1]))
2536 params
[param_count
] = QCrehash_threshold
;
2537 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2538 if (!NILP (params
[param_count
+ 1]))
2541 /* This is the hashtable data. */
2542 data
= Fplist_get (tmp
, Qdata
);
2544 /* Now use params to make a new hashtable and fill it. */
2545 ht
= Fmake_hash_table (param_count
, params
);
2547 while (CONSP (data
))
2552 error ("Odd number of elements in hashtable data");
2555 Fputhash (key
, val
, ht
);
2561 invalid_syntax ("#");
2569 tmp
= read_vector (readcharfun
, 0);
2570 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2571 error ("Invalid size char-table");
2572 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2580 /* Sub char-table can't be read as a regular
2581 vector because of a two C integer fields. */
2582 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2583 ptrdiff_t size
= XINT (Flength (tmp
));
2584 int i
, depth
, min_char
;
2585 struct Lisp_Cons
*cell
;
2588 error ("Zero-sized sub char-table");
2590 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2591 error ("Invalid depth in sub char-table");
2592 depth
= XINT (XCAR (tmp
));
2593 if (chartab_size
[depth
] != size
- 2)
2594 error ("Invalid size in sub char-table");
2595 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2598 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2599 error ("Invalid minimum character in sub-char-table");
2600 min_char
= XINT (XCAR (tmp
));
2601 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2604 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2605 for (i
= 0; i
< size
; i
++)
2607 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2608 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2613 invalid_syntax ("#^^");
2615 invalid_syntax ("#^");
2620 length
= read1 (readcharfun
, pch
, first_in_list
);
2624 Lisp_Object tmp
, val
;
2625 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2626 unsigned char *data
;
2629 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2630 if (STRING_MULTIBYTE (tmp
)
2631 || (size_in_chars
!= SCHARS (tmp
)
2632 /* We used to print 1 char too many
2633 when the number of bits was a multiple of 8.
2634 Accept such input in case it came from an old
2636 && ! (XFASTINT (length
)
2637 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2638 invalid_syntax ("#&...");
2640 val
= make_uninit_bool_vector (XFASTINT (length
));
2641 data
= bool_vector_uchar_data (val
);
2642 memcpy (data
, SDATA (tmp
), size_in_chars
);
2643 /* Clear the extraneous bits in the last byte. */
2644 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2645 data
[size_in_chars
- 1]
2646 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2649 invalid_syntax ("#&...");
2653 /* Accept compiled functions at read-time so that we don't have to
2654 build them using function calls. */
2656 struct Lisp_Vector
*vec
;
2657 tmp
= read_vector (readcharfun
, 1);
2658 vec
= XVECTOR (tmp
);
2659 if (vec
->header
.size
== 0)
2660 invalid_syntax ("Empty byte-code object");
2661 make_byte_code (vec
);
2667 struct gcpro gcpro1
;
2670 /* Read the string itself. */
2671 tmp
= read1 (readcharfun
, &ch
, 0);
2672 if (ch
!= 0 || !STRINGP (tmp
))
2673 invalid_syntax ("#");
2675 /* Read the intervals and their properties. */
2678 Lisp_Object beg
, end
, plist
;
2680 beg
= read1 (readcharfun
, &ch
, 0);
2685 end
= read1 (readcharfun
, &ch
, 0);
2687 plist
= read1 (readcharfun
, &ch
, 0);
2689 invalid_syntax ("Invalid string property list");
2690 Fset_text_properties (beg
, end
, plist
, tmp
);
2696 /* #@NUMBER is used to skip NUMBER following bytes.
2697 That's used in .elc files to skip over doc strings
2698 and function definitions. */
2701 enum { extra
= 100 };
2702 ptrdiff_t i
, nskip
= 0, digits
= 0;
2704 /* Read a decimal integer. */
2705 while ((c
= READCHAR
) >= 0
2706 && c
>= '0' && c
<= '9')
2708 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2713 if (digits
== 2 && nskip
== 0)
2714 { /* We've just seen #@00, which means "skip to end". */
2715 skip_dyn_eof (readcharfun
);
2720 /* We can't use UNREAD here, because in the code below we side-step
2721 READCHAR. Instead, assume the first char after #@NNN occupies
2722 a single byte, which is the case normally since it's just
2728 if (load_force_doc_strings
2729 && (FROM_FILE_P (readcharfun
)))
2731 /* If we are supposed to force doc strings into core right now,
2732 record the last string that we skipped,
2733 and record where in the file it comes from. */
2735 /* But first exchange saved_doc_string
2736 with prev_saved_doc_string, so we save two strings. */
2738 char *temp
= saved_doc_string
;
2739 ptrdiff_t temp_size
= saved_doc_string_size
;
2740 file_offset temp_pos
= saved_doc_string_position
;
2741 ptrdiff_t temp_len
= saved_doc_string_length
;
2743 saved_doc_string
= prev_saved_doc_string
;
2744 saved_doc_string_size
= prev_saved_doc_string_size
;
2745 saved_doc_string_position
= prev_saved_doc_string_position
;
2746 saved_doc_string_length
= prev_saved_doc_string_length
;
2748 prev_saved_doc_string
= temp
;
2749 prev_saved_doc_string_size
= temp_size
;
2750 prev_saved_doc_string_position
= temp_pos
;
2751 prev_saved_doc_string_length
= temp_len
;
2754 if (saved_doc_string_size
== 0)
2756 saved_doc_string
= xmalloc (nskip
+ extra
);
2757 saved_doc_string_size
= nskip
+ extra
;
2759 if (nskip
> saved_doc_string_size
)
2761 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2762 saved_doc_string_size
= nskip
+ extra
;
2765 saved_doc_string_position
= file_tell (instream
);
2767 /* Copy that many characters into saved_doc_string. */
2769 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2770 saved_doc_string
[i
] = c
= getc (instream
);
2773 saved_doc_string_length
= i
;
2776 /* Skip that many bytes. */
2777 skip_dyn_bytes (readcharfun
, nskip
);
2783 /* #! appears at the beginning of an executable file.
2784 Skip the first line. */
2785 while (c
!= '\n' && c
>= 0)
2790 return Vload_file_name
;
2792 return list2 (Qfunction
, read0 (readcharfun
));
2793 /* #:foo is the uninterned symbol named foo. */
2796 uninterned_symbol
= 1;
2799 && c
!= NO_BREAK_SPACE
2801 || strchr ("\"';()[]#`,", c
) == NULL
)))
2803 /* No symbol character follows, this is the empty
2806 return Fmake_symbol (empty_unibyte_string
);
2810 /* ## is the empty symbol. */
2812 return Fintern (empty_unibyte_string
, Qnil
);
2813 /* Reader forms that can reuse previously read objects. */
2814 if (c
>= '0' && c
<= '9')
2819 /* Read a non-negative integer. */
2820 while (c
>= '0' && c
<= '9')
2822 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2823 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2824 n
= MOST_POSITIVE_FIXNUM
+ 1;
2826 n
= n
* 10 + c
- '0';
2830 if (n
<= MOST_POSITIVE_FIXNUM
)
2832 if (c
== 'r' || c
== 'R')
2833 return read_integer (readcharfun
, n
);
2835 if (! NILP (Vread_circle
))
2837 /* #n=object returns object, but associates it with
2841 /* Make a placeholder for #n# to use temporarily. */
2842 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2843 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2844 read_objects
= Fcons (cell
, read_objects
);
2846 /* Read the object itself. */
2847 tem
= read0 (readcharfun
);
2849 /* Now put it everywhere the placeholder was... */
2850 substitute_object_in_subtree (tem
, placeholder
);
2852 /* ...and #n# will use the real value from now on. */
2853 Fsetcdr (cell
, tem
);
2858 /* #n# returns a previously read object. */
2861 tem
= Fassq (make_number (n
), read_objects
);
2867 /* Fall through to error message. */
2869 else if (c
== 'x' || c
== 'X')
2870 return read_integer (readcharfun
, 16);
2871 else if (c
== 'o' || c
== 'O')
2872 return read_integer (readcharfun
, 8);
2873 else if (c
== 'b' || c
== 'B')
2874 return read_integer (readcharfun
, 2);
2877 invalid_syntax ("#");
2880 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2884 return list2 (Qquote
, read0 (readcharfun
));
2888 int next_char
= READCHAR
;
2890 /* Transition from old-style to new-style:
2891 If we see "(`" it used to mean old-style, which usually works
2892 fine because ` should almost never appear in such a position
2893 for new-style. But occasionally we need "(`" to mean new
2894 style, so we try to distinguish the two by the fact that we
2895 can either write "( `foo" or "(` foo", where the first
2896 intends to use new-style whereas the second intends to use
2897 old-style. For Emacs-25, we should completely remove this
2898 first_in_list exception (old-style can still be obtained via
2900 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2902 Vold_style_backquotes
= Qt
;
2908 bool saved_new_backquote_flag
= new_backquote_flag
;
2910 new_backquote_flag
= 1;
2911 value
= read0 (readcharfun
);
2912 new_backquote_flag
= saved_new_backquote_flag
;
2914 return list2 (Qbackquote
, value
);
2919 int next_char
= READCHAR
;
2921 /* Transition from old-style to new-style:
2922 It used to be impossible to have a new-style , other than within
2923 a new-style `. This is sufficient when ` and , are used in the
2924 normal way, but ` and , can also appear in args to macros that
2925 will not interpret them in the usual way, in which case , may be
2926 used without any ` anywhere near.
2927 So we now use the same heuristic as for backquote: old-style
2928 unquotes are only recognized when first on a list, and when
2929 followed by a space.
2930 Because it's more difficult to peek 2 chars ahead, a new-style
2931 ,@ can still not be used outside of a `, unless it's in the middle
2933 if (new_backquote_flag
2935 || (next_char
!= ' ' && next_char
!= '@'))
2937 Lisp_Object comma_type
= Qnil
;
2942 comma_type
= Qcomma_at
;
2944 comma_type
= Qcomma_dot
;
2947 if (ch
>= 0) UNREAD (ch
);
2948 comma_type
= Qcomma
;
2951 value
= read0 (readcharfun
);
2952 return list2 (comma_type
, value
);
2956 Vold_style_backquotes
= Qt
;
2968 end_of_file_error ();
2970 /* Accept `single space' syntax like (list ? x) where the
2971 whitespace character is SPC or TAB.
2972 Other literal whitespace like NL, CR, and FF are not accepted,
2973 as there are well-established escape sequences for these. */
2974 if (c
== ' ' || c
== '\t')
2975 return make_number (c
);
2978 c
= read_escape (readcharfun
, 0);
2979 modifiers
= c
& CHAR_MODIFIER_MASK
;
2980 c
&= ~CHAR_MODIFIER_MASK
;
2981 if (CHAR_BYTE8_P (c
))
2982 c
= CHAR_TO_BYTE8 (c
);
2985 next_char
= READCHAR
;
2986 ok
= (next_char
<= 040
2987 || (next_char
< 0200
2988 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2991 return make_number (c
);
2993 invalid_syntax ("?");
2998 char *p
= read_buffer
;
2999 char *end
= read_buffer
+ read_buffer_size
;
3001 /* True if we saw an escape sequence specifying
3002 a multibyte character. */
3003 bool force_multibyte
= 0;
3004 /* True if we saw an escape sequence specifying
3005 a single-byte character. */
3006 bool force_singlebyte
= 0;
3008 ptrdiff_t nchars
= 0;
3010 while ((ch
= READCHAR
) >= 0
3013 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3015 ptrdiff_t offset
= p
- read_buffer
;
3016 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3017 memory_full (SIZE_MAX
);
3018 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3019 read_buffer_size
*= 2;
3020 p
= read_buffer
+ offset
;
3021 end
= read_buffer
+ read_buffer_size
;
3028 ch
= read_escape (readcharfun
, 1);
3030 /* CH is -1 if \ newline or \ space has just been seen. */
3033 if (p
== read_buffer
)
3038 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3039 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3041 if (CHAR_BYTE8_P (ch
))
3042 force_singlebyte
= 1;
3043 else if (! ASCII_CHAR_P (ch
))
3044 force_multibyte
= 1;
3045 else /* I.e. ASCII_CHAR_P (ch). */
3047 /* Allow `\C- ' and `\C-?'. */
3048 if (modifiers
== CHAR_CTL
)
3051 ch
= 0, modifiers
= 0;
3053 ch
= 127, modifiers
= 0;
3055 if (modifiers
& CHAR_SHIFT
)
3057 /* Shift modifier is valid only with [A-Za-z]. */
3058 if (ch
>= 'A' && ch
<= 'Z')
3059 modifiers
&= ~CHAR_SHIFT
;
3060 else if (ch
>= 'a' && ch
<= 'z')
3061 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3064 if (modifiers
& CHAR_META
)
3066 /* Move the meta bit to the right place for a
3068 modifiers
&= ~CHAR_META
;
3069 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3070 force_singlebyte
= 1;
3074 /* Any modifiers remaining are invalid. */
3076 error ("Invalid modifier in string");
3077 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3081 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3082 if (CHAR_BYTE8_P (ch
))
3083 force_singlebyte
= 1;
3084 else if (! ASCII_CHAR_P (ch
))
3085 force_multibyte
= 1;
3091 end_of_file_error ();
3093 /* If purifying, and string starts with \ newline,
3094 return zero instead. This is for doc strings
3095 that we are really going to find in etc/DOC.nn.nn. */
3096 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3097 return make_number (0);
3099 if (! force_multibyte
&& force_singlebyte
)
3101 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3102 forms. Convert it to unibyte. */
3103 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3105 p
= read_buffer
+ nchars
;
3108 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3110 || (p
- read_buffer
!= nchars
)));
3115 int next_char
= READCHAR
;
3118 if (next_char
<= 040
3119 || (next_char
< 0200
3120 && strchr ("\"';([#?`,", next_char
) != NULL
))
3126 /* Otherwise, we fall through! Note that the atom-reading loop
3127 below will now loop at least once, assuring that we will not
3128 try to UNREAD two characters in a row. */
3132 if (c
<= 040) goto retry
;
3133 if (c
== NO_BREAK_SPACE
)
3138 char *p
= read_buffer
;
3140 EMACS_INT start_position
= readchar_count
- 1;
3143 char *end
= read_buffer
+ read_buffer_size
;
3147 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3149 ptrdiff_t offset
= p
- read_buffer
;
3150 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3151 memory_full (SIZE_MAX
);
3152 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3153 read_buffer_size
*= 2;
3154 p
= read_buffer
+ offset
;
3155 end
= read_buffer
+ read_buffer_size
;
3162 end_of_file_error ();
3167 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3173 && c
!= NO_BREAK_SPACE
3175 || strchr ("\"';()[]#`,", c
) == NULL
));
3179 ptrdiff_t offset
= p
- read_buffer
;
3180 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3181 memory_full (SIZE_MAX
);
3182 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3183 read_buffer_size
*= 2;
3184 p
= read_buffer
+ offset
;
3185 end
= read_buffer
+ read_buffer_size
;
3191 if (!quoted
&& !uninterned_symbol
)
3193 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3194 if (! NILP (result
))
3198 Lisp_Object name
, result
;
3199 ptrdiff_t nbytes
= p
- read_buffer
;
3202 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3206 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3207 ? make_pure_string
: make_specified_string
)
3208 (read_buffer
, nchars
, nbytes
, multibyte
));
3209 result
= (uninterned_symbol
? Fmake_symbol (name
)
3210 : Fintern (name
, Qnil
));
3212 if (EQ (Vread_with_symbol_positions
, Qt
)
3213 || EQ (Vread_with_symbol_positions
, readcharfun
))
3214 Vread_symbol_positions_list
3215 = Fcons (Fcons (result
, make_number (start_position
)),
3216 Vread_symbol_positions_list
);
3224 /* List of nodes we've seen during substitute_object_in_subtree. */
3225 static Lisp_Object seen_list
;
3228 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3230 Lisp_Object check_object
;
3232 /* We haven't seen any objects when we start. */
3235 /* Make all the substitutions. */
3237 = substitute_object_recurse (object
, placeholder
, object
);
3239 /* Clear seen_list because we're done with it. */
3242 /* The returned object here is expected to always eq the
3244 if (!EQ (check_object
, object
))
3245 error ("Unexpected mutation error in reader");
3248 /* Feval doesn't get called from here, so no gc protection is needed. */
3249 #define SUBSTITUTE(get_val, set_val) \
3251 Lisp_Object old_value = get_val; \
3252 Lisp_Object true_value \
3253 = substitute_object_recurse (object, placeholder, \
3256 if (!EQ (old_value, true_value)) \
3263 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3265 /* If we find the placeholder, return the target object. */
3266 if (EQ (placeholder
, subtree
))
3269 /* If we've been to this node before, don't explore it again. */
3270 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3273 /* If this node can be the entry point to a cycle, remember that
3274 we've seen it. It can only be such an entry point if it was made
3275 by #n=, which means that we can find it as a value in
3277 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3278 seen_list
= Fcons (subtree
, seen_list
);
3280 /* Recurse according to subtree's type.
3281 Every branch must return a Lisp_Object. */
3282 switch (XTYPE (subtree
))
3284 case Lisp_Vectorlike
:
3286 ptrdiff_t i
= 0, length
= 0;
3287 if (BOOL_VECTOR_P (subtree
))
3288 return subtree
; /* No sub-objects anyway. */
3289 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3290 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3291 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3292 else if (VECTORP (subtree
))
3293 length
= ASIZE (subtree
);
3295 /* An unknown pseudovector may contain non-Lisp fields, so we
3296 can't just blindly traverse all its fields. We used to call
3297 `Flength' which signaled `sequencep', so I just preserved this
3299 wrong_type_argument (Qsequencep
, subtree
);
3301 if (SUB_CHAR_TABLE_P (subtree
))
3303 for ( ; i
< length
; i
++)
3304 SUBSTITUTE (AREF (subtree
, i
),
3305 ASET (subtree
, i
, true_value
));
3311 SUBSTITUTE (XCAR (subtree
),
3312 XSETCAR (subtree
, true_value
));
3313 SUBSTITUTE (XCDR (subtree
),
3314 XSETCDR (subtree
, true_value
));
3320 /* Check for text properties in each interval.
3321 substitute_in_interval contains part of the logic. */
3323 INTERVAL root_interval
= string_intervals (subtree
);
3324 AUTO_CONS (arg
, object
, placeholder
);
3326 traverse_intervals_noorder (root_interval
,
3327 &substitute_in_interval
, arg
);
3332 /* Other types don't recurse any further. */
3338 /* Helper function for substitute_object_recurse. */
3340 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3342 Lisp_Object object
= Fcar (arg
);
3343 Lisp_Object placeholder
= Fcdr (arg
);
3345 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3355 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3356 integer syntax and fits in a fixnum, else return the nearest float if CP has
3357 either floating point or integer syntax and BASE is 10, else return nil. If
3358 IGNORE_TRAILING, consider just the longest prefix of CP that has
3359 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3360 number has integer syntax but does not fit. */
3363 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3366 char const *cp
= string
;
3368 bool float_syntax
= 0;
3371 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3372 IEEE floating point hosts, and works around a formerly-common bug where
3373 atof ("-0.0") drops the sign. */
3374 bool negative
= *cp
== '-';
3376 bool signedp
= negative
|| *cp
== '+';
3381 leading_digit
= digit_to_number (*cp
, base
);
3382 if (leading_digit
>= 0)
3387 while (digit_to_number (*cp
, base
) >= 0);
3397 if ('0' <= *cp
&& *cp
<= '9')
3402 while ('0' <= *cp
&& *cp
<= '9');
3404 if (*cp
== 'e' || *cp
== 'E')
3406 char const *ecp
= cp
;
3408 if (*cp
== '+' || *cp
== '-')
3410 if ('0' <= *cp
&& *cp
<= '9')
3415 while ('0' <= *cp
&& *cp
<= '9');
3417 else if (cp
[-1] == '+'
3418 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3424 else if (cp
[-1] == '+'
3425 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3429 /* NAN is a "positive" NaN on all known Emacs hosts. */
3436 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3437 || state
== (LEAD_INT
|E_EXP
));
3440 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3441 any prefix that matches. Otherwise, the entire string must match. */
3442 if (! (ignore_trailing
3443 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3444 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3447 /* If the number uses integer and not float syntax, and is in C-language
3448 range, use its value, preferably as a fixnum. */
3449 if (leading_digit
>= 0 && ! float_syntax
)
3453 /* Fast special case for single-digit integers. This also avoids a
3454 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3455 case some versions of strtoumax accept numbers like "0x1" that Emacs
3457 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3458 return make_number (negative
? -leading_digit
: leading_digit
);
3461 n
= strtoumax (string
+ signedp
, NULL
, base
);
3462 if (errno
== ERANGE
)
3464 /* Unfortunately there's no simple and accurate way to convert
3465 non-base-10 numbers that are out of C-language range. */
3467 xsignal1 (Qoverflow_error
, build_string (string
));
3469 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3471 EMACS_INT signed_n
= n
;
3472 return make_number (negative
? -signed_n
: signed_n
);
3478 /* Either the number uses float syntax, or it does not fit into a fixnum.
3479 Convert it from string to floating point, unless the value is already
3480 known because it is an infinity, a NAN, or its absolute value fits in
3483 value
= atof (string
+ signedp
);
3485 return make_float (negative
? -value
: value
);
3490 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3494 Lisp_Object tem
, item
, vector
;
3495 struct Lisp_Cons
*otem
;
3498 tem
= read_list (1, readcharfun
);
3499 len
= Flength (tem
);
3500 vector
= Fmake_vector (len
, Qnil
);
3502 size
= ASIZE (vector
);
3503 ptr
= XVECTOR (vector
)->contents
;
3504 for (i
= 0; i
< size
; i
++)
3507 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3508 bytecode object, the docstring containing the bytecode and
3509 constants values must be treated as unibyte and passed to
3510 Fread, to get the actual bytecode string and constants vector. */
3511 if (bytecodeflag
&& load_force_doc_strings
)
3513 if (i
== COMPILED_BYTECODE
)
3515 if (!STRINGP (item
))
3516 error ("Invalid byte code");
3518 /* Delay handling the bytecode slot until we know whether
3519 it is lazily-loaded (we can tell by whether the
3520 constants slot is nil). */
3521 ASET (vector
, COMPILED_CONSTANTS
, item
);
3524 else if (i
== COMPILED_CONSTANTS
)
3526 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3530 /* Coerce string to unibyte (like string-as-unibyte,
3531 but without generating extra garbage and
3532 guaranteeing no change in the contents). */
3533 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3534 STRING_SET_UNIBYTE (bytestr
);
3536 item
= Fread (Fcons (bytestr
, readcharfun
));
3538 error ("Invalid byte code");
3540 otem
= XCONS (item
);
3541 bytestr
= XCAR (item
);
3546 /* Now handle the bytecode slot. */
3547 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3549 else if (i
== COMPILED_DOC_STRING
3551 && ! STRING_MULTIBYTE (item
))
3553 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3554 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3556 item
= Fstring_as_multibyte (item
);
3559 ASET (vector
, i
, item
);
3567 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3570 read_list (bool flag
, Lisp_Object readcharfun
)
3572 Lisp_Object val
, tail
;
3573 Lisp_Object elt
, tem
;
3574 struct gcpro gcpro1
, gcpro2
;
3575 /* 0 is the normal case.
3576 1 means this list is a doc reference; replace it with the number 0.
3577 2 means this list is a doc reference; replace it with the doc string. */
3578 int doc_reference
= 0;
3580 /* Initialize this to 1 if we are reading a list. */
3581 bool first_in_list
= flag
<= 0;
3590 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3595 /* While building, if the list starts with #$, treat it specially. */
3596 if (EQ (elt
, Vload_file_name
)
3598 && !NILP (Vpurify_flag
))
3600 if (NILP (Vdoc_file_name
))
3601 /* We have not yet called Snarf-documentation, so assume
3602 this file is described in the DOC file
3603 and Snarf-documentation will fill in the right value later.
3604 For now, replace the whole list with 0. */
3607 /* We have already called Snarf-documentation, so make a relative
3608 file name for this file, so it can be found properly
3609 in the installed Lisp directory.
3610 We don't use Fexpand_file_name because that would make
3611 the directory absolute now. */
3613 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3614 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3617 else if (EQ (elt
, Vload_file_name
)
3619 && load_force_doc_strings
)
3628 invalid_syntax (") or . in a vector");
3636 XSETCDR (tail
, read0 (readcharfun
));
3638 val
= read0 (readcharfun
);
3639 read1 (readcharfun
, &ch
, 0);
3643 if (doc_reference
== 1)
3644 return make_number (0);
3645 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3648 file_offset saved_position
;
3649 /* Get a doc string from the file we are loading.
3650 If it's in saved_doc_string, get it from there.
3652 Here, we don't know if the string is a
3653 bytecode string or a doc string. As a
3654 bytecode string must be unibyte, we always
3655 return a unibyte string. If it is actually a
3656 doc string, caller must make it
3659 /* Position is negative for user variables. */
3660 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3661 if (pos
>= saved_doc_string_position
3662 && pos
< (saved_doc_string_position
3663 + saved_doc_string_length
))
3665 saved
= saved_doc_string
;
3666 saved_position
= saved_doc_string_position
;
3668 /* Look in prev_saved_doc_string the same way. */
3669 else if (pos
>= prev_saved_doc_string_position
3670 && pos
< (prev_saved_doc_string_position
3671 + prev_saved_doc_string_length
))
3673 saved
= prev_saved_doc_string
;
3674 saved_position
= prev_saved_doc_string_position
;
3678 ptrdiff_t start
= pos
- saved_position
;
3681 /* Process quoting with ^A,
3682 and find the end of the string,
3683 which is marked with ^_ (037). */
3684 for (from
= start
, to
= start
;
3685 saved
[from
] != 037;)
3687 int c
= saved
[from
++];
3691 saved
[to
++] = (c
== 1 ? c
3700 return make_unibyte_string (saved
+ start
,
3704 return get_doc_string (val
, 1, 0);
3709 invalid_syntax (". in wrong context");
3711 invalid_syntax ("] in a list");
3715 XSETCDR (tail
, tem
);
3722 static Lisp_Object initial_obarray
;
3724 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3726 static size_t oblookup_last_bucket_number
;
3728 /* Get an error if OBARRAY is not an obarray.
3729 If it is one, return it. */
3732 check_obarray (Lisp_Object obarray
)
3734 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3736 /* If Vobarray is now invalid, force it to be valid. */
3737 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3738 wrong_type_argument (Qvectorp
, obarray
);
3743 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3746 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3750 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3751 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3754 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3756 XSYMBOL (sym
)->constant
= 1;
3757 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3758 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3761 ptr
= aref_addr (obarray
, XINT (index
));
3762 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3767 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3770 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3772 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3775 /* Intern the C string STR: return a symbol with that name,
3776 interned in the current obarray. */
3779 intern_1 (const char *str
, ptrdiff_t len
)
3781 Lisp_Object obarray
= check_obarray (Vobarray
);
3782 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3784 return (SYMBOLP (tem
) ? tem
3785 /* The above `oblookup' was done on the basis of nchars==nbytes, so
3786 the string has to be unibyte. */
3787 : intern_driver (make_unibyte_string (str
, len
),
3792 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3794 Lisp_Object obarray
= check_obarray (Vobarray
);
3795 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3799 /* Creating a non-pure string from a string literal not implemented yet.
3800 We could just use make_string here and live with the extra copy. */
3801 eassert (!NILP (Vpurify_flag
));
3802 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3808 define_symbol (Lisp_Object sym
, char const *str
)
3810 ptrdiff_t len
= strlen (str
);
3811 Lisp_Object string
= make_pure_c_string (str
, len
);
3812 init_symbol (sym
, string
);
3814 /* Qunbound is uninterned, so that it's not confused with any symbol
3815 'unbound' created by a Lisp program. */
3816 if (! EQ (sym
, Qunbound
))
3818 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3819 eassert (INTEGERP (bucket
));
3820 intern_sym (sym
, initial_obarray
, bucket
);
3824 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3825 doc
: /* Return the canonical symbol whose name is STRING.
3826 If there is none, one is created by this function and returned.
3827 A second optional argument specifies the obarray to use;
3828 it defaults to the value of `obarray'. */)
3829 (Lisp_Object string
, Lisp_Object obarray
)
3833 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3834 CHECK_STRING (string
);
3836 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3838 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3843 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3844 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3845 NAME may be a string or a symbol. If it is a symbol, that exact
3846 symbol is searched for.
3847 A second optional argument specifies the obarray to use;
3848 it defaults to the value of `obarray'. */)
3849 (Lisp_Object name
, Lisp_Object obarray
)
3851 register Lisp_Object tem
, string
;
3853 if (NILP (obarray
)) obarray
= Vobarray
;
3854 obarray
= check_obarray (obarray
);
3856 if (!SYMBOLP (name
))
3858 CHECK_STRING (name
);
3862 string
= SYMBOL_NAME (name
);
3864 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3865 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3871 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3872 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3873 The value is t if a symbol was found and deleted, nil otherwise.
3874 NAME may be a string or a symbol. If it is a symbol, that symbol
3875 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3876 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3877 usage: (unintern NAME OBARRAY) */)
3878 (Lisp_Object name
, Lisp_Object obarray
)
3880 register Lisp_Object string
, tem
;
3883 if (NILP (obarray
)) obarray
= Vobarray
;
3884 obarray
= check_obarray (obarray
);
3887 string
= SYMBOL_NAME (name
);
3890 CHECK_STRING (name
);
3894 tem
= oblookup (obarray
, SSDATA (string
),
3899 /* If arg was a symbol, don't delete anything but that symbol itself. */
3900 if (SYMBOLP (name
) && !EQ (name
, tem
))
3903 /* There are plenty of other symbols which will screw up the Emacs
3904 session if we unintern them, as well as even more ways to use
3905 `setq' or `fset' or whatnot to make the Emacs session
3906 unusable. Let's not go down this silly road. --Stef */
3907 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3908 error ("Attempt to unintern t or nil"); */
3910 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3912 hash
= oblookup_last_bucket_number
;
3914 if (EQ (AREF (obarray
, hash
), tem
))
3916 if (XSYMBOL (tem
)->next
)
3919 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3920 ASET (obarray
, hash
, sym
);
3923 ASET (obarray
, hash
, make_number (0));
3927 Lisp_Object tail
, following
;
3929 for (tail
= AREF (obarray
, hash
);
3930 XSYMBOL (tail
)->next
;
3933 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3934 if (EQ (following
, tem
))
3936 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3945 /* Return the symbol in OBARRAY whose names matches the string
3946 of SIZE characters (SIZE_BYTE bytes) at PTR.
3947 If there is no such symbol, return the integer bucket number of
3948 where the symbol would be if it were present.
3950 Also store the bucket number in oblookup_last_bucket_number. */
3953 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3957 register Lisp_Object tail
;
3958 Lisp_Object bucket
, tem
;
3960 obarray
= check_obarray (obarray
);
3961 obsize
= ASIZE (obarray
);
3963 /* This is sometimes needed in the middle of GC. */
3964 obsize
&= ~ARRAY_MARK_FLAG
;
3965 hash
= hash_string (ptr
, size_byte
) % obsize
;
3966 bucket
= AREF (obarray
, hash
);
3967 oblookup_last_bucket_number
= hash
;
3968 if (EQ (bucket
, make_number (0)))
3970 else if (!SYMBOLP (bucket
))
3971 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3973 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3975 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3976 && SCHARS (SYMBOL_NAME (tail
)) == size
3977 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3979 else if (XSYMBOL (tail
)->next
== 0)
3982 XSETINT (tem
, hash
);
3987 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3990 register Lisp_Object tail
;
3991 CHECK_VECTOR (obarray
);
3992 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3994 tail
= AREF (obarray
, i
);
3999 if (XSYMBOL (tail
)->next
== 0)
4001 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4007 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4009 call1 (function
, sym
);
4012 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4013 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4014 OBARRAY defaults to the value of `obarray'. */)
4015 (Lisp_Object function
, Lisp_Object obarray
)
4017 if (NILP (obarray
)) obarray
= Vobarray
;
4018 obarray
= check_obarray (obarray
);
4020 map_obarray (obarray
, mapatoms_1
, function
);
4024 #define OBARRAY_SIZE 1511
4029 Lisp_Object oblength
;
4030 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4032 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4034 Vobarray
= Fmake_vector (oblength
, make_number (0));
4035 initial_obarray
= Vobarray
;
4036 staticpro (&initial_obarray
);
4038 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4039 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4041 DEFSYM (Qunbound
, "unbound");
4043 DEFSYM (Qnil
, "nil");
4044 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4045 XSYMBOL (Qnil
)->constant
= 1;
4046 XSYMBOL (Qnil
)->declared_special
= true;
4049 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4050 XSYMBOL (Qt
)->constant
= 1;
4051 XSYMBOL (Qt
)->declared_special
= true;
4053 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4056 DEFSYM (Qvariable_documentation
, "variable-documentation");
4058 read_buffer
= xmalloc (size
);
4059 read_buffer_size
= size
;
4063 defsubr (struct Lisp_Subr
*sname
)
4065 Lisp_Object sym
, tem
;
4066 sym
= intern_c_string (sname
->symbol_name
);
4067 XSETPVECTYPE (sname
, PVEC_SUBR
);
4068 XSETSUBR (tem
, sname
);
4069 set_symbol_function (sym
, tem
);
4072 #ifdef NOTDEF /* Use fset in subr.el now! */
4074 defalias (struct Lisp_Subr
*sname
, char *string
)
4077 sym
= intern (string
);
4078 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4082 /* Define an "integer variable"; a symbol whose value is forwarded to a
4083 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4084 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4086 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4087 const char *namestring
, EMACS_INT
*address
)
4090 sym
= intern_c_string (namestring
);
4091 i_fwd
->type
= Lisp_Fwd_Int
;
4092 i_fwd
->intvar
= address
;
4093 XSYMBOL (sym
)->declared_special
= 1;
4094 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4095 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4098 /* Similar but define a variable whose value is t if address contains 1,
4099 nil if address contains 0. */
4101 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4102 const char *namestring
, bool *address
)
4105 sym
= intern_c_string (namestring
);
4106 b_fwd
->type
= Lisp_Fwd_Bool
;
4107 b_fwd
->boolvar
= address
;
4108 XSYMBOL (sym
)->declared_special
= 1;
4109 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4110 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4111 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4114 /* Similar but define a variable whose value is the Lisp Object stored
4115 at address. Two versions: with and without gc-marking of the C
4116 variable. The nopro version is used when that variable will be
4117 gc-marked for some other reason, since marking the same slot twice
4118 can cause trouble with strings. */
4120 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4121 const char *namestring
, Lisp_Object
*address
)
4124 sym
= intern_c_string (namestring
);
4125 o_fwd
->type
= Lisp_Fwd_Obj
;
4126 o_fwd
->objvar
= address
;
4127 XSYMBOL (sym
)->declared_special
= 1;
4128 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4129 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4133 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4134 const char *namestring
, Lisp_Object
*address
)
4136 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4137 staticpro (address
);
4140 /* Similar but define a variable whose value is the Lisp Object stored
4141 at a particular offset in the current kboard object. */
4144 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4145 const char *namestring
, int offset
)
4148 sym
= intern_c_string (namestring
);
4149 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4150 ko_fwd
->offset
= offset
;
4151 XSYMBOL (sym
)->declared_special
= 1;
4152 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4153 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4156 /* Check that the elements of lpath exist. */
4159 load_path_check (Lisp_Object lpath
)
4161 Lisp_Object path_tail
;
4163 /* The only elements that might not exist are those from
4164 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4166 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4168 Lisp_Object dirfile
;
4169 dirfile
= Fcar (path_tail
);
4170 if (STRINGP (dirfile
))
4172 dirfile
= Fdirectory_file_name (dirfile
);
4173 if (! file_accessible_directory_p (dirfile
))
4174 dir_warning ("Lisp directory", XCAR (path_tail
));
4179 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4180 This does not include the standard site-lisp directories
4181 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4182 but it does (unless no_site_lisp is set) include site-lisp
4183 directories in the source/build directories if those exist and we
4184 are running uninstalled.
4186 Uses the following logic:
4187 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4188 The remainder is what happens when dumping works:
4189 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4190 Otherwise use PATH_LOADSEARCH.
4192 If !initialized, then just return PATH_DUMPLOADSEARCH.
4194 If Vinstallation_directory is not nil (ie, running uninstalled):
4195 If installation-dir/lisp exists and not already a member,
4196 we must be running uninstalled. Reset the load-path
4197 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4198 refers to the eventual installation directories. Since we
4199 are not yet installed, we should not use them, even if they exist.)
4200 If installation-dir/lisp does not exist, just add
4201 PATH_DUMPLOADSEARCH at the end instead.
4202 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4203 and not already a member) at the front.
4204 If installation-dir != source-dir (ie running an uninstalled,
4205 out-of-tree build) AND install-dir/src/Makefile exists BUT
4206 install-dir/src/Makefile.in does NOT exist (this is a sanity
4207 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4210 load_path_default (void)
4212 Lisp_Object lpath
= Qnil
;
4217 const char *loadpath
= ns_load_path ();
4220 normal
= PATH_LOADSEARCH
;
4222 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4224 lpath
= decode_env_path (0, normal
, 0);
4227 #else /* !CANNOT_DUMP */
4229 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4234 const char *loadpath
= ns_load_path ();
4235 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4237 lpath
= decode_env_path (0, normal
, 0);
4239 if (!NILP (Vinstallation_directory
))
4241 Lisp_Object tem
, tem1
;
4243 /* Add to the path the lisp subdir of the installation
4244 dir, if it is accessible. Note: in out-of-tree builds,
4245 this directory is empty save for Makefile. */
4246 tem
= Fexpand_file_name (build_string ("lisp"),
4247 Vinstallation_directory
);
4248 tem1
= Ffile_accessible_directory_p (tem
);
4251 if (NILP (Fmember (tem
, lpath
)))
4253 /* We are running uninstalled. The default load-path
4254 points to the eventual installed lisp directories.
4255 We should not use those now, even if they exist,
4256 so start over from a clean slate. */
4257 lpath
= list1 (tem
);
4261 /* That dir doesn't exist, so add the build-time
4262 Lisp dirs instead. */
4264 Lisp_Object dump_path
=
4265 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4266 lpath
= nconc2 (lpath
, dump_path
);
4269 /* Add site-lisp under the installation dir, if it exists. */
4272 tem
= Fexpand_file_name (build_string ("site-lisp"),
4273 Vinstallation_directory
);
4274 tem1
= Ffile_accessible_directory_p (tem
);
4277 if (NILP (Fmember (tem
, lpath
)))
4278 lpath
= Fcons (tem
, lpath
);
4282 /* If Emacs was not built in the source directory,
4283 and it is run from where it was built, add to load-path
4284 the lisp and site-lisp dirs under that directory. */
4286 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4290 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4291 Vinstallation_directory
);
4292 tem1
= Ffile_exists_p (tem
);
4294 /* Don't be fooled if they moved the entire source tree
4295 AFTER dumping Emacs. If the build directory is indeed
4296 different from the source dir, src/Makefile.in and
4297 src/Makefile will not be found together. */
4298 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4299 Vinstallation_directory
);
4300 tem2
= Ffile_exists_p (tem
);
4301 if (!NILP (tem1
) && NILP (tem2
))
4303 tem
= Fexpand_file_name (build_string ("lisp"),
4306 if (NILP (Fmember (tem
, lpath
)))
4307 lpath
= Fcons (tem
, lpath
);
4311 tem
= Fexpand_file_name (build_string ("site-lisp"),
4313 tem1
= Ffile_accessible_directory_p (tem
);
4316 if (NILP (Fmember (tem
, lpath
)))
4317 lpath
= Fcons (tem
, lpath
);
4321 } /* Vinstallation_directory != Vsource_directory */
4323 } /* if Vinstallation_directory */
4325 else /* !initialized */
4327 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4328 source directory. We used to add ../lisp (ie the lisp dir in
4329 the build directory) at the front here, but that should not
4330 be necessary, since in out of tree builds lisp/ is empty, save
4332 lpath
= decode_env_path (0, normal
, 0);
4334 #endif /* !CANNOT_DUMP */
4342 /* First, set Vload_path. */
4344 /* Ignore EMACSLOADPATH when dumping. */
4346 bool use_loadpath
= true;
4348 bool use_loadpath
= NILP (Vpurify_flag
);
4351 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4353 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4355 /* Check (non-nil) user-supplied elements. */
4356 load_path_check (Vload_path
);
4358 /* If no nils in the environment variable, use as-is.
4359 Otherwise, replace any nils with the default. */
4360 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4362 Lisp_Object elem
, elpath
= Vload_path
;
4363 Lisp_Object default_lpath
= load_path_default ();
4365 /* Check defaults, before adding site-lisp. */
4366 load_path_check (default_lpath
);
4368 /* Add the site-lisp directories to the front of the default. */
4371 Lisp_Object sitelisp
;
4372 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4373 if (! NILP (sitelisp
))
4374 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4379 /* Replace nils from EMACSLOADPATH by default. */
4380 while (CONSP (elpath
))
4382 elem
= XCAR (elpath
);
4383 elpath
= XCDR (elpath
);
4384 Vload_path
= CALLN (Fappend
, Vload_path
,
4385 NILP (elem
) ? default_lpath
: list1 (elem
));
4387 } /* Fmemq (Qnil, Vload_path) */
4391 Vload_path
= load_path_default ();
4393 /* Check before adding site-lisp directories.
4394 The install should have created them, but they are not
4395 required, so no need to warn if they are absent.
4396 Or we might be running before installation. */
4397 load_path_check (Vload_path
);
4399 /* Add the site-lisp directories at the front. */
4400 if (initialized
&& !no_site_lisp
)
4402 Lisp_Object sitelisp
;
4403 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4404 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4410 load_in_progress
= 0;
4411 Vload_file_name
= Qnil
;
4412 Vstandard_input
= Qt
;
4413 Vloads_in_progress
= Qnil
;
4416 /* Print a warning that directory intended for use USE and with name
4417 DIRNAME cannot be accessed. On entry, errno should correspond to
4418 the access failure. Print the warning on stderr and put it in
4422 dir_warning (char const *use
, Lisp_Object dirname
)
4424 static char const format
[] = "Warning: %s '%s': %s\n";
4425 int access_errno
= errno
;
4426 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)),
4427 strerror (access_errno
));
4429 /* Don't log the warning before we've initialized!! */
4432 char const *diagnostic
= emacs_strerror (access_errno
);
4434 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4435 + strlen (use
) + SBYTES (dirname
)
4436 + strlen (diagnostic
));
4437 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4439 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4445 syms_of_lread (void)
4448 defsubr (&Sread_from_string
);
4450 defsubr (&Sintern_soft
);
4451 defsubr (&Sunintern
);
4452 defsubr (&Sget_load_suffixes
);
4454 defsubr (&Seval_buffer
);
4455 defsubr (&Seval_region
);
4456 defsubr (&Sread_char
);
4457 defsubr (&Sread_char_exclusive
);
4458 defsubr (&Sread_event
);
4459 defsubr (&Sget_file_char
);
4460 defsubr (&Smapatoms
);
4461 defsubr (&Slocate_file_internal
);
4463 DEFVAR_LISP ("obarray", Vobarray
,
4464 doc
: /* Symbol table for use by `intern' and `read'.
4465 It is a vector whose length ought to be prime for best results.
4466 The vector's contents don't make sense if examined from Lisp programs;
4467 to find all the symbols in an obarray, use `mapatoms'. */);
4469 DEFVAR_LISP ("values", Vvalues
,
4470 doc
: /* List of values of all expressions which were read, evaluated and printed.
4471 Order is reverse chronological. */);
4472 XSYMBOL (intern ("values"))->declared_special
= 0;
4474 DEFVAR_LISP ("standard-input", Vstandard_input
,
4475 doc
: /* Stream for read to get input from.
4476 See documentation of `read' for possible values. */);
4477 Vstandard_input
= Qt
;
4479 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4480 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4482 If this variable is a buffer, then only forms read from that buffer
4483 will be added to `read-symbol-positions-list'.
4484 If this variable is t, then all read forms will be added.
4485 The effect of all other values other than nil are not currently
4486 defined, although they may be in the future.
4488 The positions are relative to the last call to `read' or
4489 `read-from-string'. It is probably a bad idea to set this variable at
4490 the toplevel; bind it instead. */);
4491 Vread_with_symbol_positions
= Qnil
;
4493 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4494 doc
: /* A list mapping read symbols to their positions.
4495 This variable is modified during calls to `read' or
4496 `read-from-string', but only when `read-with-symbol-positions' is
4499 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4500 CHAR-POSITION is an integer giving the offset of that occurrence of the
4501 symbol from the position where `read' or `read-from-string' started.
4503 Note that a symbol will appear multiple times in this list, if it was
4504 read multiple times. The list is in the same order as the symbols
4506 Vread_symbol_positions_list
= Qnil
;
4508 DEFVAR_LISP ("read-circle", Vread_circle
,
4509 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4512 DEFVAR_LISP ("load-path", Vload_path
,
4513 doc
: /* List of directories to search for files to load.
4514 Each element is a string (directory name) or nil (meaning `default-directory').
4515 Initialized during startup as described in Info node `(elisp)Library Search'. */);
4517 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4518 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4519 This list should not include the empty string.
4520 `load' and related functions try to append these suffixes, in order,
4521 to the specified file name if a Lisp suffix is allowed or required. */);
4522 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4523 build_pure_c_string (".el"));
4524 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4525 doc
: /* List of suffixes that indicate representations of \
4527 This list should normally start with the empty string.
4529 Enabling Auto Compression mode appends the suffixes in
4530 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4531 mode removes them again. `load' and related functions use this list to
4532 determine whether they should look for compressed versions of a file
4533 and, if so, which suffixes they should try to append to the file name
4534 in order to do so. However, if you want to customize which suffixes
4535 the loading functions recognize as compression suffixes, you should
4536 customize `jka-compr-load-suffixes' rather than the present variable. */);
4537 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4539 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4540 doc
: /* Non-nil if inside of `load'. */);
4541 DEFSYM (Qload_in_progress
, "load-in-progress");
4543 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4544 doc
: /* An alist of functions to be evalled when particular files are loaded.
4545 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4547 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4548 a symbol \(a feature name).
4550 When `load' is run and the file-name argument matches an element's
4551 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4552 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4554 An error in FORMS does not undo the load, but does prevent execution of
4555 the rest of the FORMS. */);
4556 Vafter_load_alist
= Qnil
;
4558 DEFVAR_LISP ("load-history", Vload_history
,
4559 doc
: /* Alist mapping loaded file names to symbols and features.
4560 Each alist element should be a list (FILE-NAME ENTRIES...), where
4561 FILE-NAME is the name of a file that has been loaded into Emacs.
4562 The file name is absolute and true (i.e. it doesn't contain symlinks).
4563 As an exception, one of the alist elements may have FILE-NAME nil,
4564 for symbols and features not associated with any file.
4566 The remaining ENTRIES in the alist element describe the functions and
4567 variables defined in that file, the features provided, and the
4568 features required. Each entry has the form `(provide . FEATURE)',
4569 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4570 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4571 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4572 autoload before this file redefined it as a function. In addition,
4573 entries may also be single symbols, which means that SYMBOL was
4574 defined by `defvar' or `defconst'.
4576 During preloading, the file name recorded is relative to the main Lisp
4577 directory. These file names are converted to absolute at startup. */);
4578 Vload_history
= Qnil
;
4580 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4581 doc
: /* Full name of file being loaded by `load'. */);
4582 Vload_file_name
= Qnil
;
4584 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4585 doc
: /* File name, including directory, of user's initialization file.
4586 If the file loaded had extension `.elc', and the corresponding source file
4587 exists, this variable contains the name of source file, suitable for use
4588 by functions like `custom-save-all' which edit the init file.
4589 While Emacs loads and evaluates the init file, value is the real name
4590 of the file, regardless of whether or not it has the `.elc' extension. */);
4591 Vuser_init_file
= Qnil
;
4593 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4594 doc
: /* Used for internal purposes by `load'. */);
4595 Vcurrent_load_list
= Qnil
;
4597 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4598 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4599 Called with a single argument (the stream from which to read).
4600 The default is to use the function `read'. */);
4601 DEFSYM (Qread
, "read");
4602 Vload_read_function
= Qread
;
4604 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4605 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4606 The value should be a function for doing code conversion before
4607 reading a source file. It can also be nil, in which case loading is
4608 done without any code conversion.
4610 If the value is a function, it is called with four arguments,
4611 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4612 the file to load, FILE is the non-absolute name (for messages etc.),
4613 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4614 `load'. The function should return t if the file was loaded. */);
4615 Vload_source_file_function
= Qnil
;
4617 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4618 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4619 This is useful when the file being loaded is a temporary copy. */);
4620 load_force_doc_strings
= 0;
4622 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4623 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4624 This is normally bound by `load' and `eval-buffer' to control `read',
4625 and is not meant for users to change. */);
4626 load_convert_to_unibyte
= 0;
4628 DEFVAR_LISP ("source-directory", Vsource_directory
,
4629 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4630 You cannot count on them to still be there! */);
4632 = Fexpand_file_name (build_string ("../"),
4633 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4635 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4636 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4637 Vpreloaded_file_list
= Qnil
;
4639 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4640 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4641 Vbyte_boolean_vars
= Qnil
;
4643 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4644 doc
: /* Non-nil means load dangerous compiled Lisp files.
4645 Some versions of XEmacs use different byte codes than Emacs. These
4646 incompatible byte codes can make Emacs crash when it tries to execute
4648 load_dangerous_libraries
= 0;
4650 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4651 doc
: /* Non-nil means force printing messages when loading Lisp files.
4652 This overrides the value of the NOMESSAGE argument to `load'. */);
4653 force_load_messages
= 0;
4655 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4656 doc
: /* Regular expression matching safe to load compiled Lisp files.
4657 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4658 from the file, and matches them against this regular expression.
4659 When the regular expression matches, the file is considered to be safe
4660 to load. See also `load-dangerous-libraries'. */);
4661 Vbytecomp_version_regexp
4662 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4664 DEFSYM (Qlexical_binding
, "lexical-binding");
4665 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4666 doc
: /* Whether to use lexical binding when evaluating code.
4667 Non-nil means that the code in the current buffer should be evaluated
4668 with lexical binding.
4669 This variable is automatically set from the file variables of an
4670 interpreted Lisp file read using `load'. Unlike other file local
4671 variables, this must be set in the first line of a file. */);
4672 Vlexical_binding
= Qnil
;
4673 Fmake_variable_buffer_local (Qlexical_binding
);
4675 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4676 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4677 Veval_buffer_list
= Qnil
;
4679 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4680 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4681 Vold_style_backquotes
= Qnil
;
4682 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4684 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4685 doc
: /* Non-nil means `load' prefers the newest version of a file.
4686 This applies when a filename suffix is not explicitly specified and
4687 `load' is trying various possible suffixes (see `load-suffixes' and
4688 `load-file-rep-suffixes'). Normally, it stops at the first file
4689 that exists unless you explicitly specify one or the other. If this
4690 option is non-nil, it checks all suffixes and uses whichever file is
4692 Note that if you customize this, obviously it will not affect files
4693 that are loaded before your customizations are read! */);
4694 load_prefer_newer
= 0;
4696 /* Vsource_directory was initialized in init_lread. */
4698 DEFSYM (Qcurrent_load_list
, "current-load-list");
4699 DEFSYM (Qstandard_input
, "standard-input");
4700 DEFSYM (Qread_char
, "read-char");
4701 DEFSYM (Qget_file_char
, "get-file-char");
4703 /* Used instead of Qget_file_char while loading *.elc files compiled
4704 by Emacs 21 or older. */
4705 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4707 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4709 DEFSYM (Qbackquote
, "`");
4710 DEFSYM (Qcomma
, ",");
4711 DEFSYM (Qcomma_at
, ",@");
4712 DEFSYM (Qcomma_dot
, ",.");
4714 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4715 DEFSYM (Qascii_character
, "ascii-character");
4716 DEFSYM (Qfunction
, "function");
4717 DEFSYM (Qload
, "load");
4718 DEFSYM (Qload_file_name
, "load-file-name");
4719 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4720 DEFSYM (Qfile_truename
, "file-truename");
4721 DEFSYM (Qdir_ok
, "dir-ok");
4722 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4724 staticpro (&read_objects
);
4725 read_objects
= Qnil
;
4726 staticpro (&seen_list
);
4729 Vloads_in_progress
= Qnil
;
4730 staticpro (&Vloads_in_progress
);
4732 DEFSYM (Qhash_table
, "hash-table");
4733 DEFSYM (Qdata
, "data");
4734 DEFSYM (Qtest
, "test");
4735 DEFSYM (Qsize
, "size");
4736 DEFSYM (Qweakness
, "weakness");
4737 DEFSYM (Qrehash_size
, "rehash-size");
4738 DEFSYM (Qrehash_threshold
, "rehash-threshold");