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
);
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
);
1255 result
= stat (SSDATA (efound
), &s1
);
1258 SSET (efound
, SBYTES (efound
) - 1, 0);
1259 result
= stat (SSDATA (efound
), &s2
);
1260 SSET (efound
, SBYTES (efound
) - 1, 'c');
1264 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1266 /* Make the progress messages mention that source is newer. */
1269 /* If we won't print another message, mention this anyway. */
1270 if (!NILP (nomessage
) && !force_load_messages
)
1272 Lisp_Object msg_file
;
1273 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1274 message_with_string ("Source file `%s' newer than byte-compiled file",
1283 /* We are loading a source file (*.el). */
1284 if (!NILP (Vload_source_file_function
))
1291 clear_unwind_protect (fd_index
);
1293 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1294 NILP (noerror
) ? Qnil
: Qt
,
1295 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1296 return unbind_to (count
, val
);
1300 GCPRO3 (file
, found
, hist_file_name
);
1304 /* We somehow got here with fd == -2, meaning the file is deemed
1305 to be remote. Don't even try to reopen the file locally;
1306 just force a failure. */
1314 clear_unwind_protect (fd_index
);
1315 efound
= ENCODE_FILE (found
);
1316 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1318 stream
= fdopen (fd
, fmode
);
1322 report_file_error ("Opening stdio stream", file
);
1323 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1325 if (! NILP (Vpurify_flag
))
1326 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1328 if (NILP (nomessage
) || force_load_messages
)
1331 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1334 message_with_string ("Loading %s (source)...", file
, 1);
1336 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1338 else /* The typical case; compiled file newer than source file. */
1339 message_with_string ("Loading %s...", file
, 1);
1342 specbind (Qload_file_name
, found
);
1343 specbind (Qinhibit_file_name_operation
, Qnil
);
1344 specbind (Qload_in_progress
, Qt
);
1347 if (lisp_file_lexically_bound_p (Qget_file_char
))
1348 Fset (Qlexical_binding
, Qt
);
1350 if (! version
|| version
>= 22)
1351 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1352 0, Qnil
, Qnil
, Qnil
, Qnil
);
1355 /* We can't handle a file which was compiled with
1356 byte-compile-dynamic by older version of Emacs. */
1357 specbind (Qload_force_doc_strings
, Qt
);
1358 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1359 0, Qnil
, Qnil
, Qnil
, Qnil
);
1361 unbind_to (count
, Qnil
);
1363 /* Run any eval-after-load forms for this file. */
1364 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1365 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1369 xfree (saved_doc_string
);
1370 saved_doc_string
= 0;
1371 saved_doc_string_size
= 0;
1373 xfree (prev_saved_doc_string
);
1374 prev_saved_doc_string
= 0;
1375 prev_saved_doc_string_size
= 0;
1377 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1380 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1383 message_with_string ("Loading %s (source)...done", file
, 1);
1385 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1387 else /* The typical case; compiled file newer than source file. */
1388 message_with_string ("Loading %s...done", file
, 1);
1395 complete_filename_p (Lisp_Object pathname
)
1397 const unsigned char *s
= SDATA (pathname
);
1398 return (IS_DIRECTORY_SEP (s
[0])
1399 || (SCHARS (pathname
) > 2
1400 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1403 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1404 doc
: /* Search for FILENAME through PATH.
1405 Returns the file's name in absolute form, or nil if not found.
1406 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1407 file name when searching.
1408 If non-nil, PREDICATE is used instead of `file-readable-p'.
1409 PREDICATE can also be an integer to pass to the faccessat(2) function,
1410 in which case file-name-handlers are ignored.
1411 This function will normally skip directories, so if you want it to find
1412 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1413 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1416 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1417 if (NILP (predicate
) && fd
>= 0)
1422 static Lisp_Object Qdir_ok
;
1424 /* Search for a file whose name is STR, looking in directories
1425 in the Lisp list PATH, and trying suffixes from SUFFIX.
1426 On success, return a file descriptor (or 1 or -2 as described below).
1427 On failure, return -1 and set errno.
1429 SUFFIXES is a list of strings containing possible suffixes.
1430 The empty suffix is automatically added if the list is empty.
1432 PREDICATE non-nil means don't open the files,
1433 just look for one that satisfies the predicate. In this case,
1434 return 1 on success. The predicate can be a lisp function or
1435 an integer to pass to `access' (in which case file-name-handlers
1438 If STOREPTR is nonzero, it points to a slot where the name of
1439 the file actually found should be stored as a Lisp string.
1440 nil is stored there on failure.
1442 If the file we find is remote, return -2
1443 but store the found remote file name in *STOREPTR. */
1446 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1447 Lisp_Object
*storeptr
, Lisp_Object predicate
)
1449 ptrdiff_t fn_size
= 100;
1453 ptrdiff_t want_length
;
1454 Lisp_Object filename
;
1455 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1456 Lisp_Object string
, tail
, encoded_fn
;
1457 ptrdiff_t max_suffix_len
= 0;
1458 int last_errno
= ENOENT
;
1462 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1464 CHECK_STRING_CAR (tail
);
1465 max_suffix_len
= max (max_suffix_len
,
1466 SBYTES (XCAR (tail
)));
1469 string
= filename
= encoded_fn
= Qnil
;
1470 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1475 if (complete_filename_p (str
))
1478 for (; CONSP (path
); path
= XCDR (path
))
1480 filename
= Fexpand_file_name (str
, XCAR (path
));
1481 if (!complete_filename_p (filename
))
1482 /* If there are non-absolute elts in PATH (eg "."). */
1483 /* Of course, this could conceivably lose if luser sets
1484 default-directory to be something non-absolute... */
1486 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1487 if (!complete_filename_p (filename
))
1488 /* Give up on this path element! */
1492 /* Calculate maximum length of any filename made from
1493 this path element/specified file name and any possible suffix. */
1494 want_length
= max_suffix_len
+ SBYTES (filename
);
1495 if (fn_size
<= want_length
)
1496 fn
= alloca (fn_size
= 100 + want_length
);
1498 /* Loop over suffixes. */
1499 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1500 CONSP (tail
); tail
= XCDR (tail
))
1502 Lisp_Object suffix
= XCAR (tail
);
1503 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1504 Lisp_Object handler
;
1506 /* Concatenate path element/specified name with the suffix.
1507 If the directory starts with /:, remove that. */
1508 int prefixlen
= ((SCHARS (filename
) > 2
1509 && SREF (filename
, 0) == '/'
1510 && SREF (filename
, 1) == ':')
1512 fnlen
= SBYTES (filename
) - prefixlen
;
1513 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1514 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1516 /* Check that the file exists and is not a directory. */
1517 /* We used to only check for handlers on non-absolute file names:
1521 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1522 It's not clear why that was the case and it breaks things like
1523 (load "/bar.el") where the file is actually "/bar.el.gz". */
1524 /* make_string has its own ideas on when to return a unibyte
1525 string and when a multibyte string, but we know better.
1526 We must have a unibyte string when dumping, since
1527 file-name encoding is shaky at best at that time, and in
1528 particular default-file-name-coding-system is reset
1529 several times during loadup. We therefore don't want to
1530 encode the file before passing it to file I/O library
1532 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1533 string
= make_unibyte_string (fn
, fnlen
);
1535 string
= make_string (fn
, fnlen
);
1536 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1537 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1540 if (NILP (predicate
))
1541 exists
= !NILP (Ffile_readable_p (string
));
1544 Lisp_Object tmp
= call1 (predicate
, string
);
1547 else if (EQ (tmp
, Qdir_ok
)
1548 || NILP (Ffile_directory_p (string
)))
1553 last_errno
= EISDIR
;
1559 /* We succeeded; return this descriptor and filename. */
1571 encoded_fn
= ENCODE_FILE (string
);
1572 pfn
= SSDATA (encoded_fn
);
1574 /* Check that we can access or open it. */
1575 if (NATNUMP (predicate
))
1578 if (INT_MAX
< XFASTINT (predicate
))
1579 last_errno
= EINVAL
;
1580 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1584 if (file_directory_p (pfn
))
1585 last_errno
= EISDIR
;
1592 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1595 if (errno
!= ENOENT
)
1601 int err
= (fstat (fd
, &st
) != 0 ? errno
1602 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1614 /* We succeeded; return this descriptor and filename. */
1632 /* Merge the list we've accumulated of globals from the current input source
1633 into the load_history variable. The details depend on whether
1634 the source has an associated file name or not.
1636 FILENAME is the file name that we are loading from.
1638 ENTIRE is true if loading that entire file, false if evaluating
1642 build_load_history (Lisp_Object filename
, bool entire
)
1644 Lisp_Object tail
, prev
, newelt
;
1645 Lisp_Object tem
, tem2
;
1648 tail
= Vload_history
;
1651 while (CONSP (tail
))
1655 /* Find the feature's previous assoc list... */
1656 if (!NILP (Fequal (filename
, Fcar (tem
))))
1660 /* If we're loading the entire file, remove old data. */
1664 Vload_history
= XCDR (tail
);
1666 Fsetcdr (prev
, XCDR (tail
));
1669 /* Otherwise, cons on new symbols that are not already members. */
1672 tem2
= Vcurrent_load_list
;
1674 while (CONSP (tem2
))
1676 newelt
= XCAR (tem2
);
1678 if (NILP (Fmember (newelt
, tem
)))
1679 Fsetcar (tail
, Fcons (XCAR (tem
),
1680 Fcons (newelt
, XCDR (tem
))));
1693 /* If we're loading an entire file, cons the new assoc onto the
1694 front of load-history, the most-recently-loaded position. Also
1695 do this if we didn't find an existing member for the file. */
1696 if (entire
|| !foundit
)
1697 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1702 readevalloop_1 (int old
)
1704 load_convert_to_unibyte
= old
;
1707 /* Signal an `end-of-file' error, if possible with file name
1710 static _Noreturn
void
1711 end_of_file_error (void)
1713 if (STRINGP (Vload_file_name
))
1714 xsignal1 (Qend_of_file
, Vload_file_name
);
1716 xsignal0 (Qend_of_file
);
1719 /* UNIBYTE specifies how to set load_convert_to_unibyte
1720 for this invocation.
1721 READFUN, if non-nil, is used instead of `read'.
1723 START, END specify region to read in current buffer (from eval-region).
1724 If the input is not from a buffer, they must be nil. */
1727 readevalloop (Lisp_Object readcharfun
,
1729 Lisp_Object sourcename
,
1731 Lisp_Object unibyte
, Lisp_Object readfun
,
1732 Lisp_Object start
, Lisp_Object end
)
1735 register Lisp_Object val
;
1736 ptrdiff_t count
= SPECPDL_INDEX ();
1737 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1738 struct buffer
*b
= 0;
1739 bool continue_reading_p
;
1740 Lisp_Object lex_bound
;
1741 /* True if reading an entire buffer. */
1742 bool whole_buffer
= 0;
1743 /* True on the first time around. */
1744 bool first_sexp
= 1;
1745 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1747 if (NILP (Ffboundp (macroexpand
))
1748 /* Don't macroexpand in .elc files, since it should have been done
1749 already. We actually don't know whether we're in a .elc file or not,
1750 so we use circumstantial evidence: .el files normally go through
1751 Vload_source_file_function -> load-with-code-conversion
1753 || EQ (readcharfun
, Qget_file_char
)
1754 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1757 if (MARKERP (readcharfun
))
1760 start
= readcharfun
;
1763 if (BUFFERP (readcharfun
))
1764 b
= XBUFFER (readcharfun
);
1765 else if (MARKERP (readcharfun
))
1766 b
= XMARKER (readcharfun
)->buffer
;
1768 /* We assume START is nil when input is not from a buffer. */
1769 if (! NILP (start
) && !b
)
1772 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1773 specbind (Qcurrent_load_list
, Qnil
);
1774 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1775 load_convert_to_unibyte
= !NILP (unibyte
);
1777 /* If lexical binding is active (either because it was specified in
1778 the file's header, or via a buffer-local variable), create an empty
1779 lexical environment, otherwise, turn off lexical binding. */
1780 lex_bound
= find_symbol_value (Qlexical_binding
);
1781 specbind (Qinternal_interpreter_environment
,
1782 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1783 ? Qnil
: list1 (Qt
)));
1785 GCPRO4 (sourcename
, readfun
, start
, end
);
1787 /* Try to ensure sourcename is a truename, except whilst preloading. */
1788 if (NILP (Vpurify_flag
)
1789 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1790 && !NILP (Ffboundp (Qfile_truename
)))
1791 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1793 LOADHIST_ATTACH (sourcename
);
1795 continue_reading_p
= 1;
1796 while (continue_reading_p
)
1798 ptrdiff_t count1
= SPECPDL_INDEX ();
1800 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1801 error ("Reading from killed buffer");
1805 /* Switch to the buffer we are reading from. */
1806 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1807 set_buffer_internal (b
);
1809 /* Save point in it. */
1810 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1811 /* Save ZV in it. */
1812 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1813 /* Those get unbound after we read one expression. */
1815 /* Set point and ZV around stuff to be read. */
1818 Fnarrow_to_region (make_number (BEGV
), end
);
1820 /* Just for cleanliness, convert END to a marker
1821 if it is an integer. */
1823 end
= Fpoint_max_marker ();
1826 /* On the first cycle, we can easily test here
1827 whether we are reading the whole buffer. */
1828 if (b
&& first_sexp
)
1829 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1836 while ((c
= READCHAR
) != '\n' && c
!= -1);
1841 unbind_to (count1
, Qnil
);
1845 /* Ignore whitespace here, so we can detect eof. */
1846 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1847 || c
== 0xa0) /* NBSP */
1850 if (!NILP (Vpurify_flag
) && c
== '(')
1852 val
= read_list (0, readcharfun
);
1857 read_objects
= Qnil
;
1858 if (!NILP (readfun
))
1860 val
= call1 (readfun
, readcharfun
);
1862 /* If READCHARFUN has set point to ZV, we should
1863 stop reading, even if the form read sets point
1864 to a different value when evaluated. */
1865 if (BUFFERP (readcharfun
))
1867 struct buffer
*buf
= XBUFFER (readcharfun
);
1868 if (BUF_PT (buf
) == BUF_ZV (buf
))
1869 continue_reading_p
= 0;
1872 else if (! NILP (Vload_read_function
))
1873 val
= call1 (Vload_read_function
, readcharfun
);
1875 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1878 if (!NILP (start
) && continue_reading_p
)
1879 start
= Fpoint_marker ();
1881 /* Restore saved point and BEGV. */
1882 unbind_to (count1
, Qnil
);
1884 /* Now eval what we just read. */
1885 if (!NILP (macroexpand
))
1886 val
= call1 (macroexpand
, val
);
1887 val
= eval_sub (val
);
1891 Vvalues
= Fcons (val
, Vvalues
);
1892 if (EQ (Vstandard_output
, Qt
))
1901 build_load_history (sourcename
,
1902 stream
|| whole_buffer
);
1906 unbind_to (count
, Qnil
);
1909 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1910 doc
: /* Execute the current buffer as Lisp code.
1911 When called from a Lisp program (i.e., not interactively), this
1912 function accepts up to five optional arguments:
1913 BUFFER is the buffer to evaluate (nil means use current buffer).
1914 PRINTFLAG controls printing of output:
1915 A value of nil means discard it; anything else is stream for print.
1916 FILENAME specifies the file name to use for `load-history'.
1917 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1919 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1920 functions should work normally even if PRINTFLAG is nil.
1922 This function preserves the position of point. */)
1923 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1925 ptrdiff_t count
= SPECPDL_INDEX ();
1926 Lisp_Object tem
, buf
;
1929 buf
= Fcurrent_buffer ();
1931 buf
= Fget_buffer (buffer
);
1933 error ("No such buffer");
1935 if (NILP (printflag
) && NILP (do_allow_print
))
1940 if (NILP (filename
))
1941 filename
= BVAR (XBUFFER (buf
), filename
);
1943 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1944 specbind (Qstandard_output
, tem
);
1945 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1946 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1947 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1948 readevalloop (buf
, 0, filename
,
1949 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1950 unbind_to (count
, Qnil
);
1955 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1956 doc
: /* Execute the region as Lisp code.
1957 When called from programs, expects two arguments,
1958 giving starting and ending indices in the current buffer
1959 of the text to be executed.
1960 Programs can pass third argument PRINTFLAG which controls output:
1961 A value of nil means discard it; anything else is stream for printing it.
1962 Also the fourth argument READ-FUNCTION, if non-nil, is used
1963 instead of `read' to read each expression. It gets one argument
1964 which is the input stream for reading characters.
1966 This function does not move point. */)
1967 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1969 /* FIXME: Do the eval-sexp-add-defvars dance! */
1970 ptrdiff_t count
= SPECPDL_INDEX ();
1971 Lisp_Object tem
, cbuf
;
1973 cbuf
= Fcurrent_buffer ();
1975 if (NILP (printflag
))
1979 specbind (Qstandard_output
, tem
);
1980 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1982 /* `readevalloop' calls functions which check the type of start and end. */
1983 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1984 !NILP (printflag
), Qnil
, read_function
,
1987 return unbind_to (count
, Qnil
);
1991 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1992 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1993 If STREAM is nil, use the value of `standard-input' (which see).
1994 STREAM or the value of `standard-input' may be:
1995 a buffer (read from point and advance it)
1996 a marker (read from where it points and advance it)
1997 a function (call it with no arguments for each character,
1998 call it with a char as argument to push a char back)
1999 a string (takes text from string, starting at the beginning)
2000 t (read text line using minibuffer and use it, or read from
2001 standard input in batch mode). */)
2002 (Lisp_Object stream
)
2005 stream
= Vstandard_input
;
2006 if (EQ (stream
, Qt
))
2007 stream
= Qread_char
;
2008 if (EQ (stream
, Qread_char
))
2009 /* FIXME: ¿¡ When is this used !? */
2010 return call1 (intern ("read-minibuffer"),
2011 build_string ("Lisp expression: "));
2013 return read_internal_start (stream
, Qnil
, Qnil
);
2016 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2017 doc
: /* Read one Lisp expression which is represented as text by STRING.
2018 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2019 FINAL-STRING-INDEX is an integer giving the position of the next
2020 remaining character in STRING.
2021 START and END optionally delimit a substring of STRING from which to read;
2022 they default to 0 and (length STRING) respectively. */)
2023 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2026 CHECK_STRING (string
);
2027 /* `read_internal_start' sets `read_from_string_index'. */
2028 ret
= read_internal_start (string
, start
, end
);
2029 return Fcons (ret
, make_number (read_from_string_index
));
2032 /* Function to set up the global context we need in toplevel read
2035 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2036 /* `start', `end' only used when stream is a string. */
2041 new_backquote_flag
= 0;
2042 read_objects
= Qnil
;
2043 if (EQ (Vread_with_symbol_positions
, Qt
)
2044 || EQ (Vread_with_symbol_positions
, stream
))
2045 Vread_symbol_positions_list
= Qnil
;
2047 if (STRINGP (stream
)
2048 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2050 ptrdiff_t startval
, endval
;
2053 if (STRINGP (stream
))
2056 string
= XCAR (stream
);
2059 endval
= SCHARS (string
);
2063 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2064 args_out_of_range (string
, end
);
2065 endval
= XINT (end
);
2072 CHECK_NUMBER (start
);
2073 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2074 args_out_of_range (string
, start
);
2075 startval
= XINT (start
);
2077 read_from_string_index
= startval
;
2078 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2079 read_from_string_limit
= endval
;
2082 retval
= read0 (stream
);
2083 if (EQ (Vread_with_symbol_positions
, Qt
)
2084 || EQ (Vread_with_symbol_positions
, stream
))
2085 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2090 /* Signal Qinvalid_read_syntax error.
2091 S is error string of length N (if > 0) */
2093 static _Noreturn
void
2094 invalid_syntax (const char *s
)
2096 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2100 /* Use this for recursive reads, in contexts where internal tokens
2104 read0 (Lisp_Object readcharfun
)
2106 register Lisp_Object val
;
2109 val
= read1 (readcharfun
, &c
, 0);
2113 xsignal1 (Qinvalid_read_syntax
,
2114 Fmake_string (make_number (1), make_number (c
)));
2117 static ptrdiff_t read_buffer_size
;
2118 static char *read_buffer
;
2120 /* Read a \-escape sequence, assuming we already read the `\'.
2121 If the escape sequence forces unibyte, return eight-bit char. */
2124 read_escape (Lisp_Object readcharfun
, bool stringp
)
2127 /* \u allows up to four hex digits, \U up to eight. Default to the
2128 behavior for \u, and change this value in the case that \U is seen. */
2129 int unicode_hex_count
= 4;
2134 end_of_file_error ();
2164 error ("Invalid escape character syntax");
2167 c
= read_escape (readcharfun
, 0);
2168 return c
| meta_modifier
;
2173 error ("Invalid escape character syntax");
2176 c
= read_escape (readcharfun
, 0);
2177 return c
| shift_modifier
;
2182 error ("Invalid escape character syntax");
2185 c
= read_escape (readcharfun
, 0);
2186 return c
| hyper_modifier
;
2191 error ("Invalid escape character syntax");
2194 c
= read_escape (readcharfun
, 0);
2195 return c
| alt_modifier
;
2199 if (stringp
|| c
!= '-')
2206 c
= read_escape (readcharfun
, 0);
2207 return c
| super_modifier
;
2212 error ("Invalid escape character syntax");
2216 c
= read_escape (readcharfun
, 0);
2217 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2218 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2219 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2220 return c
| ctrl_modifier
;
2221 /* ASCII control chars are made from letters (both cases),
2222 as well as the non-letters within 0100...0137. */
2223 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2224 return (c
& (037 | ~0177));
2225 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2226 return (c
& (037 | ~0177));
2228 return c
| ctrl_modifier
;
2238 /* An octal escape, as in ANSI C. */
2240 register int i
= c
- '0';
2241 register int count
= 0;
2244 if ((c
= READCHAR
) >= '0' && c
<= '7')
2256 if (i
>= 0x80 && i
< 0x100)
2257 i
= BYTE8_TO_CHAR (i
);
2262 /* A hex escape, as in ANSI C. */
2269 if (c
>= '0' && c
<= '9')
2274 else if ((c
>= 'a' && c
<= 'f')
2275 || (c
>= 'A' && c
<= 'F'))
2278 if (c
>= 'a' && c
<= 'f')
2288 /* Allow hex escapes as large as ?\xfffffff, because some
2289 packages use them to denote characters with modifiers. */
2290 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2291 error ("Hex character out of range: \\x%x...", i
);
2295 if (count
< 3 && i
>= 0x80)
2296 return BYTE8_TO_CHAR (i
);
2301 /* Post-Unicode-2.0: Up to eight hex chars. */
2302 unicode_hex_count
= 8;
2305 /* A Unicode escape. We only permit them in strings and characters,
2306 not arbitrarily in the source code, as in some other languages. */
2311 while (++count
<= unicode_hex_count
)
2314 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2316 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2317 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2318 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2320 error ("Non-hex digit used for Unicode escape");
2323 error ("Non-Unicode character: 0x%x", i
);
2332 /* Return the digit that CHARACTER stands for in the given BASE.
2333 Return -1 if CHARACTER is out of range for BASE,
2334 and -2 if CHARACTER is not valid for any supported BASE. */
2336 digit_to_number (int character
, int base
)
2340 if ('0' <= character
&& character
<= '9')
2341 digit
= character
- '0';
2342 else if ('a' <= character
&& character
<= 'z')
2343 digit
= character
- 'a' + 10;
2344 else if ('A' <= character
&& character
<= 'Z')
2345 digit
= character
- 'A' + 10;
2349 return digit
< base
? digit
: -1;
2352 /* Read an integer in radix RADIX using READCHARFUN to read
2353 characters. RADIX must be in the interval [2..36]; if it isn't, a
2354 read error is signaled . Value is the integer read. Signals an
2355 error if encountering invalid read syntax or if RADIX is out of
2359 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2361 /* Room for sign, leading 0, other digits, trailing null byte.
2362 Also, room for invalid syntax diagnostic. */
2363 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2364 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2366 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2368 if (radix
< 2 || radix
> 36)
2376 if (c
== '-' || c
== '+')
2387 /* Ignore redundant leading zeros, so the buffer doesn't
2388 fill up with them. */
2394 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2401 if (p
< buf
+ sizeof buf
- 1)
2415 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2416 invalid_syntax (buf
);
2419 return string_to_number (buf
, radix
, 0);
2423 /* If the next token is ')' or ']' or '.', we store that character
2424 in *PCH and the return value is not interesting. Else, we store
2425 zero in *PCH and we read and return one lisp object.
2427 FIRST_IN_LIST is true if this is the first element of a list. */
2430 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2433 bool uninterned_symbol
= 0;
2440 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2442 end_of_file_error ();
2447 return read_list (0, readcharfun
);
2450 return read_vector (readcharfun
, 0);
2466 /* Accept extended format for hashtables (extensible to
2468 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2469 Lisp_Object tmp
= read_list (0, readcharfun
);
2470 Lisp_Object head
= CAR_SAFE (tmp
);
2471 Lisp_Object data
= Qnil
;
2472 Lisp_Object val
= Qnil
;
2473 /* The size is 2 * number of allowed keywords to
2475 Lisp_Object params
[10];
2477 Lisp_Object key
= Qnil
;
2478 int param_count
= 0;
2480 if (!EQ (head
, Qhash_table
))
2481 error ("Invalid extended read marker at head of #s list "
2482 "(only hash-table allowed)");
2484 tmp
= CDR_SAFE (tmp
);
2486 /* This is repetitive but fast and simple. */
2487 params
[param_count
] = QCsize
;
2488 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2489 if (!NILP (params
[param_count
+ 1]))
2492 params
[param_count
] = QCtest
;
2493 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2494 if (!NILP (params
[param_count
+ 1]))
2497 params
[param_count
] = QCweakness
;
2498 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2499 if (!NILP (params
[param_count
+ 1]))
2502 params
[param_count
] = QCrehash_size
;
2503 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2504 if (!NILP (params
[param_count
+ 1]))
2507 params
[param_count
] = QCrehash_threshold
;
2508 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2509 if (!NILP (params
[param_count
+ 1]))
2512 /* This is the hashtable data. */
2513 data
= Fplist_get (tmp
, Qdata
);
2515 /* Now use params to make a new hashtable and fill it. */
2516 ht
= Fmake_hash_table (param_count
, params
);
2518 while (CONSP (data
))
2523 error ("Odd number of elements in hashtable data");
2526 Fputhash (key
, val
, ht
);
2532 invalid_syntax ("#");
2540 tmp
= read_vector (readcharfun
, 0);
2541 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2542 error ("Invalid size char-table");
2543 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2555 tmp
= read_vector (readcharfun
, 0);
2558 error ("Invalid size char-table");
2559 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2560 error ("Invalid depth in char-table");
2561 depth
= XINT (AREF (tmp
, 0));
2562 if (chartab_size
[depth
] != size
- 2)
2563 error ("Invalid size char-table");
2564 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2567 invalid_syntax ("#^^");
2569 invalid_syntax ("#^");
2574 length
= read1 (readcharfun
, pch
, first_in_list
);
2578 Lisp_Object tmp
, val
;
2579 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2580 unsigned char *data
;
2583 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2584 if (STRING_MULTIBYTE (tmp
)
2585 || (size_in_chars
!= SCHARS (tmp
)
2586 /* We used to print 1 char too many
2587 when the number of bits was a multiple of 8.
2588 Accept such input in case it came from an old
2590 && ! (XFASTINT (length
)
2591 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2592 invalid_syntax ("#&...");
2594 val
= make_uninit_bool_vector (XFASTINT (length
));
2595 data
= bool_vector_uchar_data (val
);
2596 memcpy (data
, SDATA (tmp
), size_in_chars
);
2597 /* Clear the extraneous bits in the last byte. */
2598 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2599 data
[size_in_chars
- 1]
2600 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2603 invalid_syntax ("#&...");
2607 /* Accept compiled functions at read-time so that we don't have to
2608 build them using function calls. */
2610 tmp
= read_vector (readcharfun
, 1);
2611 struct Lisp_Vector
* vec
= XVECTOR (tmp
);
2612 if (vec
->header
.size
==0)
2613 invalid_syntax ("Empty byte-code object");
2614 make_byte_code (vec
);
2620 struct gcpro gcpro1
;
2623 /* Read the string itself. */
2624 tmp
= read1 (readcharfun
, &ch
, 0);
2625 if (ch
!= 0 || !STRINGP (tmp
))
2626 invalid_syntax ("#");
2628 /* Read the intervals and their properties. */
2631 Lisp_Object beg
, end
, plist
;
2633 beg
= read1 (readcharfun
, &ch
, 0);
2638 end
= read1 (readcharfun
, &ch
, 0);
2640 plist
= read1 (readcharfun
, &ch
, 0);
2642 invalid_syntax ("Invalid string property list");
2643 Fset_text_properties (beg
, end
, plist
, tmp
);
2649 /* #@NUMBER is used to skip NUMBER following bytes.
2650 That's used in .elc files to skip over doc strings
2651 and function definitions. */
2654 enum { extra
= 100 };
2655 ptrdiff_t i
, nskip
= 0, digits
= 0;
2657 /* Read a decimal integer. */
2658 while ((c
= READCHAR
) >= 0
2659 && c
>= '0' && c
<= '9')
2661 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2666 if (digits
== 2 && nskip
== 0)
2667 { /* We've just seen #@00, which means "skip to end". */
2668 skip_dyn_eof (readcharfun
);
2673 /* We can't use UNREAD here, because in the code below we side-step
2674 READCHAR. Instead, assume the first char after #@NNN occupies
2675 a single byte, which is the case normally since it's just
2681 if (load_force_doc_strings
2682 && (FROM_FILE_P (readcharfun
)))
2684 /* If we are supposed to force doc strings into core right now,
2685 record the last string that we skipped,
2686 and record where in the file it comes from. */
2688 /* But first exchange saved_doc_string
2689 with prev_saved_doc_string, so we save two strings. */
2691 char *temp
= saved_doc_string
;
2692 ptrdiff_t temp_size
= saved_doc_string_size
;
2693 file_offset temp_pos
= saved_doc_string_position
;
2694 ptrdiff_t temp_len
= saved_doc_string_length
;
2696 saved_doc_string
= prev_saved_doc_string
;
2697 saved_doc_string_size
= prev_saved_doc_string_size
;
2698 saved_doc_string_position
= prev_saved_doc_string_position
;
2699 saved_doc_string_length
= prev_saved_doc_string_length
;
2701 prev_saved_doc_string
= temp
;
2702 prev_saved_doc_string_size
= temp_size
;
2703 prev_saved_doc_string_position
= temp_pos
;
2704 prev_saved_doc_string_length
= temp_len
;
2707 if (saved_doc_string_size
== 0)
2709 saved_doc_string
= xmalloc (nskip
+ extra
);
2710 saved_doc_string_size
= nskip
+ extra
;
2712 if (nskip
> saved_doc_string_size
)
2714 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2715 saved_doc_string_size
= nskip
+ extra
;
2718 saved_doc_string_position
= file_tell (instream
);
2720 /* Copy that many characters into saved_doc_string. */
2722 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2723 saved_doc_string
[i
] = c
= getc (instream
);
2726 saved_doc_string_length
= i
;
2729 /* Skip that many bytes. */
2730 skip_dyn_bytes (readcharfun
, nskip
);
2736 /* #! appears at the beginning of an executable file.
2737 Skip the first line. */
2738 while (c
!= '\n' && c
>= 0)
2743 return Vload_file_name
;
2745 return list2 (Qfunction
, read0 (readcharfun
));
2746 /* #:foo is the uninterned symbol named foo. */
2749 uninterned_symbol
= 1;
2752 && c
!= 0xa0 /* NBSP */
2754 || strchr ("\"';()[]#`,", c
) == NULL
)))
2756 /* No symbol character follows, this is the empty
2759 return Fmake_symbol (empty_unibyte_string
);
2763 /* ## is the empty symbol. */
2765 return Fintern (empty_unibyte_string
, Qnil
);
2766 /* Reader forms that can reuse previously read objects. */
2767 if (c
>= '0' && c
<= '9')
2772 /* Read a non-negative integer. */
2773 while (c
>= '0' && c
<= '9')
2775 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2776 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2777 n
= MOST_POSITIVE_FIXNUM
+ 1;
2779 n
= n
* 10 + c
- '0';
2783 if (n
<= MOST_POSITIVE_FIXNUM
)
2785 if (c
== 'r' || c
== 'R')
2786 return read_integer (readcharfun
, n
);
2788 if (! NILP (Vread_circle
))
2790 /* #n=object returns object, but associates it with
2794 /* Make a placeholder for #n# to use temporarily. */
2795 Lisp_Object placeholder
;
2798 placeholder
= Fcons (Qnil
, Qnil
);
2799 cell
= Fcons (make_number (n
), placeholder
);
2800 read_objects
= Fcons (cell
, read_objects
);
2802 /* Read the object itself. */
2803 tem
= read0 (readcharfun
);
2805 /* Now put it everywhere the placeholder was... */
2806 substitute_object_in_subtree (tem
, placeholder
);
2808 /* ...and #n# will use the real value from now on. */
2809 Fsetcdr (cell
, tem
);
2814 /* #n# returns a previously read object. */
2817 tem
= Fassq (make_number (n
), read_objects
);
2823 /* Fall through to error message. */
2825 else if (c
== 'x' || c
== 'X')
2826 return read_integer (readcharfun
, 16);
2827 else if (c
== 'o' || c
== 'O')
2828 return read_integer (readcharfun
, 8);
2829 else if (c
== 'b' || c
== 'B')
2830 return read_integer (readcharfun
, 2);
2833 invalid_syntax ("#");
2836 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2840 return list2 (Qquote
, read0 (readcharfun
));
2844 int next_char
= READCHAR
;
2846 /* Transition from old-style to new-style:
2847 If we see "(`" it used to mean old-style, which usually works
2848 fine because ` should almost never appear in such a position
2849 for new-style. But occasionally we need "(`" to mean new
2850 style, so we try to distinguish the two by the fact that we
2851 can either write "( `foo" or "(` foo", where the first
2852 intends to use new-style whereas the second intends to use
2853 old-style. For Emacs-25, we should completely remove this
2854 first_in_list exception (old-style can still be obtained via
2856 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2858 Vold_style_backquotes
= Qt
;
2864 bool saved_new_backquote_flag
= new_backquote_flag
;
2866 new_backquote_flag
= 1;
2867 value
= read0 (readcharfun
);
2868 new_backquote_flag
= saved_new_backquote_flag
;
2870 return list2 (Qbackquote
, value
);
2875 int next_char
= READCHAR
;
2877 /* Transition from old-style to new-style:
2878 It used to be impossible to have a new-style , other than within
2879 a new-style `. This is sufficient when ` and , are used in the
2880 normal way, but ` and , can also appear in args to macros that
2881 will not interpret them in the usual way, in which case , may be
2882 used without any ` anywhere near.
2883 So we now use the same heuristic as for backquote: old-style
2884 unquotes are only recognized when first on a list, and when
2885 followed by a space.
2886 Because it's more difficult to peek 2 chars ahead, a new-style
2887 ,@ can still not be used outside of a `, unless it's in the middle
2889 if (new_backquote_flag
2891 || (next_char
!= ' ' && next_char
!= '@'))
2893 Lisp_Object comma_type
= Qnil
;
2898 comma_type
= Qcomma_at
;
2900 comma_type
= Qcomma_dot
;
2903 if (ch
>= 0) UNREAD (ch
);
2904 comma_type
= Qcomma
;
2907 value
= read0 (readcharfun
);
2908 return list2 (comma_type
, value
);
2912 Vold_style_backquotes
= Qt
;
2924 end_of_file_error ();
2926 /* Accept `single space' syntax like (list ? x) where the
2927 whitespace character is SPC or TAB.
2928 Other literal whitespace like NL, CR, and FF are not accepted,
2929 as there are well-established escape sequences for these. */
2930 if (c
== ' ' || c
== '\t')
2931 return make_number (c
);
2934 c
= read_escape (readcharfun
, 0);
2935 modifiers
= c
& CHAR_MODIFIER_MASK
;
2936 c
&= ~CHAR_MODIFIER_MASK
;
2937 if (CHAR_BYTE8_P (c
))
2938 c
= CHAR_TO_BYTE8 (c
);
2941 next_char
= READCHAR
;
2942 ok
= (next_char
<= 040
2943 || (next_char
< 0200
2944 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2947 return make_number (c
);
2949 invalid_syntax ("?");
2954 char *p
= read_buffer
;
2955 char *end
= read_buffer
+ read_buffer_size
;
2957 /* True if we saw an escape sequence specifying
2958 a multibyte character. */
2959 bool force_multibyte
= 0;
2960 /* True if we saw an escape sequence specifying
2961 a single-byte character. */
2962 bool force_singlebyte
= 0;
2964 ptrdiff_t nchars
= 0;
2966 while ((ch
= READCHAR
) >= 0
2969 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2971 ptrdiff_t offset
= p
- read_buffer
;
2972 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2973 memory_full (SIZE_MAX
);
2974 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
2975 read_buffer_size
*= 2;
2976 p
= read_buffer
+ offset
;
2977 end
= read_buffer
+ read_buffer_size
;
2984 ch
= read_escape (readcharfun
, 1);
2986 /* CH is -1 if \ newline has just been seen. */
2989 if (p
== read_buffer
)
2994 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2995 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2997 if (CHAR_BYTE8_P (ch
))
2998 force_singlebyte
= 1;
2999 else if (! ASCII_CHAR_P (ch
))
3000 force_multibyte
= 1;
3001 else /* I.e. ASCII_CHAR_P (ch). */
3003 /* Allow `\C- ' and `\C-?'. */
3004 if (modifiers
== CHAR_CTL
)
3007 ch
= 0, modifiers
= 0;
3009 ch
= 127, modifiers
= 0;
3011 if (modifiers
& CHAR_SHIFT
)
3013 /* Shift modifier is valid only with [A-Za-z]. */
3014 if (ch
>= 'A' && ch
<= 'Z')
3015 modifiers
&= ~CHAR_SHIFT
;
3016 else if (ch
>= 'a' && ch
<= 'z')
3017 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3020 if (modifiers
& CHAR_META
)
3022 /* Move the meta bit to the right place for a
3024 modifiers
&= ~CHAR_META
;
3025 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3026 force_singlebyte
= 1;
3030 /* Any modifiers remaining are invalid. */
3032 error ("Invalid modifier in string");
3033 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3037 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3038 if (CHAR_BYTE8_P (ch
))
3039 force_singlebyte
= 1;
3040 else if (! ASCII_CHAR_P (ch
))
3041 force_multibyte
= 1;
3047 end_of_file_error ();
3049 /* If purifying, and string starts with \ newline,
3050 return zero instead. This is for doc strings
3051 that we are really going to find in etc/DOC.nn.nn. */
3052 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3053 return make_number (0);
3055 if (! force_multibyte
&& force_singlebyte
)
3057 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3058 forms. Convert it to unibyte. */
3059 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3061 p
= read_buffer
+ nchars
;
3064 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3066 || (p
- read_buffer
!= nchars
)));
3071 int next_char
= READCHAR
;
3074 if (next_char
<= 040
3075 || (next_char
< 0200
3076 && strchr ("\"';([#?`,", next_char
) != NULL
))
3082 /* Otherwise, we fall through! Note that the atom-reading loop
3083 below will now loop at least once, assuring that we will not
3084 try to UNREAD two characters in a row. */
3088 if (c
<= 040) goto retry
;
3089 if (c
== 0xa0) /* NBSP */
3094 char *p
= read_buffer
;
3096 EMACS_INT start_position
= readchar_count
- 1;
3099 char *end
= read_buffer
+ read_buffer_size
;
3103 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3105 ptrdiff_t offset
= p
- read_buffer
;
3106 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3107 memory_full (SIZE_MAX
);
3108 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3109 read_buffer_size
*= 2;
3110 p
= read_buffer
+ offset
;
3111 end
= read_buffer
+ read_buffer_size
;
3118 end_of_file_error ();
3123 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3129 && c
!= 0xa0 /* NBSP */
3131 || strchr ("\"';()[]#`,", c
) == NULL
));
3135 ptrdiff_t offset
= p
- read_buffer
;
3136 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3137 memory_full (SIZE_MAX
);
3138 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3139 read_buffer_size
*= 2;
3140 p
= read_buffer
+ offset
;
3141 end
= read_buffer
+ read_buffer_size
;
3147 if (!quoted
&& !uninterned_symbol
)
3149 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3150 if (! NILP (result
))
3154 Lisp_Object name
, result
;
3155 ptrdiff_t nbytes
= p
- read_buffer
;
3158 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3162 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3163 ? make_pure_string
: make_specified_string
)
3164 (read_buffer
, nchars
, nbytes
, multibyte
));
3165 result
= (uninterned_symbol
? Fmake_symbol (name
)
3166 : Fintern (name
, Qnil
));
3168 if (EQ (Vread_with_symbol_positions
, Qt
)
3169 || EQ (Vread_with_symbol_positions
, readcharfun
))
3170 Vread_symbol_positions_list
3171 = Fcons (Fcons (result
, make_number (start_position
)),
3172 Vread_symbol_positions_list
);
3180 /* List of nodes we've seen during substitute_object_in_subtree. */
3181 static Lisp_Object seen_list
;
3184 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3186 Lisp_Object check_object
;
3188 /* We haven't seen any objects when we start. */
3191 /* Make all the substitutions. */
3193 = substitute_object_recurse (object
, placeholder
, object
);
3195 /* Clear seen_list because we're done with it. */
3198 /* The returned object here is expected to always eq the
3200 if (!EQ (check_object
, object
))
3201 error ("Unexpected mutation error in reader");
3204 /* Feval doesn't get called from here, so no gc protection is needed. */
3205 #define SUBSTITUTE(get_val, set_val) \
3207 Lisp_Object old_value = get_val; \
3208 Lisp_Object true_value \
3209 = substitute_object_recurse (object, placeholder, \
3212 if (!EQ (old_value, true_value)) \
3219 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3221 /* If we find the placeholder, return the target object. */
3222 if (EQ (placeholder
, subtree
))
3225 /* If we've been to this node before, don't explore it again. */
3226 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3229 /* If this node can be the entry point to a cycle, remember that
3230 we've seen it. It can only be such an entry point if it was made
3231 by #n=, which means that we can find it as a value in
3233 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3234 seen_list
= Fcons (subtree
, seen_list
);
3236 /* Recurse according to subtree's type.
3237 Every branch must return a Lisp_Object. */
3238 switch (XTYPE (subtree
))
3240 case Lisp_Vectorlike
:
3242 ptrdiff_t i
, length
= 0;
3243 if (BOOL_VECTOR_P (subtree
))
3244 return subtree
; /* No sub-objects anyway. */
3245 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3246 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3247 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3248 else if (VECTORP (subtree
))
3249 length
= ASIZE (subtree
);
3251 /* An unknown pseudovector may contain non-Lisp fields, so we
3252 can't just blindly traverse all its fields. We used to call
3253 `Flength' which signaled `sequencep', so I just preserved this
3255 wrong_type_argument (Qsequencep
, subtree
);
3257 for (i
= 0; i
< length
; i
++)
3258 SUBSTITUTE (AREF (subtree
, i
),
3259 ASET (subtree
, i
, true_value
));
3265 SUBSTITUTE (XCAR (subtree
),
3266 XSETCAR (subtree
, true_value
));
3267 SUBSTITUTE (XCDR (subtree
),
3268 XSETCDR (subtree
, true_value
));
3274 /* Check for text properties in each interval.
3275 substitute_in_interval contains part of the logic. */
3277 INTERVAL root_interval
= string_intervals (subtree
);
3278 Lisp_Object arg
= Fcons (object
, placeholder
);
3280 traverse_intervals_noorder (root_interval
,
3281 &substitute_in_interval
, arg
);
3286 /* Other types don't recurse any further. */
3292 /* Helper function for substitute_object_recurse. */
3294 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3296 Lisp_Object object
= Fcar (arg
);
3297 Lisp_Object placeholder
= Fcdr (arg
);
3299 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3309 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3310 integer syntax and fits in a fixnum, else return the nearest float if CP has
3311 either floating point or integer syntax and BASE is 10, else return nil. If
3312 IGNORE_TRAILING, consider just the longest prefix of CP that has
3313 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3314 number has integer syntax but does not fit. */
3317 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3320 char const *cp
= string
;
3322 bool float_syntax
= 0;
3325 /* Compute NaN and infinities using a variable, to cope with compilers that
3326 think they are smarter than we are. */
3329 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3330 IEEE floating point hosts, and works around a formerly-common bug where
3331 atof ("-0.0") drops the sign. */
3332 bool negative
= *cp
== '-';
3334 bool signedp
= negative
|| *cp
== '+';
3339 leading_digit
= digit_to_number (*cp
, base
);
3340 if (leading_digit
>= 0)
3345 while (digit_to_number (*cp
, base
) >= 0);
3355 if ('0' <= *cp
&& *cp
<= '9')
3360 while ('0' <= *cp
&& *cp
<= '9');
3362 if (*cp
== 'e' || *cp
== 'E')
3364 char const *ecp
= cp
;
3366 if (*cp
== '+' || *cp
== '-')
3368 if ('0' <= *cp
&& *cp
<= '9')
3373 while ('0' <= *cp
&& *cp
<= '9');
3375 else if (cp
[-1] == '+'
3376 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3382 else if (cp
[-1] == '+'
3383 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3387 value
= zero
/ zero
;
3389 /* If that made a "negative" NaN, negate it. */
3392 union { double d
; char c
[sizeof (double)]; }
3393 u_data
, u_minus_zero
;
3395 u_minus_zero
.d
= -0.0;
3396 for (i
= 0; i
< sizeof (double); i
++)
3397 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3403 /* Now VALUE is a positive NaN. */
3409 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3410 || state
== (LEAD_INT
|E_EXP
));
3413 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3414 any prefix that matches. Otherwise, the entire string must match. */
3415 if (! (ignore_trailing
3416 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3417 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3420 /* If the number uses integer and not float syntax, and is in C-language
3421 range, use its value, preferably as a fixnum. */
3422 if (leading_digit
>= 0 && ! float_syntax
)
3426 /* Fast special case for single-digit integers. This also avoids a
3427 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3428 case some versions of strtoumax accept numbers like "0x1" that Emacs
3430 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3431 return make_number (negative
? -leading_digit
: leading_digit
);
3434 n
= strtoumax (string
+ signedp
, NULL
, base
);
3435 if (errno
== ERANGE
)
3437 /* Unfortunately there's no simple and accurate way to convert
3438 non-base-10 numbers that are out of C-language range. */
3440 xsignal1 (Qoverflow_error
, build_string (string
));
3442 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3444 EMACS_INT signed_n
= n
;
3445 return make_number (negative
? -signed_n
: signed_n
);
3451 /* Either the number uses float syntax, or it does not fit into a fixnum.
3452 Convert it from string to floating point, unless the value is already
3453 known because it is an infinity, a NAN, or its absolute value fits in
3456 value
= atof (string
+ signedp
);
3458 return make_float (negative
? -value
: value
);
3463 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3467 Lisp_Object tem
, item
, vector
;
3468 struct Lisp_Cons
*otem
;
3471 tem
= read_list (1, readcharfun
);
3472 len
= Flength (tem
);
3473 vector
= Fmake_vector (len
, Qnil
);
3475 size
= ASIZE (vector
);
3476 ptr
= XVECTOR (vector
)->contents
;
3477 for (i
= 0; i
< size
; i
++)
3480 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3481 bytecode object, the docstring containing the bytecode and
3482 constants values must be treated as unibyte and passed to
3483 Fread, to get the actual bytecode string and constants vector. */
3484 if (bytecodeflag
&& load_force_doc_strings
)
3486 if (i
== COMPILED_BYTECODE
)
3488 if (!STRINGP (item
))
3489 error ("Invalid byte code");
3491 /* Delay handling the bytecode slot until we know whether
3492 it is lazily-loaded (we can tell by whether the
3493 constants slot is nil). */
3494 ASET (vector
, COMPILED_CONSTANTS
, item
);
3497 else if (i
== COMPILED_CONSTANTS
)
3499 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3503 /* Coerce string to unibyte (like string-as-unibyte,
3504 but without generating extra garbage and
3505 guaranteeing no change in the contents). */
3506 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3507 STRING_SET_UNIBYTE (bytestr
);
3509 item
= Fread (Fcons (bytestr
, readcharfun
));
3511 error ("Invalid byte code");
3513 otem
= XCONS (item
);
3514 bytestr
= XCAR (item
);
3519 /* Now handle the bytecode slot. */
3520 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3522 else if (i
== COMPILED_DOC_STRING
3524 && ! STRING_MULTIBYTE (item
))
3526 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3527 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3529 item
= Fstring_as_multibyte (item
);
3532 ASET (vector
, i
, item
);
3540 /* FLAG means check for ] to terminate rather than ) and . */
3543 read_list (bool flag
, Lisp_Object readcharfun
)
3545 Lisp_Object val
, tail
;
3546 Lisp_Object elt
, tem
;
3547 struct gcpro gcpro1
, gcpro2
;
3548 /* 0 is the normal case.
3549 1 means this list is a doc reference; replace it with the number 0.
3550 2 means this list is a doc reference; replace it with the doc string. */
3551 int doc_reference
= 0;
3553 /* Initialize this to 1 if we are reading a list. */
3554 bool first_in_list
= flag
<= 0;
3563 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3568 /* While building, if the list starts with #$, treat it specially. */
3569 if (EQ (elt
, Vload_file_name
)
3571 && !NILP (Vpurify_flag
))
3573 if (NILP (Vdoc_file_name
))
3574 /* We have not yet called Snarf-documentation, so assume
3575 this file is described in the DOC file
3576 and Snarf-documentation will fill in the right value later.
3577 For now, replace the whole list with 0. */
3580 /* We have already called Snarf-documentation, so make a relative
3581 file name for this file, so it can be found properly
3582 in the installed Lisp directory.
3583 We don't use Fexpand_file_name because that would make
3584 the directory absolute now. */
3585 elt
= concat2 (build_string ("../lisp/"),
3586 Ffile_name_nondirectory (elt
));
3588 else if (EQ (elt
, Vload_file_name
)
3590 && load_force_doc_strings
)
3599 invalid_syntax (") or . in a vector");
3607 XSETCDR (tail
, read0 (readcharfun
));
3609 val
= read0 (readcharfun
);
3610 read1 (readcharfun
, &ch
, 0);
3614 if (doc_reference
== 1)
3615 return make_number (0);
3616 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3619 file_offset saved_position
;
3620 /* Get a doc string from the file we are loading.
3621 If it's in saved_doc_string, get it from there.
3623 Here, we don't know if the string is a
3624 bytecode string or a doc string. As a
3625 bytecode string must be unibyte, we always
3626 return a unibyte string. If it is actually a
3627 doc string, caller must make it
3630 /* Position is negative for user variables. */
3631 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3632 if (pos
>= saved_doc_string_position
3633 && pos
< (saved_doc_string_position
3634 + saved_doc_string_length
))
3636 saved
= saved_doc_string
;
3637 saved_position
= saved_doc_string_position
;
3639 /* Look in prev_saved_doc_string the same way. */
3640 else if (pos
>= prev_saved_doc_string_position
3641 && pos
< (prev_saved_doc_string_position
3642 + prev_saved_doc_string_length
))
3644 saved
= prev_saved_doc_string
;
3645 saved_position
= prev_saved_doc_string_position
;
3649 ptrdiff_t start
= pos
- saved_position
;
3652 /* Process quoting with ^A,
3653 and find the end of the string,
3654 which is marked with ^_ (037). */
3655 for (from
= start
, to
= start
;
3656 saved
[from
] != 037;)
3658 int c
= saved
[from
++];
3662 saved
[to
++] = (c
== 1 ? c
3671 return make_unibyte_string (saved
+ start
,
3675 return get_doc_string (val
, 1, 0);
3680 invalid_syntax (". in wrong context");
3682 invalid_syntax ("] in a list");
3686 XSETCDR (tail
, tem
);
3693 static Lisp_Object initial_obarray
;
3695 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3697 static size_t oblookup_last_bucket_number
;
3699 /* Get an error if OBARRAY is not an obarray.
3700 If it is one, return it. */
3703 check_obarray (Lisp_Object obarray
)
3705 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3707 /* If Vobarray is now invalid, force it to be valid. */
3708 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3709 wrong_type_argument (Qvectorp
, obarray
);
3714 /* Intern the C string STR: return a symbol with that name,
3715 interned in the current obarray. */
3718 intern_1 (const char *str
, ptrdiff_t len
)
3720 Lisp_Object obarray
= check_obarray (Vobarray
);
3721 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3723 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3727 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3729 Lisp_Object obarray
= check_obarray (Vobarray
);
3730 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3735 if (NILP (Vpurify_flag
))
3736 /* Creating a non-pure string from a string literal not
3737 implemented yet. We could just use make_string here and live
3738 with the extra copy. */
3741 return Fintern (make_pure_c_string (str
, len
), obarray
);
3744 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3745 doc
: /* Return the canonical symbol whose name is STRING.
3746 If there is none, one is created by this function and returned.
3747 A second optional argument specifies the obarray to use;
3748 it defaults to the value of `obarray'. */)
3749 (Lisp_Object string
, Lisp_Object obarray
)
3751 register Lisp_Object tem
, sym
, *ptr
;
3753 if (NILP (obarray
)) obarray
= Vobarray
;
3754 obarray
= check_obarray (obarray
);
3756 CHECK_STRING (string
);
3758 tem
= oblookup (obarray
, SSDATA (string
),
3761 if (!INTEGERP (tem
))
3764 if (!NILP (Vpurify_flag
))
3765 string
= Fpurecopy (string
);
3766 sym
= Fmake_symbol (string
);
3768 if (EQ (obarray
, initial_obarray
))
3769 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3771 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3773 if ((SREF (string
, 0) == ':')
3774 && EQ (obarray
, initial_obarray
))
3776 XSYMBOL (sym
)->constant
= 1;
3777 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3778 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3781 ptr
= aref_addr (obarray
, XINT(tem
));
3783 set_symbol_next (sym
, XSYMBOL (*ptr
));
3785 set_symbol_next (sym
, NULL
);
3790 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3791 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3792 NAME may be a string or a symbol. If it is a symbol, that exact
3793 symbol is searched for.
3794 A second optional argument specifies the obarray to use;
3795 it defaults to the value of `obarray'. */)
3796 (Lisp_Object name
, Lisp_Object obarray
)
3798 register Lisp_Object tem
, string
;
3800 if (NILP (obarray
)) obarray
= Vobarray
;
3801 obarray
= check_obarray (obarray
);
3803 if (!SYMBOLP (name
))
3805 CHECK_STRING (name
);
3809 string
= SYMBOL_NAME (name
);
3811 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3812 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3818 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3819 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3820 The value is t if a symbol was found and deleted, nil otherwise.
3821 NAME may be a string or a symbol. If it is a symbol, that symbol
3822 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3823 OBARRAY defaults to the value of the variable `obarray'. */)
3824 (Lisp_Object name
, Lisp_Object obarray
)
3826 register Lisp_Object string
, tem
;
3829 if (NILP (obarray
)) obarray
= Vobarray
;
3830 obarray
= check_obarray (obarray
);
3833 string
= SYMBOL_NAME (name
);
3836 CHECK_STRING (name
);
3840 tem
= oblookup (obarray
, SSDATA (string
),
3845 /* If arg was a symbol, don't delete anything but that symbol itself. */
3846 if (SYMBOLP (name
) && !EQ (name
, tem
))
3849 /* There are plenty of other symbols which will screw up the Emacs
3850 session if we unintern them, as well as even more ways to use
3851 `setq' or `fset' or whatnot to make the Emacs session
3852 unusable. Let's not go down this silly road. --Stef */
3853 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3854 error ("Attempt to unintern t or nil"); */
3856 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3858 hash
= oblookup_last_bucket_number
;
3860 if (EQ (AREF (obarray
, hash
), tem
))
3862 if (XSYMBOL (tem
)->next
)
3865 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3866 ASET (obarray
, hash
, sym
);
3869 ASET (obarray
, hash
, make_number (0));
3873 Lisp_Object tail
, following
;
3875 for (tail
= AREF (obarray
, hash
);
3876 XSYMBOL (tail
)->next
;
3879 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3880 if (EQ (following
, tem
))
3882 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3891 /* Return the symbol in OBARRAY whose names matches the string
3892 of SIZE characters (SIZE_BYTE bytes) at PTR.
3893 If there is no such symbol in OBARRAY, return nil.
3895 Also store the bucket number in oblookup_last_bucket_number. */
3898 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3902 register Lisp_Object tail
;
3903 Lisp_Object bucket
, tem
;
3905 obarray
= check_obarray (obarray
);
3906 obsize
= ASIZE (obarray
);
3908 /* This is sometimes needed in the middle of GC. */
3909 obsize
&= ~ARRAY_MARK_FLAG
;
3910 hash
= hash_string (ptr
, size_byte
) % obsize
;
3911 bucket
= AREF (obarray
, hash
);
3912 oblookup_last_bucket_number
= hash
;
3913 if (EQ (bucket
, make_number (0)))
3915 else if (!SYMBOLP (bucket
))
3916 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3918 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3920 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3921 && SCHARS (SYMBOL_NAME (tail
)) == size
3922 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3924 else if (XSYMBOL (tail
)->next
== 0)
3927 XSETINT (tem
, hash
);
3932 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3935 register Lisp_Object tail
;
3936 CHECK_VECTOR (obarray
);
3937 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3939 tail
= AREF (obarray
, i
);
3944 if (XSYMBOL (tail
)->next
== 0)
3946 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3952 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3954 call1 (function
, sym
);
3957 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3958 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3959 OBARRAY defaults to the value of `obarray'. */)
3960 (Lisp_Object function
, Lisp_Object obarray
)
3962 if (NILP (obarray
)) obarray
= Vobarray
;
3963 obarray
= check_obarray (obarray
);
3965 map_obarray (obarray
, mapatoms_1
, function
);
3969 #define OBARRAY_SIZE 1511
3974 Lisp_Object oblength
;
3975 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3977 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3979 Vobarray
= Fmake_vector (oblength
, make_number (0));
3980 initial_obarray
= Vobarray
;
3981 staticpro (&initial_obarray
);
3983 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
3984 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3985 NILP (Vpurify_flag) check in intern_c_string. */
3986 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3987 Qnil
= intern_c_string ("nil");
3989 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3990 so those two need to be fixed manually. */
3991 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3992 set_symbol_function (Qunbound
, Qnil
);
3993 set_symbol_plist (Qunbound
, Qnil
);
3994 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3995 XSYMBOL (Qnil
)->constant
= 1;
3996 XSYMBOL (Qnil
)->declared_special
= 1;
3997 set_symbol_plist (Qnil
, Qnil
);
3998 set_symbol_function (Qnil
, Qnil
);
4000 Qt
= intern_c_string ("t");
4001 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4002 XSYMBOL (Qnil
)->declared_special
= 1;
4003 XSYMBOL (Qt
)->constant
= 1;
4005 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4008 DEFSYM (Qvariable_documentation
, "variable-documentation");
4010 read_buffer
= xmalloc (size
);
4011 read_buffer_size
= size
;
4015 defsubr (struct Lisp_Subr
*sname
)
4017 Lisp_Object sym
, tem
;
4018 sym
= intern_c_string (sname
->symbol_name
);
4019 XSETPVECTYPE (sname
, PVEC_SUBR
);
4020 XSETSUBR (tem
, sname
);
4021 set_symbol_function (sym
, tem
);
4024 #ifdef NOTDEF /* Use fset in subr.el now! */
4026 defalias (struct Lisp_Subr
*sname
, char *string
)
4029 sym
= intern (string
);
4030 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4034 /* Define an "integer variable"; a symbol whose value is forwarded to a
4035 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4036 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4038 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4039 const char *namestring
, EMACS_INT
*address
)
4042 sym
= intern_c_string (namestring
);
4043 i_fwd
->type
= Lisp_Fwd_Int
;
4044 i_fwd
->intvar
= address
;
4045 XSYMBOL (sym
)->declared_special
= 1;
4046 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4047 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4050 /* Similar but define a variable whose value is t if address contains 1,
4051 nil if address contains 0. */
4053 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4054 const char *namestring
, bool *address
)
4057 sym
= intern_c_string (namestring
);
4058 b_fwd
->type
= Lisp_Fwd_Bool
;
4059 b_fwd
->boolvar
= address
;
4060 XSYMBOL (sym
)->declared_special
= 1;
4061 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4062 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4063 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4066 /* Similar but define a variable whose value is the Lisp Object stored
4067 at address. Two versions: with and without gc-marking of the C
4068 variable. The nopro version is used when that variable will be
4069 gc-marked for some other reason, since marking the same slot twice
4070 can cause trouble with strings. */
4072 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4073 const char *namestring
, Lisp_Object
*address
)
4076 sym
= intern_c_string (namestring
);
4077 o_fwd
->type
= Lisp_Fwd_Obj
;
4078 o_fwd
->objvar
= address
;
4079 XSYMBOL (sym
)->declared_special
= 1;
4080 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4081 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4085 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4086 const char *namestring
, Lisp_Object
*address
)
4088 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4089 staticpro (address
);
4092 /* Similar but define a variable whose value is the Lisp Object stored
4093 at a particular offset in the current kboard object. */
4096 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4097 const char *namestring
, int offset
)
4100 sym
= intern_c_string (namestring
);
4101 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4102 ko_fwd
->offset
= offset
;
4103 XSYMBOL (sym
)->declared_special
= 1;
4104 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4105 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4108 /* Check that the elements of lpath exist. */
4111 load_path_check (Lisp_Object lpath
)
4113 Lisp_Object path_tail
;
4115 /* The only elements that might not exist are those from
4116 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4118 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4120 Lisp_Object dirfile
;
4121 dirfile
= Fcar (path_tail
);
4122 if (STRINGP (dirfile
))
4124 dirfile
= Fdirectory_file_name (dirfile
);
4125 if (! file_accessible_directory_p (SSDATA (dirfile
)))
4126 dir_warning ("Lisp directory", XCAR (path_tail
));
4131 /* Record the value of load-path used at the start of dumping
4132 so we can see if the site changed it later during dumping. */
4133 static Lisp_Object dump_path
;
4135 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4136 This does not include the standard site-lisp directories
4137 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4138 but it does (unless no_site_lisp is set) include site-lisp
4139 directories in the source/build directories if those exist and we
4140 are running uninstalled.
4142 Uses the following logic:
4143 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4144 The remainder is what happens when dumping works:
4145 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4146 Otherwise use PATH_LOADSEARCH.
4148 If !initialized, then just set dump_path and return PATH_DUMPLOADSEARCH.
4149 If initialized, then if Vload_path != dump_path, return just Vload_path.
4150 (Presumably the load-path has already been changed by something.
4151 This can only be from a site-load file during dumping.)
4152 If Vinstallation_directory is not nil (ie, running uninstalled):
4153 If installation-dir/lisp exists and not already a member,
4154 we must be running uninstalled. Reset the load-path
4155 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4156 refers to the eventual installation directories. Since we
4157 are not yet installed, we should not use them, even if they exist.)
4158 If installation-dir/lisp does not exist, just add dump_path at the
4160 Add installation-dir/leim (if exists and not already a member) at the front.
4161 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4162 and not already a member) at the front.
4163 If installation-dir != source-dir (ie running an uninstalled,
4164 out-of-tree build) AND install-dir/src/Makefile exists BUT
4165 install-dir/src/Makefile.in does NOT exist (this is a sanity
4166 check), then repeat the above steps for source-dir/lisp,
4170 load_path_default (bool ignore_existing
)
4172 Lisp_Object lpath
= Qnil
;
4177 const char *loadpath
= ns_load_path ();
4180 normal
= PATH_LOADSEARCH
;
4182 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4184 lpath
= decode_env_path (0, normal
, 0);
4187 #else /* !CANNOT_DUMP */
4189 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4191 /* In a dumped Emacs, we normally reset the value of Vload_path using
4192 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4193 the source directory, instead of the path of the installed elisp
4194 libraries. However, if it appears that Vload_path has already been
4195 changed from the default that was saved before dumping, don't
4196 change it further. Changes can only be due to EMACSLOADPATH, or
4197 site-lisp files that were processed during dumping. */
4200 if (!ignore_existing
&& NILP (Fequal (dump_path
, Vload_path
)))
4202 /* Do not make any changes. */
4208 const char *loadpath
= ns_load_path ();
4209 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4211 lpath
= decode_env_path (0, normal
, 0);
4213 if (!NILP (Vinstallation_directory
))
4215 Lisp_Object tem
, tem1
;
4217 /* Add to the path the lisp subdir of the installation
4218 dir, if it is accessible. Note: in out-of-tree builds,
4219 this directory is empty save for Makefile. */
4220 tem
= Fexpand_file_name (build_string ("lisp"),
4221 Vinstallation_directory
);
4222 tem1
= Ffile_accessible_directory_p (tem
);
4225 if (NILP (Fmember (tem
, lpath
)))
4227 /* We are running uninstalled. The default load-path
4228 points to the eventual installed lisp, leim
4229 directories. We should not use those now, even
4230 if they exist, so start over from a clean slate. */
4231 lpath
= list1 (tem
);
4235 /* That dir doesn't exist, so add the build-time
4236 Lisp dirs instead. */
4237 lpath
= nconc2 (lpath
, dump_path
);
4239 /* Add leim under the installation dir, if it is accessible. */
4240 tem
= Fexpand_file_name (build_string ("leim"),
4241 Vinstallation_directory
);
4242 tem1
= Ffile_accessible_directory_p (tem
);
4245 if (NILP (Fmember (tem
, lpath
)))
4246 lpath
= Fcons (tem
, lpath
);
4249 /* Add site-lisp under the installation dir, if it exists. */
4252 tem
= Fexpand_file_name (build_string ("site-lisp"),
4253 Vinstallation_directory
);
4254 tem1
= Ffile_accessible_directory_p (tem
);
4257 if (NILP (Fmember (tem
, lpath
)))
4258 lpath
= Fcons (tem
, lpath
);
4262 /* If Emacs was not built in the source directory,
4263 and it is run from where it was built, add to load-path
4264 the lisp, leim and site-lisp dirs under that directory. */
4266 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4270 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4271 Vinstallation_directory
);
4272 tem1
= Ffile_exists_p (tem
);
4274 /* Don't be fooled if they moved the entire source tree
4275 AFTER dumping Emacs. If the build directory is indeed
4276 different from the source dir, src/Makefile.in and
4277 src/Makefile will not be found together. */
4278 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4279 Vinstallation_directory
);
4280 tem2
= Ffile_exists_p (tem
);
4281 if (!NILP (tem1
) && NILP (tem2
))
4283 tem
= Fexpand_file_name (build_string ("lisp"),
4286 if (NILP (Fmember (tem
, lpath
)))
4287 lpath
= Fcons (tem
, lpath
);
4289 tem
= Fexpand_file_name (build_string ("leim"),
4292 if (NILP (Fmember (tem
, lpath
)))
4293 lpath
= Fcons (tem
, lpath
);
4297 tem
= Fexpand_file_name (build_string ("site-lisp"),
4299 tem1
= Ffile_accessible_directory_p (tem
);
4302 if (NILP (Fmember (tem
, lpath
)))
4303 lpath
= Fcons (tem
, lpath
);
4307 } /* Vinstallation_directory != Vsource_directory */
4309 } /* if Vinstallation_directory */
4311 } /* if dump_path == Vload_path */
4313 else /* !initialized */
4315 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4316 source directory. We used to add ../lisp (ie the lisp dir in
4317 the build directory) at the front here, but that caused trouble
4318 because it was copied from dump_path into Vload_path, above,
4319 when Vinstallation_directory was non-nil. It should not be
4320 necessary, since in out of tree builds lisp/ is empty, save
4322 lpath
= decode_env_path (0, normal
, 0);
4325 #endif /* !CANNOT_DUMP */
4333 /* First, set Vload_path. */
4335 /* We explicitly ignore EMACSLOADPATH when dumping. */
4336 if (NILP (Vpurify_flag
) && egetenv ("EMACSLOADPATH"))
4338 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4340 /* Check (non-nil) user-supplied elements. */
4341 load_path_check (Vload_path
);
4343 /* Replace any nil elements from the environment with the default. */
4344 if (Fmemq (Qnil
, Vload_path
))
4346 Lisp_Object lpath
= Vload_path
;
4347 Lisp_Object elem
, default_lpath
= load_path_default (1);
4349 /* Check defaults, before adding site-lisp. */
4350 load_path_check (default_lpath
);
4352 /* Add the site-lisp directories to the front of the default. */
4355 Lisp_Object sitelisp
;
4356 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4357 if (! NILP (sitelisp
))
4358 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4363 /* Replace nils from EMACSLOADPATH by default. */
4364 while (CONSP (lpath
))
4367 elem
= XCAR (lpath
);
4368 lpath
= XCDR (lpath
);
4369 arg
[0] = Vload_path
;
4370 arg
[1] = NILP (elem
) ? default_lpath
: Fcons (elem
, Qnil
);
4371 Vload_path
= Fappend (2, arg
);
4373 } /* Fmemq (Qnil, Vload_path) */
4375 else /* Vpurify_flag || !EMACSLOADPATH */
4377 Vload_path
= load_path_default (0);
4379 /* Check before adding site-lisp directories.
4380 The install should have created them, but they are not
4381 required, so no need to warn if they are absent.
4382 Or we might be running before installation. */
4383 load_path_check (Vload_path
);
4385 /* Add the site-lisp directories at the front, unless the
4386 load-path has somehow already been changed (this can only be
4387 from a site-load file during dumping?) from the dumped value.
4388 FIXME? Should we ignore any dump_path changes? */
4389 if (initialized
&& !no_site_lisp
&&
4390 ! NILP (Fequal (dump_path
, Vload_path
)))
4392 Lisp_Object sitelisp
;
4393 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4394 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4396 } /* !Vpurify_flag && EMACSLOADPATH */
4400 load_in_progress
= 0;
4401 Vload_file_name
= Qnil
;
4402 Vstandard_input
= Qt
;
4403 Vloads_in_progress
= Qnil
;
4406 /* Print a warning that directory intended for use USE and with name
4407 DIRNAME cannot be accessed. On entry, errno should correspond to
4408 the access failure. Print the warning on stderr and put it in
4412 dir_warning (char const *use
, Lisp_Object dirname
)
4414 static char const format
[] = "Warning: %s `%s': %s\n";
4415 int access_errno
= errno
;
4416 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4418 /* Don't log the warning before we've initialized!! */
4421 char const *diagnostic
= emacs_strerror (access_errno
);
4423 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4424 + strlen (use
) + SBYTES (dirname
)
4425 + strlen (diagnostic
));
4426 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4428 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4434 syms_of_lread (void)
4437 defsubr (&Sread_from_string
);
4439 defsubr (&Sintern_soft
);
4440 defsubr (&Sunintern
);
4441 defsubr (&Sget_load_suffixes
);
4443 defsubr (&Seval_buffer
);
4444 defsubr (&Seval_region
);
4445 defsubr (&Sread_char
);
4446 defsubr (&Sread_char_exclusive
);
4447 defsubr (&Sread_event
);
4448 defsubr (&Sget_file_char
);
4449 defsubr (&Smapatoms
);
4450 defsubr (&Slocate_file_internal
);
4452 DEFVAR_LISP ("obarray", Vobarray
,
4453 doc
: /* Symbol table for use by `intern' and `read'.
4454 It is a vector whose length ought to be prime for best results.
4455 The vector's contents don't make sense if examined from Lisp programs;
4456 to find all the symbols in an obarray, use `mapatoms'. */);
4458 DEFVAR_LISP ("values", Vvalues
,
4459 doc
: /* List of values of all expressions which were read, evaluated and printed.
4460 Order is reverse chronological. */);
4461 XSYMBOL (intern ("values"))->declared_special
= 0;
4463 DEFVAR_LISP ("standard-input", Vstandard_input
,
4464 doc
: /* Stream for read to get input from.
4465 See documentation of `read' for possible values. */);
4466 Vstandard_input
= Qt
;
4468 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4469 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4471 If this variable is a buffer, then only forms read from that buffer
4472 will be added to `read-symbol-positions-list'.
4473 If this variable is t, then all read forms will be added.
4474 The effect of all other values other than nil are not currently
4475 defined, although they may be in the future.
4477 The positions are relative to the last call to `read' or
4478 `read-from-string'. It is probably a bad idea to set this variable at
4479 the toplevel; bind it instead. */);
4480 Vread_with_symbol_positions
= Qnil
;
4482 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4483 doc
: /* A list mapping read symbols to their positions.
4484 This variable is modified during calls to `read' or
4485 `read-from-string', but only when `read-with-symbol-positions' is
4488 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4489 CHAR-POSITION is an integer giving the offset of that occurrence of the
4490 symbol from the position where `read' or `read-from-string' started.
4492 Note that a symbol will appear multiple times in this list, if it was
4493 read multiple times. The list is in the same order as the symbols
4495 Vread_symbol_positions_list
= Qnil
;
4497 DEFVAR_LISP ("read-circle", Vread_circle
,
4498 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4501 DEFVAR_LISP ("load-path", Vload_path
,
4502 doc
: /* List of directories to search for files to load.
4503 Each element is a string (directory name) or nil (meaning `default-directory').
4504 Initialized during startup as described in Info node `(elisp)Library Search'. */);
4506 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4507 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4508 This list should not include the empty string.
4509 `load' and related functions try to append these suffixes, in order,
4510 to the specified file name if a Lisp suffix is allowed or required. */);
4511 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4512 build_pure_c_string (".el"));
4513 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4514 doc
: /* List of suffixes that indicate representations of \
4516 This list should normally start with the empty string.
4518 Enabling Auto Compression mode appends the suffixes in
4519 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4520 mode removes them again. `load' and related functions use this list to
4521 determine whether they should look for compressed versions of a file
4522 and, if so, which suffixes they should try to append to the file name
4523 in order to do so. However, if you want to customize which suffixes
4524 the loading functions recognize as compression suffixes, you should
4525 customize `jka-compr-load-suffixes' rather than the present variable. */);
4526 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4528 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4529 doc
: /* Non-nil if inside of `load'. */);
4530 DEFSYM (Qload_in_progress
, "load-in-progress");
4532 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4533 doc
: /* An alist of functions to be evalled when particular files are loaded.
4534 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4536 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4537 a symbol \(a feature name).
4539 When `load' is run and the file-name argument matches an element's
4540 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4541 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4543 An error in FORMS does not undo the load, but does prevent execution of
4544 the rest of the FORMS. */);
4545 Vafter_load_alist
= Qnil
;
4547 DEFVAR_LISP ("load-history", Vload_history
,
4548 doc
: /* Alist mapping loaded file names to symbols and features.
4549 Each alist element should be a list (FILE-NAME ENTRIES...), where
4550 FILE-NAME is the name of a file that has been loaded into Emacs.
4551 The file name is absolute and true (i.e. it doesn't contain symlinks).
4552 As an exception, one of the alist elements may have FILE-NAME nil,
4553 for symbols and features not associated with any file.
4555 The remaining ENTRIES in the alist element describe the functions and
4556 variables defined in that file, the features provided, and the
4557 features required. Each entry has the form `(provide . FEATURE)',
4558 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4559 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4560 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4561 autoload before this file redefined it as a function. In addition,
4562 entries may also be single symbols, which means that SYMBOL was
4563 defined by `defvar' or `defconst'.
4565 During preloading, the file name recorded is relative to the main Lisp
4566 directory. These file names are converted to absolute at startup. */);
4567 Vload_history
= Qnil
;
4569 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4570 doc
: /* Full name of file being loaded by `load'. */);
4571 Vload_file_name
= Qnil
;
4573 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4574 doc
: /* File name, including directory, of user's initialization file.
4575 If the file loaded had extension `.elc', and the corresponding source file
4576 exists, this variable contains the name of source file, suitable for use
4577 by functions like `custom-save-all' which edit the init file.
4578 While Emacs loads and evaluates the init file, value is the real name
4579 of the file, regardless of whether or not it has the `.elc' extension. */);
4580 Vuser_init_file
= Qnil
;
4582 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4583 doc
: /* Used for internal purposes by `load'. */);
4584 Vcurrent_load_list
= Qnil
;
4586 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4587 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4588 The default is nil, which means use the function `read'. */);
4589 Vload_read_function
= Qnil
;
4591 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4592 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4593 The value should be a function for doing code conversion before
4594 reading a source file. It can also be nil, in which case loading is
4595 done without any code conversion.
4597 If the value is a function, it is called with four arguments,
4598 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4599 the file to load, FILE is the non-absolute name (for messages etc.),
4600 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4601 `load'. The function should return t if the file was loaded. */);
4602 Vload_source_file_function
= Qnil
;
4604 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4605 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4606 This is useful when the file being loaded is a temporary copy. */);
4607 load_force_doc_strings
= 0;
4609 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4610 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4611 This is normally bound by `load' and `eval-buffer' to control `read',
4612 and is not meant for users to change. */);
4613 load_convert_to_unibyte
= 0;
4615 DEFVAR_LISP ("source-directory", Vsource_directory
,
4616 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4617 You cannot count on them to still be there! */);
4619 = Fexpand_file_name (build_string ("../"),
4620 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4622 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4623 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4624 Vpreloaded_file_list
= Qnil
;
4626 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4627 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4628 Vbyte_boolean_vars
= Qnil
;
4630 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4631 doc
: /* Non-nil means load dangerous compiled Lisp files.
4632 Some versions of XEmacs use different byte codes than Emacs. These
4633 incompatible byte codes can make Emacs crash when it tries to execute
4635 load_dangerous_libraries
= 0;
4637 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4638 doc
: /* Non-nil means force printing messages when loading Lisp files.
4639 This overrides the value of the NOMESSAGE argument to `load'. */);
4640 force_load_messages
= 0;
4642 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4643 doc
: /* Regular expression matching safe to load compiled Lisp files.
4644 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4645 from the file, and matches them against this regular expression.
4646 When the regular expression matches, the file is considered to be safe
4647 to load. See also `load-dangerous-libraries'. */);
4648 Vbytecomp_version_regexp
4649 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4651 DEFSYM (Qlexical_binding
, "lexical-binding");
4652 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4653 doc
: /* Whether to use lexical binding when evaluating code.
4654 Non-nil means that the code in the current buffer should be evaluated
4655 with lexical binding.
4656 This variable is automatically set from the file variables of an
4657 interpreted Lisp file read using `load'. Unlike other file local
4658 variables, this must be set in the first line of a file. */);
4659 Vlexical_binding
= Qnil
;
4660 Fmake_variable_buffer_local (Qlexical_binding
);
4662 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4663 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4664 Veval_buffer_list
= Qnil
;
4666 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4667 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4668 Vold_style_backquotes
= Qnil
;
4669 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4671 /* Vsource_directory was initialized in init_lread. */
4673 DEFSYM (Qcurrent_load_list
, "current-load-list");
4674 DEFSYM (Qstandard_input
, "standard-input");
4675 DEFSYM (Qread_char
, "read-char");
4676 DEFSYM (Qget_file_char
, "get-file-char");
4677 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4678 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4680 DEFSYM (Qbackquote
, "`");
4681 DEFSYM (Qcomma
, ",");
4682 DEFSYM (Qcomma_at
, ",@");
4683 DEFSYM (Qcomma_dot
, ",.");
4685 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4686 DEFSYM (Qascii_character
, "ascii-character");
4687 DEFSYM (Qfunction
, "function");
4688 DEFSYM (Qload
, "load");
4689 DEFSYM (Qload_file_name
, "load-file-name");
4690 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4691 DEFSYM (Qfile_truename
, "file-truename");
4692 DEFSYM (Qdir_ok
, "dir-ok");
4693 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4695 staticpro (&dump_path
);
4697 staticpro (&read_objects
);
4698 read_objects
= Qnil
;
4699 staticpro (&seen_list
);
4702 Vloads_in_progress
= Qnil
;
4703 staticpro (&Vloads_in_progress
);
4705 DEFSYM (Qhash_table
, "hash-table");
4706 DEFSYM (Qdata
, "data");
4707 DEFSYM (Qtest
, "test");
4708 DEFSYM (Qsize
, "size");
4709 DEFSYM (Qweakness
, "weakness");
4710 DEFSYM (Qrehash_size
, "rehash-size");
4711 DEFSYM (Qrehash_threshold
, "rehash-threshold");