1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2013 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
28 #include <limits.h> /* For CHAR_BIT. */
29 #include <stat-time.h>
31 #include "intervals.h"
32 #include "character.h"
40 #include "termhooks.h"
42 #include "blockinput.h"
56 #endif /* HAVE_SETLOCALE */
61 #define file_offset off_t
62 #define file_tell ftello
64 #define file_offset long
65 #define file_tell ftell
68 /* Hash table read constants. */
69 static Lisp_Object Qhash_table
, Qdata
;
70 static Lisp_Object Qtest
, Qsize
;
71 static Lisp_Object Qweakness
;
72 static Lisp_Object Qrehash_size
;
73 static Lisp_Object Qrehash_threshold
;
75 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
76 Lisp_Object Qstandard_input
;
77 Lisp_Object Qvariable_documentation
;
78 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
79 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
80 static Lisp_Object Qinhibit_file_name_operation
;
81 static Lisp_Object Qeval_buffer_list
;
82 Lisp_Object Qlexical_binding
;
83 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
85 /* Used instead of Qget_file_char while loading *.elc files compiled
86 by Emacs 21 or older. */
87 static Lisp_Object Qget_emacs_mule_file_char
;
89 static Lisp_Object Qload_force_doc_strings
;
91 static Lisp_Object Qload_in_progress
;
93 /* The association list of objects read with the #n=object form.
94 Each member of the list has the form (n . object), and is used to
95 look up the object for the corresponding #n# construct.
96 It must be set to nil before all top-level calls to read0. */
97 static Lisp_Object read_objects
;
99 /* List of descriptors now open for Fload. */
100 static Lisp_Object load_descriptor_list
;
102 /* File for get_file_char to read from. Use by load. */
103 static FILE *instream
;
105 /* For use within read-from-string (this reader is non-reentrant!!) */
106 static ptrdiff_t read_from_string_index
;
107 static ptrdiff_t read_from_string_index_byte
;
108 static ptrdiff_t read_from_string_limit
;
110 /* Number of characters read in the current call to Fread or
111 Fread_from_string. */
112 static EMACS_INT readchar_count
;
114 /* This contains the last string skipped with #@. */
115 static char *saved_doc_string
;
116 /* Length of buffer allocated in saved_doc_string. */
117 static ptrdiff_t saved_doc_string_size
;
118 /* Length of actual data in saved_doc_string. */
119 static ptrdiff_t saved_doc_string_length
;
120 /* This is the file position that string came from. */
121 static file_offset saved_doc_string_position
;
123 /* This contains the previous string skipped with #@.
124 We copy it from saved_doc_string when a new string
125 is put in saved_doc_string. */
126 static char *prev_saved_doc_string
;
127 /* Length of buffer allocated in prev_saved_doc_string. */
128 static ptrdiff_t prev_saved_doc_string_size
;
129 /* Length of actual data in prev_saved_doc_string. */
130 static ptrdiff_t prev_saved_doc_string_length
;
131 /* This is the file position that string came from. */
132 static file_offset prev_saved_doc_string_position
;
134 /* True means inside a new-style backquote
135 with no surrounding parentheses.
136 Fread initializes this to false, so we need not specbind it
137 or worry about what happens to it when there is an error. */
138 static bool new_backquote_flag
;
139 static Lisp_Object Qold_style_backquotes
;
141 /* A list of file names for files being loaded in Fload. Used to
142 check for recursive loads. */
144 static Lisp_Object Vloads_in_progress
;
146 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
149 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
150 Lisp_Object
, Lisp_Object
,
151 Lisp_Object
, Lisp_Object
);
152 static Lisp_Object
load_unwind (Lisp_Object
);
153 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
155 /* Functions that read one byte from the current source READCHARFUN
156 or unreads one byte. If the integer argument C is -1, it returns
157 one read byte, or -1 when there's no more byte in the source. If C
158 is 0 or positive, it unreads C, and the return value is not
161 static int readbyte_for_lambda (int, Lisp_Object
);
162 static int readbyte_from_file (int, Lisp_Object
);
163 static int readbyte_from_string (int, Lisp_Object
);
165 /* Handle unreading and rereading of characters.
166 Write READCHAR to read a character,
167 UNREAD(c) to unread c to be read again.
169 These macros correctly read/unread multibyte characters. */
171 #define READCHAR readchar (readcharfun, NULL)
172 #define UNREAD(c) unreadchar (readcharfun, c)
174 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
175 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
177 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
178 Qlambda, or a cons, we use this to keep an unread character because
179 a file stream can't handle multibyte-char unreading. The value -1
180 means that there's no unread character. */
181 static int unread_char
;
184 readchar (Lisp_Object readcharfun
, bool *multibyte
)
188 int (*readbyte
) (int, Lisp_Object
);
189 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
191 bool emacs_mule_encoding
= 0;
198 if (BUFFERP (readcharfun
))
200 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
202 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
204 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
207 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
209 /* Fetch the character code from the buffer. */
210 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
211 BUF_INC_POS (inbuffer
, pt_byte
);
218 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
219 if (! ASCII_BYTE_P (c
))
220 c
= BYTE8_TO_CHAR (c
);
223 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
227 if (MARKERP (readcharfun
))
229 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
231 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
233 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
236 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
238 /* Fetch the character code from the buffer. */
239 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
240 BUF_INC_POS (inbuffer
, bytepos
);
247 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
248 if (! ASCII_BYTE_P (c
))
249 c
= BYTE8_TO_CHAR (c
);
253 XMARKER (readcharfun
)->bytepos
= bytepos
;
254 XMARKER (readcharfun
)->charpos
++;
259 if (EQ (readcharfun
, Qlambda
))
261 readbyte
= readbyte_for_lambda
;
265 if (EQ (readcharfun
, Qget_file_char
))
267 readbyte
= readbyte_from_file
;
271 if (STRINGP (readcharfun
))
273 if (read_from_string_index
>= read_from_string_limit
)
275 else if (STRING_MULTIBYTE (readcharfun
))
279 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
280 read_from_string_index
,
281 read_from_string_index_byte
);
285 c
= SREF (readcharfun
, read_from_string_index_byte
);
286 read_from_string_index
++;
287 read_from_string_index_byte
++;
292 if (CONSP (readcharfun
))
294 /* This is the case that read_vector is reading from a unibyte
295 string that contains a byte sequence previously skipped
296 because of #@NUMBER. The car part of readcharfun is that
297 string, and the cdr part is a value of readcharfun given to
299 readbyte
= readbyte_from_string
;
300 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
301 emacs_mule_encoding
= 1;
305 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
307 readbyte
= readbyte_from_file
;
308 emacs_mule_encoding
= 1;
312 tem
= call0 (readcharfun
);
319 if (unread_char
>= 0)
325 c
= (*readbyte
) (-1, readcharfun
);
330 if (ASCII_BYTE_P (c
))
332 if (emacs_mule_encoding
)
333 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
336 len
= BYTES_BY_CHAR_HEAD (c
);
339 c
= (*readbyte
) (-1, readcharfun
);
340 if (c
< 0 || ! TRAILING_CODE_P (c
))
343 (*readbyte
) (buf
[i
], readcharfun
);
344 return BYTE8_TO_CHAR (buf
[0]);
348 return STRING_CHAR (buf
);
352 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
354 if (EQ (readcharfun
, Qget_file_char
)
355 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
357 block_input (); /* FIXME: Not sure if it's needed. */
358 fseek (instream
, n
, SEEK_CUR
);
362 { /* We're not reading directly from a file. In that case, it's difficult
363 to reliably count bytes, since these are usually meant for the file's
364 encoding, whereas we're now typically in the internal encoding.
365 But luckily, skip_dyn_bytes is used to skip over a single
366 dynamic-docstring (or dynamic byte-code) which is always quoted such
367 that \037 is the final char. */
371 } while (c
>= 0 && c
!= '\037');
375 /* Unread the character C in the way appropriate for the stream READCHARFUN.
376 If the stream is a user function, call it with the char as argument. */
379 unreadchar (Lisp_Object readcharfun
, int c
)
383 /* Don't back up the pointer if we're unreading the end-of-input mark,
384 since readchar didn't advance it when we read it. */
386 else if (BUFFERP (readcharfun
))
388 struct buffer
*b
= XBUFFER (readcharfun
);
389 ptrdiff_t charpos
= BUF_PT (b
);
390 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
392 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
393 BUF_DEC_POS (b
, bytepos
);
397 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
399 else if (MARKERP (readcharfun
))
401 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
402 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
404 XMARKER (readcharfun
)->charpos
--;
405 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
406 BUF_DEC_POS (b
, bytepos
);
410 XMARKER (readcharfun
)->bytepos
= bytepos
;
412 else if (STRINGP (readcharfun
))
414 read_from_string_index
--;
415 read_from_string_index_byte
416 = string_char_to_byte (readcharfun
, read_from_string_index
);
418 else if (CONSP (readcharfun
))
422 else if (EQ (readcharfun
, Qlambda
))
426 else if (EQ (readcharfun
, Qget_file_char
)
427 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
432 call1 (readcharfun
, make_number (c
));
436 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
438 return read_bytecode_char (c
>= 0);
443 readbyte_from_file (int c
, Lisp_Object readcharfun
)
448 ungetc (c
, instream
);
456 /* Interrupted reads have been observed while reading over the network. */
457 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
468 return (c
== EOF
? -1 : c
);
472 readbyte_from_string (int c
, Lisp_Object readcharfun
)
474 Lisp_Object string
= XCAR (readcharfun
);
478 read_from_string_index
--;
479 read_from_string_index_byte
480 = string_char_to_byte (string
, read_from_string_index
);
483 if (read_from_string_index
>= read_from_string_limit
)
486 FETCH_STRING_CHAR_ADVANCE (c
, string
,
487 read_from_string_index
,
488 read_from_string_index_byte
);
493 /* Read one non-ASCII character from INSTREAM. The character is
494 encoded in `emacs-mule' and the first byte is already read in
498 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
500 /* Emacs-mule coding uses at most 4-byte for one character. */
501 unsigned char buf
[4];
502 int len
= emacs_mule_bytes
[c
];
503 struct charset
*charset
;
508 /* C is not a valid leading-code of `emacs-mule'. */
509 return BYTE8_TO_CHAR (c
);
515 c
= (*readbyte
) (-1, readcharfun
);
519 (*readbyte
) (buf
[i
], readcharfun
);
520 return BYTE8_TO_CHAR (buf
[0]);
527 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
528 code
= buf
[1] & 0x7F;
532 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
533 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
535 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
536 code
= buf
[2] & 0x7F;
540 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
541 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
546 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
547 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
549 c
= DECODE_CHAR (charset
, code
);
551 Fsignal (Qinvalid_read_syntax
,
552 Fcons (build_string ("invalid multibyte form"), Qnil
));
557 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
559 static Lisp_Object
read0 (Lisp_Object
);
560 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
562 static Lisp_Object
read_list (bool, Lisp_Object
);
563 static Lisp_Object
read_vector (Lisp_Object
, bool);
565 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
567 static void substitute_object_in_subtree (Lisp_Object
,
569 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
572 /* Get a character from the tty. */
574 /* Read input events until we get one that's acceptable for our purposes.
576 If NO_SWITCH_FRAME, switch-frame events are stashed
577 until we get a character we like, and then stuffed into
580 If ASCII_REQUIRED, check function key events to see
581 if the unmodified version of the symbol has a Qascii_character
582 property, and use that character, if present.
584 If ERROR_NONASCII, signal an error if the input we
585 get isn't an ASCII character with modifiers. If it's false but
586 ASCII_REQUIRED is true, just re-read until we get an ASCII
589 If INPUT_METHOD, invoke the current input method
590 if the character warrants that.
592 If SECONDS is a number, wait that many seconds for input, and
593 return Qnil if no input arrives within that time. */
596 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
597 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
599 Lisp_Object val
, delayed_switch_frame
;
602 #ifdef HAVE_WINDOW_SYSTEM
603 if (display_hourglass_p
)
607 delayed_switch_frame
= Qnil
;
609 /* Compute timeout. */
610 if (NUMBERP (seconds
))
612 double duration
= extract_float (seconds
);
613 EMACS_TIME wait_time
= EMACS_TIME_FROM_DOUBLE (duration
);
614 end_time
= add_emacs_time (current_emacs_time (), wait_time
);
617 /* Read until we get an acceptable event. */
620 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
621 NUMBERP (seconds
) ? &end_time
: NULL
);
622 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
627 /* `switch-frame' events are put off until after the next ASCII
628 character. This is better than signaling an error just because
629 the last characters were typed to a separate minibuffer frame,
630 for example. Eventually, some code which can deal with
631 switch-frame events will read it and process it. */
633 && EVENT_HAS_PARAMETERS (val
)
634 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
636 delayed_switch_frame
= val
;
640 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
642 /* Convert certain symbols to their ASCII equivalents. */
645 Lisp_Object tem
, tem1
;
646 tem
= Fget (val
, Qevent_symbol_element_mask
);
649 tem1
= Fget (Fcar (tem
), Qascii_character
);
650 /* Merge this symbol's modifier bits
651 with the ASCII equivalent of its basic code. */
653 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
657 /* If we don't have a character now, deal with it appropriately. */
662 Vunread_command_events
= Fcons (val
, Qnil
);
663 error ("Non-character input-event");
670 if (! NILP (delayed_switch_frame
))
671 unread_switch_frame
= delayed_switch_frame
;
675 #ifdef HAVE_WINDOW_SYSTEM
676 if (display_hourglass_p
)
685 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
686 doc
: /* Read a character from the command input (keyboard or macro).
687 It is returned as a number.
688 If the character has modifiers, they are resolved and reflected to the
689 character code if possible (e.g. C-SPC -> 0).
691 If the user generates an event which is not a character (i.e. a mouse
692 click or function key event), `read-char' signals an error. As an
693 exception, switch-frame events are put off until non-character events
695 If you want to read non-character events, or ignore them, call
696 `read-event' or `read-char-exclusive' instead.
698 If the optional argument PROMPT is non-nil, display that as a prompt.
699 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
700 input method is turned on in the current buffer, that input method
701 is used for reading a character.
702 If the optional argument SECONDS is non-nil, it should be a number
703 specifying the maximum number of seconds to wait for input. If no
704 input arrives in that time, return nil. SECONDS may be a
705 floating-point value. */)
706 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
711 message_with_string ("%s", prompt
, 0);
712 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
714 return (NILP (val
) ? Qnil
715 : make_number (char_resolve_modifier_mask (XINT (val
))));
718 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
719 doc
: /* Read an event object from the input stream.
720 If the optional argument PROMPT is non-nil, display that as a prompt.
721 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
722 input method is turned on in the current buffer, that input method
723 is used for reading a character.
724 If the optional argument SECONDS is non-nil, it should be a number
725 specifying the maximum number of seconds to wait for input. If no
726 input arrives in that time, return nil. SECONDS may be a
727 floating-point value. */)
728 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
731 message_with_string ("%s", prompt
, 0);
732 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
735 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
736 doc
: /* Read a character from the command input (keyboard or macro).
737 It is returned as a number. Non-character events are ignored.
738 If the character has modifiers, they are resolved and reflected to the
739 character code if possible (e.g. C-SPC -> 0).
741 If the optional argument PROMPT is non-nil, display that as a prompt.
742 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
743 input method is turned on in the current buffer, that input method
744 is used for reading a character.
745 If the optional argument SECONDS is non-nil, it should be a number
746 specifying the maximum number of seconds to wait for input. If no
747 input arrives in that time, return nil. SECONDS may be a
748 floating-point value. */)
749 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
754 message_with_string ("%s", prompt
, 0);
756 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
758 return (NILP (val
) ? Qnil
759 : make_number (char_resolve_modifier_mask (XINT (val
))));
762 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
763 doc
: /* Don't use this yourself. */)
766 register Lisp_Object val
;
768 XSETINT (val
, getc (instream
));
776 /* Return true if the lisp code read using READCHARFUN defines a non-nil
777 `lexical-binding' file variable. After returning, the stream is
778 positioned following the first line, if it is a comment or #! line,
779 otherwise nothing is read. */
782 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
795 while (ch
!= '\n' && ch
!= EOF
)
797 if (ch
== '\n') ch
= READCHAR
;
798 /* It is OK to leave the position after a #! line, since
799 that is what read1 does. */
803 /* The first line isn't a comment, just give up. */
809 /* Look for an appropriate file-variable in the first line. */
813 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
814 } beg_end_state
= NOMINAL
;
815 bool in_file_vars
= 0;
817 #define UPDATE_BEG_END_STATE(ch) \
818 if (beg_end_state == NOMINAL) \
819 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
820 else if (beg_end_state == AFTER_FIRST_DASH) \
821 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
822 else if (beg_end_state == AFTER_ASTERIX) \
825 in_file_vars = !in_file_vars; \
826 beg_end_state = NOMINAL; \
829 /* Skip until we get to the file vars, if any. */
833 UPDATE_BEG_END_STATE (ch
);
835 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
839 char var
[100], val
[100];
844 /* Read a variable name. */
845 while (ch
== ' ' || ch
== '\t')
849 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
851 if (i
< sizeof var
- 1)
853 UPDATE_BEG_END_STATE (ch
);
857 /* Stop scanning if no colon was found before end marker. */
858 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
861 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
867 /* Read a variable value. */
870 while (ch
== ' ' || ch
== '\t')
874 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
876 if (i
< sizeof val
- 1)
878 UPDATE_BEG_END_STATE (ch
);
882 /* The value was terminated by an end-marker, which remove. */
884 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
888 if (strcmp (var
, "lexical-binding") == 0)
891 rv
= (strcmp (val
, "nil") != 0);
897 while (ch
!= '\n' && ch
!= EOF
)
904 /* Value is a version number of byte compiled code if the file
905 associated with file descriptor FD is a compiled Lisp file that's
906 safe to load. Only files compiled with Emacs are safe to load.
907 Files compiled with XEmacs can lead to a crash in Fbyte_code
908 because of an incompatible change in the byte compiler. */
911 safe_to_load_version (int fd
)
917 /* Read the first few bytes from the file, and look for a line
918 specifying the byte compiler version used. */
919 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
922 /* Skip to the next newline, skipping over the initial `ELC'
923 with NUL bytes following it, but note the version. */
924 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
929 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
930 buf
+ i
, nbytes
- i
) < 0)
934 lseek (fd
, 0, SEEK_SET
);
939 /* Callback for record_unwind_protect. Restore the old load list OLD,
940 after loading a file successfully. */
943 record_load_unwind (Lisp_Object old
)
945 return Vloads_in_progress
= old
;
948 /* This handler function is used via internal_condition_case_1. */
951 load_error_handler (Lisp_Object data
)
957 load_warn_old_style_backquotes (Lisp_Object file
)
959 if (!NILP (Vold_style_backquotes
))
962 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
969 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
970 doc
: /* Return the suffixes that `load' should try if a suffix is \
972 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
975 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
976 while (CONSP (suffixes
))
978 Lisp_Object exts
= Vload_file_rep_suffixes
;
979 suffix
= XCAR (suffixes
);
980 suffixes
= XCDR (suffixes
);
985 lst
= Fcons (concat2 (suffix
, ext
), lst
);
988 return Fnreverse (lst
);
991 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
992 doc
: /* Execute a file of Lisp code named FILE.
993 First try FILE with `.elc' appended, then try with `.el',
994 then try FILE unmodified (the exact suffixes in the exact order are
995 determined by `load-suffixes'). Environment variable references in
996 FILE are replaced with their values by calling `substitute-in-file-name'.
997 This function searches the directories in `load-path'.
999 If optional second arg NOERROR is non-nil,
1000 report no error if FILE doesn't exist.
1001 Print messages at start and end of loading unless
1002 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1004 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1005 suffixes `.elc' or `.el' to the specified name FILE.
1006 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1007 the suffix `.elc' or `.el'; don't accept just FILE unless
1008 it ends in one of those suffixes or includes a directory name.
1010 If NOSUFFIX is nil, then if a file could not be found, try looking for
1011 a different representation of the file by adding non-empty suffixes to
1012 its name, before trying another file. Emacs uses this feature to find
1013 compressed versions of files when Auto Compression mode is enabled.
1014 If NOSUFFIX is non-nil, disable this feature.
1016 The suffixes that this function tries out, when NOSUFFIX is nil, are
1017 given by the return value of `get-load-suffixes' and the values listed
1018 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1019 return value of `get-load-suffixes' is used, i.e. the file name is
1020 required to have a non-empty suffix.
1022 Loading a file records its definitions, and its `provide' and
1023 `require' calls, in an element of `load-history' whose
1024 car is the file name loaded. See `load-history'.
1026 While the file is in the process of being loaded, the variable
1027 `load-in-progress' is non-nil and the variable `load-file-name'
1028 is bound to the file's name.
1030 Return t if the file exists and loads successfully. */)
1031 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1033 register FILE *stream
;
1034 register int fd
= -1;
1035 ptrdiff_t count
= SPECPDL_INDEX ();
1036 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1037 Lisp_Object found
, efound
, hist_file_name
;
1038 /* True means we printed the ".el is newer" message. */
1040 /* True means we are loading a compiled file. */
1042 Lisp_Object handler
;
1044 const char *fmode
= "r";
1052 CHECK_STRING (file
);
1054 /* If file name is magic, call the handler. */
1055 /* This shouldn't be necessary any more now that `openp' handles it right.
1056 handler = Ffind_file_name_handler (file, Qload);
1057 if (!NILP (handler))
1058 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1060 /* Do this after the handler to avoid
1061 the need to gcpro noerror, nomessage and nosuffix.
1062 (Below here, we care only whether they are nil or not.)
1063 The presence of this call is the result of a historical accident:
1064 it used to be in every file-operation and when it got removed
1065 everywhere, it accidentally stayed here. Since then, enough people
1066 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1067 that it seemed risky to remove. */
1068 if (! NILP (noerror
))
1070 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1071 Qt
, load_error_handler
);
1076 file
= Fsubstitute_in_file_name (file
);
1079 /* Avoid weird lossage with null string as arg,
1080 since it would try to load a directory as a Lisp file. */
1081 if (SBYTES (file
) > 0)
1083 ptrdiff_t size
= SBYTES (file
);
1086 GCPRO2 (file
, found
);
1088 if (! NILP (must_suffix
))
1090 /* Don't insist on adding a suffix if FILE already ends with one. */
1092 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1095 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1097 /* Don't insist on adding a suffix
1098 if the argument includes a directory name. */
1099 else if (! NILP (Ffile_name_directory (file
)))
1103 fd
= openp (Vload_path
, file
,
1104 (!NILP (nosuffix
) ? Qnil
1105 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1106 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1107 tmp
[1] = Vload_file_rep_suffixes
,
1116 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1120 /* Tell startup.el whether or not we found the user's init file. */
1121 if (EQ (Qt
, Vuser_init_file
))
1122 Vuser_init_file
= found
;
1124 /* If FD is -2, that means openp found a magic file. */
1127 if (NILP (Fequal (found
, file
)))
1128 /* If FOUND is a different file name from FILE,
1129 find its handler even if we have already inhibited
1130 the `load' operation on FILE. */
1131 handler
= Ffind_file_name_handler (found
, Qt
);
1133 handler
= Ffind_file_name_handler (found
, Qload
);
1134 if (! NILP (handler
))
1135 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1137 /* Tramp has to deal with semi-broken packages that prepend
1138 drive letters to remote files. For that reason, Tramp
1139 catches file operations that test for file existence, which
1140 makes openp think X:/foo.elc files are remote. However,
1141 Tramp does not catch `load' operations for such files, so we
1142 end up with a nil as the `load' handler above. If we would
1143 continue with fd = -2, we will behave wrongly, and in
1144 particular try reading a .elc file in the "rt" mode instead
1145 of "rb". See bug #9311 for the results. To work around
1146 this, we try to open the file locally, and go with that if it
1148 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1154 /* Check if we're stuck in a recursive load cycle.
1156 2000-09-21: It's not possible to just check for the file loaded
1157 being a member of Vloads_in_progress. This fails because of the
1158 way the byte compiler currently works; `provide's are not
1159 evaluated, see font-lock.el/jit-lock.el as an example. This
1160 leads to a certain amount of ``normal'' recursion.
1162 Also, just loading a file recursively is not always an error in
1163 the general case; the second load may do something different. */
1167 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1168 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1172 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1174 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1175 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1178 /* All loads are by default dynamic, unless the file itself specifies
1179 otherwise using a file-variable in the first line. This is bound here
1180 so that it takes effect whether or not we use
1181 Vload_source_file_function. */
1182 specbind (Qlexical_binding
, Qnil
);
1184 /* Get the name for load-history. */
1185 hist_file_name
= (! NILP (Vpurify_flag
)
1186 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1187 tmp
[1] = Ffile_name_nondirectory (found
),
1193 /* Check for the presence of old-style quotes and warn about them. */
1194 specbind (Qold_style_backquotes
, Qnil
);
1195 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1197 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1198 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1199 /* Load .elc files directly, but not when they are
1200 remote and have no handler! */
1207 GCPRO3 (file
, found
, hist_file_name
);
1210 && ! (version
= safe_to_load_version (fd
)))
1213 if (!load_dangerous_libraries
)
1217 error ("File `%s' was not compiled in Emacs",
1220 else if (!NILP (nomessage
) && !force_load_messages
)
1221 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1226 efound
= ENCODE_FILE (found
);
1231 result
= stat (SSDATA (efound
), &s1
);
1234 SSET (efound
, SBYTES (efound
) - 1, 0);
1235 result
= stat (SSDATA (efound
), &s2
);
1236 SSET (efound
, SBYTES (efound
) - 1, 'c');
1240 && EMACS_TIME_LT (get_stat_mtime (&s1
), get_stat_mtime (&s2
)))
1242 /* Make the progress messages mention that source is newer. */
1245 /* If we won't print another message, mention this anyway. */
1246 if (!NILP (nomessage
) && !force_load_messages
)
1248 Lisp_Object msg_file
;
1249 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1250 message_with_string ("Source file `%s' newer than byte-compiled file",
1259 /* We are loading a source file (*.el). */
1260 if (!NILP (Vload_source_file_function
))
1266 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1267 NILP (noerror
) ? Qnil
: Qt
,
1268 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1269 return unbind_to (count
, val
);
1273 GCPRO3 (file
, found
, hist_file_name
);
1276 efound
= ENCODE_FILE (found
);
1277 /* If we somehow got here with fd == -2, meaning the file is deemed
1278 to be remote, don't even try to reopen the file locally; just
1279 force a failure instead. */
1283 stream
= fopen (SSDATA (efound
), fmode
);
1287 #else /* not WINDOWSNT */
1288 stream
= fdopen (fd
, fmode
);
1289 #endif /* not WINDOWSNT */
1293 error ("Failure to create stdio stream for %s", SDATA (file
));
1296 if (! NILP (Vpurify_flag
))
1297 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1299 if (NILP (nomessage
) || force_load_messages
)
1302 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1305 message_with_string ("Loading %s (source)...", file
, 1);
1307 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1309 else /* The typical case; compiled file newer than source file. */
1310 message_with_string ("Loading %s...", file
, 1);
1313 record_unwind_protect (load_unwind
, make_save_pointer (stream
));
1314 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1315 specbind (Qload_file_name
, found
);
1316 specbind (Qinhibit_file_name_operation
, Qnil
);
1317 load_descriptor_list
1318 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1319 specbind (Qload_in_progress
, Qt
);
1322 if (lisp_file_lexically_bound_p (Qget_file_char
))
1323 Fset (Qlexical_binding
, Qt
);
1325 if (! version
|| version
>= 22)
1326 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1327 0, Qnil
, Qnil
, Qnil
, Qnil
);
1330 /* We can't handle a file which was compiled with
1331 byte-compile-dynamic by older version of Emacs. */
1332 specbind (Qload_force_doc_strings
, Qt
);
1333 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1334 0, Qnil
, Qnil
, Qnil
, Qnil
);
1336 unbind_to (count
, Qnil
);
1338 /* Run any eval-after-load forms for this file. */
1339 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1340 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1344 xfree (saved_doc_string
);
1345 saved_doc_string
= 0;
1346 saved_doc_string_size
= 0;
1348 xfree (prev_saved_doc_string
);
1349 prev_saved_doc_string
= 0;
1350 prev_saved_doc_string_size
= 0;
1352 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1355 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1358 message_with_string ("Loading %s (source)...done", file
, 1);
1360 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1362 else /* The typical case; compiled file newer than source file. */
1363 message_with_string ("Loading %s...done", file
, 1);
1370 load_unwind (Lisp_Object arg
) /* Used as unwind-protect function in load. */
1372 FILE *stream
= XSAVE_POINTER (arg
, 0);
1383 load_descriptor_unwind (Lisp_Object oldlist
)
1385 load_descriptor_list
= oldlist
;
1389 /* Close all descriptors in use for Floads.
1390 This is used when starting a subprocess. */
1393 close_load_descs (void)
1397 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1398 emacs_close (XFASTINT (XCAR (tail
)));
1403 complete_filename_p (Lisp_Object pathname
)
1405 const unsigned char *s
= SDATA (pathname
);
1406 return (IS_DIRECTORY_SEP (s
[0])
1407 || (SCHARS (pathname
) > 2
1408 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1411 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1412 doc
: /* Search for FILENAME through PATH.
1413 Returns the file's name in absolute form, or nil if not found.
1414 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1415 file name when searching.
1416 If non-nil, PREDICATE is used instead of `file-readable-p'.
1417 PREDICATE can also be an integer to pass to the faccessat(2) function,
1418 in which case file-name-handlers are ignored.
1419 This function will normally skip directories, so if you want it to find
1420 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1421 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1424 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1425 if (NILP (predicate
) && fd
> 0)
1430 static Lisp_Object Qdir_ok
;
1432 /* Search for a file whose name is STR, looking in directories
1433 in the Lisp list PATH, and trying suffixes from SUFFIX.
1434 On success, returns a file descriptor. On failure, returns -1.
1436 SUFFIXES is a list of strings containing possible suffixes.
1437 The empty suffix is automatically added if the list is empty.
1439 PREDICATE non-nil means don't open the files,
1440 just look for one that satisfies the predicate. In this case,
1441 returns 1 on success. The predicate can be a lisp function or
1442 an integer to pass to `access' (in which case file-name-handlers
1445 If STOREPTR is nonzero, it points to a slot where the name of
1446 the file actually found should be stored as a Lisp string.
1447 nil is stored there on failure.
1449 If the file we find is remote, return -2
1450 but store the found remote file name in *STOREPTR. */
1453 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1455 ptrdiff_t fn_size
= 100;
1459 ptrdiff_t want_length
;
1460 Lisp_Object filename
;
1461 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1462 Lisp_Object string
, tail
, encoded_fn
;
1463 ptrdiff_t max_suffix_len
= 0;
1467 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1469 CHECK_STRING_CAR (tail
);
1470 max_suffix_len
= max (max_suffix_len
,
1471 SBYTES (XCAR (tail
)));
1474 string
= filename
= encoded_fn
= Qnil
;
1475 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1480 if (complete_filename_p (str
))
1483 for (; CONSP (path
); path
= XCDR (path
))
1485 filename
= Fexpand_file_name (str
, XCAR (path
));
1486 if (!complete_filename_p (filename
))
1487 /* If there are non-absolute elts in PATH (eg "."). */
1488 /* Of course, this could conceivably lose if luser sets
1489 default-directory to be something non-absolute... */
1491 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1492 if (!complete_filename_p (filename
))
1493 /* Give up on this path element! */
1497 /* Calculate maximum length of any filename made from
1498 this path element/specified file name and any possible suffix. */
1499 want_length
= max_suffix_len
+ SBYTES (filename
);
1500 if (fn_size
<= want_length
)
1501 fn
= alloca (fn_size
= 100 + want_length
);
1503 /* Loop over suffixes. */
1504 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1505 CONSP (tail
); tail
= XCDR (tail
))
1507 ptrdiff_t fnlen
, lsuffix
= SBYTES (XCAR (tail
));
1508 Lisp_Object handler
;
1510 /* Concatenate path element/specified name with the suffix.
1511 If the directory starts with /:, remove that. */
1512 int prefixlen
= ((SCHARS (filename
) > 2
1513 && SREF (filename
, 0) == '/'
1514 && SREF (filename
, 1) == ':')
1516 fnlen
= SBYTES (filename
) - prefixlen
;
1517 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1518 memcpy (fn
+ fnlen
, SDATA (XCAR (tail
)), lsuffix
+ 1);
1520 /* Check that the file exists and is not a directory. */
1521 /* We used to only check for handlers on non-absolute file names:
1525 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1526 It's not clear why that was the case and it breaks things like
1527 (load "/bar.el") where the file is actually "/bar.el.gz". */
1528 string
= make_string (fn
, fnlen
);
1529 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1530 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1533 if (NILP (predicate
))
1534 exists
= !NILP (Ffile_readable_p (string
));
1537 Lisp_Object tmp
= call1 (predicate
, string
);
1538 exists
= !NILP (tmp
)
1539 && (EQ (tmp
, Qdir_ok
)
1540 || NILP (Ffile_directory_p (string
)));
1545 /* We succeeded; return this descriptor and filename. */
1557 encoded_fn
= ENCODE_FILE (string
);
1558 pfn
= SSDATA (encoded_fn
);
1560 /* Check that we can access or open it. */
1561 if (NATNUMP (predicate
))
1562 fd
= (((XFASTINT (predicate
) & ~INT_MAX
) == 0
1563 && (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1566 && ! file_directory_p (pfn
))
1571 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1573 && (fstat (fd
, &st
) != 0 || S_ISDIR (st
.st_mode
)))
1582 /* We succeeded; return this descriptor and filename. */
1599 /* Merge the list we've accumulated of globals from the current input source
1600 into the load_history variable. The details depend on whether
1601 the source has an associated file name or not.
1603 FILENAME is the file name that we are loading from.
1605 ENTIRE is true if loading that entire file, false if evaluating
1609 build_load_history (Lisp_Object filename
, bool entire
)
1611 Lisp_Object tail
, prev
, newelt
;
1612 Lisp_Object tem
, tem2
;
1615 tail
= Vload_history
;
1618 while (CONSP (tail
))
1622 /* Find the feature's previous assoc list... */
1623 if (!NILP (Fequal (filename
, Fcar (tem
))))
1627 /* If we're loading the entire file, remove old data. */
1631 Vload_history
= XCDR (tail
);
1633 Fsetcdr (prev
, XCDR (tail
));
1636 /* Otherwise, cons on new symbols that are not already members. */
1639 tem2
= Vcurrent_load_list
;
1641 while (CONSP (tem2
))
1643 newelt
= XCAR (tem2
);
1645 if (NILP (Fmember (newelt
, tem
)))
1646 Fsetcar (tail
, Fcons (XCAR (tem
),
1647 Fcons (newelt
, XCDR (tem
))));
1660 /* If we're loading an entire file, cons the new assoc onto the
1661 front of load-history, the most-recently-loaded position. Also
1662 do this if we didn't find an existing member for the file. */
1663 if (entire
|| !foundit
)
1664 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1669 readevalloop_1 (Lisp_Object old
)
1671 load_convert_to_unibyte
= ! NILP (old
);
1675 /* Signal an `end-of-file' error, if possible with file name
1678 static _Noreturn
void
1679 end_of_file_error (void)
1681 if (STRINGP (Vload_file_name
))
1682 xsignal1 (Qend_of_file
, Vload_file_name
);
1684 xsignal0 (Qend_of_file
);
1687 /* UNIBYTE specifies how to set load_convert_to_unibyte
1688 for this invocation.
1689 READFUN, if non-nil, is used instead of `read'.
1691 START, END specify region to read in current buffer (from eval-region).
1692 If the input is not from a buffer, they must be nil. */
1695 readevalloop (Lisp_Object readcharfun
,
1697 Lisp_Object sourcename
,
1699 Lisp_Object unibyte
, Lisp_Object readfun
,
1700 Lisp_Object start
, Lisp_Object end
)
1703 register Lisp_Object val
;
1704 ptrdiff_t count
= SPECPDL_INDEX ();
1705 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1706 struct buffer
*b
= 0;
1707 bool continue_reading_p
;
1708 Lisp_Object lex_bound
;
1709 /* True if reading an entire buffer. */
1710 bool whole_buffer
= 0;
1711 /* True on the first time around. */
1712 bool first_sexp
= 1;
1713 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1715 if (NILP (Ffboundp (macroexpand
))
1716 /* Don't macroexpand in .elc files, since it should have been done
1717 already. We actually don't know whether we're in a .elc file or not,
1718 so we use circumstantial evidence: .el files normally go through
1719 Vload_source_file_function -> load-with-code-conversion
1721 || EQ (readcharfun
, Qget_file_char
)
1722 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1725 if (MARKERP (readcharfun
))
1728 start
= readcharfun
;
1731 if (BUFFERP (readcharfun
))
1732 b
= XBUFFER (readcharfun
);
1733 else if (MARKERP (readcharfun
))
1734 b
= XMARKER (readcharfun
)->buffer
;
1736 /* We assume START is nil when input is not from a buffer. */
1737 if (! NILP (start
) && !b
)
1740 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1741 specbind (Qcurrent_load_list
, Qnil
);
1742 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1743 load_convert_to_unibyte
= !NILP (unibyte
);
1745 /* If lexical binding is active (either because it was specified in
1746 the file's header, or via a buffer-local variable), create an empty
1747 lexical environment, otherwise, turn off lexical binding. */
1748 lex_bound
= find_symbol_value (Qlexical_binding
);
1749 specbind (Qinternal_interpreter_environment
,
1750 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1751 ? Qnil
: Fcons (Qt
, Qnil
));
1753 GCPRO4 (sourcename
, readfun
, start
, end
);
1755 /* Try to ensure sourcename is a truename, except whilst preloading. */
1756 if (NILP (Vpurify_flag
)
1757 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1758 && !NILP (Ffboundp (Qfile_truename
)))
1759 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1761 LOADHIST_ATTACH (sourcename
);
1763 continue_reading_p
= 1;
1764 while (continue_reading_p
)
1766 ptrdiff_t count1
= SPECPDL_INDEX ();
1768 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1769 error ("Reading from killed buffer");
1773 /* Switch to the buffer we are reading from. */
1774 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1775 set_buffer_internal (b
);
1777 /* Save point in it. */
1778 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1779 /* Save ZV in it. */
1780 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1781 /* Those get unbound after we read one expression. */
1783 /* Set point and ZV around stuff to be read. */
1786 Fnarrow_to_region (make_number (BEGV
), end
);
1788 /* Just for cleanliness, convert END to a marker
1789 if it is an integer. */
1791 end
= Fpoint_max_marker ();
1794 /* On the first cycle, we can easily test here
1795 whether we are reading the whole buffer. */
1796 if (b
&& first_sexp
)
1797 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1804 while ((c
= READCHAR
) != '\n' && c
!= -1);
1809 unbind_to (count1
, Qnil
);
1813 /* Ignore whitespace here, so we can detect eof. */
1814 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1815 || c
== 0xa0) /* NBSP */
1818 if (!NILP (Vpurify_flag
) && c
== '(')
1820 val
= read_list (0, readcharfun
);
1825 read_objects
= Qnil
;
1826 if (!NILP (readfun
))
1828 val
= call1 (readfun
, readcharfun
);
1830 /* If READCHARFUN has set point to ZV, we should
1831 stop reading, even if the form read sets point
1832 to a different value when evaluated. */
1833 if (BUFFERP (readcharfun
))
1835 struct buffer
*buf
= XBUFFER (readcharfun
);
1836 if (BUF_PT (buf
) == BUF_ZV (buf
))
1837 continue_reading_p
= 0;
1840 else if (! NILP (Vload_read_function
))
1841 val
= call1 (Vload_read_function
, readcharfun
);
1843 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1846 if (!NILP (start
) && continue_reading_p
)
1847 start
= Fpoint_marker ();
1849 /* Restore saved point and BEGV. */
1850 unbind_to (count1
, Qnil
);
1852 /* Now eval what we just read. */
1853 if (!NILP (macroexpand
))
1854 val
= call1 (macroexpand
, val
);
1855 val
= eval_sub (val
);
1859 Vvalues
= Fcons (val
, Vvalues
);
1860 if (EQ (Vstandard_output
, Qt
))
1869 build_load_history (sourcename
,
1870 stream
|| whole_buffer
);
1874 unbind_to (count
, Qnil
);
1877 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1878 doc
: /* Execute the current buffer as Lisp code.
1879 When called from a Lisp program (i.e., not interactively), this
1880 function accepts up to five optional arguments:
1881 BUFFER is the buffer to evaluate (nil means use current buffer).
1882 PRINTFLAG controls printing of output:
1883 A value of nil means discard it; anything else is stream for print.
1884 FILENAME specifies the file name to use for `load-history'.
1885 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1887 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1888 functions should work normally even if PRINTFLAG is nil.
1890 This function preserves the position of point. */)
1891 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1893 ptrdiff_t count
= SPECPDL_INDEX ();
1894 Lisp_Object tem
, buf
;
1897 buf
= Fcurrent_buffer ();
1899 buf
= Fget_buffer (buffer
);
1901 error ("No such buffer");
1903 if (NILP (printflag
) && NILP (do_allow_print
))
1908 if (NILP (filename
))
1909 filename
= BVAR (XBUFFER (buf
), filename
);
1911 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1912 specbind (Qstandard_output
, tem
);
1913 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1914 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1915 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1916 readevalloop (buf
, 0, filename
,
1917 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1918 unbind_to (count
, Qnil
);
1923 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1924 doc
: /* Execute the region as Lisp code.
1925 When called from programs, expects two arguments,
1926 giving starting and ending indices in the current buffer
1927 of the text to be executed.
1928 Programs can pass third argument PRINTFLAG which controls output:
1929 A value of nil means discard it; anything else is stream for printing it.
1930 Also the fourth argument READ-FUNCTION, if non-nil, is used
1931 instead of `read' to read each expression. It gets one argument
1932 which is the input stream for reading characters.
1934 This function does not move point. */)
1935 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1937 /* FIXME: Do the eval-sexp-add-defvars dance! */
1938 ptrdiff_t count
= SPECPDL_INDEX ();
1939 Lisp_Object tem
, cbuf
;
1941 cbuf
= Fcurrent_buffer ();
1943 if (NILP (printflag
))
1947 specbind (Qstandard_output
, tem
);
1948 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1950 /* `readevalloop' calls functions which check the type of start and end. */
1951 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1952 !NILP (printflag
), Qnil
, read_function
,
1955 return unbind_to (count
, Qnil
);
1959 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1960 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1961 If STREAM is nil, use the value of `standard-input' (which see).
1962 STREAM or the value of `standard-input' may be:
1963 a buffer (read from point and advance it)
1964 a marker (read from where it points and advance it)
1965 a function (call it with no arguments for each character,
1966 call it with a char as argument to push a char back)
1967 a string (takes text from string, starting at the beginning)
1968 t (read text line using minibuffer and use it, or read from
1969 standard input in batch mode). */)
1970 (Lisp_Object stream
)
1973 stream
= Vstandard_input
;
1974 if (EQ (stream
, Qt
))
1975 stream
= Qread_char
;
1976 if (EQ (stream
, Qread_char
))
1977 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1979 return read_internal_start (stream
, Qnil
, Qnil
);
1982 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1983 doc
: /* Read one Lisp expression which is represented as text by STRING.
1984 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1985 FINAL-STRING-INDEX is an integer giving the position of the next
1986 remaining character in STRING.
1987 START and END optionally delimit a substring of STRING from which to read;
1988 they default to 0 and (length STRING) respectively. */)
1989 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1992 CHECK_STRING (string
);
1993 /* `read_internal_start' sets `read_from_string_index'. */
1994 ret
= read_internal_start (string
, start
, end
);
1995 return Fcons (ret
, make_number (read_from_string_index
));
1998 /* Function to set up the global context we need in toplevel read
2001 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2002 /* `start', `end' only used when stream is a string. */
2007 new_backquote_flag
= 0;
2008 read_objects
= Qnil
;
2009 if (EQ (Vread_with_symbol_positions
, Qt
)
2010 || EQ (Vread_with_symbol_positions
, stream
))
2011 Vread_symbol_positions_list
= Qnil
;
2013 if (STRINGP (stream
)
2014 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2016 ptrdiff_t startval
, endval
;
2019 if (STRINGP (stream
))
2022 string
= XCAR (stream
);
2025 endval
= SCHARS (string
);
2029 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2030 args_out_of_range (string
, end
);
2031 endval
= XINT (end
);
2038 CHECK_NUMBER (start
);
2039 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2040 args_out_of_range (string
, start
);
2041 startval
= XINT (start
);
2043 read_from_string_index
= startval
;
2044 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2045 read_from_string_limit
= endval
;
2048 retval
= read0 (stream
);
2049 if (EQ (Vread_with_symbol_positions
, Qt
)
2050 || EQ (Vread_with_symbol_positions
, stream
))
2051 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2056 /* Signal Qinvalid_read_syntax error.
2057 S is error string of length N (if > 0) */
2059 static _Noreturn
void
2060 invalid_syntax (const char *s
)
2062 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2066 /* Use this for recursive reads, in contexts where internal tokens
2070 read0 (Lisp_Object readcharfun
)
2072 register Lisp_Object val
;
2075 val
= read1 (readcharfun
, &c
, 0);
2079 xsignal1 (Qinvalid_read_syntax
,
2080 Fmake_string (make_number (1), make_number (c
)));
2083 static ptrdiff_t read_buffer_size
;
2084 static char *read_buffer
;
2086 /* Read a \-escape sequence, assuming we already read the `\'.
2087 If the escape sequence forces unibyte, return eight-bit char. */
2090 read_escape (Lisp_Object readcharfun
, bool stringp
)
2093 /* \u allows up to four hex digits, \U up to eight. Default to the
2094 behavior for \u, and change this value in the case that \U is seen. */
2095 int unicode_hex_count
= 4;
2100 end_of_file_error ();
2130 error ("Invalid escape character syntax");
2133 c
= read_escape (readcharfun
, 0);
2134 return c
| meta_modifier
;
2139 error ("Invalid escape character syntax");
2142 c
= read_escape (readcharfun
, 0);
2143 return c
| shift_modifier
;
2148 error ("Invalid escape character syntax");
2151 c
= read_escape (readcharfun
, 0);
2152 return c
| hyper_modifier
;
2157 error ("Invalid escape character syntax");
2160 c
= read_escape (readcharfun
, 0);
2161 return c
| alt_modifier
;
2165 if (stringp
|| c
!= '-')
2172 c
= read_escape (readcharfun
, 0);
2173 return c
| super_modifier
;
2178 error ("Invalid escape character syntax");
2182 c
= read_escape (readcharfun
, 0);
2183 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2184 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2185 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2186 return c
| ctrl_modifier
;
2187 /* ASCII control chars are made from letters (both cases),
2188 as well as the non-letters within 0100...0137. */
2189 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2190 return (c
& (037 | ~0177));
2191 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2192 return (c
& (037 | ~0177));
2194 return c
| ctrl_modifier
;
2204 /* An octal escape, as in ANSI C. */
2206 register int i
= c
- '0';
2207 register int count
= 0;
2210 if ((c
= READCHAR
) >= '0' && c
<= '7')
2222 if (i
>= 0x80 && i
< 0x100)
2223 i
= BYTE8_TO_CHAR (i
);
2228 /* A hex escape, as in ANSI C. */
2235 if (c
>= '0' && c
<= '9')
2240 else if ((c
>= 'a' && c
<= 'f')
2241 || (c
>= 'A' && c
<= 'F'))
2244 if (c
>= 'a' && c
<= 'f')
2254 /* Allow hex escapes as large as ?\xfffffff, because some
2255 packages use them to denote characters with modifiers. */
2256 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2257 error ("Hex character out of range: \\x%x...", i
);
2261 if (count
< 3 && i
>= 0x80)
2262 return BYTE8_TO_CHAR (i
);
2267 /* Post-Unicode-2.0: Up to eight hex chars. */
2268 unicode_hex_count
= 8;
2271 /* A Unicode escape. We only permit them in strings and characters,
2272 not arbitrarily in the source code, as in some other languages. */
2277 while (++count
<= unicode_hex_count
)
2280 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2282 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2283 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2284 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2286 error ("Non-hex digit used for Unicode escape");
2289 error ("Non-Unicode character: 0x%x", i
);
2298 /* Return the digit that CHARACTER stands for in the given BASE.
2299 Return -1 if CHARACTER is out of range for BASE,
2300 and -2 if CHARACTER is not valid for any supported BASE. */
2302 digit_to_number (int character
, int base
)
2306 if ('0' <= character
&& character
<= '9')
2307 digit
= character
- '0';
2308 else if ('a' <= character
&& character
<= 'z')
2309 digit
= character
- 'a' + 10;
2310 else if ('A' <= character
&& character
<= 'Z')
2311 digit
= character
- 'A' + 10;
2315 return digit
< base
? digit
: -1;
2318 /* Read an integer in radix RADIX using READCHARFUN to read
2319 characters. RADIX must be in the interval [2..36]; if it isn't, a
2320 read error is signaled . Value is the integer read. Signals an
2321 error if encountering invalid read syntax or if RADIX is out of
2325 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2327 /* Room for sign, leading 0, other digits, trailing null byte.
2328 Also, room for invalid syntax diagnostic. */
2329 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2330 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2332 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2334 if (radix
< 2 || radix
> 36)
2342 if (c
== '-' || c
== '+')
2353 /* Ignore redundant leading zeros, so the buffer doesn't
2354 fill up with them. */
2360 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2367 if (p
< buf
+ sizeof buf
- 1)
2381 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2382 invalid_syntax (buf
);
2385 return string_to_number (buf
, radix
, 0);
2389 /* If the next token is ')' or ']' or '.', we store that character
2390 in *PCH and the return value is not interesting. Else, we store
2391 zero in *PCH and we read and return one lisp object.
2393 FIRST_IN_LIST is true if this is the first element of a list. */
2396 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2399 bool uninterned_symbol
= 0;
2406 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2408 end_of_file_error ();
2413 return read_list (0, readcharfun
);
2416 return read_vector (readcharfun
, 0);
2432 /* Accept extended format for hashtables (extensible to
2434 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2435 Lisp_Object tmp
= read_list (0, readcharfun
);
2436 Lisp_Object head
= CAR_SAFE (tmp
);
2437 Lisp_Object data
= Qnil
;
2438 Lisp_Object val
= Qnil
;
2439 /* The size is 2 * number of allowed keywords to
2441 Lisp_Object params
[10];
2443 Lisp_Object key
= Qnil
;
2444 int param_count
= 0;
2446 if (!EQ (head
, Qhash_table
))
2447 error ("Invalid extended read marker at head of #s list "
2448 "(only hash-table allowed)");
2450 tmp
= CDR_SAFE (tmp
);
2452 /* This is repetitive but fast and simple. */
2453 params
[param_count
] = QCsize
;
2454 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2455 if (!NILP (params
[param_count
+ 1]))
2458 params
[param_count
] = QCtest
;
2459 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2460 if (!NILP (params
[param_count
+ 1]))
2463 params
[param_count
] = QCweakness
;
2464 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2465 if (!NILP (params
[param_count
+ 1]))
2468 params
[param_count
] = QCrehash_size
;
2469 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2470 if (!NILP (params
[param_count
+ 1]))
2473 params
[param_count
] = QCrehash_threshold
;
2474 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2475 if (!NILP (params
[param_count
+ 1]))
2478 /* This is the hashtable data. */
2479 data
= Fplist_get (tmp
, Qdata
);
2481 /* Now use params to make a new hashtable and fill it. */
2482 ht
= Fmake_hash_table (param_count
, params
);
2484 while (CONSP (data
))
2489 error ("Odd number of elements in hashtable data");
2492 Fputhash (key
, val
, ht
);
2498 invalid_syntax ("#");
2506 tmp
= read_vector (readcharfun
, 0);
2507 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2508 error ("Invalid size char-table");
2509 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2521 tmp
= read_vector (readcharfun
, 0);
2524 error ("Invalid size char-table");
2525 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2526 error ("Invalid depth in char-table");
2527 depth
= XINT (AREF (tmp
, 0));
2528 if (chartab_size
[depth
] != size
- 2)
2529 error ("Invalid size char-table");
2530 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2533 invalid_syntax ("#^^");
2535 invalid_syntax ("#^");
2540 length
= read1 (readcharfun
, pch
, first_in_list
);
2544 Lisp_Object tmp
, val
;
2545 EMACS_INT size_in_chars
2546 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2547 / BOOL_VECTOR_BITS_PER_CHAR
);
2550 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2551 if (STRING_MULTIBYTE (tmp
)
2552 || (size_in_chars
!= SCHARS (tmp
)
2553 /* We used to print 1 char too many
2554 when the number of bits was a multiple of 8.
2555 Accept such input in case it came from an old
2557 && ! (XFASTINT (length
)
2558 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2559 invalid_syntax ("#&...");
2561 val
= Fmake_bool_vector (length
, Qnil
);
2562 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2563 /* Clear the extraneous bits in the last byte. */
2564 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2565 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2566 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2569 invalid_syntax ("#&...");
2573 /* Accept compiled functions at read-time so that we don't have to
2574 build them using function calls. */
2576 tmp
= read_vector (readcharfun
, 1);
2577 make_byte_code (XVECTOR (tmp
));
2583 struct gcpro gcpro1
;
2586 /* Read the string itself. */
2587 tmp
= read1 (readcharfun
, &ch
, 0);
2588 if (ch
!= 0 || !STRINGP (tmp
))
2589 invalid_syntax ("#");
2591 /* Read the intervals and their properties. */
2594 Lisp_Object beg
, end
, plist
;
2596 beg
= read1 (readcharfun
, &ch
, 0);
2601 end
= read1 (readcharfun
, &ch
, 0);
2603 plist
= read1 (readcharfun
, &ch
, 0);
2605 invalid_syntax ("Invalid string property list");
2606 Fset_text_properties (beg
, end
, plist
, tmp
);
2612 /* #@NUMBER is used to skip NUMBER following bytes.
2613 That's used in .elc files to skip over doc strings
2614 and function definitions. */
2617 enum { extra
= 100 };
2618 ptrdiff_t i
, nskip
= 0;
2620 /* Read a decimal integer. */
2621 while ((c
= READCHAR
) >= 0
2622 && c
>= '0' && c
<= '9')
2624 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2630 /* We can't use UNREAD here, because in the code below we side-step
2631 READCHAR. Instead, assume the first char after #@NNN occupies
2632 a single byte, which is the case normally since it's just
2638 if (load_force_doc_strings
2639 && (EQ (readcharfun
, Qget_file_char
)
2640 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2642 /* If we are supposed to force doc strings into core right now,
2643 record the last string that we skipped,
2644 and record where in the file it comes from. */
2646 /* But first exchange saved_doc_string
2647 with prev_saved_doc_string, so we save two strings. */
2649 char *temp
= saved_doc_string
;
2650 ptrdiff_t temp_size
= saved_doc_string_size
;
2651 file_offset temp_pos
= saved_doc_string_position
;
2652 ptrdiff_t temp_len
= saved_doc_string_length
;
2654 saved_doc_string
= prev_saved_doc_string
;
2655 saved_doc_string_size
= prev_saved_doc_string_size
;
2656 saved_doc_string_position
= prev_saved_doc_string_position
;
2657 saved_doc_string_length
= prev_saved_doc_string_length
;
2659 prev_saved_doc_string
= temp
;
2660 prev_saved_doc_string_size
= temp_size
;
2661 prev_saved_doc_string_position
= temp_pos
;
2662 prev_saved_doc_string_length
= temp_len
;
2665 if (saved_doc_string_size
== 0)
2667 saved_doc_string
= xmalloc (nskip
+ extra
);
2668 saved_doc_string_size
= nskip
+ extra
;
2670 if (nskip
> saved_doc_string_size
)
2672 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2673 saved_doc_string_size
= nskip
+ extra
;
2676 saved_doc_string_position
= file_tell (instream
);
2678 /* Copy that many characters into saved_doc_string. */
2680 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2681 saved_doc_string
[i
] = c
= getc (instream
);
2684 saved_doc_string_length
= i
;
2687 /* Skip that many bytes. */
2688 skip_dyn_bytes (readcharfun
, nskip
);
2694 /* #! appears at the beginning of an executable file.
2695 Skip the first line. */
2696 while (c
!= '\n' && c
>= 0)
2701 return Vload_file_name
;
2703 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2704 /* #:foo is the uninterned symbol named foo. */
2707 uninterned_symbol
= 1;
2710 && c
!= 0xa0 /* NBSP */
2712 || strchr ("\"';()[]#`,", c
) == NULL
)))
2714 /* No symbol character follows, this is the empty
2717 return Fmake_symbol (empty_unibyte_string
);
2721 /* ## is the empty symbol. */
2723 return Fintern (empty_unibyte_string
, Qnil
);
2724 /* Reader forms that can reuse previously read objects. */
2725 if (c
>= '0' && c
<= '9')
2730 /* Read a non-negative integer. */
2731 while (c
>= '0' && c
<= '9')
2733 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2734 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2735 n
= MOST_POSITIVE_FIXNUM
+ 1;
2737 n
= n
* 10 + c
- '0';
2741 if (n
<= MOST_POSITIVE_FIXNUM
)
2743 if (c
== 'r' || c
== 'R')
2744 return read_integer (readcharfun
, n
);
2746 if (! NILP (Vread_circle
))
2748 /* #n=object returns object, but associates it with
2752 /* Make a placeholder for #n# to use temporarily. */
2753 Lisp_Object placeholder
;
2756 placeholder
= Fcons (Qnil
, Qnil
);
2757 cell
= Fcons (make_number (n
), placeholder
);
2758 read_objects
= Fcons (cell
, read_objects
);
2760 /* Read the object itself. */
2761 tem
= read0 (readcharfun
);
2763 /* Now put it everywhere the placeholder was... */
2764 substitute_object_in_subtree (tem
, placeholder
);
2766 /* ...and #n# will use the real value from now on. */
2767 Fsetcdr (cell
, tem
);
2772 /* #n# returns a previously read object. */
2775 tem
= Fassq (make_number (n
), read_objects
);
2781 /* Fall through to error message. */
2783 else if (c
== 'x' || c
== 'X')
2784 return read_integer (readcharfun
, 16);
2785 else if (c
== 'o' || c
== 'O')
2786 return read_integer (readcharfun
, 8);
2787 else if (c
== 'b' || c
== 'B')
2788 return read_integer (readcharfun
, 2);
2791 invalid_syntax ("#");
2794 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2799 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2804 int next_char
= READCHAR
;
2806 /* Transition from old-style to new-style:
2807 If we see "(`" it used to mean old-style, which usually works
2808 fine because ` should almost never appear in such a position
2809 for new-style. But occasionally we need "(`" to mean new
2810 style, so we try to distinguish the two by the fact that we
2811 can either write "( `foo" or "(` foo", where the first
2812 intends to use new-style whereas the second intends to use
2813 old-style. For Emacs-25, we should completely remove this
2814 first_in_list exception (old-style can still be obtained via
2816 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2818 Vold_style_backquotes
= Qt
;
2824 bool saved_new_backquote_flag
= new_backquote_flag
;
2826 new_backquote_flag
= 1;
2827 value
= read0 (readcharfun
);
2828 new_backquote_flag
= saved_new_backquote_flag
;
2830 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2835 int next_char
= READCHAR
;
2837 /* Transition from old-style to new-style:
2838 It used to be impossible to have a new-style , other than within
2839 a new-style `. This is sufficient when ` and , are used in the
2840 normal way, but ` and , can also appear in args to macros that
2841 will not interpret them in the usual way, in which case , may be
2842 used without any ` anywhere near.
2843 So we now use the same heuristic as for backquote: old-style
2844 unquotes are only recognized when first on a list, and when
2845 followed by a space.
2846 Because it's more difficult to peek 2 chars ahead, a new-style
2847 ,@ can still not be used outside of a `, unless it's in the middle
2849 if (new_backquote_flag
2851 || (next_char
!= ' ' && next_char
!= '@'))
2853 Lisp_Object comma_type
= Qnil
;
2858 comma_type
= Qcomma_at
;
2860 comma_type
= Qcomma_dot
;
2863 if (ch
>= 0) UNREAD (ch
);
2864 comma_type
= Qcomma
;
2867 value
= read0 (readcharfun
);
2868 return Fcons (comma_type
, Fcons (value
, Qnil
));
2872 Vold_style_backquotes
= Qt
;
2884 end_of_file_error ();
2886 /* Accept `single space' syntax like (list ? x) where the
2887 whitespace character is SPC or TAB.
2888 Other literal whitespace like NL, CR, and FF are not accepted,
2889 as there are well-established escape sequences for these. */
2890 if (c
== ' ' || c
== '\t')
2891 return make_number (c
);
2894 c
= read_escape (readcharfun
, 0);
2895 modifiers
= c
& CHAR_MODIFIER_MASK
;
2896 c
&= ~CHAR_MODIFIER_MASK
;
2897 if (CHAR_BYTE8_P (c
))
2898 c
= CHAR_TO_BYTE8 (c
);
2901 next_char
= READCHAR
;
2902 ok
= (next_char
<= 040
2903 || (next_char
< 0200
2904 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2907 return make_number (c
);
2909 invalid_syntax ("?");
2914 char *p
= read_buffer
;
2915 char *end
= read_buffer
+ read_buffer_size
;
2917 /* True if we saw an escape sequence specifying
2918 a multibyte character. */
2919 bool force_multibyte
= 0;
2920 /* True if we saw an escape sequence specifying
2921 a single-byte character. */
2922 bool force_singlebyte
= 0;
2924 ptrdiff_t nchars
= 0;
2926 while ((ch
= READCHAR
) >= 0
2929 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2931 ptrdiff_t offset
= p
- read_buffer
;
2932 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2933 memory_full (SIZE_MAX
);
2934 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
2935 read_buffer_size
*= 2;
2936 p
= read_buffer
+ offset
;
2937 end
= read_buffer
+ read_buffer_size
;
2944 ch
= read_escape (readcharfun
, 1);
2946 /* CH is -1 if \ newline has just been seen. */
2949 if (p
== read_buffer
)
2954 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2955 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2957 if (CHAR_BYTE8_P (ch
))
2958 force_singlebyte
= 1;
2959 else if (! ASCII_CHAR_P (ch
))
2960 force_multibyte
= 1;
2961 else /* I.e. ASCII_CHAR_P (ch). */
2963 /* Allow `\C- ' and `\C-?'. */
2964 if (modifiers
== CHAR_CTL
)
2967 ch
= 0, modifiers
= 0;
2969 ch
= 127, modifiers
= 0;
2971 if (modifiers
& CHAR_SHIFT
)
2973 /* Shift modifier is valid only with [A-Za-z]. */
2974 if (ch
>= 'A' && ch
<= 'Z')
2975 modifiers
&= ~CHAR_SHIFT
;
2976 else if (ch
>= 'a' && ch
<= 'z')
2977 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2980 if (modifiers
& CHAR_META
)
2982 /* Move the meta bit to the right place for a
2984 modifiers
&= ~CHAR_META
;
2985 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2986 force_singlebyte
= 1;
2990 /* Any modifiers remaining are invalid. */
2992 error ("Invalid modifier in string");
2993 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2997 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2998 if (CHAR_BYTE8_P (ch
))
2999 force_singlebyte
= 1;
3000 else if (! ASCII_CHAR_P (ch
))
3001 force_multibyte
= 1;
3007 end_of_file_error ();
3009 /* If purifying, and string starts with \ newline,
3010 return zero instead. This is for doc strings
3011 that we are really going to find in etc/DOC.nn.nn. */
3012 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3013 return make_number (0);
3015 if (! force_multibyte
&& force_singlebyte
)
3017 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3018 forms. Convert it to unibyte. */
3019 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3021 p
= read_buffer
+ nchars
;
3024 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3026 || (p
- read_buffer
!= nchars
)));
3031 int next_char
= READCHAR
;
3034 if (next_char
<= 040
3035 || (next_char
< 0200
3036 && strchr ("\"';([#?`,", next_char
) != NULL
))
3042 /* Otherwise, we fall through! Note that the atom-reading loop
3043 below will now loop at least once, assuring that we will not
3044 try to UNREAD two characters in a row. */
3048 if (c
<= 040) goto retry
;
3049 if (c
== 0xa0) /* NBSP */
3054 char *p
= read_buffer
;
3056 EMACS_INT start_position
= readchar_count
- 1;
3059 char *end
= read_buffer
+ read_buffer_size
;
3063 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3065 ptrdiff_t offset
= p
- read_buffer
;
3066 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3067 memory_full (SIZE_MAX
);
3068 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3069 read_buffer_size
*= 2;
3070 p
= read_buffer
+ offset
;
3071 end
= read_buffer
+ read_buffer_size
;
3078 end_of_file_error ();
3083 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3089 && c
!= 0xa0 /* NBSP */
3091 || strchr ("\"';()[]#`,", c
) == NULL
));
3095 ptrdiff_t offset
= p
- read_buffer
;
3096 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3097 memory_full (SIZE_MAX
);
3098 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3099 read_buffer_size
*= 2;
3100 p
= read_buffer
+ offset
;
3101 end
= read_buffer
+ read_buffer_size
;
3107 if (!quoted
&& !uninterned_symbol
)
3109 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3110 if (! NILP (result
))
3114 Lisp_Object name
, result
;
3115 ptrdiff_t nbytes
= p
- read_buffer
;
3118 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3122 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3123 ? make_pure_string
: make_specified_string
)
3124 (read_buffer
, nchars
, nbytes
, multibyte
));
3125 result
= (uninterned_symbol
? Fmake_symbol (name
)
3126 : Fintern (name
, Qnil
));
3128 if (EQ (Vread_with_symbol_positions
, Qt
)
3129 || EQ (Vread_with_symbol_positions
, readcharfun
))
3130 Vread_symbol_positions_list
3131 = Fcons (Fcons (result
, make_number (start_position
)),
3132 Vread_symbol_positions_list
);
3140 /* List of nodes we've seen during substitute_object_in_subtree. */
3141 static Lisp_Object seen_list
;
3144 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3146 Lisp_Object check_object
;
3148 /* We haven't seen any objects when we start. */
3151 /* Make all the substitutions. */
3153 = substitute_object_recurse (object
, placeholder
, object
);
3155 /* Clear seen_list because we're done with it. */
3158 /* The returned object here is expected to always eq the
3160 if (!EQ (check_object
, object
))
3161 error ("Unexpected mutation error in reader");
3164 /* Feval doesn't get called from here, so no gc protection is needed. */
3165 #define SUBSTITUTE(get_val, set_val) \
3167 Lisp_Object old_value = get_val; \
3168 Lisp_Object true_value \
3169 = substitute_object_recurse (object, placeholder, \
3172 if (!EQ (old_value, true_value)) \
3179 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3181 /* If we find the placeholder, return the target object. */
3182 if (EQ (placeholder
, subtree
))
3185 /* If we've been to this node before, don't explore it again. */
3186 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3189 /* If this node can be the entry point to a cycle, remember that
3190 we've seen it. It can only be such an entry point if it was made
3191 by #n=, which means that we can find it as a value in
3193 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3194 seen_list
= Fcons (subtree
, seen_list
);
3196 /* Recurse according to subtree's type.
3197 Every branch must return a Lisp_Object. */
3198 switch (XTYPE (subtree
))
3200 case Lisp_Vectorlike
:
3202 ptrdiff_t i
, length
= 0;
3203 if (BOOL_VECTOR_P (subtree
))
3204 return subtree
; /* No sub-objects anyway. */
3205 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3206 || COMPILEDP (subtree
))
3207 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3208 else if (VECTORP (subtree
))
3209 length
= ASIZE (subtree
);
3211 /* An unknown pseudovector may contain non-Lisp fields, so we
3212 can't just blindly traverse all its fields. We used to call
3213 `Flength' which signaled `sequencep', so I just preserved this
3215 wrong_type_argument (Qsequencep
, subtree
);
3217 for (i
= 0; i
< length
; i
++)
3218 SUBSTITUTE (AREF (subtree
, i
),
3219 ASET (subtree
, i
, true_value
));
3225 SUBSTITUTE (XCAR (subtree
),
3226 XSETCAR (subtree
, true_value
));
3227 SUBSTITUTE (XCDR (subtree
),
3228 XSETCDR (subtree
, true_value
));
3234 /* Check for text properties in each interval.
3235 substitute_in_interval contains part of the logic. */
3237 INTERVAL root_interval
= string_intervals (subtree
);
3238 Lisp_Object arg
= Fcons (object
, placeholder
);
3240 traverse_intervals_noorder (root_interval
,
3241 &substitute_in_interval
, arg
);
3246 /* Other types don't recurse any further. */
3252 /* Helper function for substitute_object_recurse. */
3254 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3256 Lisp_Object object
= Fcar (arg
);
3257 Lisp_Object placeholder
= Fcdr (arg
);
3259 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3269 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3270 integer syntax and fits in a fixnum, else return the nearest float if CP has
3271 either floating point or integer syntax and BASE is 10, else return nil. If
3272 IGNORE_TRAILING, consider just the longest prefix of CP that has
3273 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3274 number has integer syntax but does not fit. */
3277 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3280 char const *cp
= string
;
3282 bool float_syntax
= 0;
3285 /* Compute NaN and infinities using a variable, to cope with compilers that
3286 think they are smarter than we are. */
3289 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3290 IEEE floating point hosts, and works around a formerly-common bug where
3291 atof ("-0.0") drops the sign. */
3292 bool negative
= *cp
== '-';
3294 bool signedp
= negative
|| *cp
== '+';
3299 leading_digit
= digit_to_number (*cp
, base
);
3300 if (0 <= leading_digit
)
3305 while (0 <= digit_to_number (*cp
, base
));
3315 if ('0' <= *cp
&& *cp
<= '9')
3320 while ('0' <= *cp
&& *cp
<= '9');
3322 if (*cp
== 'e' || *cp
== 'E')
3324 char const *ecp
= cp
;
3326 if (*cp
== '+' || *cp
== '-')
3328 if ('0' <= *cp
&& *cp
<= '9')
3333 while ('0' <= *cp
&& *cp
<= '9');
3335 else if (cp
[-1] == '+'
3336 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3342 else if (cp
[-1] == '+'
3343 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3347 value
= zero
/ zero
;
3349 /* If that made a "negative" NaN, negate it. */
3352 union { double d
; char c
[sizeof (double)]; }
3353 u_data
, u_minus_zero
;
3355 u_minus_zero
.d
= -0.0;
3356 for (i
= 0; i
< sizeof (double); i
++)
3357 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3363 /* Now VALUE is a positive NaN. */
3369 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3370 || state
== (LEAD_INT
|E_EXP
));
3373 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3374 any prefix that matches. Otherwise, the entire string must match. */
3375 if (! (ignore_trailing
3376 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3377 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3380 /* If the number uses integer and not float syntax, and is in C-language
3381 range, use its value, preferably as a fixnum. */
3382 if (0 <= leading_digit
&& ! float_syntax
)
3386 /* Fast special case for single-digit integers. This also avoids a
3387 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3388 case some versions of strtoumax accept numbers like "0x1" that Emacs
3390 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3391 return make_number (negative
? -leading_digit
: leading_digit
);
3394 n
= strtoumax (string
+ signedp
, NULL
, base
);
3395 if (errno
== ERANGE
)
3397 /* Unfortunately there's no simple and accurate way to convert
3398 non-base-10 numbers that are out of C-language range. */
3400 xsignal1 (Qoverflow_error
, build_string (string
));
3402 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3404 EMACS_INT signed_n
= n
;
3405 return make_number (negative
? -signed_n
: signed_n
);
3411 /* Either the number uses float syntax, or it does not fit into a fixnum.
3412 Convert it from string to floating point, unless the value is already
3413 known because it is an infinity, a NAN, or its absolute value fits in
3416 value
= atof (string
+ signedp
);
3418 return make_float (negative
? -value
: value
);
3423 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3427 Lisp_Object tem
, item
, vector
;
3428 struct Lisp_Cons
*otem
;
3431 tem
= read_list (1, readcharfun
);
3432 len
= Flength (tem
);
3433 vector
= Fmake_vector (len
, Qnil
);
3435 size
= ASIZE (vector
);
3436 ptr
= XVECTOR (vector
)->contents
;
3437 for (i
= 0; i
< size
; i
++)
3440 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3441 bytecode object, the docstring containing the bytecode and
3442 constants values must be treated as unibyte and passed to
3443 Fread, to get the actual bytecode string and constants vector. */
3444 if (bytecodeflag
&& load_force_doc_strings
)
3446 if (i
== COMPILED_BYTECODE
)
3448 if (!STRINGP (item
))
3449 error ("Invalid byte code");
3451 /* Delay handling the bytecode slot until we know whether
3452 it is lazily-loaded (we can tell by whether the
3453 constants slot is nil). */
3454 ASET (vector
, COMPILED_CONSTANTS
, item
);
3457 else if (i
== COMPILED_CONSTANTS
)
3459 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3463 /* Coerce string to unibyte (like string-as-unibyte,
3464 but without generating extra garbage and
3465 guaranteeing no change in the contents). */
3466 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3467 STRING_SET_UNIBYTE (bytestr
);
3469 item
= Fread (Fcons (bytestr
, readcharfun
));
3471 error ("Invalid byte code");
3473 otem
= XCONS (item
);
3474 bytestr
= XCAR (item
);
3479 /* Now handle the bytecode slot. */
3480 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3482 else if (i
== COMPILED_DOC_STRING
3484 && ! STRING_MULTIBYTE (item
))
3486 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3487 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3489 item
= Fstring_as_multibyte (item
);
3492 ASET (vector
, i
, item
);
3500 /* FLAG means check for ] to terminate rather than ) and . */
3503 read_list (bool flag
, Lisp_Object readcharfun
)
3505 Lisp_Object val
, tail
;
3506 Lisp_Object elt
, tem
;
3507 struct gcpro gcpro1
, gcpro2
;
3508 /* 0 is the normal case.
3509 1 means this list is a doc reference; replace it with the number 0.
3510 2 means this list is a doc reference; replace it with the doc string. */
3511 int doc_reference
= 0;
3513 /* Initialize this to 1 if we are reading a list. */
3514 bool first_in_list
= flag
<= 0;
3523 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3528 /* While building, if the list starts with #$, treat it specially. */
3529 if (EQ (elt
, Vload_file_name
)
3531 && !NILP (Vpurify_flag
))
3533 if (NILP (Vdoc_file_name
))
3534 /* We have not yet called Snarf-documentation, so assume
3535 this file is described in the DOC-MM.NN file
3536 and Snarf-documentation will fill in the right value later.
3537 For now, replace the whole list with 0. */
3540 /* We have already called Snarf-documentation, so make a relative
3541 file name for this file, so it can be found properly
3542 in the installed Lisp directory.
3543 We don't use Fexpand_file_name because that would make
3544 the directory absolute now. */
3545 elt
= concat2 (build_string ("../lisp/"),
3546 Ffile_name_nondirectory (elt
));
3548 else if (EQ (elt
, Vload_file_name
)
3550 && load_force_doc_strings
)
3559 invalid_syntax (") or . in a vector");
3567 XSETCDR (tail
, read0 (readcharfun
));
3569 val
= read0 (readcharfun
);
3570 read1 (readcharfun
, &ch
, 0);
3574 if (doc_reference
== 1)
3575 return make_number (0);
3576 if (doc_reference
== 2)
3578 /* Get a doc string from the file we are loading.
3579 If it's in saved_doc_string, get it from there.
3581 Here, we don't know if the string is a
3582 bytecode string or a doc string. As a
3583 bytecode string must be unibyte, we always
3584 return a unibyte string. If it is actually a
3585 doc string, caller must make it
3588 /* Position is negative for user variables. */
3589 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3590 if (pos
>= saved_doc_string_position
3591 && pos
< (saved_doc_string_position
3592 + saved_doc_string_length
))
3594 ptrdiff_t start
= pos
- saved_doc_string_position
;
3597 /* Process quoting with ^A,
3598 and find the end of the string,
3599 which is marked with ^_ (037). */
3600 for (from
= start
, to
= start
;
3601 saved_doc_string
[from
] != 037;)
3603 int c
= saved_doc_string
[from
++];
3606 c
= saved_doc_string
[from
++];
3608 saved_doc_string
[to
++] = c
;
3610 saved_doc_string
[to
++] = 0;
3612 saved_doc_string
[to
++] = 037;
3615 saved_doc_string
[to
++] = c
;
3618 return make_unibyte_string (saved_doc_string
+ start
,
3621 /* Look in prev_saved_doc_string the same way. */
3622 else if (pos
>= prev_saved_doc_string_position
3623 && pos
< (prev_saved_doc_string_position
3624 + prev_saved_doc_string_length
))
3627 pos
- prev_saved_doc_string_position
;
3630 /* Process quoting with ^A,
3631 and find the end of the string,
3632 which is marked with ^_ (037). */
3633 for (from
= start
, to
= start
;
3634 prev_saved_doc_string
[from
] != 037;)
3636 int c
= prev_saved_doc_string
[from
++];
3639 c
= prev_saved_doc_string
[from
++];
3641 prev_saved_doc_string
[to
++] = c
;
3643 prev_saved_doc_string
[to
++] = 0;
3645 prev_saved_doc_string
[to
++] = 037;
3648 prev_saved_doc_string
[to
++] = c
;
3651 return make_unibyte_string (prev_saved_doc_string
3656 return get_doc_string (val
, 1, 0);
3661 invalid_syntax (". in wrong context");
3663 invalid_syntax ("] in a list");
3665 tem
= Fcons (elt
, Qnil
);
3667 XSETCDR (tail
, tem
);
3674 static Lisp_Object initial_obarray
;
3676 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3678 static size_t oblookup_last_bucket_number
;
3680 /* Get an error if OBARRAY is not an obarray.
3681 If it is one, return it. */
3684 check_obarray (Lisp_Object obarray
)
3686 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3688 /* If Vobarray is now invalid, force it to be valid. */
3689 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3690 wrong_type_argument (Qvectorp
, obarray
);
3695 /* Intern the C string STR: return a symbol with that name,
3696 interned in the current obarray. */
3699 intern_1 (const char *str
, ptrdiff_t len
)
3701 Lisp_Object obarray
= check_obarray (Vobarray
);
3702 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3704 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3708 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3710 Lisp_Object obarray
= check_obarray (Vobarray
);
3711 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3716 if (NILP (Vpurify_flag
))
3717 /* Creating a non-pure string from a string literal not
3718 implemented yet. We could just use make_string here and live
3719 with the extra copy. */
3722 return Fintern (make_pure_c_string (str
, len
), obarray
);
3725 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3726 doc
: /* Return the canonical symbol whose name is STRING.
3727 If there is none, one is created by this function and returned.
3728 A second optional argument specifies the obarray to use;
3729 it defaults to the value of `obarray'. */)
3730 (Lisp_Object string
, Lisp_Object obarray
)
3732 register Lisp_Object tem
, sym
, *ptr
;
3734 if (NILP (obarray
)) obarray
= Vobarray
;
3735 obarray
= check_obarray (obarray
);
3737 CHECK_STRING (string
);
3739 tem
= oblookup (obarray
, SSDATA (string
),
3742 if (!INTEGERP (tem
))
3745 if (!NILP (Vpurify_flag
))
3746 string
= Fpurecopy (string
);
3747 sym
= Fmake_symbol (string
);
3749 if (EQ (obarray
, initial_obarray
))
3750 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3752 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3754 if ((SREF (string
, 0) == ':')
3755 && EQ (obarray
, initial_obarray
))
3757 XSYMBOL (sym
)->constant
= 1;
3758 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3759 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3762 ptr
= aref_addr (obarray
, XINT(tem
));
3764 set_symbol_next (sym
, XSYMBOL (*ptr
));
3766 set_symbol_next (sym
, NULL
);
3771 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3772 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3773 NAME may be a string or a symbol. If it is a symbol, that exact
3774 symbol is searched for.
3775 A second optional argument specifies the obarray to use;
3776 it defaults to the value of `obarray'. */)
3777 (Lisp_Object name
, Lisp_Object obarray
)
3779 register Lisp_Object tem
, string
;
3781 if (NILP (obarray
)) obarray
= Vobarray
;
3782 obarray
= check_obarray (obarray
);
3784 if (!SYMBOLP (name
))
3786 CHECK_STRING (name
);
3790 string
= SYMBOL_NAME (name
);
3792 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3793 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3799 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3800 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3801 The value is t if a symbol was found and deleted, nil otherwise.
3802 NAME may be a string or a symbol. If it is a symbol, that symbol
3803 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3804 OBARRAY defaults to the value of the variable `obarray'. */)
3805 (Lisp_Object name
, Lisp_Object obarray
)
3807 register Lisp_Object string
, tem
;
3810 if (NILP (obarray
)) obarray
= Vobarray
;
3811 obarray
= check_obarray (obarray
);
3814 string
= SYMBOL_NAME (name
);
3817 CHECK_STRING (name
);
3821 tem
= oblookup (obarray
, SSDATA (string
),
3826 /* If arg was a symbol, don't delete anything but that symbol itself. */
3827 if (SYMBOLP (name
) && !EQ (name
, tem
))
3830 /* There are plenty of other symbols which will screw up the Emacs
3831 session if we unintern them, as well as even more ways to use
3832 `setq' or `fset' or whatnot to make the Emacs session
3833 unusable. Let's not go down this silly road. --Stef */
3834 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3835 error ("Attempt to unintern t or nil"); */
3837 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3839 hash
= oblookup_last_bucket_number
;
3841 if (EQ (AREF (obarray
, hash
), tem
))
3843 if (XSYMBOL (tem
)->next
)
3846 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3847 ASET (obarray
, hash
, sym
);
3850 ASET (obarray
, hash
, make_number (0));
3854 Lisp_Object tail
, following
;
3856 for (tail
= AREF (obarray
, hash
);
3857 XSYMBOL (tail
)->next
;
3860 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3861 if (EQ (following
, tem
))
3863 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3872 /* Return the symbol in OBARRAY whose names matches the string
3873 of SIZE characters (SIZE_BYTE bytes) at PTR.
3874 If there is no such symbol in OBARRAY, return nil.
3876 Also store the bucket number in oblookup_last_bucket_number. */
3879 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3883 register Lisp_Object tail
;
3884 Lisp_Object bucket
, tem
;
3886 obarray
= check_obarray (obarray
);
3887 obsize
= ASIZE (obarray
);
3889 /* This is sometimes needed in the middle of GC. */
3890 obsize
&= ~ARRAY_MARK_FLAG
;
3891 hash
= hash_string (ptr
, size_byte
) % obsize
;
3892 bucket
= AREF (obarray
, hash
);
3893 oblookup_last_bucket_number
= hash
;
3894 if (EQ (bucket
, make_number (0)))
3896 else if (!SYMBOLP (bucket
))
3897 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3899 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3901 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3902 && SCHARS (SYMBOL_NAME (tail
)) == size
3903 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3905 else if (XSYMBOL (tail
)->next
== 0)
3908 XSETINT (tem
, hash
);
3913 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3916 register Lisp_Object tail
;
3917 CHECK_VECTOR (obarray
);
3918 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3920 tail
= AREF (obarray
, i
);
3925 if (XSYMBOL (tail
)->next
== 0)
3927 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3933 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3935 call1 (function
, sym
);
3938 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3939 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3940 OBARRAY defaults to the value of `obarray'. */)
3941 (Lisp_Object function
, Lisp_Object obarray
)
3943 if (NILP (obarray
)) obarray
= Vobarray
;
3944 obarray
= check_obarray (obarray
);
3946 map_obarray (obarray
, mapatoms_1
, function
);
3950 #define OBARRAY_SIZE 1511
3955 Lisp_Object oblength
;
3956 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3958 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3960 Vobarray
= Fmake_vector (oblength
, make_number (0));
3961 initial_obarray
= Vobarray
;
3962 staticpro (&initial_obarray
);
3964 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
3965 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3966 NILP (Vpurify_flag) check in intern_c_string. */
3967 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3968 Qnil
= intern_c_string ("nil");
3970 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3971 so those two need to be fixed manually. */
3972 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3973 set_symbol_function (Qunbound
, Qnil
);
3974 set_symbol_plist (Qunbound
, Qnil
);
3975 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3976 XSYMBOL (Qnil
)->constant
= 1;
3977 XSYMBOL (Qnil
)->declared_special
= 1;
3978 set_symbol_plist (Qnil
, Qnil
);
3979 set_symbol_function (Qnil
, Qnil
);
3981 Qt
= intern_c_string ("t");
3982 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3983 XSYMBOL (Qnil
)->declared_special
= 1;
3984 XSYMBOL (Qt
)->constant
= 1;
3986 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3989 DEFSYM (Qvariable_documentation
, "variable-documentation");
3991 read_buffer
= xmalloc (size
);
3992 read_buffer_size
= size
;
3996 defsubr (struct Lisp_Subr
*sname
)
3998 Lisp_Object sym
, tem
;
3999 sym
= intern_c_string (sname
->symbol_name
);
4000 XSETPVECTYPE (sname
, PVEC_SUBR
);
4001 XSETSUBR (tem
, sname
);
4002 set_symbol_function (sym
, tem
);
4005 #ifdef NOTDEF /* Use fset in subr.el now! */
4007 defalias (struct Lisp_Subr
*sname
, char *string
)
4010 sym
= intern (string
);
4011 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4015 /* Define an "integer variable"; a symbol whose value is forwarded to a
4016 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4017 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4019 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4020 const char *namestring
, EMACS_INT
*address
)
4023 sym
= intern_c_string (namestring
);
4024 i_fwd
->type
= Lisp_Fwd_Int
;
4025 i_fwd
->intvar
= address
;
4026 XSYMBOL (sym
)->declared_special
= 1;
4027 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4028 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4031 /* Similar but define a variable whose value is t if address contains 1,
4032 nil if address contains 0. */
4034 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4035 const char *namestring
, bool *address
)
4038 sym
= intern_c_string (namestring
);
4039 b_fwd
->type
= Lisp_Fwd_Bool
;
4040 b_fwd
->boolvar
= address
;
4041 XSYMBOL (sym
)->declared_special
= 1;
4042 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4043 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4044 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4047 /* Similar but define a variable whose value is the Lisp Object stored
4048 at address. Two versions: with and without gc-marking of the C
4049 variable. The nopro version is used when that variable will be
4050 gc-marked for some other reason, since marking the same slot twice
4051 can cause trouble with strings. */
4053 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4054 const char *namestring
, Lisp_Object
*address
)
4057 sym
= intern_c_string (namestring
);
4058 o_fwd
->type
= Lisp_Fwd_Obj
;
4059 o_fwd
->objvar
= address
;
4060 XSYMBOL (sym
)->declared_special
= 1;
4061 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4062 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4066 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4067 const char *namestring
, Lisp_Object
*address
)
4069 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4070 staticpro (address
);
4073 /* Similar but define a variable whose value is the Lisp Object stored
4074 at a particular offset in the current kboard object. */
4077 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4078 const char *namestring
, int offset
)
4081 sym
= intern_c_string (namestring
);
4082 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4083 ko_fwd
->offset
= offset
;
4084 XSYMBOL (sym
)->declared_special
= 1;
4085 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4086 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4089 /* Check that the elements of Vload_path exist. */
4092 load_path_check (void)
4094 Lisp_Object path_tail
;
4096 /* The only elements that might not exist are those from
4097 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4099 for (path_tail
= Vload_path
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4101 Lisp_Object dirfile
;
4102 dirfile
= Fcar (path_tail
);
4103 if (STRINGP (dirfile
))
4105 dirfile
= Fdirectory_file_name (dirfile
);
4106 if (! file_accessible_directory_p (SSDATA (dirfile
)))
4107 dir_warning ("Lisp directory", XCAR (path_tail
));
4112 /* Record the value of load-path used at the start of dumping
4113 so we can see if the site changed it later during dumping. */
4114 static Lisp_Object dump_path
;
4116 /* Compute the default Vload_path, with the following logic:
4118 use EMACSLOADPATH env-var if set; otherwise use PATH_LOADSEARCH,
4119 prepending PATH_SITELOADSEARCH unless --no-site-lisp.
4120 The remainder is what happens when dumping works:
4121 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4122 Otherwise use EMACSLOADPATH if set, else PATH_LOADSEARCH.
4124 If !initialized, then just set both Vload_path and dump_path.
4125 If initialized, then if Vload_path != dump_path, do nothing.
4126 (Presumably the load-path has already been changed by something.
4127 This can only be from a site-load file during dumping,
4128 or because EMACSLOADPATH is set.)
4129 If Vinstallation_directory is not nil (ie, running uninstalled):
4130 If installation-dir/lisp exists and not already a member,
4131 we must be running uninstalled. Reset the load-path
4132 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4133 refers to the eventual installation directories. Since we
4134 are not yet installed, we should not use them, even if they exist.)
4135 If installation-dir/lisp does not exist, just add dump_path at the
4137 Add installation-dir/leim (if exists and not already a member) at the front.
4138 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4139 and not already a member) at the front.
4140 If installation-dir != source-dir (ie running an uninstalled,
4141 out-of-tree build) AND install-dir/src/Makefile exists BUT
4142 install-dir/src/Makefile.in does NOT exist (this is a sanity
4143 check), then repeat the above steps for source-dir/lisp,
4145 Finally, add the site-lisp directories at the front (if !no_site_lisp).
4155 const char *loadpath
= ns_load_path ();
4158 normal
= PATH_LOADSEARCH
;
4160 Vload_path
= decode_env_path ("EMACSLOADPATH", loadpath
? loadpath
: normal
);
4162 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4167 /* FIXME CANNOT_DUMP platforms should get source-dir/lisp etc added
4168 to their load-path too, AFAICS. I don't think we can tell the
4169 difference between initialized and !initialized in this case,
4170 so we'll have to do it unconditionally when Vinstallation_directory
4172 if (!no_site_lisp
&& !egetenv ("EMACSLOADPATH"))
4174 Lisp_Object sitelisp
;
4175 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4176 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4178 #else /* !CANNOT_DUMP */
4179 if (NILP (Vpurify_flag
))
4181 normal
= PATH_LOADSEARCH
;
4182 /* If the EMACSLOADPATH environment variable is set, use its value.
4183 This doesn't apply if we're dumping. */
4184 if (egetenv ("EMACSLOADPATH"))
4185 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4188 normal
= PATH_DUMPLOADSEARCH
;
4190 /* In a dumped Emacs, we normally reset the value of Vload_path using
4191 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4192 the source directory, instead of the path of the installed elisp
4193 libraries. However, if it appears that Vload_path has already been
4194 changed from the default that was saved before dumping, don't
4195 change it further. Changes can only be due to EMACSLOADPATH, or
4196 site-lisp files that were processed during dumping. */
4199 if (NILP (Fequal (dump_path
, Vload_path
)))
4201 /* Do not make any changes, just check the elements exist. */
4202 /* Note: --no-site-lisp is ignored.
4203 I don't know what to do about this. */
4209 const char *loadpath
= ns_load_path ();
4210 Vload_path
= decode_env_path (0, loadpath
? loadpath
: normal
);
4212 Vload_path
= decode_env_path (0, normal
);
4214 if (!NILP (Vinstallation_directory
))
4216 Lisp_Object tem
, tem1
;
4218 /* Add to the path the lisp subdir of the installation
4219 dir, if it is accessible. Note: in out-of-tree builds,
4220 this directory is empty save for Makefile. */
4221 tem
= Fexpand_file_name (build_string ("lisp"),
4222 Vinstallation_directory
);
4223 tem1
= Ffile_accessible_directory_p (tem
);
4226 if (NILP (Fmember (tem
, Vload_path
)))
4228 /* We are running uninstalled. The default load-path
4229 points to the eventual installed lisp, leim
4230 directories. We should not use those now, even
4231 if they exist, so start over from a clean slate. */
4232 Vload_path
= Fcons (tem
, Qnil
);
4236 /* That dir doesn't exist, so add the build-time
4237 Lisp dirs instead. */
4238 Vload_path
= nconc2 (Vload_path
, dump_path
);
4240 /* Add leim under the installation dir, if it is accessible. */
4241 tem
= Fexpand_file_name (build_string ("leim"),
4242 Vinstallation_directory
);
4243 tem1
= Ffile_accessible_directory_p (tem
);
4246 if (NILP (Fmember (tem
, Vload_path
)))
4247 Vload_path
= Fcons (tem
, Vload_path
);
4250 /* Add site-lisp under the installation dir, if it exists. */
4253 tem
= Fexpand_file_name (build_string ("site-lisp"),
4254 Vinstallation_directory
);
4255 tem1
= Ffile_accessible_directory_p (tem
);
4258 if (NILP (Fmember (tem
, Vload_path
)))
4259 Vload_path
= Fcons (tem
, Vload_path
);
4263 /* If Emacs was not built in the source directory,
4264 and it is run from where it was built, add to load-path
4265 the lisp, leim and site-lisp dirs under that directory. */
4267 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4271 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4272 Vinstallation_directory
);
4273 tem1
= Ffile_exists_p (tem
);
4275 /* Don't be fooled if they moved the entire source tree
4276 AFTER dumping Emacs. If the build directory is indeed
4277 different from the source dir, src/Makefile.in and
4278 src/Makefile will not be found together. */
4279 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4280 Vinstallation_directory
);
4281 tem2
= Ffile_exists_p (tem
);
4282 if (!NILP (tem1
) && NILP (tem2
))
4284 tem
= Fexpand_file_name (build_string ("lisp"),
4287 if (NILP (Fmember (tem
, Vload_path
)))
4288 Vload_path
= Fcons (tem
, Vload_path
);
4290 tem
= Fexpand_file_name (build_string ("leim"),
4293 if (NILP (Fmember (tem
, Vload_path
)))
4294 Vload_path
= Fcons (tem
, Vload_path
);
4298 tem
= Fexpand_file_name (build_string ("site-lisp"),
4300 tem1
= Ffile_accessible_directory_p (tem
);
4303 if (NILP (Fmember (tem
, Vload_path
)))
4304 Vload_path
= Fcons (tem
, Vload_path
);
4308 } /* Vinstallation_directory != Vsource_directory */
4310 } /* if Vinstallation_directory */
4312 /* Check before adding the site-lisp directories.
4313 The install should have created them, but they are not
4314 required, so no need to warn if they are absent.
4315 Or we might be running before installation. */
4318 /* Add the site-lisp directories at the front. */
4321 Lisp_Object sitelisp
;
4322 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4323 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4325 } /* if dump_path == Vload_path */
4327 else /* !initialized */
4329 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4330 source directory. We used to add ../lisp (ie the lisp dir in
4331 the build directory) at the front here, but that caused trouble
4332 because it was copied from dump_path into Vload_path, above,
4333 when Vinstallation_directory was non-nil. It should not be
4334 necessary, since in out of tree builds lisp/ is empty, save
4336 Vload_path
= decode_env_path (0, normal
);
4337 dump_path
= Vload_path
;
4338 /* No point calling load_path_check; load-path only contains essential
4339 elements from the source directory at this point. They cannot
4340 be missing unless something went extremely (and improbably)
4341 wrong, in which case the build will fail in obvious ways. */
4343 #endif /* !CANNOT_DUMP */
4347 load_in_progress
= 0;
4348 Vload_file_name
= Qnil
;
4350 load_descriptor_list
= Qnil
;
4352 Vstandard_input
= Qt
;
4353 Vloads_in_progress
= Qnil
;
4356 /* Print a warning that directory intended for use USE and with name
4357 DIRNAME cannot be accessed. On entry, errno should correspond to
4358 the access failure. Print the warning on stderr and put it in
4362 dir_warning (char const *use
, Lisp_Object dirname
)
4364 static char const format
[] = "Warning: %s `%s': %s\n";
4365 int access_errno
= errno
;
4366 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4368 /* Don't log the warning before we've initialized!! */
4371 char const *diagnostic
= emacs_strerror (access_errno
);
4373 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4374 + strlen (use
) + SBYTES (dirname
)
4375 + strlen (diagnostic
));
4376 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4378 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4384 syms_of_lread (void)
4387 defsubr (&Sread_from_string
);
4389 defsubr (&Sintern_soft
);
4390 defsubr (&Sunintern
);
4391 defsubr (&Sget_load_suffixes
);
4393 defsubr (&Seval_buffer
);
4394 defsubr (&Seval_region
);
4395 defsubr (&Sread_char
);
4396 defsubr (&Sread_char_exclusive
);
4397 defsubr (&Sread_event
);
4398 defsubr (&Sget_file_char
);
4399 defsubr (&Smapatoms
);
4400 defsubr (&Slocate_file_internal
);
4402 DEFVAR_LISP ("obarray", Vobarray
,
4403 doc
: /* Symbol table for use by `intern' and `read'.
4404 It is a vector whose length ought to be prime for best results.
4405 The vector's contents don't make sense if examined from Lisp programs;
4406 to find all the symbols in an obarray, use `mapatoms'. */);
4408 DEFVAR_LISP ("values", Vvalues
,
4409 doc
: /* List of values of all expressions which were read, evaluated and printed.
4410 Order is reverse chronological. */);
4411 XSYMBOL (intern ("values"))->declared_special
= 0;
4413 DEFVAR_LISP ("standard-input", Vstandard_input
,
4414 doc
: /* Stream for read to get input from.
4415 See documentation of `read' for possible values. */);
4416 Vstandard_input
= Qt
;
4418 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4419 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4421 If this variable is a buffer, then only forms read from that buffer
4422 will be added to `read-symbol-positions-list'.
4423 If this variable is t, then all read forms will be added.
4424 The effect of all other values other than nil are not currently
4425 defined, although they may be in the future.
4427 The positions are relative to the last call to `read' or
4428 `read-from-string'. It is probably a bad idea to set this variable at
4429 the toplevel; bind it instead. */);
4430 Vread_with_symbol_positions
= Qnil
;
4432 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4433 doc
: /* A list mapping read symbols to their positions.
4434 This variable is modified during calls to `read' or
4435 `read-from-string', but only when `read-with-symbol-positions' is
4438 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4439 CHAR-POSITION is an integer giving the offset of that occurrence of the
4440 symbol from the position where `read' or `read-from-string' started.
4442 Note that a symbol will appear multiple times in this list, if it was
4443 read multiple times. The list is in the same order as the symbols
4445 Vread_symbol_positions_list
= Qnil
;
4447 DEFVAR_LISP ("read-circle", Vread_circle
,
4448 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4451 DEFVAR_LISP ("load-path", Vload_path
,
4452 doc
: /* List of directories to search for files to load.
4453 Each element is a string (directory name) or nil (try default directory).
4454 Initialized based on EMACSLOADPATH environment variable, if any,
4455 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4457 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4458 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4459 This list should not include the empty string.
4460 `load' and related functions try to append these suffixes, in order,
4461 to the specified file name if a Lisp suffix is allowed or required. */);
4462 Vload_suffixes
= Fcons (build_pure_c_string (".elc"),
4463 Fcons (build_pure_c_string (".el"), Qnil
));
4464 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4465 doc
: /* List of suffixes that indicate representations of \
4467 This list should normally start with the empty string.
4469 Enabling Auto Compression mode appends the suffixes in
4470 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4471 mode removes them again. `load' and related functions use this list to
4472 determine whether they should look for compressed versions of a file
4473 and, if so, which suffixes they should try to append to the file name
4474 in order to do so. However, if you want to customize which suffixes
4475 the loading functions recognize as compression suffixes, you should
4476 customize `jka-compr-load-suffixes' rather than the present variable. */);
4477 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4479 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4480 doc
: /* Non-nil if inside of `load'. */);
4481 DEFSYM (Qload_in_progress
, "load-in-progress");
4483 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4484 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4485 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4487 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4488 a symbol \(a feature name).
4490 When `load' is run and the file-name argument matches an element's
4491 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4492 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4494 An error in FORMS does not undo the load, but does prevent execution of
4495 the rest of the FORMS. */);
4496 Vafter_load_alist
= Qnil
;
4498 DEFVAR_LISP ("load-history", Vload_history
,
4499 doc
: /* Alist mapping loaded file names to symbols and features.
4500 Each alist element should be a list (FILE-NAME ENTRIES...), where
4501 FILE-NAME is the name of a file that has been loaded into Emacs.
4502 The file name is absolute and true (i.e. it doesn't contain symlinks).
4503 As an exception, one of the alist elements may have FILE-NAME nil,
4504 for symbols and features not associated with any file.
4506 The remaining ENTRIES in the alist element describe the functions and
4507 variables defined in that file, the features provided, and the
4508 features required. Each entry has the form `(provide . FEATURE)',
4509 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4510 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4511 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4512 autoload before this file redefined it as a function. In addition,
4513 entries may also be single symbols, which means that SYMBOL was
4514 defined by `defvar' or `defconst'.
4516 During preloading, the file name recorded is relative to the main Lisp
4517 directory. These file names are converted to absolute at startup. */);
4518 Vload_history
= Qnil
;
4520 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4521 doc
: /* Full name of file being loaded by `load'. */);
4522 Vload_file_name
= Qnil
;
4524 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4525 doc
: /* File name, including directory, of user's initialization file.
4526 If the file loaded had extension `.elc', and the corresponding source file
4527 exists, this variable contains the name of source file, suitable for use
4528 by functions like `custom-save-all' which edit the init file.
4529 While Emacs loads and evaluates the init file, value is the real name
4530 of the file, regardless of whether or not it has the `.elc' extension. */);
4531 Vuser_init_file
= Qnil
;
4533 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4534 doc
: /* Used for internal purposes by `load'. */);
4535 Vcurrent_load_list
= Qnil
;
4537 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4538 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4539 The default is nil, which means use the function `read'. */);
4540 Vload_read_function
= Qnil
;
4542 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4543 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4544 The value should be a function for doing code conversion before
4545 reading a source file. It can also be nil, in which case loading is
4546 done without any code conversion.
4548 If the value is a function, it is called with four arguments,
4549 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4550 the file to load, FILE is the non-absolute name (for messages etc.),
4551 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4552 `load'. The function should return t if the file was loaded. */);
4553 Vload_source_file_function
= Qnil
;
4555 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4556 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4557 This is useful when the file being loaded is a temporary copy. */);
4558 load_force_doc_strings
= 0;
4560 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4561 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4562 This is normally bound by `load' and `eval-buffer' to control `read',
4563 and is not meant for users to change. */);
4564 load_convert_to_unibyte
= 0;
4566 DEFVAR_LISP ("source-directory", Vsource_directory
,
4567 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4568 You cannot count on them to still be there! */);
4570 = Fexpand_file_name (build_string ("../"),
4571 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4573 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4574 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4575 Vpreloaded_file_list
= Qnil
;
4577 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4578 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4579 Vbyte_boolean_vars
= Qnil
;
4581 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4582 doc
: /* Non-nil means load dangerous compiled Lisp files.
4583 Some versions of XEmacs use different byte codes than Emacs. These
4584 incompatible byte codes can make Emacs crash when it tries to execute
4586 load_dangerous_libraries
= 0;
4588 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4589 doc
: /* Non-nil means force printing messages when loading Lisp files.
4590 This overrides the value of the NOMESSAGE argument to `load'. */);
4591 force_load_messages
= 0;
4593 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4594 doc
: /* Regular expression matching safe to load compiled Lisp files.
4595 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4596 from the file, and matches them against this regular expression.
4597 When the regular expression matches, the file is considered to be safe
4598 to load. See also `load-dangerous-libraries'. */);
4599 Vbytecomp_version_regexp
4600 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4602 DEFSYM (Qlexical_binding
, "lexical-binding");
4603 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4604 doc
: /* Whether to use lexical binding when evaluating code.
4605 Non-nil means that the code in the current buffer should be evaluated
4606 with lexical binding.
4607 This variable is automatically set from the file variables of an
4608 interpreted Lisp file read using `load'. Unlike other file local
4609 variables, this must be set in the first line of a file. */);
4610 Vlexical_binding
= Qnil
;
4611 Fmake_variable_buffer_local (Qlexical_binding
);
4613 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4614 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4615 Veval_buffer_list
= Qnil
;
4617 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4618 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4619 Vold_style_backquotes
= Qnil
;
4620 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4622 /* Vsource_directory was initialized in init_lread. */
4624 load_descriptor_list
= Qnil
;
4625 staticpro (&load_descriptor_list
);
4627 DEFSYM (Qcurrent_load_list
, "current-load-list");
4628 DEFSYM (Qstandard_input
, "standard-input");
4629 DEFSYM (Qread_char
, "read-char");
4630 DEFSYM (Qget_file_char
, "get-file-char");
4631 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4632 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4634 DEFSYM (Qbackquote
, "`");
4635 DEFSYM (Qcomma
, ",");
4636 DEFSYM (Qcomma_at
, ",@");
4637 DEFSYM (Qcomma_dot
, ",.");
4639 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4640 DEFSYM (Qascii_character
, "ascii-character");
4641 DEFSYM (Qfunction
, "function");
4642 DEFSYM (Qload
, "load");
4643 DEFSYM (Qload_file_name
, "load-file-name");
4644 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4645 DEFSYM (Qfile_truename
, "file-truename");
4646 DEFSYM (Qdir_ok
, "dir-ok");
4647 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4649 staticpro (&dump_path
);
4651 staticpro (&read_objects
);
4652 read_objects
= Qnil
;
4653 staticpro (&seen_list
);
4656 Vloads_in_progress
= Qnil
;
4657 staticpro (&Vloads_in_progress
);
4659 DEFSYM (Qhash_table
, "hash-table");
4660 DEFSYM (Qdata
, "data");
4661 DEFSYM (Qtest
, "test");
4662 DEFSYM (Qsize
, "size");
4663 DEFSYM (Qweakness
, "weakness");
4664 DEFSYM (Qrehash_size
, "rehash-size");
4665 DEFSYM (Qrehash_threshold
, "rehash-threshold");