1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2013 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
27 #include <limits.h> /* For CHAR_BIT. */
28 #include <stat-time.h>
30 #include "intervals.h"
31 #include "character.h"
39 #include "termhooks.h"
40 #include "blockinput.h"
54 #endif /* HAVE_SETLOCALE */
59 #define file_offset off_t
60 #define file_tell ftello
62 #define file_offset long
63 #define file_tell ftell
66 /* Hash table read constants. */
67 static Lisp_Object Qhash_table
, Qdata
;
68 static Lisp_Object Qtest
, Qsize
;
69 static Lisp_Object Qweakness
;
70 static Lisp_Object Qrehash_size
;
71 static Lisp_Object Qrehash_threshold
;
73 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
74 Lisp_Object Qstandard_input
;
75 Lisp_Object Qvariable_documentation
;
76 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
77 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
78 static Lisp_Object Qinhibit_file_name_operation
;
79 static Lisp_Object Qeval_buffer_list
;
80 Lisp_Object Qlexical_binding
;
81 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
83 /* Used instead of Qget_file_char while loading *.elc files compiled
84 by Emacs 21 or older. */
85 static Lisp_Object Qget_emacs_mule_file_char
;
87 static Lisp_Object Qload_force_doc_strings
;
89 static Lisp_Object Qload_in_progress
;
91 /* The association list of objects read with the #n=object form.
92 Each member of the list has the form (n . object), and is used to
93 look up the object for the corresponding #n# construct.
94 It must be set to nil before all top-level calls to read0. */
95 static Lisp_Object read_objects
;
97 /* File for get_file_char to read from. Use by load. */
98 static FILE *instream
;
100 /* For use within read-from-string (this reader is non-reentrant!!) */
101 static ptrdiff_t read_from_string_index
;
102 static ptrdiff_t read_from_string_index_byte
;
103 static ptrdiff_t read_from_string_limit
;
105 /* Number of characters read in the current call to Fread or
106 Fread_from_string. */
107 static EMACS_INT readchar_count
;
109 /* This contains the last string skipped with #@. */
110 static char *saved_doc_string
;
111 /* Length of buffer allocated in saved_doc_string. */
112 static ptrdiff_t saved_doc_string_size
;
113 /* Length of actual data in saved_doc_string. */
114 static ptrdiff_t saved_doc_string_length
;
115 /* This is the file position that string came from. */
116 static file_offset saved_doc_string_position
;
118 /* This contains the previous string skipped with #@.
119 We copy it from saved_doc_string when a new string
120 is put in saved_doc_string. */
121 static char *prev_saved_doc_string
;
122 /* Length of buffer allocated in prev_saved_doc_string. */
123 static ptrdiff_t prev_saved_doc_string_size
;
124 /* Length of actual data in prev_saved_doc_string. */
125 static ptrdiff_t prev_saved_doc_string_length
;
126 /* This is the file position that string came from. */
127 static file_offset prev_saved_doc_string_position
;
129 /* True means inside a new-style backquote
130 with no surrounding parentheses.
131 Fread initializes this to false, so we need not specbind it
132 or worry about what happens to it when there is an error. */
133 static bool new_backquote_flag
;
134 static Lisp_Object Qold_style_backquotes
;
136 /* A list of file names for files being loaded in Fload. Used to
137 check for recursive loads. */
139 static Lisp_Object Vloads_in_progress
;
141 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
144 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
145 Lisp_Object
, Lisp_Object
,
146 Lisp_Object
, Lisp_Object
);
148 /* Functions that read one byte from the current source READCHARFUN
149 or unreads one byte. If the integer argument C is -1, it returns
150 one read byte, or -1 when there's no more byte in the source. If C
151 is 0 or positive, it unreads C, and the return value is not
154 static int readbyte_for_lambda (int, Lisp_Object
);
155 static int readbyte_from_file (int, Lisp_Object
);
156 static int readbyte_from_string (int, Lisp_Object
);
158 /* Handle unreading and rereading of characters.
159 Write READCHAR to read a character,
160 UNREAD(c) to unread c to be read again.
162 These macros correctly read/unread multibyte characters. */
164 #define READCHAR readchar (readcharfun, NULL)
165 #define UNREAD(c) unreadchar (readcharfun, c)
167 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
168 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
170 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
171 Qlambda, or a cons, we use this to keep an unread character because
172 a file stream can't handle multibyte-char unreading. The value -1
173 means that there's no unread character. */
174 static int unread_char
;
177 readchar (Lisp_Object readcharfun
, bool *multibyte
)
181 int (*readbyte
) (int, Lisp_Object
);
182 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
184 bool emacs_mule_encoding
= 0;
191 if (BUFFERP (readcharfun
))
193 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
195 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
197 if (! BUFFER_LIVE_P (inbuffer
))
200 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
203 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
205 /* Fetch the character code from the buffer. */
206 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
207 BUF_INC_POS (inbuffer
, pt_byte
);
214 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
215 if (! ASCII_BYTE_P (c
))
216 c
= BYTE8_TO_CHAR (c
);
219 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
223 if (MARKERP (readcharfun
))
225 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
227 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
229 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
232 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
234 /* Fetch the character code from the buffer. */
235 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
236 BUF_INC_POS (inbuffer
, bytepos
);
243 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
244 if (! ASCII_BYTE_P (c
))
245 c
= BYTE8_TO_CHAR (c
);
249 XMARKER (readcharfun
)->bytepos
= bytepos
;
250 XMARKER (readcharfun
)->charpos
++;
255 if (EQ (readcharfun
, Qlambda
))
257 readbyte
= readbyte_for_lambda
;
261 if (EQ (readcharfun
, Qget_file_char
))
263 readbyte
= readbyte_from_file
;
267 if (STRINGP (readcharfun
))
269 if (read_from_string_index
>= read_from_string_limit
)
271 else if (STRING_MULTIBYTE (readcharfun
))
275 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
276 read_from_string_index
,
277 read_from_string_index_byte
);
281 c
= SREF (readcharfun
, read_from_string_index_byte
);
282 read_from_string_index
++;
283 read_from_string_index_byte
++;
288 if (CONSP (readcharfun
))
290 /* This is the case that read_vector is reading from a unibyte
291 string that contains a byte sequence previously skipped
292 because of #@NUMBER. The car part of readcharfun is that
293 string, and the cdr part is a value of readcharfun given to
295 readbyte
= readbyte_from_string
;
296 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
297 emacs_mule_encoding
= 1;
301 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
303 readbyte
= readbyte_from_file
;
304 emacs_mule_encoding
= 1;
308 tem
= call0 (readcharfun
);
315 if (unread_char
>= 0)
321 c
= (*readbyte
) (-1, readcharfun
);
326 if (ASCII_BYTE_P (c
))
328 if (emacs_mule_encoding
)
329 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
332 len
= BYTES_BY_CHAR_HEAD (c
);
335 c
= (*readbyte
) (-1, readcharfun
);
336 if (c
< 0 || ! TRAILING_CODE_P (c
))
339 (*readbyte
) (buf
[i
], readcharfun
);
340 return BYTE8_TO_CHAR (buf
[0]);
344 return STRING_CHAR (buf
);
347 #define FROM_FILE_P(readcharfun) \
348 (EQ (readcharfun, Qget_file_char) \
349 || EQ (readcharfun, Qget_emacs_mule_file_char))
352 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
354 if (FROM_FILE_P (readcharfun
))
356 block_input (); /* FIXME: Not sure if it's needed. */
357 fseek (instream
, n
, SEEK_CUR
);
361 { /* We're not reading directly from a file. In that case, it's difficult
362 to reliably count bytes, since these are usually meant for the file's
363 encoding, whereas we're now typically in the internal encoding.
364 But luckily, skip_dyn_bytes is used to skip over a single
365 dynamic-docstring (or dynamic byte-code) which is always quoted such
366 that \037 is the final char. */
370 } while (c
>= 0 && c
!= '\037');
375 skip_dyn_eof (Lisp_Object readcharfun
)
377 if (FROM_FILE_P (readcharfun
))
379 block_input (); /* FIXME: Not sure if it's needed. */
380 fseek (instream
, 0, SEEK_END
);
384 while (READCHAR
>= 0);
387 /* Unread the character C in the way appropriate for the stream READCHARFUN.
388 If the stream is a user function, call it with the char as argument. */
391 unreadchar (Lisp_Object readcharfun
, int c
)
395 /* Don't back up the pointer if we're unreading the end-of-input mark,
396 since readchar didn't advance it when we read it. */
398 else if (BUFFERP (readcharfun
))
400 struct buffer
*b
= XBUFFER (readcharfun
);
401 ptrdiff_t charpos
= BUF_PT (b
);
402 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
404 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
405 BUF_DEC_POS (b
, bytepos
);
409 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
411 else if (MARKERP (readcharfun
))
413 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
414 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
416 XMARKER (readcharfun
)->charpos
--;
417 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
418 BUF_DEC_POS (b
, bytepos
);
422 XMARKER (readcharfun
)->bytepos
= bytepos
;
424 else if (STRINGP (readcharfun
))
426 read_from_string_index
--;
427 read_from_string_index_byte
428 = string_char_to_byte (readcharfun
, read_from_string_index
);
430 else if (CONSP (readcharfun
))
434 else if (EQ (readcharfun
, Qlambda
))
438 else if (FROM_FILE_P (readcharfun
))
443 call1 (readcharfun
, make_number (c
));
447 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
449 return read_bytecode_char (c
>= 0);
454 readbyte_from_file (int c
, Lisp_Object readcharfun
)
459 ungetc (c
, instream
);
467 /* Interrupted reads have been observed while reading over the network. */
468 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
479 return (c
== EOF
? -1 : c
);
483 readbyte_from_string (int c
, Lisp_Object readcharfun
)
485 Lisp_Object string
= XCAR (readcharfun
);
489 read_from_string_index
--;
490 read_from_string_index_byte
491 = string_char_to_byte (string
, read_from_string_index
);
494 if (read_from_string_index
>= read_from_string_limit
)
497 FETCH_STRING_CHAR_ADVANCE (c
, string
,
498 read_from_string_index
,
499 read_from_string_index_byte
);
504 /* Read one non-ASCII character from INSTREAM. The character is
505 encoded in `emacs-mule' and the first byte is already read in
509 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
511 /* Emacs-mule coding uses at most 4-byte for one character. */
512 unsigned char buf
[4];
513 int len
= emacs_mule_bytes
[c
];
514 struct charset
*charset
;
519 /* C is not a valid leading-code of `emacs-mule'. */
520 return BYTE8_TO_CHAR (c
);
526 c
= (*readbyte
) (-1, readcharfun
);
530 (*readbyte
) (buf
[i
], readcharfun
);
531 return BYTE8_TO_CHAR (buf
[0]);
538 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
539 code
= buf
[1] & 0x7F;
543 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
544 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
546 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
547 code
= buf
[2] & 0x7F;
551 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
552 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
557 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
558 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
560 c
= DECODE_CHAR (charset
, code
);
562 Fsignal (Qinvalid_read_syntax
,
563 list1 (build_string ("invalid multibyte form")));
568 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
570 static Lisp_Object
read0 (Lisp_Object
);
571 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
573 static Lisp_Object
read_list (bool, Lisp_Object
);
574 static Lisp_Object
read_vector (Lisp_Object
, bool);
576 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
578 static void substitute_object_in_subtree (Lisp_Object
,
580 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
583 /* Get a character from the tty. */
585 /* Read input events until we get one that's acceptable for our purposes.
587 If NO_SWITCH_FRAME, switch-frame events are stashed
588 until we get a character we like, and then stuffed into
591 If ASCII_REQUIRED, check function key events to see
592 if the unmodified version of the symbol has a Qascii_character
593 property, and use that character, if present.
595 If ERROR_NONASCII, signal an error if the input we
596 get isn't an ASCII character with modifiers. If it's false but
597 ASCII_REQUIRED is true, just re-read until we get an ASCII
600 If INPUT_METHOD, invoke the current input method
601 if the character warrants that.
603 If SECONDS is a number, wait that many seconds for input, and
604 return Qnil if no input arrives within that time. */
607 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
608 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
610 Lisp_Object val
, delayed_switch_frame
;
611 struct timespec end_time
;
613 #ifdef HAVE_WINDOW_SYSTEM
614 if (display_hourglass_p
)
618 delayed_switch_frame
= Qnil
;
620 /* Compute timeout. */
621 if (NUMBERP (seconds
))
623 double duration
= extract_float (seconds
);
624 struct timespec wait_time
= dtotimespec (duration
);
625 end_time
= timespec_add (current_timespec (), wait_time
);
628 /* Read until we get an acceptable event. */
631 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
632 NUMBERP (seconds
) ? &end_time
: NULL
);
633 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
638 /* `switch-frame' events are put off until after the next ASCII
639 character. This is better than signaling an error just because
640 the last characters were typed to a separate minibuffer frame,
641 for example. Eventually, some code which can deal with
642 switch-frame events will read it and process it. */
644 && EVENT_HAS_PARAMETERS (val
)
645 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
647 delayed_switch_frame
= val
;
651 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
653 /* Convert certain symbols to their ASCII equivalents. */
656 Lisp_Object tem
, tem1
;
657 tem
= Fget (val
, Qevent_symbol_element_mask
);
660 tem1
= Fget (Fcar (tem
), Qascii_character
);
661 /* Merge this symbol's modifier bits
662 with the ASCII equivalent of its basic code. */
664 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
668 /* If we don't have a character now, deal with it appropriately. */
673 Vunread_command_events
= list1 (val
);
674 error ("Non-character input-event");
681 if (! NILP (delayed_switch_frame
))
682 unread_switch_frame
= delayed_switch_frame
;
686 #ifdef HAVE_WINDOW_SYSTEM
687 if (display_hourglass_p
)
696 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
697 doc
: /* Read a character from the command input (keyboard or macro).
698 It is returned as a number.
699 If the character has modifiers, they are resolved and reflected to the
700 character code if possible (e.g. C-SPC -> 0).
702 If the user generates an event which is not a character (i.e. a mouse
703 click or function key event), `read-char' signals an error. As an
704 exception, switch-frame events are put off until non-character events
706 If you want to read non-character events, or ignore them, call
707 `read-event' or `read-char-exclusive' instead.
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
)
722 message_with_string ("%s", prompt
, 0);
723 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
725 return (NILP (val
) ? Qnil
726 : make_number (char_resolve_modifier_mask (XINT (val
))));
729 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
730 doc
: /* Read an event object from the input stream.
731 If the optional argument PROMPT is non-nil, display that as a prompt.
732 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
733 input method is turned on in the current buffer, that input method
734 is used for reading a character.
735 If the optional argument SECONDS is non-nil, it should be a number
736 specifying the maximum number of seconds to wait for input. If no
737 input arrives in that time, return nil. SECONDS may be a
738 floating-point value. */)
739 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
742 message_with_string ("%s", prompt
, 0);
743 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
746 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
747 doc
: /* Read a character from the command input (keyboard or macro).
748 It is returned as a number. Non-character events are ignored.
749 If the character has modifiers, they are resolved and reflected to the
750 character code if possible (e.g. C-SPC -> 0).
752 If the optional argument PROMPT is non-nil, display that as a prompt.
753 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
754 input method is turned on in the current buffer, that input method
755 is used for reading a character.
756 If the optional argument SECONDS is non-nil, it should be a number
757 specifying the maximum number of seconds to wait for input. If no
758 input arrives in that time, return nil. SECONDS may be a
759 floating-point value. */)
760 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
765 message_with_string ("%s", prompt
, 0);
767 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
769 return (NILP (val
) ? Qnil
770 : make_number (char_resolve_modifier_mask (XINT (val
))));
773 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
774 doc
: /* Don't use this yourself. */)
777 register Lisp_Object val
;
779 XSETINT (val
, getc (instream
));
787 /* Return true if the lisp code read using READCHARFUN defines a non-nil
788 `lexical-binding' file variable. After returning, the stream is
789 positioned following the first line, if it is a comment or #! line,
790 otherwise nothing is read. */
793 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
806 while (ch
!= '\n' && ch
!= EOF
)
808 if (ch
== '\n') ch
= READCHAR
;
809 /* It is OK to leave the position after a #! line, since
810 that is what read1 does. */
814 /* The first line isn't a comment, just give up. */
820 /* Look for an appropriate file-variable in the first line. */
824 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
825 } beg_end_state
= NOMINAL
;
826 bool in_file_vars
= 0;
828 #define UPDATE_BEG_END_STATE(ch) \
829 if (beg_end_state == NOMINAL) \
830 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
831 else if (beg_end_state == AFTER_FIRST_DASH) \
832 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
833 else if (beg_end_state == AFTER_ASTERIX) \
836 in_file_vars = !in_file_vars; \
837 beg_end_state = NOMINAL; \
840 /* Skip until we get to the file vars, if any. */
844 UPDATE_BEG_END_STATE (ch
);
846 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
850 char var
[100], val
[100];
855 /* Read a variable name. */
856 while (ch
== ' ' || ch
== '\t')
860 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
862 if (i
< sizeof var
- 1)
864 UPDATE_BEG_END_STATE (ch
);
868 /* Stop scanning if no colon was found before end marker. */
869 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
872 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
878 /* Read a variable value. */
881 while (ch
== ' ' || ch
== '\t')
885 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
887 if (i
< sizeof val
- 1)
889 UPDATE_BEG_END_STATE (ch
);
893 /* The value was terminated by an end-marker, which remove. */
895 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
899 if (strcmp (var
, "lexical-binding") == 0)
902 rv
= (strcmp (val
, "nil") != 0);
908 while (ch
!= '\n' && ch
!= EOF
)
915 /* Value is a version number of byte compiled code if the file
916 associated with file descriptor FD is a compiled Lisp file that's
917 safe to load. Only files compiled with Emacs are safe to load.
918 Files compiled with XEmacs can lead to a crash in Fbyte_code
919 because of an incompatible change in the byte compiler. */
922 safe_to_load_version (int fd
)
928 /* Read the first few bytes from the file, and look for a line
929 specifying the byte compiler version used. */
930 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
933 /* Skip to the next newline, skipping over the initial `ELC'
934 with NUL bytes following it, but note the version. */
935 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
940 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
941 buf
+ i
, nbytes
- i
) < 0)
945 lseek (fd
, 0, SEEK_SET
);
950 /* Callback for record_unwind_protect. Restore the old load list OLD,
951 after loading a file successfully. */
954 record_load_unwind (Lisp_Object old
)
956 Vloads_in_progress
= old
;
959 /* This handler function is used via internal_condition_case_1. */
962 load_error_handler (Lisp_Object data
)
968 load_warn_old_style_backquotes (Lisp_Object file
)
970 if (!NILP (Vold_style_backquotes
))
973 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
979 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
980 doc
: /* Return the suffixes that `load' should try if a suffix is \
982 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
985 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
986 while (CONSP (suffixes
))
988 Lisp_Object exts
= Vload_file_rep_suffixes
;
989 suffix
= XCAR (suffixes
);
990 suffixes
= XCDR (suffixes
);
995 lst
= Fcons (concat2 (suffix
, ext
), lst
);
998 return Fnreverse (lst
);
1001 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1002 doc
: /* Execute a file of Lisp code named FILE.
1003 First try FILE with `.elc' appended, then try with `.el',
1004 then try FILE unmodified (the exact suffixes in the exact order are
1005 determined by `load-suffixes'). Environment variable references in
1006 FILE are replaced with their values by calling `substitute-in-file-name'.
1007 This function searches the directories in `load-path'.
1009 If optional second arg NOERROR is non-nil,
1010 report no error if FILE doesn't exist.
1011 Print messages at start and end of loading unless
1012 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1014 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1015 suffixes `.elc' or `.el' to the specified name FILE.
1016 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1017 the suffix `.elc' or `.el'; don't accept just FILE unless
1018 it ends in one of those suffixes or includes a directory name.
1020 If NOSUFFIX is nil, then if a file could not be found, try looking for
1021 a different representation of the file by adding non-empty suffixes to
1022 its name, before trying another file. Emacs uses this feature to find
1023 compressed versions of files when Auto Compression mode is enabled.
1024 If NOSUFFIX is non-nil, disable this feature.
1026 The suffixes that this function tries out, when NOSUFFIX is nil, are
1027 given by the return value of `get-load-suffixes' and the values listed
1028 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1029 return value of `get-load-suffixes' is used, i.e. the file name is
1030 required to have a non-empty suffix.
1032 Loading a file records its definitions, and its `provide' and
1033 `require' calls, in an element of `load-history' whose
1034 car is the file name loaded. See `load-history'.
1036 While the file is in the process of being loaded, the variable
1037 `load-in-progress' is non-nil and the variable `load-file-name'
1038 is bound to the file's name.
1040 Return t if the file exists and loads successfully. */)
1041 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1042 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1047 ptrdiff_t count
= SPECPDL_INDEX ();
1048 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1049 Lisp_Object found
, efound
, hist_file_name
;
1050 /* True means we printed the ".el is newer" message. */
1052 /* True means we are loading a compiled file. */
1054 Lisp_Object handler
;
1056 const char *fmode
= "r";
1063 CHECK_STRING (file
);
1065 /* If file name is magic, call the handler. */
1066 /* This shouldn't be necessary any more now that `openp' handles it right.
1067 handler = Ffind_file_name_handler (file, Qload);
1068 if (!NILP (handler))
1069 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1071 /* Do this after the handler to avoid
1072 the need to gcpro noerror, nomessage and nosuffix.
1073 (Below here, we care only whether they are nil or not.)
1074 The presence of this call is the result of a historical accident:
1075 it used to be in every file-operation and when it got removed
1076 everywhere, it accidentally stayed here. Since then, enough people
1077 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1078 that it seemed risky to remove. */
1079 if (! NILP (noerror
))
1081 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1082 Qt
, load_error_handler
);
1087 file
= Fsubstitute_in_file_name (file
);
1089 /* Avoid weird lossage with null string as arg,
1090 since it would try to load a directory as a Lisp file. */
1091 if (SCHARS (file
) == 0)
1098 Lisp_Object suffixes
;
1100 GCPRO2 (file
, found
);
1102 if (! NILP (must_suffix
))
1104 /* Don't insist on adding a suffix if FILE already ends with one. */
1105 ptrdiff_t size
= SBYTES (file
);
1107 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1110 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1112 /* Don't insist on adding a suffix
1113 if the argument includes a directory name. */
1114 else if (! NILP (Ffile_name_directory (file
)))
1118 if (!NILP (nosuffix
))
1122 suffixes
= Fget_load_suffixes ();
1123 if (NILP (must_suffix
))
1127 arg
[1] = Vload_file_rep_suffixes
;
1128 suffixes
= Fappend (2, arg
);
1132 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1139 report_file_error ("Cannot open load file", file
);
1143 /* Tell startup.el whether or not we found the user's init file. */
1144 if (EQ (Qt
, Vuser_init_file
))
1145 Vuser_init_file
= found
;
1147 /* If FD is -2, that means openp found a magic file. */
1150 if (NILP (Fequal (found
, file
)))
1151 /* If FOUND is a different file name from FILE,
1152 find its handler even if we have already inhibited
1153 the `load' operation on FILE. */
1154 handler
= Ffind_file_name_handler (found
, Qt
);
1156 handler
= Ffind_file_name_handler (found
, Qload
);
1157 if (! NILP (handler
))
1158 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1160 /* Tramp has to deal with semi-broken packages that prepend
1161 drive letters to remote files. For that reason, Tramp
1162 catches file operations that test for file existence, which
1163 makes openp think X:/foo.elc files are remote. However,
1164 Tramp does not catch `load' operations for such files, so we
1165 end up with a nil as the `load' handler above. If we would
1166 continue with fd = -2, we will behave wrongly, and in
1167 particular try reading a .elc file in the "rt" mode instead
1168 of "rb". See bug #9311 for the results. To work around
1169 this, we try to open the file locally, and go with that if it
1171 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1179 /* Pacify older GCC with --enable-gcc-warnings. */
1180 IF_LINT (fd_index
= 0);
1184 fd_index
= SPECPDL_INDEX ();
1185 record_unwind_protect_int (close_file_unwind
, fd
);
1188 /* Check if we're stuck in a recursive load cycle.
1190 2000-09-21: It's not possible to just check for the file loaded
1191 being a member of Vloads_in_progress. This fails because of the
1192 way the byte compiler currently works; `provide's are not
1193 evaluated, see font-lock.el/jit-lock.el as an example. This
1194 leads to a certain amount of ``normal'' recursion.
1196 Also, just loading a file recursively is not always an error in
1197 the general case; the second load may do something different. */
1201 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1202 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1203 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1204 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1205 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1208 /* All loads are by default dynamic, unless the file itself specifies
1209 otherwise using a file-variable in the first line. This is bound here
1210 so that it takes effect whether or not we use
1211 Vload_source_file_function. */
1212 specbind (Qlexical_binding
, Qnil
);
1214 /* Get the name for load-history. */
1215 hist_file_name
= (! NILP (Vpurify_flag
)
1216 ? concat2 (Ffile_name_directory (file
),
1217 Ffile_name_nondirectory (found
))
1222 /* Check for the presence of old-style quotes and warn about them. */
1223 specbind (Qold_style_backquotes
, Qnil
);
1224 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1226 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1227 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1228 /* Load .elc files directly, but not when they are
1229 remote and have no handler! */
1236 GCPRO3 (file
, found
, hist_file_name
);
1239 && ! (version
= safe_to_load_version (fd
)))
1242 if (!load_dangerous_libraries
)
1243 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1244 else if (!NILP (nomessage
) && !force_load_messages
)
1245 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1250 efound
= ENCODE_FILE (found
);
1256 /* openp already checked for newness, no point doing it again.
1257 FIXME would be nice to get a message when openp
1258 ignores suffix order due to load_prefer_newer. */
1259 if (!load_prefer_newer
)
1261 result
= stat (SSDATA (efound
), &s1
);
1264 SSET (efound
, SBYTES (efound
) - 1, 0);
1265 result
= stat (SSDATA (efound
), &s2
);
1266 SSET (efound
, SBYTES (efound
) - 1, 'c');
1270 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1272 /* Make the progress messages mention that source is newer. */
1275 /* If we won't print another message, mention this anyway. */
1276 if (!NILP (nomessage
) && !force_load_messages
)
1278 Lisp_Object msg_file
;
1279 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1280 message_with_string ("Source file `%s' newer than byte-compiled file",
1284 } /* !load_prefer_newer */
1290 /* We are loading a source file (*.el). */
1291 if (!NILP (Vload_source_file_function
))
1298 clear_unwind_protect (fd_index
);
1300 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1301 NILP (noerror
) ? Qnil
: Qt
,
1302 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1303 return unbind_to (count
, val
);
1307 GCPRO3 (file
, found
, hist_file_name
);
1311 /* We somehow got here with fd == -2, meaning the file is deemed
1312 to be remote. Don't even try to reopen the file locally;
1313 just force a failure. */
1321 clear_unwind_protect (fd_index
);
1322 efound
= ENCODE_FILE (found
);
1323 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1325 stream
= fdopen (fd
, fmode
);
1329 report_file_error ("Opening stdio stream", file
);
1330 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1332 if (! NILP (Vpurify_flag
))
1333 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1335 if (NILP (nomessage
) || force_load_messages
)
1338 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1341 message_with_string ("Loading %s (source)...", file
, 1);
1343 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1345 else /* The typical case; compiled file newer than source file. */
1346 message_with_string ("Loading %s...", file
, 1);
1349 specbind (Qload_file_name
, found
);
1350 specbind (Qinhibit_file_name_operation
, Qnil
);
1351 specbind (Qload_in_progress
, Qt
);
1354 if (lisp_file_lexically_bound_p (Qget_file_char
))
1355 Fset (Qlexical_binding
, Qt
);
1357 if (! version
|| version
>= 22)
1358 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1359 0, Qnil
, Qnil
, Qnil
, Qnil
);
1362 /* We can't handle a file which was compiled with
1363 byte-compile-dynamic by older version of Emacs. */
1364 specbind (Qload_force_doc_strings
, Qt
);
1365 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1366 0, Qnil
, Qnil
, Qnil
, Qnil
);
1368 unbind_to (count
, Qnil
);
1370 /* Run any eval-after-load forms for this file. */
1371 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1372 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1376 xfree (saved_doc_string
);
1377 saved_doc_string
= 0;
1378 saved_doc_string_size
= 0;
1380 xfree (prev_saved_doc_string
);
1381 prev_saved_doc_string
= 0;
1382 prev_saved_doc_string_size
= 0;
1384 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1387 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1390 message_with_string ("Loading %s (source)...done", file
, 1);
1392 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1394 else /* The typical case; compiled file newer than source file. */
1395 message_with_string ("Loading %s...done", file
, 1);
1402 complete_filename_p (Lisp_Object pathname
)
1404 const unsigned char *s
= SDATA (pathname
);
1405 return (IS_DIRECTORY_SEP (s
[0])
1406 || (SCHARS (pathname
) > 2
1407 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1410 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1411 doc
: /* Search for FILENAME through PATH.
1412 Returns the file's name in absolute form, or nil if not found.
1413 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1414 file name when searching.
1415 If non-nil, PREDICATE is used instead of `file-readable-p'.
1416 PREDICATE can also be an integer to pass to the faccessat(2) function,
1417 in which case file-name-handlers are ignored.
1418 This function will normally skip directories, so if you want it to find
1419 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1420 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1423 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1424 if (NILP (predicate
) && fd
>= 0)
1429 static Lisp_Object Qdir_ok
;
1431 /* Search for a file whose name is STR, looking in directories
1432 in the Lisp list PATH, and trying suffixes from SUFFIX.
1433 On success, return a file descriptor (or 1 or -2 as described below).
1434 On failure, return -1 and set errno.
1436 SUFFIXES is a list of strings containing possible suffixes.
1437 The empty suffix is automatically added if the list is empty.
1439 PREDICATE non-nil means don't open the files,
1440 just look for one that satisfies the predicate. In this case,
1441 return 1 on success. The predicate can be a lisp function or
1442 an integer to pass to `access' (in which case file-name-handlers
1445 If STOREPTR is nonzero, it points to a slot where the name of
1446 the file actually found should be stored as a Lisp string.
1447 nil is stored there on failure.
1449 If the file we find is remote, return -2
1450 but store the found remote file name in *STOREPTR.
1452 If NEWER is true, try all SUFFIXes and return the result for the
1453 newest file that exists. Does not apply to remote files,
1454 or if PREDICATE is specified. */
1457 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1458 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1460 ptrdiff_t fn_size
= 100;
1464 ptrdiff_t want_length
;
1465 Lisp_Object filename
;
1466 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
, gcpro7
;
1467 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1468 ptrdiff_t max_suffix_len
= 0;
1469 int last_errno
= ENOENT
;
1472 /* The last-modified time of the newest matching file found.
1473 Initialize it to something less than all valid timestamps. */
1474 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1478 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1480 CHECK_STRING_CAR (tail
);
1481 max_suffix_len
= max (max_suffix_len
,
1482 SBYTES (XCAR (tail
)));
1485 string
= filename
= encoded_fn
= save_string
= Qnil
;
1486 GCPRO7 (str
, string
, save_string
, filename
, path
, suffixes
, encoded_fn
);
1491 absolute
= complete_filename_p (str
);
1493 for (; CONSP (path
); path
= XCDR (path
))
1495 filename
= Fexpand_file_name (str
, XCAR (path
));
1496 if (!complete_filename_p (filename
))
1497 /* If there are non-absolute elts in PATH (eg "."). */
1498 /* Of course, this could conceivably lose if luser sets
1499 default-directory to be something non-absolute... */
1501 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1502 if (!complete_filename_p (filename
))
1503 /* Give up on this path element! */
1507 /* Calculate maximum length of any filename made from
1508 this path element/specified file name and any possible suffix. */
1509 want_length
= max_suffix_len
+ SBYTES (filename
);
1510 if (fn_size
<= want_length
)
1511 fn
= alloca (fn_size
= 100 + want_length
);
1513 /* Loop over suffixes. */
1514 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1515 CONSP (tail
); tail
= XCDR (tail
))
1517 Lisp_Object suffix
= XCAR (tail
);
1518 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1519 Lisp_Object handler
;
1521 /* Concatenate path element/specified name with the suffix.
1522 If the directory starts with /:, remove that. */
1523 int prefixlen
= ((SCHARS (filename
) > 2
1524 && SREF (filename
, 0) == '/'
1525 && SREF (filename
, 1) == ':')
1527 fnlen
= SBYTES (filename
) - prefixlen
;
1528 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1529 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1531 /* Check that the file exists and is not a directory. */
1532 /* We used to only check for handlers on non-absolute file names:
1536 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1537 It's not clear why that was the case and it breaks things like
1538 (load "/bar.el") where the file is actually "/bar.el.gz". */
1539 /* make_string has its own ideas on when to return a unibyte
1540 string and when a multibyte string, but we know better.
1541 We must have a unibyte string when dumping, since
1542 file-name encoding is shaky at best at that time, and in
1543 particular default-file-name-coding-system is reset
1544 several times during loadup. We therefore don't want to
1545 encode the file before passing it to file I/O library
1547 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1548 string
= make_unibyte_string (fn
, fnlen
);
1550 string
= make_string (fn
, fnlen
);
1551 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1552 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1555 if (NILP (predicate
))
1556 exists
= !NILP (Ffile_readable_p (string
));
1559 Lisp_Object tmp
= call1 (predicate
, string
);
1562 else if (EQ (tmp
, Qdir_ok
)
1563 || NILP (Ffile_directory_p (string
)))
1568 last_errno
= EISDIR
;
1574 /* We succeeded; return this descriptor and filename. */
1587 encoded_fn
= ENCODE_FILE (string
);
1588 pfn
= SSDATA (encoded_fn
);
1590 /* Check that we can access or open it. */
1591 if (NATNUMP (predicate
))
1594 if (INT_MAX
< XFASTINT (predicate
))
1595 last_errno
= EINVAL
;
1596 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1600 if (file_directory_p (pfn
))
1601 last_errno
= EISDIR
;
1608 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1611 if (errno
!= ENOENT
)
1616 int err
= (fstat (fd
, &st
) != 0 ? errno
1617 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1629 if (newer
&& !NATNUMP (predicate
))
1631 struct timespec mtime
= get_stat_mtime (&st
);
1633 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1638 emacs_close (save_fd
);
1641 save_string
= string
;
1646 /* We succeeded; return this descriptor and filename. */
1654 /* No more suffixes. Return the newest. */
1655 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1658 *storeptr
= save_string
;
1674 /* Merge the list we've accumulated of globals from the current input source
1675 into the load_history variable. The details depend on whether
1676 the source has an associated file name or not.
1678 FILENAME is the file name that we are loading from.
1680 ENTIRE is true if loading that entire file, false if evaluating
1684 build_load_history (Lisp_Object filename
, bool entire
)
1686 Lisp_Object tail
, prev
, newelt
;
1687 Lisp_Object tem
, tem2
;
1690 tail
= Vload_history
;
1693 while (CONSP (tail
))
1697 /* Find the feature's previous assoc list... */
1698 if (!NILP (Fequal (filename
, Fcar (tem
))))
1702 /* If we're loading the entire file, remove old data. */
1706 Vload_history
= XCDR (tail
);
1708 Fsetcdr (prev
, XCDR (tail
));
1711 /* Otherwise, cons on new symbols that are not already members. */
1714 tem2
= Vcurrent_load_list
;
1716 while (CONSP (tem2
))
1718 newelt
= XCAR (tem2
);
1720 if (NILP (Fmember (newelt
, tem
)))
1721 Fsetcar (tail
, Fcons (XCAR (tem
),
1722 Fcons (newelt
, XCDR (tem
))));
1735 /* If we're loading an entire file, cons the new assoc onto the
1736 front of load-history, the most-recently-loaded position. Also
1737 do this if we didn't find an existing member for the file. */
1738 if (entire
|| !foundit
)
1739 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1744 readevalloop_1 (int old
)
1746 load_convert_to_unibyte
= old
;
1749 /* Signal an `end-of-file' error, if possible with file name
1752 static _Noreturn
void
1753 end_of_file_error (void)
1755 if (STRINGP (Vload_file_name
))
1756 xsignal1 (Qend_of_file
, Vload_file_name
);
1758 xsignal0 (Qend_of_file
);
1761 /* UNIBYTE specifies how to set load_convert_to_unibyte
1762 for this invocation.
1763 READFUN, if non-nil, is used instead of `read'.
1765 START, END specify region to read in current buffer (from eval-region).
1766 If the input is not from a buffer, they must be nil. */
1769 readevalloop (Lisp_Object readcharfun
,
1771 Lisp_Object sourcename
,
1773 Lisp_Object unibyte
, Lisp_Object readfun
,
1774 Lisp_Object start
, Lisp_Object end
)
1777 register Lisp_Object val
;
1778 ptrdiff_t count
= SPECPDL_INDEX ();
1779 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1780 struct buffer
*b
= 0;
1781 bool continue_reading_p
;
1782 Lisp_Object lex_bound
;
1783 /* True if reading an entire buffer. */
1784 bool whole_buffer
= 0;
1785 /* True on the first time around. */
1786 bool first_sexp
= 1;
1787 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1789 if (NILP (Ffboundp (macroexpand
))
1790 /* Don't macroexpand in .elc files, since it should have been done
1791 already. We actually don't know whether we're in a .elc file or not,
1792 so we use circumstantial evidence: .el files normally go through
1793 Vload_source_file_function -> load-with-code-conversion
1795 || EQ (readcharfun
, Qget_file_char
)
1796 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1799 if (MARKERP (readcharfun
))
1802 start
= readcharfun
;
1805 if (BUFFERP (readcharfun
))
1806 b
= XBUFFER (readcharfun
);
1807 else if (MARKERP (readcharfun
))
1808 b
= XMARKER (readcharfun
)->buffer
;
1810 /* We assume START is nil when input is not from a buffer. */
1811 if (! NILP (start
) && !b
)
1814 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1815 specbind (Qcurrent_load_list
, Qnil
);
1816 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1817 load_convert_to_unibyte
= !NILP (unibyte
);
1819 /* If lexical binding is active (either because it was specified in
1820 the file's header, or via a buffer-local variable), create an empty
1821 lexical environment, otherwise, turn off lexical binding. */
1822 lex_bound
= find_symbol_value (Qlexical_binding
);
1823 specbind (Qinternal_interpreter_environment
,
1824 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1825 ? Qnil
: list1 (Qt
)));
1827 GCPRO4 (sourcename
, readfun
, start
, end
);
1829 /* Try to ensure sourcename is a truename, except whilst preloading. */
1830 if (NILP (Vpurify_flag
)
1831 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1832 && !NILP (Ffboundp (Qfile_truename
)))
1833 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1835 LOADHIST_ATTACH (sourcename
);
1837 continue_reading_p
= 1;
1838 while (continue_reading_p
)
1840 ptrdiff_t count1
= SPECPDL_INDEX ();
1842 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1843 error ("Reading from killed buffer");
1847 /* Switch to the buffer we are reading from. */
1848 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1849 set_buffer_internal (b
);
1851 /* Save point in it. */
1852 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1853 /* Save ZV in it. */
1854 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1855 /* Those get unbound after we read one expression. */
1857 /* Set point and ZV around stuff to be read. */
1860 Fnarrow_to_region (make_number (BEGV
), end
);
1862 /* Just for cleanliness, convert END to a marker
1863 if it is an integer. */
1865 end
= Fpoint_max_marker ();
1868 /* On the first cycle, we can easily test here
1869 whether we are reading the whole buffer. */
1870 if (b
&& first_sexp
)
1871 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1878 while ((c
= READCHAR
) != '\n' && c
!= -1);
1883 unbind_to (count1
, Qnil
);
1887 /* Ignore whitespace here, so we can detect eof. */
1888 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1889 || c
== 0xa0) /* NBSP */
1892 if (!NILP (Vpurify_flag
) && c
== '(')
1894 val
= read_list (0, readcharfun
);
1899 read_objects
= Qnil
;
1900 if (!NILP (readfun
))
1902 val
= call1 (readfun
, readcharfun
);
1904 /* If READCHARFUN has set point to ZV, we should
1905 stop reading, even if the form read sets point
1906 to a different value when evaluated. */
1907 if (BUFFERP (readcharfun
))
1909 struct buffer
*buf
= XBUFFER (readcharfun
);
1910 if (BUF_PT (buf
) == BUF_ZV (buf
))
1911 continue_reading_p
= 0;
1914 else if (! NILP (Vload_read_function
))
1915 val
= call1 (Vload_read_function
, readcharfun
);
1917 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1920 if (!NILP (start
) && continue_reading_p
)
1921 start
= Fpoint_marker ();
1923 /* Restore saved point and BEGV. */
1924 unbind_to (count1
, Qnil
);
1926 /* Now eval what we just read. */
1927 if (!NILP (macroexpand
))
1928 val
= call1 (macroexpand
, val
);
1929 val
= eval_sub (val
);
1933 Vvalues
= Fcons (val
, Vvalues
);
1934 if (EQ (Vstandard_output
, Qt
))
1943 build_load_history (sourcename
,
1944 stream
|| whole_buffer
);
1948 unbind_to (count
, Qnil
);
1951 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1952 doc
: /* Execute the current buffer as Lisp code.
1953 When called from a Lisp program (i.e., not interactively), this
1954 function accepts up to five optional arguments:
1955 BUFFER is the buffer to evaluate (nil means use current buffer).
1956 PRINTFLAG controls printing of output:
1957 A value of nil means discard it; anything else is stream for print.
1958 FILENAME specifies the file name to use for `load-history'.
1959 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1961 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1962 functions should work normally even if PRINTFLAG is nil.
1964 This function preserves the position of point. */)
1965 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1967 ptrdiff_t count
= SPECPDL_INDEX ();
1968 Lisp_Object tem
, buf
;
1971 buf
= Fcurrent_buffer ();
1973 buf
= Fget_buffer (buffer
);
1975 error ("No such buffer");
1977 if (NILP (printflag
) && NILP (do_allow_print
))
1982 if (NILP (filename
))
1983 filename
= BVAR (XBUFFER (buf
), filename
);
1985 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1986 specbind (Qstandard_output
, tem
);
1987 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1988 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1989 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1990 readevalloop (buf
, 0, filename
,
1991 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1992 unbind_to (count
, Qnil
);
1997 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1998 doc
: /* Execute the region as Lisp code.
1999 When called from programs, expects two arguments,
2000 giving starting and ending indices in the current buffer
2001 of the text to be executed.
2002 Programs can pass third argument PRINTFLAG which controls output:
2003 A value of nil means discard it; anything else is stream for printing it.
2004 Also the fourth argument READ-FUNCTION, if non-nil, is used
2005 instead of `read' to read each expression. It gets one argument
2006 which is the input stream for reading characters.
2008 This function does not move point. */)
2009 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2011 /* FIXME: Do the eval-sexp-add-defvars dance! */
2012 ptrdiff_t count
= SPECPDL_INDEX ();
2013 Lisp_Object tem
, cbuf
;
2015 cbuf
= Fcurrent_buffer ();
2017 if (NILP (printflag
))
2021 specbind (Qstandard_output
, tem
);
2022 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2024 /* `readevalloop' calls functions which check the type of start and end. */
2025 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2026 !NILP (printflag
), Qnil
, read_function
,
2029 return unbind_to (count
, Qnil
);
2033 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2034 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2035 If STREAM is nil, use the value of `standard-input' (which see).
2036 STREAM or the value of `standard-input' may be:
2037 a buffer (read from point and advance it)
2038 a marker (read from where it points and advance it)
2039 a function (call it with no arguments for each character,
2040 call it with a char as argument to push a char back)
2041 a string (takes text from string, starting at the beginning)
2042 t (read text line using minibuffer and use it, or read from
2043 standard input in batch mode). */)
2044 (Lisp_Object stream
)
2047 stream
= Vstandard_input
;
2048 if (EQ (stream
, Qt
))
2049 stream
= Qread_char
;
2050 if (EQ (stream
, Qread_char
))
2051 /* FIXME: ¿¡ When is this used !? */
2052 return call1 (intern ("read-minibuffer"),
2053 build_string ("Lisp expression: "));
2055 return read_internal_start (stream
, Qnil
, Qnil
);
2058 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2059 doc
: /* Read one Lisp expression which is represented as text by STRING.
2060 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2061 FINAL-STRING-INDEX is an integer giving the position of the next
2062 remaining character in STRING.
2063 START and END optionally delimit a substring of STRING from which to read;
2064 they default to 0 and (length STRING) respectively. */)
2065 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2068 CHECK_STRING (string
);
2069 /* `read_internal_start' sets `read_from_string_index'. */
2070 ret
= read_internal_start (string
, start
, end
);
2071 return Fcons (ret
, make_number (read_from_string_index
));
2074 /* Function to set up the global context we need in toplevel read
2077 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2078 /* `start', `end' only used when stream is a string. */
2083 new_backquote_flag
= 0;
2084 read_objects
= Qnil
;
2085 if (EQ (Vread_with_symbol_positions
, Qt
)
2086 || EQ (Vread_with_symbol_positions
, stream
))
2087 Vread_symbol_positions_list
= Qnil
;
2089 if (STRINGP (stream
)
2090 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2092 ptrdiff_t startval
, endval
;
2095 if (STRINGP (stream
))
2098 string
= XCAR (stream
);
2101 endval
= SCHARS (string
);
2105 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2106 args_out_of_range (string
, end
);
2107 endval
= XINT (end
);
2114 CHECK_NUMBER (start
);
2115 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2116 args_out_of_range (string
, start
);
2117 startval
= XINT (start
);
2119 read_from_string_index
= startval
;
2120 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2121 read_from_string_limit
= endval
;
2124 retval
= read0 (stream
);
2125 if (EQ (Vread_with_symbol_positions
, Qt
)
2126 || EQ (Vread_with_symbol_positions
, stream
))
2127 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2132 /* Signal Qinvalid_read_syntax error.
2133 S is error string of length N (if > 0) */
2135 static _Noreturn
void
2136 invalid_syntax (const char *s
)
2138 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2142 /* Use this for recursive reads, in contexts where internal tokens
2146 read0 (Lisp_Object readcharfun
)
2148 register Lisp_Object val
;
2151 val
= read1 (readcharfun
, &c
, 0);
2155 xsignal1 (Qinvalid_read_syntax
,
2156 Fmake_string (make_number (1), make_number (c
)));
2159 static ptrdiff_t read_buffer_size
;
2160 static char *read_buffer
;
2162 /* Read a \-escape sequence, assuming we already read the `\'.
2163 If the escape sequence forces unibyte, return eight-bit char. */
2166 read_escape (Lisp_Object readcharfun
, bool stringp
)
2169 /* \u allows up to four hex digits, \U up to eight. Default to the
2170 behavior for \u, and change this value in the case that \U is seen. */
2171 int unicode_hex_count
= 4;
2176 end_of_file_error ();
2206 error ("Invalid escape character syntax");
2209 c
= read_escape (readcharfun
, 0);
2210 return c
| meta_modifier
;
2215 error ("Invalid escape character syntax");
2218 c
= read_escape (readcharfun
, 0);
2219 return c
| shift_modifier
;
2224 error ("Invalid escape character syntax");
2227 c
= read_escape (readcharfun
, 0);
2228 return c
| hyper_modifier
;
2233 error ("Invalid escape character syntax");
2236 c
= read_escape (readcharfun
, 0);
2237 return c
| alt_modifier
;
2241 if (stringp
|| c
!= '-')
2248 c
= read_escape (readcharfun
, 0);
2249 return c
| super_modifier
;
2254 error ("Invalid escape character syntax");
2258 c
= read_escape (readcharfun
, 0);
2259 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2260 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2261 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2262 return c
| ctrl_modifier
;
2263 /* ASCII control chars are made from letters (both cases),
2264 as well as the non-letters within 0100...0137. */
2265 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2266 return (c
& (037 | ~0177));
2267 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2268 return (c
& (037 | ~0177));
2270 return c
| ctrl_modifier
;
2280 /* An octal escape, as in ANSI C. */
2282 register int i
= c
- '0';
2283 register int count
= 0;
2286 if ((c
= READCHAR
) >= '0' && c
<= '7')
2298 if (i
>= 0x80 && i
< 0x100)
2299 i
= BYTE8_TO_CHAR (i
);
2304 /* A hex escape, as in ANSI C. */
2311 if (c
>= '0' && c
<= '9')
2316 else if ((c
>= 'a' && c
<= 'f')
2317 || (c
>= 'A' && c
<= 'F'))
2320 if (c
>= 'a' && c
<= 'f')
2330 /* Allow hex escapes as large as ?\xfffffff, because some
2331 packages use them to denote characters with modifiers. */
2332 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2333 error ("Hex character out of range: \\x%x...", i
);
2337 if (count
< 3 && i
>= 0x80)
2338 return BYTE8_TO_CHAR (i
);
2343 /* Post-Unicode-2.0: Up to eight hex chars. */
2344 unicode_hex_count
= 8;
2347 /* A Unicode escape. We only permit them in strings and characters,
2348 not arbitrarily in the source code, as in some other languages. */
2353 while (++count
<= unicode_hex_count
)
2356 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2358 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2359 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2360 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2362 error ("Non-hex digit used for Unicode escape");
2365 error ("Non-Unicode character: 0x%x", i
);
2374 /* Return the digit that CHARACTER stands for in the given BASE.
2375 Return -1 if CHARACTER is out of range for BASE,
2376 and -2 if CHARACTER is not valid for any supported BASE. */
2378 digit_to_number (int character
, int base
)
2382 if ('0' <= character
&& character
<= '9')
2383 digit
= character
- '0';
2384 else if ('a' <= character
&& character
<= 'z')
2385 digit
= character
- 'a' + 10;
2386 else if ('A' <= character
&& character
<= 'Z')
2387 digit
= character
- 'A' + 10;
2391 return digit
< base
? digit
: -1;
2394 /* Read an integer in radix RADIX using READCHARFUN to read
2395 characters. RADIX must be in the interval [2..36]; if it isn't, a
2396 read error is signaled . Value is the integer read. Signals an
2397 error if encountering invalid read syntax or if RADIX is out of
2401 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2403 /* Room for sign, leading 0, other digits, trailing null byte.
2404 Also, room for invalid syntax diagnostic. */
2405 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2406 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2408 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2410 if (radix
< 2 || radix
> 36)
2418 if (c
== '-' || c
== '+')
2429 /* Ignore redundant leading zeros, so the buffer doesn't
2430 fill up with them. */
2436 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2443 if (p
< buf
+ sizeof buf
- 1)
2457 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2458 invalid_syntax (buf
);
2461 return string_to_number (buf
, radix
, 0);
2465 /* If the next token is ')' or ']' or '.', we store that character
2466 in *PCH and the return value is not interesting. Else, we store
2467 zero in *PCH and we read and return one lisp object.
2469 FIRST_IN_LIST is true if this is the first element of a list. */
2472 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2475 bool uninterned_symbol
= 0;
2482 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2484 end_of_file_error ();
2489 return read_list (0, readcharfun
);
2492 return read_vector (readcharfun
, 0);
2508 /* Accept extended format for hashtables (extensible to
2510 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2511 Lisp_Object tmp
= read_list (0, readcharfun
);
2512 Lisp_Object head
= CAR_SAFE (tmp
);
2513 Lisp_Object data
= Qnil
;
2514 Lisp_Object val
= Qnil
;
2515 /* The size is 2 * number of allowed keywords to
2517 Lisp_Object params
[10];
2519 Lisp_Object key
= Qnil
;
2520 int param_count
= 0;
2522 if (!EQ (head
, Qhash_table
))
2523 error ("Invalid extended read marker at head of #s list "
2524 "(only hash-table allowed)");
2526 tmp
= CDR_SAFE (tmp
);
2528 /* This is repetitive but fast and simple. */
2529 params
[param_count
] = QCsize
;
2530 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2531 if (!NILP (params
[param_count
+ 1]))
2534 params
[param_count
] = QCtest
;
2535 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2536 if (!NILP (params
[param_count
+ 1]))
2539 params
[param_count
] = QCweakness
;
2540 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2541 if (!NILP (params
[param_count
+ 1]))
2544 params
[param_count
] = QCrehash_size
;
2545 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2546 if (!NILP (params
[param_count
+ 1]))
2549 params
[param_count
] = QCrehash_threshold
;
2550 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2551 if (!NILP (params
[param_count
+ 1]))
2554 /* This is the hashtable data. */
2555 data
= Fplist_get (tmp
, Qdata
);
2557 /* Now use params to make a new hashtable and fill it. */
2558 ht
= Fmake_hash_table (param_count
, params
);
2560 while (CONSP (data
))
2565 error ("Odd number of elements in hashtable data");
2568 Fputhash (key
, val
, ht
);
2574 invalid_syntax ("#");
2582 tmp
= read_vector (readcharfun
, 0);
2583 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2584 error ("Invalid size char-table");
2585 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2597 tmp
= read_vector (readcharfun
, 0);
2600 error ("Invalid size char-table");
2601 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2602 error ("Invalid depth in char-table");
2603 depth
= XINT (AREF (tmp
, 0));
2604 if (chartab_size
[depth
] != size
- 2)
2605 error ("Invalid size char-table");
2606 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2609 invalid_syntax ("#^^");
2611 invalid_syntax ("#^");
2616 length
= read1 (readcharfun
, pch
, first_in_list
);
2620 Lisp_Object tmp
, val
;
2621 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2622 unsigned char *data
;
2625 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2626 if (STRING_MULTIBYTE (tmp
)
2627 || (size_in_chars
!= SCHARS (tmp
)
2628 /* We used to print 1 char too many
2629 when the number of bits was a multiple of 8.
2630 Accept such input in case it came from an old
2632 && ! (XFASTINT (length
)
2633 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2634 invalid_syntax ("#&...");
2636 val
= make_uninit_bool_vector (XFASTINT (length
));
2637 data
= bool_vector_uchar_data (val
);
2638 memcpy (data
, SDATA (tmp
), size_in_chars
);
2639 /* Clear the extraneous bits in the last byte. */
2640 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2641 data
[size_in_chars
- 1]
2642 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2645 invalid_syntax ("#&...");
2649 /* Accept compiled functions at read-time so that we don't have to
2650 build them using function calls. */
2652 tmp
= read_vector (readcharfun
, 1);
2653 struct Lisp_Vector
* vec
= XVECTOR (tmp
);
2654 if (vec
->header
.size
==0)
2655 invalid_syntax ("Empty byte-code object");
2656 make_byte_code (vec
);
2662 struct gcpro gcpro1
;
2665 /* Read the string itself. */
2666 tmp
= read1 (readcharfun
, &ch
, 0);
2667 if (ch
!= 0 || !STRINGP (tmp
))
2668 invalid_syntax ("#");
2670 /* Read the intervals and their properties. */
2673 Lisp_Object beg
, end
, plist
;
2675 beg
= read1 (readcharfun
, &ch
, 0);
2680 end
= read1 (readcharfun
, &ch
, 0);
2682 plist
= read1 (readcharfun
, &ch
, 0);
2684 invalid_syntax ("Invalid string property list");
2685 Fset_text_properties (beg
, end
, plist
, tmp
);
2691 /* #@NUMBER is used to skip NUMBER following bytes.
2692 That's used in .elc files to skip over doc strings
2693 and function definitions. */
2696 enum { extra
= 100 };
2697 ptrdiff_t i
, nskip
= 0, digits
= 0;
2699 /* Read a decimal integer. */
2700 while ((c
= READCHAR
) >= 0
2701 && c
>= '0' && c
<= '9')
2703 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2708 if (digits
== 2 && nskip
== 0)
2709 { /* We've just seen #@00, which means "skip to end". */
2710 skip_dyn_eof (readcharfun
);
2715 /* We can't use UNREAD here, because in the code below we side-step
2716 READCHAR. Instead, assume the first char after #@NNN occupies
2717 a single byte, which is the case normally since it's just
2723 if (load_force_doc_strings
2724 && (FROM_FILE_P (readcharfun
)))
2726 /* If we are supposed to force doc strings into core right now,
2727 record the last string that we skipped,
2728 and record where in the file it comes from. */
2730 /* But first exchange saved_doc_string
2731 with prev_saved_doc_string, so we save two strings. */
2733 char *temp
= saved_doc_string
;
2734 ptrdiff_t temp_size
= saved_doc_string_size
;
2735 file_offset temp_pos
= saved_doc_string_position
;
2736 ptrdiff_t temp_len
= saved_doc_string_length
;
2738 saved_doc_string
= prev_saved_doc_string
;
2739 saved_doc_string_size
= prev_saved_doc_string_size
;
2740 saved_doc_string_position
= prev_saved_doc_string_position
;
2741 saved_doc_string_length
= prev_saved_doc_string_length
;
2743 prev_saved_doc_string
= temp
;
2744 prev_saved_doc_string_size
= temp_size
;
2745 prev_saved_doc_string_position
= temp_pos
;
2746 prev_saved_doc_string_length
= temp_len
;
2749 if (saved_doc_string_size
== 0)
2751 saved_doc_string
= xmalloc (nskip
+ extra
);
2752 saved_doc_string_size
= nskip
+ extra
;
2754 if (nskip
> saved_doc_string_size
)
2756 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2757 saved_doc_string_size
= nskip
+ extra
;
2760 saved_doc_string_position
= file_tell (instream
);
2762 /* Copy that many characters into saved_doc_string. */
2764 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2765 saved_doc_string
[i
] = c
= getc (instream
);
2768 saved_doc_string_length
= i
;
2771 /* Skip that many bytes. */
2772 skip_dyn_bytes (readcharfun
, nskip
);
2778 /* #! appears at the beginning of an executable file.
2779 Skip the first line. */
2780 while (c
!= '\n' && c
>= 0)
2785 return Vload_file_name
;
2787 return list2 (Qfunction
, read0 (readcharfun
));
2788 /* #:foo is the uninterned symbol named foo. */
2791 uninterned_symbol
= 1;
2794 && c
!= 0xa0 /* NBSP */
2796 || strchr ("\"';()[]#`,", c
) == NULL
)))
2798 /* No symbol character follows, this is the empty
2801 return Fmake_symbol (empty_unibyte_string
);
2805 /* ## is the empty symbol. */
2807 return Fintern (empty_unibyte_string
, Qnil
);
2808 /* Reader forms that can reuse previously read objects. */
2809 if (c
>= '0' && c
<= '9')
2814 /* Read a non-negative integer. */
2815 while (c
>= '0' && c
<= '9')
2817 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2818 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2819 n
= MOST_POSITIVE_FIXNUM
+ 1;
2821 n
= n
* 10 + c
- '0';
2825 if (n
<= MOST_POSITIVE_FIXNUM
)
2827 if (c
== 'r' || c
== 'R')
2828 return read_integer (readcharfun
, n
);
2830 if (! NILP (Vread_circle
))
2832 /* #n=object returns object, but associates it with
2836 /* Make a placeholder for #n# to use temporarily. */
2837 Lisp_Object placeholder
;
2840 placeholder
= Fcons (Qnil
, Qnil
);
2841 cell
= Fcons (make_number (n
), placeholder
);
2842 read_objects
= Fcons (cell
, read_objects
);
2844 /* Read the object itself. */
2845 tem
= read0 (readcharfun
);
2847 /* Now put it everywhere the placeholder was... */
2848 substitute_object_in_subtree (tem
, placeholder
);
2850 /* ...and #n# will use the real value from now on. */
2851 Fsetcdr (cell
, tem
);
2856 /* #n# returns a previously read object. */
2859 tem
= Fassq (make_number (n
), read_objects
);
2865 /* Fall through to error message. */
2867 else if (c
== 'x' || c
== 'X')
2868 return read_integer (readcharfun
, 16);
2869 else if (c
== 'o' || c
== 'O')
2870 return read_integer (readcharfun
, 8);
2871 else if (c
== 'b' || c
== 'B')
2872 return read_integer (readcharfun
, 2);
2875 invalid_syntax ("#");
2878 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2882 return list2 (Qquote
, read0 (readcharfun
));
2886 int next_char
= READCHAR
;
2888 /* Transition from old-style to new-style:
2889 If we see "(`" it used to mean old-style, which usually works
2890 fine because ` should almost never appear in such a position
2891 for new-style. But occasionally we need "(`" to mean new
2892 style, so we try to distinguish the two by the fact that we
2893 can either write "( `foo" or "(` foo", where the first
2894 intends to use new-style whereas the second intends to use
2895 old-style. For Emacs-25, we should completely remove this
2896 first_in_list exception (old-style can still be obtained via
2898 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2900 Vold_style_backquotes
= Qt
;
2906 bool saved_new_backquote_flag
= new_backquote_flag
;
2908 new_backquote_flag
= 1;
2909 value
= read0 (readcharfun
);
2910 new_backquote_flag
= saved_new_backquote_flag
;
2912 return list2 (Qbackquote
, value
);
2917 int next_char
= READCHAR
;
2919 /* Transition from old-style to new-style:
2920 It used to be impossible to have a new-style , other than within
2921 a new-style `. This is sufficient when ` and , are used in the
2922 normal way, but ` and , can also appear in args to macros that
2923 will not interpret them in the usual way, in which case , may be
2924 used without any ` anywhere near.
2925 So we now use the same heuristic as for backquote: old-style
2926 unquotes are only recognized when first on a list, and when
2927 followed by a space.
2928 Because it's more difficult to peek 2 chars ahead, a new-style
2929 ,@ can still not be used outside of a `, unless it's in the middle
2931 if (new_backquote_flag
2933 || (next_char
!= ' ' && next_char
!= '@'))
2935 Lisp_Object comma_type
= Qnil
;
2940 comma_type
= Qcomma_at
;
2942 comma_type
= Qcomma_dot
;
2945 if (ch
>= 0) UNREAD (ch
);
2946 comma_type
= Qcomma
;
2949 value
= read0 (readcharfun
);
2950 return list2 (comma_type
, value
);
2954 Vold_style_backquotes
= Qt
;
2966 end_of_file_error ();
2968 /* Accept `single space' syntax like (list ? x) where the
2969 whitespace character is SPC or TAB.
2970 Other literal whitespace like NL, CR, and FF are not accepted,
2971 as there are well-established escape sequences for these. */
2972 if (c
== ' ' || c
== '\t')
2973 return make_number (c
);
2976 c
= read_escape (readcharfun
, 0);
2977 modifiers
= c
& CHAR_MODIFIER_MASK
;
2978 c
&= ~CHAR_MODIFIER_MASK
;
2979 if (CHAR_BYTE8_P (c
))
2980 c
= CHAR_TO_BYTE8 (c
);
2983 next_char
= READCHAR
;
2984 ok
= (next_char
<= 040
2985 || (next_char
< 0200
2986 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2989 return make_number (c
);
2991 invalid_syntax ("?");
2996 char *p
= read_buffer
;
2997 char *end
= read_buffer
+ read_buffer_size
;
2999 /* True if we saw an escape sequence specifying
3000 a multibyte character. */
3001 bool force_multibyte
= 0;
3002 /* True if we saw an escape sequence specifying
3003 a single-byte character. */
3004 bool force_singlebyte
= 0;
3006 ptrdiff_t nchars
= 0;
3008 while ((ch
= READCHAR
) >= 0
3011 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3013 ptrdiff_t offset
= p
- read_buffer
;
3014 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3015 memory_full (SIZE_MAX
);
3016 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3017 read_buffer_size
*= 2;
3018 p
= read_buffer
+ offset
;
3019 end
= read_buffer
+ read_buffer_size
;
3026 ch
= read_escape (readcharfun
, 1);
3028 /* CH is -1 if \ newline has just been seen. */
3031 if (p
== read_buffer
)
3036 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3037 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3039 if (CHAR_BYTE8_P (ch
))
3040 force_singlebyte
= 1;
3041 else if (! ASCII_CHAR_P (ch
))
3042 force_multibyte
= 1;
3043 else /* I.e. ASCII_CHAR_P (ch). */
3045 /* Allow `\C- ' and `\C-?'. */
3046 if (modifiers
== CHAR_CTL
)
3049 ch
= 0, modifiers
= 0;
3051 ch
= 127, modifiers
= 0;
3053 if (modifiers
& CHAR_SHIFT
)
3055 /* Shift modifier is valid only with [A-Za-z]. */
3056 if (ch
>= 'A' && ch
<= 'Z')
3057 modifiers
&= ~CHAR_SHIFT
;
3058 else if (ch
>= 'a' && ch
<= 'z')
3059 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3062 if (modifiers
& CHAR_META
)
3064 /* Move the meta bit to the right place for a
3066 modifiers
&= ~CHAR_META
;
3067 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3068 force_singlebyte
= 1;
3072 /* Any modifiers remaining are invalid. */
3074 error ("Invalid modifier in string");
3075 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3079 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3080 if (CHAR_BYTE8_P (ch
))
3081 force_singlebyte
= 1;
3082 else if (! ASCII_CHAR_P (ch
))
3083 force_multibyte
= 1;
3089 end_of_file_error ();
3091 /* If purifying, and string starts with \ newline,
3092 return zero instead. This is for doc strings
3093 that we are really going to find in etc/DOC.nn.nn. */
3094 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3095 return make_number (0);
3097 if (! force_multibyte
&& force_singlebyte
)
3099 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3100 forms. Convert it to unibyte. */
3101 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3103 p
= read_buffer
+ nchars
;
3106 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3108 || (p
- read_buffer
!= nchars
)));
3113 int next_char
= READCHAR
;
3116 if (next_char
<= 040
3117 || (next_char
< 0200
3118 && strchr ("\"';([#?`,", next_char
) != NULL
))
3124 /* Otherwise, we fall through! Note that the atom-reading loop
3125 below will now loop at least once, assuring that we will not
3126 try to UNREAD two characters in a row. */
3130 if (c
<= 040) goto retry
;
3131 if (c
== 0xa0) /* NBSP */
3136 char *p
= read_buffer
;
3138 EMACS_INT start_position
= readchar_count
- 1;
3141 char *end
= read_buffer
+ read_buffer_size
;
3145 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3147 ptrdiff_t offset
= p
- read_buffer
;
3148 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3149 memory_full (SIZE_MAX
);
3150 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3151 read_buffer_size
*= 2;
3152 p
= read_buffer
+ offset
;
3153 end
= read_buffer
+ read_buffer_size
;
3160 end_of_file_error ();
3165 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3171 && c
!= 0xa0 /* NBSP */
3173 || strchr ("\"';()[]#`,", c
) == NULL
));
3177 ptrdiff_t offset
= p
- read_buffer
;
3178 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3179 memory_full (SIZE_MAX
);
3180 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3181 read_buffer_size
*= 2;
3182 p
= read_buffer
+ offset
;
3183 end
= read_buffer
+ read_buffer_size
;
3189 if (!quoted
&& !uninterned_symbol
)
3191 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3192 if (! NILP (result
))
3196 Lisp_Object name
, result
;
3197 ptrdiff_t nbytes
= p
- read_buffer
;
3200 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3204 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3205 ? make_pure_string
: make_specified_string
)
3206 (read_buffer
, nchars
, nbytes
, multibyte
));
3207 result
= (uninterned_symbol
? Fmake_symbol (name
)
3208 : Fintern (name
, Qnil
));
3210 if (EQ (Vread_with_symbol_positions
, Qt
)
3211 || EQ (Vread_with_symbol_positions
, readcharfun
))
3212 Vread_symbol_positions_list
3213 = Fcons (Fcons (result
, make_number (start_position
)),
3214 Vread_symbol_positions_list
);
3222 /* List of nodes we've seen during substitute_object_in_subtree. */
3223 static Lisp_Object seen_list
;
3226 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3228 Lisp_Object check_object
;
3230 /* We haven't seen any objects when we start. */
3233 /* Make all the substitutions. */
3235 = substitute_object_recurse (object
, placeholder
, object
);
3237 /* Clear seen_list because we're done with it. */
3240 /* The returned object here is expected to always eq the
3242 if (!EQ (check_object
, object
))
3243 error ("Unexpected mutation error in reader");
3246 /* Feval doesn't get called from here, so no gc protection is needed. */
3247 #define SUBSTITUTE(get_val, set_val) \
3249 Lisp_Object old_value = get_val; \
3250 Lisp_Object true_value \
3251 = substitute_object_recurse (object, placeholder, \
3254 if (!EQ (old_value, true_value)) \
3261 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3263 /* If we find the placeholder, return the target object. */
3264 if (EQ (placeholder
, subtree
))
3267 /* If we've been to this node before, don't explore it again. */
3268 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3271 /* If this node can be the entry point to a cycle, remember that
3272 we've seen it. It can only be such an entry point if it was made
3273 by #n=, which means that we can find it as a value in
3275 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3276 seen_list
= Fcons (subtree
, seen_list
);
3278 /* Recurse according to subtree's type.
3279 Every branch must return a Lisp_Object. */
3280 switch (XTYPE (subtree
))
3282 case Lisp_Vectorlike
:
3284 ptrdiff_t i
, length
= 0;
3285 if (BOOL_VECTOR_P (subtree
))
3286 return subtree
; /* No sub-objects anyway. */
3287 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3288 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3289 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3290 else if (VECTORP (subtree
))
3291 length
= ASIZE (subtree
);
3293 /* An unknown pseudovector may contain non-Lisp fields, so we
3294 can't just blindly traverse all its fields. We used to call
3295 `Flength' which signaled `sequencep', so I just preserved this
3297 wrong_type_argument (Qsequencep
, subtree
);
3299 for (i
= 0; i
< length
; i
++)
3300 SUBSTITUTE (AREF (subtree
, i
),
3301 ASET (subtree
, i
, true_value
));
3307 SUBSTITUTE (XCAR (subtree
),
3308 XSETCAR (subtree
, true_value
));
3309 SUBSTITUTE (XCDR (subtree
),
3310 XSETCDR (subtree
, true_value
));
3316 /* Check for text properties in each interval.
3317 substitute_in_interval contains part of the logic. */
3319 INTERVAL root_interval
= string_intervals (subtree
);
3320 Lisp_Object arg
= Fcons (object
, placeholder
);
3322 traverse_intervals_noorder (root_interval
,
3323 &substitute_in_interval
, arg
);
3328 /* Other types don't recurse any further. */
3334 /* Helper function for substitute_object_recurse. */
3336 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3338 Lisp_Object object
= Fcar (arg
);
3339 Lisp_Object placeholder
= Fcdr (arg
);
3341 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3351 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3352 integer syntax and fits in a fixnum, else return the nearest float if CP has
3353 either floating point or integer syntax and BASE is 10, else return nil. If
3354 IGNORE_TRAILING, consider just the longest prefix of CP that has
3355 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3356 number has integer syntax but does not fit. */
3359 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3362 char const *cp
= string
;
3364 bool float_syntax
= 0;
3367 /* Compute NaN and infinities using a variable, to cope with compilers that
3368 think they are smarter than we are. */
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 value
= zero
/ zero
;
3431 /* If that made a "negative" NaN, negate it. */
3434 union { double d
; char c
[sizeof (double)]; }
3435 u_data
, u_minus_zero
;
3437 u_minus_zero
.d
= -0.0;
3438 for (i
= 0; i
< sizeof (double); i
++)
3439 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3445 /* Now VALUE is a positive NaN. */
3451 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3452 || state
== (LEAD_INT
|E_EXP
));
3455 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3456 any prefix that matches. Otherwise, the entire string must match. */
3457 if (! (ignore_trailing
3458 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3459 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3462 /* If the number uses integer and not float syntax, and is in C-language
3463 range, use its value, preferably as a fixnum. */
3464 if (leading_digit
>= 0 && ! float_syntax
)
3468 /* Fast special case for single-digit integers. This also avoids a
3469 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3470 case some versions of strtoumax accept numbers like "0x1" that Emacs
3472 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3473 return make_number (negative
? -leading_digit
: leading_digit
);
3476 n
= strtoumax (string
+ signedp
, NULL
, base
);
3477 if (errno
== ERANGE
)
3479 /* Unfortunately there's no simple and accurate way to convert
3480 non-base-10 numbers that are out of C-language range. */
3482 xsignal1 (Qoverflow_error
, build_string (string
));
3484 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3486 EMACS_INT signed_n
= n
;
3487 return make_number (negative
? -signed_n
: signed_n
);
3493 /* Either the number uses float syntax, or it does not fit into a fixnum.
3494 Convert it from string to floating point, unless the value is already
3495 known because it is an infinity, a NAN, or its absolute value fits in
3498 value
= atof (string
+ signedp
);
3500 return make_float (negative
? -value
: value
);
3505 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3509 Lisp_Object tem
, item
, vector
;
3510 struct Lisp_Cons
*otem
;
3513 tem
= read_list (1, readcharfun
);
3514 len
= Flength (tem
);
3515 vector
= Fmake_vector (len
, Qnil
);
3517 size
= ASIZE (vector
);
3518 ptr
= XVECTOR (vector
)->contents
;
3519 for (i
= 0; i
< size
; i
++)
3522 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3523 bytecode object, the docstring containing the bytecode and
3524 constants values must be treated as unibyte and passed to
3525 Fread, to get the actual bytecode string and constants vector. */
3526 if (bytecodeflag
&& load_force_doc_strings
)
3528 if (i
== COMPILED_BYTECODE
)
3530 if (!STRINGP (item
))
3531 error ("Invalid byte code");
3533 /* Delay handling the bytecode slot until we know whether
3534 it is lazily-loaded (we can tell by whether the
3535 constants slot is nil). */
3536 ASET (vector
, COMPILED_CONSTANTS
, item
);
3539 else if (i
== COMPILED_CONSTANTS
)
3541 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3545 /* Coerce string to unibyte (like string-as-unibyte,
3546 but without generating extra garbage and
3547 guaranteeing no change in the contents). */
3548 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3549 STRING_SET_UNIBYTE (bytestr
);
3551 item
= Fread (Fcons (bytestr
, readcharfun
));
3553 error ("Invalid byte code");
3555 otem
= XCONS (item
);
3556 bytestr
= XCAR (item
);
3561 /* Now handle the bytecode slot. */
3562 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3564 else if (i
== COMPILED_DOC_STRING
3566 && ! STRING_MULTIBYTE (item
))
3568 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3569 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3571 item
= Fstring_as_multibyte (item
);
3574 ASET (vector
, i
, item
);
3582 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3585 read_list (bool flag
, Lisp_Object readcharfun
)
3587 Lisp_Object val
, tail
;
3588 Lisp_Object elt
, tem
;
3589 struct gcpro gcpro1
, gcpro2
;
3590 /* 0 is the normal case.
3591 1 means this list is a doc reference; replace it with the number 0.
3592 2 means this list is a doc reference; replace it with the doc string. */
3593 int doc_reference
= 0;
3595 /* Initialize this to 1 if we are reading a list. */
3596 bool first_in_list
= flag
<= 0;
3605 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3610 /* While building, if the list starts with #$, treat it specially. */
3611 if (EQ (elt
, Vload_file_name
)
3613 && !NILP (Vpurify_flag
))
3615 if (NILP (Vdoc_file_name
))
3616 /* We have not yet called Snarf-documentation, so assume
3617 this file is described in the DOC file
3618 and Snarf-documentation will fill in the right value later.
3619 For now, replace the whole list with 0. */
3622 /* We have already called Snarf-documentation, so make a relative
3623 file name for this file, so it can be found properly
3624 in the installed Lisp directory.
3625 We don't use Fexpand_file_name because that would make
3626 the directory absolute now. */
3627 elt
= concat2 (build_string ("../lisp/"),
3628 Ffile_name_nondirectory (elt
));
3630 else if (EQ (elt
, Vload_file_name
)
3632 && load_force_doc_strings
)
3641 invalid_syntax (") or . in a vector");
3649 XSETCDR (tail
, read0 (readcharfun
));
3651 val
= read0 (readcharfun
);
3652 read1 (readcharfun
, &ch
, 0);
3656 if (doc_reference
== 1)
3657 return make_number (0);
3658 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3661 file_offset saved_position
;
3662 /* Get a doc string from the file we are loading.
3663 If it's in saved_doc_string, get it from there.
3665 Here, we don't know if the string is a
3666 bytecode string or a doc string. As a
3667 bytecode string must be unibyte, we always
3668 return a unibyte string. If it is actually a
3669 doc string, caller must make it
3672 /* Position is negative for user variables. */
3673 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3674 if (pos
>= saved_doc_string_position
3675 && pos
< (saved_doc_string_position
3676 + saved_doc_string_length
))
3678 saved
= saved_doc_string
;
3679 saved_position
= saved_doc_string_position
;
3681 /* Look in prev_saved_doc_string the same way. */
3682 else if (pos
>= prev_saved_doc_string_position
3683 && pos
< (prev_saved_doc_string_position
3684 + prev_saved_doc_string_length
))
3686 saved
= prev_saved_doc_string
;
3687 saved_position
= prev_saved_doc_string_position
;
3691 ptrdiff_t start
= pos
- saved_position
;
3694 /* Process quoting with ^A,
3695 and find the end of the string,
3696 which is marked with ^_ (037). */
3697 for (from
= start
, to
= start
;
3698 saved
[from
] != 037;)
3700 int c
= saved
[from
++];
3704 saved
[to
++] = (c
== 1 ? c
3713 return make_unibyte_string (saved
+ start
,
3717 return get_doc_string (val
, 1, 0);
3722 invalid_syntax (". in wrong context");
3724 invalid_syntax ("] in a list");
3728 XSETCDR (tail
, tem
);
3735 static Lisp_Object initial_obarray
;
3737 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3739 static size_t oblookup_last_bucket_number
;
3741 /* Get an error if OBARRAY is not an obarray.
3742 If it is one, return it. */
3745 check_obarray (Lisp_Object obarray
)
3747 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3749 /* If Vobarray is now invalid, force it to be valid. */
3750 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3751 wrong_type_argument (Qvectorp
, obarray
);
3756 /* Intern the C string STR: return a symbol with that name,
3757 interned in the current obarray. */
3760 intern_1 (const char *str
, ptrdiff_t len
)
3762 Lisp_Object obarray
= check_obarray (Vobarray
);
3763 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3765 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3769 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3771 Lisp_Object obarray
= check_obarray (Vobarray
);
3772 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3777 if (NILP (Vpurify_flag
))
3778 /* Creating a non-pure string from a string literal not
3779 implemented yet. We could just use make_string here and live
3780 with the extra copy. */
3783 return Fintern (make_pure_c_string (str
, len
), obarray
);
3786 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3787 doc
: /* Return the canonical symbol whose name is STRING.
3788 If there is none, one is created by this function and returned.
3789 A second optional argument specifies the obarray to use;
3790 it defaults to the value of `obarray'. */)
3791 (Lisp_Object string
, Lisp_Object obarray
)
3793 register Lisp_Object tem
, sym
, *ptr
;
3795 if (NILP (obarray
)) obarray
= Vobarray
;
3796 obarray
= check_obarray (obarray
);
3798 CHECK_STRING (string
);
3800 tem
= oblookup (obarray
, SSDATA (string
),
3803 if (!INTEGERP (tem
))
3806 if (!NILP (Vpurify_flag
))
3807 string
= Fpurecopy (string
);
3808 sym
= Fmake_symbol (string
);
3810 if (EQ (obarray
, initial_obarray
))
3811 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3813 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3815 if ((SREF (string
, 0) == ':')
3816 && EQ (obarray
, initial_obarray
))
3818 XSYMBOL (sym
)->constant
= 1;
3819 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3820 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3823 ptr
= aref_addr (obarray
, XINT(tem
));
3825 set_symbol_next (sym
, XSYMBOL (*ptr
));
3827 set_symbol_next (sym
, NULL
);
3832 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3833 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3834 NAME may be a string or a symbol. If it is a symbol, that exact
3835 symbol is searched for.
3836 A second optional argument specifies the obarray to use;
3837 it defaults to the value of `obarray'. */)
3838 (Lisp_Object name
, Lisp_Object obarray
)
3840 register Lisp_Object tem
, string
;
3842 if (NILP (obarray
)) obarray
= Vobarray
;
3843 obarray
= check_obarray (obarray
);
3845 if (!SYMBOLP (name
))
3847 CHECK_STRING (name
);
3851 string
= SYMBOL_NAME (name
);
3853 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3854 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3860 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3861 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3862 The value is t if a symbol was found and deleted, nil otherwise.
3863 NAME may be a string or a symbol. If it is a symbol, that symbol
3864 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3865 OBARRAY defaults to the value of the variable `obarray'. */)
3866 (Lisp_Object name
, Lisp_Object obarray
)
3868 register Lisp_Object string
, tem
;
3871 if (NILP (obarray
)) obarray
= Vobarray
;
3872 obarray
= check_obarray (obarray
);
3875 string
= SYMBOL_NAME (name
);
3878 CHECK_STRING (name
);
3882 tem
= oblookup (obarray
, SSDATA (string
),
3887 /* If arg was a symbol, don't delete anything but that symbol itself. */
3888 if (SYMBOLP (name
) && !EQ (name
, tem
))
3891 /* There are plenty of other symbols which will screw up the Emacs
3892 session if we unintern them, as well as even more ways to use
3893 `setq' or `fset' or whatnot to make the Emacs session
3894 unusable. Let's not go down this silly road. --Stef */
3895 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3896 error ("Attempt to unintern t or nil"); */
3898 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3900 hash
= oblookup_last_bucket_number
;
3902 if (EQ (AREF (obarray
, hash
), tem
))
3904 if (XSYMBOL (tem
)->next
)
3907 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3908 ASET (obarray
, hash
, sym
);
3911 ASET (obarray
, hash
, make_number (0));
3915 Lisp_Object tail
, following
;
3917 for (tail
= AREF (obarray
, hash
);
3918 XSYMBOL (tail
)->next
;
3921 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3922 if (EQ (following
, tem
))
3924 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3933 /* Return the symbol in OBARRAY whose names matches the string
3934 of SIZE characters (SIZE_BYTE bytes) at PTR.
3935 If there is no such symbol in OBARRAY, return nil.
3937 Also store the bucket number in oblookup_last_bucket_number. */
3940 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3944 register Lisp_Object tail
;
3945 Lisp_Object bucket
, tem
;
3947 obarray
= check_obarray (obarray
);
3948 obsize
= ASIZE (obarray
);
3950 /* This is sometimes needed in the middle of GC. */
3951 obsize
&= ~ARRAY_MARK_FLAG
;
3952 hash
= hash_string (ptr
, size_byte
) % obsize
;
3953 bucket
= AREF (obarray
, hash
);
3954 oblookup_last_bucket_number
= hash
;
3955 if (EQ (bucket
, make_number (0)))
3957 else if (!SYMBOLP (bucket
))
3958 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3960 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3962 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3963 && SCHARS (SYMBOL_NAME (tail
)) == size
3964 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3966 else if (XSYMBOL (tail
)->next
== 0)
3969 XSETINT (tem
, hash
);
3974 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3977 register Lisp_Object tail
;
3978 CHECK_VECTOR (obarray
);
3979 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3981 tail
= AREF (obarray
, i
);
3986 if (XSYMBOL (tail
)->next
== 0)
3988 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3994 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3996 call1 (function
, sym
);
3999 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4000 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4001 OBARRAY defaults to the value of `obarray'. */)
4002 (Lisp_Object function
, Lisp_Object obarray
)
4004 if (NILP (obarray
)) obarray
= Vobarray
;
4005 obarray
= check_obarray (obarray
);
4007 map_obarray (obarray
, mapatoms_1
, function
);
4011 #define OBARRAY_SIZE 1511
4016 Lisp_Object oblength
;
4017 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4019 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4021 Vobarray
= Fmake_vector (oblength
, make_number (0));
4022 initial_obarray
= Vobarray
;
4023 staticpro (&initial_obarray
);
4025 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
4026 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
4027 NILP (Vpurify_flag) check in intern_c_string. */
4028 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
4029 Qnil
= intern_c_string ("nil");
4031 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
4032 so those two need to be fixed manually. */
4033 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
4034 set_symbol_function (Qunbound
, Qnil
);
4035 set_symbol_plist (Qunbound
, Qnil
);
4036 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4037 XSYMBOL (Qnil
)->constant
= 1;
4038 XSYMBOL (Qnil
)->declared_special
= 1;
4039 set_symbol_plist (Qnil
, Qnil
);
4040 set_symbol_function (Qnil
, Qnil
);
4042 Qt
= intern_c_string ("t");
4043 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4044 XSYMBOL (Qnil
)->declared_special
= 1;
4045 XSYMBOL (Qt
)->constant
= 1;
4047 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4050 DEFSYM (Qvariable_documentation
, "variable-documentation");
4052 read_buffer
= xmalloc (size
);
4053 read_buffer_size
= size
;
4057 defsubr (struct Lisp_Subr
*sname
)
4059 Lisp_Object sym
, tem
;
4060 sym
= intern_c_string (sname
->symbol_name
);
4061 XSETPVECTYPE (sname
, PVEC_SUBR
);
4062 XSETSUBR (tem
, sname
);
4063 set_symbol_function (sym
, tem
);
4066 #ifdef NOTDEF /* Use fset in subr.el now! */
4068 defalias (struct Lisp_Subr
*sname
, char *string
)
4071 sym
= intern (string
);
4072 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4076 /* Define an "integer variable"; a symbol whose value is forwarded to a
4077 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4078 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4080 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4081 const char *namestring
, EMACS_INT
*address
)
4084 sym
= intern_c_string (namestring
);
4085 i_fwd
->type
= Lisp_Fwd_Int
;
4086 i_fwd
->intvar
= address
;
4087 XSYMBOL (sym
)->declared_special
= 1;
4088 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4089 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4092 /* Similar but define a variable whose value is t if address contains 1,
4093 nil if address contains 0. */
4095 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4096 const char *namestring
, bool *address
)
4099 sym
= intern_c_string (namestring
);
4100 b_fwd
->type
= Lisp_Fwd_Bool
;
4101 b_fwd
->boolvar
= address
;
4102 XSYMBOL (sym
)->declared_special
= 1;
4103 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4104 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4105 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4108 /* Similar but define a variable whose value is the Lisp Object stored
4109 at address. Two versions: with and without gc-marking of the C
4110 variable. The nopro version is used when that variable will be
4111 gc-marked for some other reason, since marking the same slot twice
4112 can cause trouble with strings. */
4114 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4115 const char *namestring
, Lisp_Object
*address
)
4118 sym
= intern_c_string (namestring
);
4119 o_fwd
->type
= Lisp_Fwd_Obj
;
4120 o_fwd
->objvar
= address
;
4121 XSYMBOL (sym
)->declared_special
= 1;
4122 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4123 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4127 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4128 const char *namestring
, Lisp_Object
*address
)
4130 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4131 staticpro (address
);
4134 /* Similar but define a variable whose value is the Lisp Object stored
4135 at a particular offset in the current kboard object. */
4138 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4139 const char *namestring
, int offset
)
4142 sym
= intern_c_string (namestring
);
4143 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4144 ko_fwd
->offset
= offset
;
4145 XSYMBOL (sym
)->declared_special
= 1;
4146 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4147 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4150 /* Check that the elements of lpath exist. */
4153 load_path_check (Lisp_Object lpath
)
4155 Lisp_Object path_tail
;
4157 /* The only elements that might not exist are those from
4158 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4160 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4162 Lisp_Object dirfile
;
4163 dirfile
= Fcar (path_tail
);
4164 if (STRINGP (dirfile
))
4166 dirfile
= Fdirectory_file_name (dirfile
);
4167 if (! file_accessible_directory_p (SSDATA (dirfile
)))
4168 dir_warning ("Lisp directory", XCAR (path_tail
));
4173 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4174 This does not include the standard site-lisp directories
4175 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4176 but it does (unless no_site_lisp is set) include site-lisp
4177 directories in the source/build directories if those exist and we
4178 are running uninstalled.
4180 Uses the following logic:
4181 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4182 The remainder is what happens when dumping works:
4183 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4184 Otherwise use PATH_LOADSEARCH.
4186 If !initialized, then just return PATH_DUMPLOADSEARCH.
4188 If Vinstallation_directory is not nil (ie, running uninstalled):
4189 If installation-dir/lisp exists and not already a member,
4190 we must be running uninstalled. Reset the load-path
4191 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4192 refers to the eventual installation directories. Since we
4193 are not yet installed, we should not use them, even if they exist.)
4194 If installation-dir/lisp does not exist, just add
4195 PATH_DUMPLOADSEARCH at the end instead.
4196 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4197 and not already a member) at the front.
4198 If installation-dir != source-dir (ie running an uninstalled,
4199 out-of-tree build) AND install-dir/src/Makefile exists BUT
4200 install-dir/src/Makefile.in does NOT exist (this is a sanity
4201 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4204 load_path_default (void)
4206 Lisp_Object lpath
= Qnil
;
4211 const char *loadpath
= ns_load_path ();
4214 normal
= PATH_LOADSEARCH
;
4216 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4218 lpath
= decode_env_path (0, normal
, 0);
4221 #else /* !CANNOT_DUMP */
4223 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4228 const char *loadpath
= ns_load_path ();
4229 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4231 lpath
= decode_env_path (0, normal
, 0);
4233 if (!NILP (Vinstallation_directory
))
4235 Lisp_Object tem
, tem1
;
4237 /* Add to the path the lisp subdir of the installation
4238 dir, if it is accessible. Note: in out-of-tree builds,
4239 this directory is empty save for Makefile. */
4240 tem
= Fexpand_file_name (build_string ("lisp"),
4241 Vinstallation_directory
);
4242 tem1
= Ffile_accessible_directory_p (tem
);
4245 if (NILP (Fmember (tem
, lpath
)))
4247 /* We are running uninstalled. The default load-path
4248 points to the eventual installed lisp directories.
4249 We should not use those now, even if they exist,
4250 so start over from a clean slate. */
4251 lpath
= list1 (tem
);
4255 /* That dir doesn't exist, so add the build-time
4256 Lisp dirs instead. */
4258 Lisp_Object dump_path
=
4259 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4260 lpath
= nconc2 (lpath
, dump_path
);
4263 /* Add site-lisp under the installation dir, if it exists. */
4266 tem
= Fexpand_file_name (build_string ("site-lisp"),
4267 Vinstallation_directory
);
4268 tem1
= Ffile_accessible_directory_p (tem
);
4271 if (NILP (Fmember (tem
, lpath
)))
4272 lpath
= Fcons (tem
, lpath
);
4276 /* If Emacs was not built in the source directory,
4277 and it is run from where it was built, add to load-path
4278 the lisp and site-lisp dirs under that directory. */
4280 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4284 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4285 Vinstallation_directory
);
4286 tem1
= Ffile_exists_p (tem
);
4288 /* Don't be fooled if they moved the entire source tree
4289 AFTER dumping Emacs. If the build directory is indeed
4290 different from the source dir, src/Makefile.in and
4291 src/Makefile will not be found together. */
4292 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4293 Vinstallation_directory
);
4294 tem2
= Ffile_exists_p (tem
);
4295 if (!NILP (tem1
) && NILP (tem2
))
4297 tem
= Fexpand_file_name (build_string ("lisp"),
4300 if (NILP (Fmember (tem
, lpath
)))
4301 lpath
= Fcons (tem
, lpath
);
4305 tem
= Fexpand_file_name (build_string ("site-lisp"),
4307 tem1
= Ffile_accessible_directory_p (tem
);
4310 if (NILP (Fmember (tem
, lpath
)))
4311 lpath
= Fcons (tem
, lpath
);
4315 } /* Vinstallation_directory != Vsource_directory */
4317 } /* if Vinstallation_directory */
4319 else /* !initialized */
4321 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4322 source directory. We used to add ../lisp (ie the lisp dir in
4323 the build directory) at the front here, but that should not
4324 be necessary, since in out of tree builds lisp/ is empty, save
4326 lpath
= decode_env_path (0, normal
, 0);
4328 #endif /* !CANNOT_DUMP */
4336 /* First, set Vload_path. */
4338 /* Ignore EMACSLOADPATH when dumping. */
4340 bool use_loadpath
= true;
4342 bool use_loadpath
= !NILP (Vpurify_flag
);
4345 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4347 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4349 /* Check (non-nil) user-supplied elements. */
4350 load_path_check (Vload_path
);
4352 /* If no nils in the environment variable, use as-is.
4353 Otherwise, replace any nils with the default. */
4354 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4356 Lisp_Object elem
, elpath
= Vload_path
;
4357 Lisp_Object default_lpath
= load_path_default ();
4359 /* Check defaults, before adding site-lisp. */
4360 load_path_check (default_lpath
);
4362 /* Add the site-lisp directories to the front of the default. */
4365 Lisp_Object sitelisp
;
4366 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4367 if (! NILP (sitelisp
))
4368 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4373 /* Replace nils from EMACSLOADPATH by default. */
4374 while (CONSP (elpath
))
4377 elem
= XCAR (elpath
);
4378 elpath
= XCDR (elpath
);
4379 arg
[0] = Vload_path
;
4380 arg
[1] = NILP (elem
) ? default_lpath
: Fcons (elem
, Qnil
);
4381 Vload_path
= Fappend (2, arg
);
4383 } /* Fmemq (Qnil, Vload_path) */
4385 else /* Vpurify_flag || !EMACSLOADPATH */
4387 Vload_path
= load_path_default ();
4389 /* Check before adding site-lisp directories.
4390 The install should have created them, but they are not
4391 required, so no need to warn if they are absent.
4392 Or we might be running before installation. */
4393 load_path_check (Vload_path
);
4395 /* Add the site-lisp directories at the front. */
4396 if (initialized
&& !no_site_lisp
)
4398 Lisp_Object sitelisp
;
4399 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4400 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4402 } /* !Vpurify_flag && EMACSLOADPATH */
4406 load_in_progress
= 0;
4407 Vload_file_name
= Qnil
;
4408 Vstandard_input
= Qt
;
4409 Vloads_in_progress
= Qnil
;
4412 /* Print a warning that directory intended for use USE and with name
4413 DIRNAME cannot be accessed. On entry, errno should correspond to
4414 the access failure. Print the warning on stderr and put it in
4418 dir_warning (char const *use
, Lisp_Object dirname
)
4420 static char const format
[] = "Warning: %s `%s': %s\n";
4421 int access_errno
= errno
;
4422 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4424 /* Don't log the warning before we've initialized!! */
4427 char const *diagnostic
= emacs_strerror (access_errno
);
4429 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4430 + strlen (use
) + SBYTES (dirname
)
4431 + strlen (diagnostic
));
4432 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4434 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4440 syms_of_lread (void)
4443 defsubr (&Sread_from_string
);
4445 defsubr (&Sintern_soft
);
4446 defsubr (&Sunintern
);
4447 defsubr (&Sget_load_suffixes
);
4449 defsubr (&Seval_buffer
);
4450 defsubr (&Seval_region
);
4451 defsubr (&Sread_char
);
4452 defsubr (&Sread_char_exclusive
);
4453 defsubr (&Sread_event
);
4454 defsubr (&Sget_file_char
);
4455 defsubr (&Smapatoms
);
4456 defsubr (&Slocate_file_internal
);
4458 DEFVAR_LISP ("obarray", Vobarray
,
4459 doc
: /* Symbol table for use by `intern' and `read'.
4460 It is a vector whose length ought to be prime for best results.
4461 The vector's contents don't make sense if examined from Lisp programs;
4462 to find all the symbols in an obarray, use `mapatoms'. */);
4464 DEFVAR_LISP ("values", Vvalues
,
4465 doc
: /* List of values of all expressions which were read, evaluated and printed.
4466 Order is reverse chronological. */);
4467 XSYMBOL (intern ("values"))->declared_special
= 0;
4469 DEFVAR_LISP ("standard-input", Vstandard_input
,
4470 doc
: /* Stream for read to get input from.
4471 See documentation of `read' for possible values. */);
4472 Vstandard_input
= Qt
;
4474 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4475 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4477 If this variable is a buffer, then only forms read from that buffer
4478 will be added to `read-symbol-positions-list'.
4479 If this variable is t, then all read forms will be added.
4480 The effect of all other values other than nil are not currently
4481 defined, although they may be in the future.
4483 The positions are relative to the last call to `read' or
4484 `read-from-string'. It is probably a bad idea to set this variable at
4485 the toplevel; bind it instead. */);
4486 Vread_with_symbol_positions
= Qnil
;
4488 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4489 doc
: /* A list mapping read symbols to their positions.
4490 This variable is modified during calls to `read' or
4491 `read-from-string', but only when `read-with-symbol-positions' is
4494 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4495 CHAR-POSITION is an integer giving the offset of that occurrence of the
4496 symbol from the position where `read' or `read-from-string' started.
4498 Note that a symbol will appear multiple times in this list, if it was
4499 read multiple times. The list is in the same order as the symbols
4501 Vread_symbol_positions_list
= Qnil
;
4503 DEFVAR_LISP ("read-circle", Vread_circle
,
4504 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4507 DEFVAR_LISP ("load-path", Vload_path
,
4508 doc
: /* List of directories to search for files to load.
4509 Each element is a string (directory name) or nil (meaning `default-directory').
4510 Initialized during startup as described in Info node `(elisp)Library Search'. */);
4512 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4513 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4514 This list should not include the empty string.
4515 `load' and related functions try to append these suffixes, in order,
4516 to the specified file name if a Lisp suffix is allowed or required. */);
4517 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4518 build_pure_c_string (".el"));
4519 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4520 doc
: /* List of suffixes that indicate representations of \
4522 This list should normally start with the empty string.
4524 Enabling Auto Compression mode appends the suffixes in
4525 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4526 mode removes them again. `load' and related functions use this list to
4527 determine whether they should look for compressed versions of a file
4528 and, if so, which suffixes they should try to append to the file name
4529 in order to do so. However, if you want to customize which suffixes
4530 the loading functions recognize as compression suffixes, you should
4531 customize `jka-compr-load-suffixes' rather than the present variable. */);
4532 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4534 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4535 doc
: /* Non-nil if inside of `load'. */);
4536 DEFSYM (Qload_in_progress
, "load-in-progress");
4538 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4539 doc
: /* An alist of functions to be evalled when particular files are loaded.
4540 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4542 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4543 a symbol \(a feature name).
4545 When `load' is run and the file-name argument matches an element's
4546 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4547 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4549 An error in FORMS does not undo the load, but does prevent execution of
4550 the rest of the FORMS. */);
4551 Vafter_load_alist
= Qnil
;
4553 DEFVAR_LISP ("load-history", Vload_history
,
4554 doc
: /* Alist mapping loaded file names to symbols and features.
4555 Each alist element should be a list (FILE-NAME ENTRIES...), where
4556 FILE-NAME is the name of a file that has been loaded into Emacs.
4557 The file name is absolute and true (i.e. it doesn't contain symlinks).
4558 As an exception, one of the alist elements may have FILE-NAME nil,
4559 for symbols and features not associated with any file.
4561 The remaining ENTRIES in the alist element describe the functions and
4562 variables defined in that file, the features provided, and the
4563 features required. Each entry has the form `(provide . FEATURE)',
4564 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4565 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4566 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4567 autoload before this file redefined it as a function. In addition,
4568 entries may also be single symbols, which means that SYMBOL was
4569 defined by `defvar' or `defconst'.
4571 During preloading, the file name recorded is relative to the main Lisp
4572 directory. These file names are converted to absolute at startup. */);
4573 Vload_history
= Qnil
;
4575 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4576 doc
: /* Full name of file being loaded by `load'. */);
4577 Vload_file_name
= Qnil
;
4579 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4580 doc
: /* File name, including directory, of user's initialization file.
4581 If the file loaded had extension `.elc', and the corresponding source file
4582 exists, this variable contains the name of source file, suitable for use
4583 by functions like `custom-save-all' which edit the init file.
4584 While Emacs loads and evaluates the init file, value is the real name
4585 of the file, regardless of whether or not it has the `.elc' extension. */);
4586 Vuser_init_file
= Qnil
;
4588 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4589 doc
: /* Used for internal purposes by `load'. */);
4590 Vcurrent_load_list
= Qnil
;
4592 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4593 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4594 The default is nil, which means use the function `read'. */);
4595 Vload_read_function
= Qnil
;
4597 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4598 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4599 The value should be a function for doing code conversion before
4600 reading a source file. It can also be nil, in which case loading is
4601 done without any code conversion.
4603 If the value is a function, it is called with four arguments,
4604 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4605 the file to load, FILE is the non-absolute name (for messages etc.),
4606 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4607 `load'. The function should return t if the file was loaded. */);
4608 Vload_source_file_function
= Qnil
;
4610 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4611 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4612 This is useful when the file being loaded is a temporary copy. */);
4613 load_force_doc_strings
= 0;
4615 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4616 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4617 This is normally bound by `load' and `eval-buffer' to control `read',
4618 and is not meant for users to change. */);
4619 load_convert_to_unibyte
= 0;
4621 DEFVAR_LISP ("source-directory", Vsource_directory
,
4622 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4623 You cannot count on them to still be there! */);
4625 = Fexpand_file_name (build_string ("../"),
4626 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4628 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4629 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4630 Vpreloaded_file_list
= Qnil
;
4632 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4633 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4634 Vbyte_boolean_vars
= Qnil
;
4636 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4637 doc
: /* Non-nil means load dangerous compiled Lisp files.
4638 Some versions of XEmacs use different byte codes than Emacs. These
4639 incompatible byte codes can make Emacs crash when it tries to execute
4641 load_dangerous_libraries
= 0;
4643 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4644 doc
: /* Non-nil means force printing messages when loading Lisp files.
4645 This overrides the value of the NOMESSAGE argument to `load'. */);
4646 force_load_messages
= 0;
4648 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4649 doc
: /* Regular expression matching safe to load compiled Lisp files.
4650 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4651 from the file, and matches them against this regular expression.
4652 When the regular expression matches, the file is considered to be safe
4653 to load. See also `load-dangerous-libraries'. */);
4654 Vbytecomp_version_regexp
4655 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4657 DEFSYM (Qlexical_binding
, "lexical-binding");
4658 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4659 doc
: /* Whether to use lexical binding when evaluating code.
4660 Non-nil means that the code in the current buffer should be evaluated
4661 with lexical binding.
4662 This variable is automatically set from the file variables of an
4663 interpreted Lisp file read using `load'. Unlike other file local
4664 variables, this must be set in the first line of a file. */);
4665 Vlexical_binding
= Qnil
;
4666 Fmake_variable_buffer_local (Qlexical_binding
);
4668 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4669 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4670 Veval_buffer_list
= Qnil
;
4672 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4673 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4674 Vold_style_backquotes
= Qnil
;
4675 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4677 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4678 doc
: /* Non-nil means `load' prefers the newest version of a file.
4679 This applies when a filename suffix is not explicitly specified and
4680 `load' is trying various possible suffixes (see `load-suffixes' and
4681 `load-file-rep-suffixes'). Normally, it stops at the first file
4682 that exists. If this option is non-nil, it checks all suffixes and
4683 uses whichever file is newest.
4684 Note that if you customize this, obviously it will not affect files
4685 that are loaded before your customizations are read! */);
4686 load_prefer_newer
= 0;
4688 /* Vsource_directory was initialized in init_lread. */
4690 DEFSYM (Qcurrent_load_list
, "current-load-list");
4691 DEFSYM (Qstandard_input
, "standard-input");
4692 DEFSYM (Qread_char
, "read-char");
4693 DEFSYM (Qget_file_char
, "get-file-char");
4694 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4695 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4697 DEFSYM (Qbackquote
, "`");
4698 DEFSYM (Qcomma
, ",");
4699 DEFSYM (Qcomma_at
, ",@");
4700 DEFSYM (Qcomma_dot
, ",.");
4702 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4703 DEFSYM (Qascii_character
, "ascii-character");
4704 DEFSYM (Qfunction
, "function");
4705 DEFSYM (Qload
, "load");
4706 DEFSYM (Qload_file_name
, "load-file-name");
4707 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4708 DEFSYM (Qfile_truename
, "file-truename");
4709 DEFSYM (Qdir_ok
, "dir-ok");
4710 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4712 staticpro (&read_objects
);
4713 read_objects
= Qnil
;
4714 staticpro (&seen_list
);
4717 Vloads_in_progress
= Qnil
;
4718 staticpro (&Vloads_in_progress
);
4720 DEFSYM (Qhash_table
, "hash-table");
4721 DEFSYM (Qdata
, "data");
4722 DEFSYM (Qtest
, "test");
4723 DEFSYM (Qsize
, "size");
4724 DEFSYM (Qweakness
, "weakness");
4725 DEFSYM (Qrehash_size
, "rehash-size");
4726 DEFSYM (Qrehash_threshold
, "rehash-threshold");