1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2012 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
27 #include <limits.h> /* For CHAR_BIT. */
28 #include <stat-time.h>
30 #include "intervals.h"
31 #include "character.h"
39 #include "termhooks.h"
41 #include "blockinput.h"
55 #endif /* HAVE_SETLOCALE */
60 #define file_offset off_t
61 #define file_tell ftello
63 #define file_offset long
64 #define file_tell ftell
67 /* Hash table read constants. */
68 static Lisp_Object Qhash_table
, Qdata
;
69 static Lisp_Object Qtest
, Qsize
;
70 static Lisp_Object Qweakness
;
71 static Lisp_Object Qrehash_size
;
72 static Lisp_Object Qrehash_threshold
;
74 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
75 Lisp_Object Qstandard_input
;
76 Lisp_Object Qvariable_documentation
;
77 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
78 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
79 static Lisp_Object Qinhibit_file_name_operation
;
80 static Lisp_Object Qeval_buffer_list
;
81 Lisp_Object Qlexical_binding
;
82 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
84 /* Used instead of Qget_file_char while loading *.elc files compiled
85 by Emacs 21 or older. */
86 static Lisp_Object Qget_emacs_mule_file_char
;
88 static Lisp_Object Qload_force_doc_strings
;
90 static Lisp_Object Qload_in_progress
;
92 /* The association list of objects read with the #n=object form.
93 Each member of the list has the form (n . object), and is used to
94 look up the object for the corresponding #n# construct.
95 It must be set to nil before all top-level calls to read0. */
96 static Lisp_Object read_objects
;
98 /* True means READCHAR should read bytes one by one (not character)
99 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
100 This is set by read1 temporarily while handling #@NUMBER. */
101 static bool load_each_byte
;
103 /* List of descriptors now open for Fload. */
104 static Lisp_Object load_descriptor_list
;
106 /* File for get_file_char to read from. Use by load. */
107 static FILE *instream
;
109 /* For use within read-from-string (this reader is non-reentrant!!) */
110 static ptrdiff_t read_from_string_index
;
111 static ptrdiff_t read_from_string_index_byte
;
112 static ptrdiff_t read_from_string_limit
;
114 /* Number of characters read in the current call to Fread or
115 Fread_from_string. */
116 static EMACS_INT readchar_count
;
118 /* This contains the last string skipped with #@. */
119 static char *saved_doc_string
;
120 /* Length of buffer allocated in saved_doc_string. */
121 static ptrdiff_t saved_doc_string_size
;
122 /* Length of actual data in saved_doc_string. */
123 static ptrdiff_t saved_doc_string_length
;
124 /* This is the file position that string came from. */
125 static file_offset saved_doc_string_position
;
127 /* This contains the previous string skipped with #@.
128 We copy it from saved_doc_string when a new string
129 is put in saved_doc_string. */
130 static char *prev_saved_doc_string
;
131 /* Length of buffer allocated in prev_saved_doc_string. */
132 static ptrdiff_t prev_saved_doc_string_size
;
133 /* Length of actual data in prev_saved_doc_string. */
134 static ptrdiff_t prev_saved_doc_string_length
;
135 /* This is the file position that string came from. */
136 static file_offset prev_saved_doc_string_position
;
138 /* True means inside a new-style backquote
139 with no surrounding parentheses.
140 Fread initializes this to false, so we need not specbind it
141 or worry about what happens to it when there is an error. */
142 static bool new_backquote_flag
;
143 static Lisp_Object Qold_style_backquotes
;
145 /* A list of file names for files being loaded in Fload. Used to
146 check for recursive loads. */
148 static Lisp_Object Vloads_in_progress
;
150 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
153 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
154 Lisp_Object
, Lisp_Object
,
155 Lisp_Object
, Lisp_Object
);
156 static Lisp_Object
load_unwind (Lisp_Object
);
157 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
159 /* Functions that read one byte from the current source READCHARFUN
160 or unreads one byte. If the integer argument C is -1, it returns
161 one read byte, or -1 when there's no more byte in the source. If C
162 is 0 or positive, it unreads C, and the return value is not
165 static int readbyte_for_lambda (int, Lisp_Object
);
166 static int readbyte_from_file (int, Lisp_Object
);
167 static int readbyte_from_string (int, Lisp_Object
);
169 /* Handle unreading and rereading of characters.
170 Write READCHAR to read a character,
171 UNREAD(c) to unread c to be read again.
173 These macros correctly read/unread multibyte characters. */
175 #define READCHAR readchar (readcharfun, NULL)
176 #define UNREAD(c) unreadchar (readcharfun, c)
178 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
179 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
181 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
182 Qlambda, or a cons, we use this to keep an unread character because
183 a file stream can't handle multibyte-char unreading. The value -1
184 means that there's no unread character. */
185 static int unread_char
;
188 readchar (Lisp_Object readcharfun
, bool *multibyte
)
192 int (*readbyte
) (int, Lisp_Object
);
193 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
195 bool emacs_mule_encoding
= 0;
202 if (BUFFERP (readcharfun
))
204 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
206 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
208 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
211 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
213 /* Fetch the character code from the buffer. */
214 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
215 BUF_INC_POS (inbuffer
, pt_byte
);
222 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
223 if (! ASCII_BYTE_P (c
))
224 c
= BYTE8_TO_CHAR (c
);
227 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
231 if (MARKERP (readcharfun
))
233 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
235 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
237 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
240 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
242 /* Fetch the character code from the buffer. */
243 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
244 BUF_INC_POS (inbuffer
, bytepos
);
251 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
252 if (! ASCII_BYTE_P (c
))
253 c
= BYTE8_TO_CHAR (c
);
257 XMARKER (readcharfun
)->bytepos
= bytepos
;
258 XMARKER (readcharfun
)->charpos
++;
263 if (EQ (readcharfun
, Qlambda
))
265 readbyte
= readbyte_for_lambda
;
269 if (EQ (readcharfun
, Qget_file_char
))
271 readbyte
= readbyte_from_file
;
275 if (STRINGP (readcharfun
))
277 if (read_from_string_index
>= read_from_string_limit
)
279 else if (STRING_MULTIBYTE (readcharfun
))
283 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
284 read_from_string_index
,
285 read_from_string_index_byte
);
289 c
= SREF (readcharfun
, read_from_string_index_byte
);
290 read_from_string_index
++;
291 read_from_string_index_byte
++;
296 if (CONSP (readcharfun
))
298 /* This is the case that read_vector is reading from a unibyte
299 string that contains a byte sequence previously skipped
300 because of #@NUMBER. The car part of readcharfun is that
301 string, and the cdr part is a value of readcharfun given to
303 readbyte
= readbyte_from_string
;
304 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
305 emacs_mule_encoding
= 1;
309 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
311 readbyte
= readbyte_from_file
;
312 emacs_mule_encoding
= 1;
316 tem
= call0 (readcharfun
);
323 if (unread_char
>= 0)
329 c
= (*readbyte
) (-1, readcharfun
);
330 if (c
< 0 || load_each_byte
)
334 if (ASCII_BYTE_P (c
))
336 if (emacs_mule_encoding
)
337 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
340 len
= BYTES_BY_CHAR_HEAD (c
);
343 c
= (*readbyte
) (-1, readcharfun
);
344 if (c
< 0 || ! TRAILING_CODE_P (c
))
347 (*readbyte
) (buf
[i
], readcharfun
);
348 return BYTE8_TO_CHAR (buf
[0]);
352 return STRING_CHAR (buf
);
355 /* Unread the character C in the way appropriate for the stream READCHARFUN.
356 If the stream is a user function, call it with the char as argument. */
359 unreadchar (Lisp_Object readcharfun
, int c
)
363 /* Don't back up the pointer if we're unreading the end-of-input mark,
364 since readchar didn't advance it when we read it. */
366 else if (BUFFERP (readcharfun
))
368 struct buffer
*b
= XBUFFER (readcharfun
);
369 ptrdiff_t charpos
= BUF_PT (b
);
370 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
372 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
373 BUF_DEC_POS (b
, bytepos
);
377 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
379 else if (MARKERP (readcharfun
))
381 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
382 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
384 XMARKER (readcharfun
)->charpos
--;
385 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
386 BUF_DEC_POS (b
, bytepos
);
390 XMARKER (readcharfun
)->bytepos
= bytepos
;
392 else if (STRINGP (readcharfun
))
394 read_from_string_index
--;
395 read_from_string_index_byte
396 = string_char_to_byte (readcharfun
, read_from_string_index
);
398 else if (CONSP (readcharfun
))
402 else if (EQ (readcharfun
, Qlambda
))
406 else if (EQ (readcharfun
, Qget_file_char
)
407 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
412 ungetc (c
, instream
);
419 call1 (readcharfun
, make_number (c
));
423 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
425 return read_bytecode_char (c
>= 0);
430 readbyte_from_file (int c
, Lisp_Object readcharfun
)
435 ungetc (c
, instream
);
443 /* Interrupted reads have been observed while reading over the network. */
444 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
455 return (c
== EOF
? -1 : c
);
459 readbyte_from_string (int c
, Lisp_Object readcharfun
)
461 Lisp_Object string
= XCAR (readcharfun
);
465 read_from_string_index
--;
466 read_from_string_index_byte
467 = string_char_to_byte (string
, read_from_string_index
);
470 if (read_from_string_index
>= read_from_string_limit
)
473 FETCH_STRING_CHAR_ADVANCE (c
, string
,
474 read_from_string_index
,
475 read_from_string_index_byte
);
480 /* Read one non-ASCII character from INSTREAM. The character is
481 encoded in `emacs-mule' and the first byte is already read in
485 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
487 /* Emacs-mule coding uses at most 4-byte for one character. */
488 unsigned char buf
[4];
489 int len
= emacs_mule_bytes
[c
];
490 struct charset
*charset
;
495 /* C is not a valid leading-code of `emacs-mule'. */
496 return BYTE8_TO_CHAR (c
);
502 c
= (*readbyte
) (-1, readcharfun
);
506 (*readbyte
) (buf
[i
], readcharfun
);
507 return BYTE8_TO_CHAR (buf
[0]);
514 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
515 code
= buf
[1] & 0x7F;
519 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
520 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
522 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
523 code
= buf
[2] & 0x7F;
527 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
528 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
533 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
534 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
536 c
= DECODE_CHAR (charset
, code
);
538 Fsignal (Qinvalid_read_syntax
,
539 Fcons (build_string ("invalid multibyte form"), Qnil
));
544 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
546 static Lisp_Object
read0 (Lisp_Object
);
547 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
549 static Lisp_Object
read_list (bool, Lisp_Object
);
550 static Lisp_Object
read_vector (Lisp_Object
, bool);
552 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
554 static void substitute_object_in_subtree (Lisp_Object
,
556 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
559 /* Get a character from the tty. */
561 /* Read input events until we get one that's acceptable for our purposes.
563 If NO_SWITCH_FRAME, switch-frame events are stashed
564 until we get a character we like, and then stuffed into
567 If ASCII_REQUIRED, check function key events to see
568 if the unmodified version of the symbol has a Qascii_character
569 property, and use that character, if present.
571 If ERROR_NONASCII, signal an error if the input we
572 get isn't an ASCII character with modifiers. If it's false but
573 ASCII_REQUIRED is true, just re-read until we get an ASCII
576 If INPUT_METHOD, invoke the current input method
577 if the character warrants that.
579 If SECONDS is a number, wait that many seconds for input, and
580 return Qnil if no input arrives within that time. */
583 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
584 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
586 Lisp_Object val
, delayed_switch_frame
;
589 #ifdef HAVE_WINDOW_SYSTEM
590 if (display_hourglass_p
)
594 delayed_switch_frame
= Qnil
;
596 /* Compute timeout. */
597 if (NUMBERP (seconds
))
599 double duration
= extract_float (seconds
);
600 EMACS_TIME wait_time
= EMACS_TIME_FROM_DOUBLE (duration
);
601 end_time
= add_emacs_time (current_emacs_time (), wait_time
);
604 /* Read until we get an acceptable event. */
607 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
608 NUMBERP (seconds
) ? &end_time
: NULL
);
609 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
614 /* switch-frame events are put off until after the next ASCII
615 character. This is better than signaling an error just because
616 the last characters were typed to a separate minibuffer frame,
617 for example. Eventually, some code which can deal with
618 switch-frame events will read it and process it. */
620 && EVENT_HAS_PARAMETERS (val
)
621 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
623 delayed_switch_frame
= val
;
627 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
629 /* Convert certain symbols to their ASCII equivalents. */
632 Lisp_Object tem
, tem1
;
633 tem
= Fget (val
, Qevent_symbol_element_mask
);
636 tem1
= Fget (Fcar (tem
), Qascii_character
);
637 /* Merge this symbol's modifier bits
638 with the ASCII equivalent of its basic code. */
640 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
644 /* If we don't have a character now, deal with it appropriately. */
649 Vunread_command_events
= Fcons (val
, Qnil
);
650 error ("Non-character input-event");
657 if (! NILP (delayed_switch_frame
))
658 unread_switch_frame
= delayed_switch_frame
;
662 #ifdef HAVE_WINDOW_SYSTEM
663 if (display_hourglass_p
)
672 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
673 doc
: /* Read a character from the command input (keyboard or macro).
674 It is returned as a number.
675 If the character has modifiers, they are resolved and reflected to the
676 character code if possible (e.g. C-SPC -> 0).
678 If the user generates an event which is not a character (i.e. a mouse
679 click or function key event), `read-char' signals an error. As an
680 exception, switch-frame events are put off until non-character events
682 If you want to read non-character events, or ignore them, call
683 `read-event' or `read-char-exclusive' instead.
685 If the optional argument PROMPT is non-nil, display that as a prompt.
686 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
687 input method is turned on in the current buffer, that input method
688 is used for reading a character.
689 If the optional argument SECONDS is non-nil, it should be a number
690 specifying the maximum number of seconds to wait for input. If no
691 input arrives in that time, return nil. SECONDS may be a
692 floating-point value. */)
693 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
698 message_with_string ("%s", prompt
, 0);
699 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
701 return (NILP (val
) ? Qnil
702 : make_number (char_resolve_modifier_mask (XINT (val
))));
705 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
706 doc
: /* Read an event object from the input stream.
707 If the optional argument PROMPT is non-nil, display that as a prompt.
708 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
709 input method is turned on in the current buffer, that input method
710 is used for reading a character.
711 If the optional argument SECONDS is non-nil, it should be a number
712 specifying the maximum number of seconds to wait for input. If no
713 input arrives in that time, return nil. SECONDS may be a
714 floating-point value. */)
715 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
718 message_with_string ("%s", prompt
, 0);
719 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
722 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
723 doc
: /* Read a character from the command input (keyboard or macro).
724 It is returned as a number. Non-character events are ignored.
725 If the character has modifiers, they are resolved and reflected to the
726 character code if possible (e.g. C-SPC -> 0).
728 If the optional argument PROMPT is non-nil, display that as a prompt.
729 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
730 input method is turned on in the current buffer, that input method
731 is used for reading a character.
732 If the optional argument SECONDS is non-nil, it should be a number
733 specifying the maximum number of seconds to wait for input. If no
734 input arrives in that time, return nil. SECONDS may be a
735 floating-point value. */)
736 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
741 message_with_string ("%s", prompt
, 0);
743 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
745 return (NILP (val
) ? Qnil
746 : make_number (char_resolve_modifier_mask (XINT (val
))));
749 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
750 doc
: /* Don't use this yourself. */)
753 register Lisp_Object val
;
755 XSETINT (val
, getc (instream
));
763 /* Return true if the lisp code read using READCHARFUN defines a non-nil
764 `lexical-binding' file variable. After returning, the stream is
765 positioned following the first line, if it is a comment or #! line,
766 otherwise nothing is read. */
769 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
782 while (ch
!= '\n' && ch
!= EOF
)
784 if (ch
== '\n') ch
= READCHAR
;
785 /* It is OK to leave the position after a #! line, since
786 that is what read1 does. */
790 /* The first line isn't a comment, just give up. */
796 /* Look for an appropriate file-variable in the first line. */
800 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
801 } beg_end_state
= NOMINAL
;
802 bool in_file_vars
= 0;
804 #define UPDATE_BEG_END_STATE(ch) \
805 if (beg_end_state == NOMINAL) \
806 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
807 else if (beg_end_state == AFTER_FIRST_DASH) \
808 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
809 else if (beg_end_state == AFTER_ASTERIX) \
812 in_file_vars = !in_file_vars; \
813 beg_end_state = NOMINAL; \
816 /* Skip until we get to the file vars, if any. */
820 UPDATE_BEG_END_STATE (ch
);
822 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
826 char var
[100], val
[100];
831 /* Read a variable name. */
832 while (ch
== ' ' || ch
== '\t')
836 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
838 if (i
< sizeof var
- 1)
840 UPDATE_BEG_END_STATE (ch
);
844 /* Stop scanning if no colon was found before end marker. */
845 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
848 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
854 /* Read a variable value. */
857 while (ch
== ' ' || ch
== '\t')
861 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
863 if (i
< sizeof val
- 1)
865 UPDATE_BEG_END_STATE (ch
);
869 /* The value was terminated by an end-marker, which remove. */
871 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
875 if (strcmp (var
, "lexical-binding") == 0)
878 rv
= (strcmp (val
, "nil") != 0);
884 while (ch
!= '\n' && ch
!= EOF
)
891 /* Value is a version number of byte compiled code if the file
892 associated with file descriptor FD is a compiled Lisp file that's
893 safe to load. Only files compiled with Emacs are safe to load.
894 Files compiled with XEmacs can lead to a crash in Fbyte_code
895 because of an incompatible change in the byte compiler. */
898 safe_to_load_version (int fd
)
904 /* Read the first few bytes from the file, and look for a line
905 specifying the byte compiler version used. */
906 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
909 /* Skip to the next newline, skipping over the initial `ELC'
910 with NUL bytes following it, but note the version. */
911 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
916 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
917 buf
+ i
, nbytes
- i
) < 0)
921 lseek (fd
, 0, SEEK_SET
);
926 /* Callback for record_unwind_protect. Restore the old load list OLD,
927 after loading a file successfully. */
930 record_load_unwind (Lisp_Object old
)
932 return Vloads_in_progress
= old
;
935 /* This handler function is used via internal_condition_case_1. */
938 load_error_handler (Lisp_Object data
)
944 load_warn_old_style_backquotes (Lisp_Object file
)
946 if (!NILP (Vold_style_backquotes
))
949 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
956 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
957 doc
: /* Return the suffixes that `load' should try if a suffix is \
959 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
962 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
963 while (CONSP (suffixes
))
965 Lisp_Object exts
= Vload_file_rep_suffixes
;
966 suffix
= XCAR (suffixes
);
967 suffixes
= XCDR (suffixes
);
972 lst
= Fcons (concat2 (suffix
, ext
), lst
);
975 return Fnreverse (lst
);
978 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
979 doc
: /* Execute a file of Lisp code named FILE.
980 First try FILE with `.elc' appended, then try with `.el',
981 then try FILE unmodified (the exact suffixes in the exact order are
982 determined by `load-suffixes'). Environment variable references in
983 FILE are replaced with their values by calling `substitute-in-file-name'.
984 This function searches the directories in `load-path'.
986 If optional second arg NOERROR is non-nil,
987 report no error if FILE doesn't exist.
988 Print messages at start and end of loading unless
989 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
991 If optional fourth arg NOSUFFIX is non-nil, don't try adding
992 suffixes `.elc' or `.el' to the specified name FILE.
993 If optional fifth arg MUST-SUFFIX is non-nil, insist on
994 the suffix `.elc' or `.el'; don't accept just FILE unless
995 it ends in one of those suffixes or includes a directory name.
997 If NOSUFFIX is nil, then if a file could not be found, try looking for
998 a different representation of the file by adding non-empty suffixes to
999 its name, before trying another file. Emacs uses this feature to find
1000 compressed versions of files when Auto Compression mode is enabled.
1001 If NOSUFFIX is non-nil, disable this feature.
1003 The suffixes that this function tries out, when NOSUFFIX is nil, are
1004 given by the return value of `get-load-suffixes' and the values listed
1005 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1006 return value of `get-load-suffixes' is used, i.e. the file name is
1007 required to have a non-empty suffix.
1009 Loading a file records its definitions, and its `provide' and
1010 `require' calls, in an element of `load-history' whose
1011 car is the file name loaded. See `load-history'.
1013 While the file is in the process of being loaded, the variable
1014 `load-in-progress' is non-nil and the variable `load-file-name'
1015 is bound to the file's name.
1017 Return t if the file exists and loads successfully. */)
1018 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1020 register FILE *stream
;
1021 register int fd
= -1;
1022 ptrdiff_t count
= SPECPDL_INDEX ();
1023 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1024 Lisp_Object found
, efound
, hist_file_name
;
1025 /* True means we printed the ".el is newer" message. */
1027 /* True means we are loading a compiled file. */
1029 Lisp_Object handler
;
1031 const char *fmode
= "r";
1039 CHECK_STRING (file
);
1041 /* If file name is magic, call the handler. */
1042 /* This shouldn't be necessary any more now that `openp' handles it right.
1043 handler = Ffind_file_name_handler (file, Qload);
1044 if (!NILP (handler))
1045 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1047 /* Do this after the handler to avoid
1048 the need to gcpro noerror, nomessage and nosuffix.
1049 (Below here, we care only whether they are nil or not.)
1050 The presence of this call is the result of a historical accident:
1051 it used to be in every file-operation and when it got removed
1052 everywhere, it accidentally stayed here. Since then, enough people
1053 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1054 that it seemed risky to remove. */
1055 if (! NILP (noerror
))
1057 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1058 Qt
, load_error_handler
);
1063 file
= Fsubstitute_in_file_name (file
);
1066 /* Avoid weird lossage with null string as arg,
1067 since it would try to load a directory as a Lisp file. */
1068 if (SBYTES (file
) > 0)
1070 ptrdiff_t size
= SBYTES (file
);
1073 GCPRO2 (file
, found
);
1075 if (! NILP (must_suffix
))
1077 /* Don't insist on adding a suffix if FILE already ends with one. */
1079 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1082 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1084 /* Don't insist on adding a suffix
1085 if the argument includes a directory name. */
1086 else if (! NILP (Ffile_name_directory (file
)))
1090 fd
= openp (Vload_path
, file
,
1091 (!NILP (nosuffix
) ? Qnil
1092 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1093 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1094 tmp
[1] = Vload_file_rep_suffixes
,
1103 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1107 /* Tell startup.el whether or not we found the user's init file. */
1108 if (EQ (Qt
, Vuser_init_file
))
1109 Vuser_init_file
= found
;
1111 /* If FD is -2, that means openp found a magic file. */
1114 if (NILP (Fequal (found
, file
)))
1115 /* If FOUND is a different file name from FILE,
1116 find its handler even if we have already inhibited
1117 the `load' operation on FILE. */
1118 handler
= Ffind_file_name_handler (found
, Qt
);
1120 handler
= Ffind_file_name_handler (found
, Qload
);
1121 if (! NILP (handler
))
1122 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1124 /* Tramp has to deal with semi-broken packages that prepend
1125 drive letters to remote files. For that reason, Tramp
1126 catches file operations that test for file existence, which
1127 makes openp think X:/foo.elc files are remote. However,
1128 Tramp does not catch `load' operations for such files, so we
1129 end up with a nil as the `load' handler above. If we would
1130 continue with fd = -2, we will behave wrongly, and in
1131 particular try reading a .elc file in the "rt" mode instead
1132 of "rb". See bug #9311 for the results. To work around
1133 this, we try to open the file locally, and go with that if it
1135 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1141 /* Check if we're stuck in a recursive load cycle.
1143 2000-09-21: It's not possible to just check for the file loaded
1144 being a member of Vloads_in_progress. This fails because of the
1145 way the byte compiler currently works; `provide's are not
1146 evaluated, see font-lock.el/jit-lock.el as an example. This
1147 leads to a certain amount of ``normal'' recursion.
1149 Also, just loading a file recursively is not always an error in
1150 the general case; the second load may do something different. */
1154 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1155 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1159 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1161 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1162 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1165 /* All loads are by default dynamic, unless the file itself specifies
1166 otherwise using a file-variable in the first line. This is bound here
1167 so that it takes effect whether or not we use
1168 Vload_source_file_function. */
1169 specbind (Qlexical_binding
, Qnil
);
1171 /* Get the name for load-history. */
1172 hist_file_name
= (! NILP (Vpurify_flag
)
1173 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1174 tmp
[1] = Ffile_name_nondirectory (found
),
1180 /* Check for the presence of old-style quotes and warn about them. */
1181 specbind (Qold_style_backquotes
, Qnil
);
1182 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1184 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1185 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1186 /* Load .elc files directly, but not when they are
1187 remote and have no handler! */
1194 GCPRO3 (file
, found
, hist_file_name
);
1197 && ! (version
= safe_to_load_version (fd
)))
1200 if (!load_dangerous_libraries
)
1204 error ("File `%s' was not compiled in Emacs",
1207 else if (!NILP (nomessage
) && !force_load_messages
)
1208 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1213 efound
= ENCODE_FILE (found
);
1218 result
= stat (SSDATA (efound
), &s1
);
1221 SSET (efound
, SBYTES (efound
) - 1, 0);
1222 result
= stat (SSDATA (efound
), &s2
);
1223 SSET (efound
, SBYTES (efound
) - 1, 'c');
1227 && EMACS_TIME_LT (get_stat_mtime (&s1
), get_stat_mtime (&s2
)))
1229 /* Make the progress messages mention that source is newer. */
1232 /* If we won't print another message, mention this anyway. */
1233 if (!NILP (nomessage
) && !force_load_messages
)
1235 Lisp_Object msg_file
;
1236 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1237 message_with_string ("Source file `%s' newer than byte-compiled file",
1246 /* We are loading a source file (*.el). */
1247 if (!NILP (Vload_source_file_function
))
1253 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1254 NILP (noerror
) ? Qnil
: Qt
,
1255 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1256 return unbind_to (count
, val
);
1260 GCPRO3 (file
, found
, hist_file_name
);
1263 efound
= ENCODE_FILE (found
);
1264 /* If we somehow got here with fd == -2, meaning the file is deemed
1265 to be remote, don't even try to reopen the file locally; just
1266 force a failure instead. */
1270 stream
= fopen (SSDATA (efound
), fmode
);
1274 #else /* not WINDOWSNT */
1275 stream
= fdopen (fd
, fmode
);
1276 #endif /* not WINDOWSNT */
1280 error ("Failure to create stdio stream for %s", SDATA (file
));
1283 if (! NILP (Vpurify_flag
))
1284 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1286 if (NILP (nomessage
) || force_load_messages
)
1289 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1292 message_with_string ("Loading %s (source)...", file
, 1);
1294 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1296 else /* The typical case; compiled file newer than source file. */
1297 message_with_string ("Loading %s...", file
, 1);
1300 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1301 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1302 specbind (Qload_file_name
, found
);
1303 specbind (Qinhibit_file_name_operation
, Qnil
);
1304 load_descriptor_list
1305 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1306 specbind (Qload_in_progress
, Qt
);
1309 if (lisp_file_lexically_bound_p (Qget_file_char
))
1310 Fset (Qlexical_binding
, Qt
);
1312 if (! version
|| version
>= 22)
1313 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1314 0, Qnil
, Qnil
, Qnil
, Qnil
);
1317 /* We can't handle a file which was compiled with
1318 byte-compile-dynamic by older version of Emacs. */
1319 specbind (Qload_force_doc_strings
, Qt
);
1320 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1321 0, Qnil
, Qnil
, Qnil
, Qnil
);
1323 unbind_to (count
, Qnil
);
1325 /* Run any eval-after-load forms for this file. */
1326 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1327 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1331 xfree (saved_doc_string
);
1332 saved_doc_string
= 0;
1333 saved_doc_string_size
= 0;
1335 xfree (prev_saved_doc_string
);
1336 prev_saved_doc_string
= 0;
1337 prev_saved_doc_string_size
= 0;
1339 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1342 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1345 message_with_string ("Loading %s (source)...done", file
, 1);
1347 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1349 else /* The typical case; compiled file newer than source file. */
1350 message_with_string ("Loading %s...done", file
, 1);
1357 load_unwind (Lisp_Object arg
) /* Used as unwind-protect function in load. */
1359 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1370 load_descriptor_unwind (Lisp_Object oldlist
)
1372 load_descriptor_list
= oldlist
;
1376 /* Close all descriptors in use for Floads.
1377 This is used when starting a subprocess. */
1380 close_load_descs (void)
1384 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1385 emacs_close (XFASTINT (XCAR (tail
)));
1390 complete_filename_p (Lisp_Object pathname
)
1392 const unsigned char *s
= SDATA (pathname
);
1393 return (IS_DIRECTORY_SEP (s
[0])
1394 || (SCHARS (pathname
) > 2
1395 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1398 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1399 doc
: /* Search for FILENAME through PATH.
1400 Returns the file's name in absolute form, or nil if not found.
1401 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1402 file name when searching.
1403 If non-nil, PREDICATE is used instead of `file-readable-p'.
1404 PREDICATE can also be an integer to pass to the faccessat(2) function,
1405 in which case file-name-handlers are ignored.
1406 This function will normally skip directories, so if you want it to find
1407 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1408 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1411 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1412 if (NILP (predicate
) && fd
> 0)
1417 static Lisp_Object Qdir_ok
;
1419 /* Search for a file whose name is STR, looking in directories
1420 in the Lisp list PATH, and trying suffixes from SUFFIX.
1421 On success, returns a file descriptor. On failure, returns -1.
1423 SUFFIXES is a list of strings containing possible suffixes.
1424 The empty suffix is automatically added if the list is empty.
1426 PREDICATE non-nil means don't open the files,
1427 just look for one that satisfies the predicate. In this case,
1428 returns 1 on success. The predicate can be a lisp function or
1429 an integer to pass to `access' (in which case file-name-handlers
1432 If STOREPTR is nonzero, it points to a slot where the name of
1433 the file actually found should be stored as a Lisp string.
1434 nil is stored there on failure.
1436 If the file we find is remote, return -2
1437 but store the found remote file name in *STOREPTR. */
1440 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1442 ptrdiff_t fn_size
= 100;
1446 ptrdiff_t want_length
;
1447 Lisp_Object filename
;
1448 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1449 Lisp_Object string
, tail
, encoded_fn
;
1450 ptrdiff_t max_suffix_len
= 0;
1454 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1456 CHECK_STRING_CAR (tail
);
1457 max_suffix_len
= max (max_suffix_len
,
1458 SBYTES (XCAR (tail
)));
1461 string
= filename
= encoded_fn
= Qnil
;
1462 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1467 if (complete_filename_p (str
))
1470 for (; CONSP (path
); path
= XCDR (path
))
1472 filename
= Fexpand_file_name (str
, XCAR (path
));
1473 if (!complete_filename_p (filename
))
1474 /* If there are non-absolute elts in PATH (eg "."). */
1475 /* Of course, this could conceivably lose if luser sets
1476 default-directory to be something non-absolute... */
1478 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1479 if (!complete_filename_p (filename
))
1480 /* Give up on this path element! */
1484 /* Calculate maximum length of any filename made from
1485 this path element/specified file name and any possible suffix. */
1486 want_length
= max_suffix_len
+ SBYTES (filename
);
1487 if (fn_size
<= want_length
)
1488 fn
= alloca (fn_size
= 100 + want_length
);
1490 /* Loop over suffixes. */
1491 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1492 CONSP (tail
); tail
= XCDR (tail
))
1494 ptrdiff_t fnlen
, lsuffix
= SBYTES (XCAR (tail
));
1495 Lisp_Object handler
;
1497 /* Concatenate path element/specified name with the suffix.
1498 If the directory starts with /:, remove that. */
1499 int prefixlen
= ((SCHARS (filename
) > 2
1500 && SREF (filename
, 0) == '/'
1501 && SREF (filename
, 1) == ':')
1503 fnlen
= SBYTES (filename
) - prefixlen
;
1504 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1505 memcpy (fn
+ fnlen
, SDATA (XCAR (tail
)), lsuffix
+ 1);
1507 /* Check that the file exists and is not a directory. */
1508 /* We used to only check for handlers on non-absolute file names:
1512 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1513 It's not clear why that was the case and it breaks things like
1514 (load "/bar.el") where the file is actually "/bar.el.gz". */
1515 string
= make_string (fn
, fnlen
);
1516 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1517 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1520 if (NILP (predicate
))
1521 exists
= !NILP (Ffile_readable_p (string
));
1524 Lisp_Object tmp
= call1 (predicate
, string
);
1525 exists
= !NILP (tmp
)
1526 && (EQ (tmp
, Qdir_ok
)
1527 || NILP (Ffile_directory_p (string
)));
1532 /* We succeeded; return this descriptor and filename. */
1544 encoded_fn
= ENCODE_FILE (string
);
1545 pfn
= SSDATA (encoded_fn
);
1547 /* Check that we can access or open it. */
1548 if (NATNUMP (predicate
))
1549 fd
= (((XFASTINT (predicate
) & ~INT_MAX
) == 0
1550 && (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1553 && ! file_directory_p (pfn
))
1558 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1560 && (fstat (fd
, &st
) != 0 || S_ISDIR (st
.st_mode
)))
1569 /* We succeeded; return this descriptor and filename. */
1586 /* Merge the list we've accumulated of globals from the current input source
1587 into the load_history variable. The details depend on whether
1588 the source has an associated file name or not.
1590 FILENAME is the file name that we are loading from.
1592 ENTIRE is true if loading that entire file, false if evaluating
1596 build_load_history (Lisp_Object filename
, bool entire
)
1598 Lisp_Object tail
, prev
, newelt
;
1599 Lisp_Object tem
, tem2
;
1602 tail
= Vload_history
;
1605 while (CONSP (tail
))
1609 /* Find the feature's previous assoc list... */
1610 if (!NILP (Fequal (filename
, Fcar (tem
))))
1614 /* If we're loading the entire file, remove old data. */
1618 Vload_history
= XCDR (tail
);
1620 Fsetcdr (prev
, XCDR (tail
));
1623 /* Otherwise, cons on new symbols that are not already members. */
1626 tem2
= Vcurrent_load_list
;
1628 while (CONSP (tem2
))
1630 newelt
= XCAR (tem2
);
1632 if (NILP (Fmember (newelt
, tem
)))
1633 Fsetcar (tail
, Fcons (XCAR (tem
),
1634 Fcons (newelt
, XCDR (tem
))));
1647 /* If we're loading an entire file, cons the new assoc onto the
1648 front of load-history, the most-recently-loaded position. Also
1649 do this if we didn't find an existing member for the file. */
1650 if (entire
|| !foundit
)
1651 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1656 readevalloop_1 (Lisp_Object old
)
1658 load_convert_to_unibyte
= ! NILP (old
);
1662 /* Signal an `end-of-file' error, if possible with file name
1665 static _Noreturn
void
1666 end_of_file_error (void)
1668 if (STRINGP (Vload_file_name
))
1669 xsignal1 (Qend_of_file
, Vload_file_name
);
1671 xsignal0 (Qend_of_file
);
1674 /* UNIBYTE specifies how to set load_convert_to_unibyte
1675 for this invocation.
1676 READFUN, if non-nil, is used instead of `read'.
1678 START, END specify region to read in current buffer (from eval-region).
1679 If the input is not from a buffer, they must be nil. */
1682 readevalloop (Lisp_Object readcharfun
,
1684 Lisp_Object sourcename
,
1686 Lisp_Object unibyte
, Lisp_Object readfun
,
1687 Lisp_Object start
, Lisp_Object end
)
1690 register Lisp_Object val
;
1691 ptrdiff_t count
= SPECPDL_INDEX ();
1692 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1693 struct buffer
*b
= 0;
1694 bool continue_reading_p
;
1695 Lisp_Object lex_bound
;
1696 /* True if reading an entire buffer. */
1697 bool whole_buffer
= 0;
1698 /* True on the first time around. */
1699 bool first_sexp
= 1;
1700 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1702 if (NILP (Ffboundp (macroexpand
))
1703 /* Don't macroexpand in .elc files, since it should have been done
1704 already. We actually don't know whether we're in a .elc file or not,
1705 so we use circumstantial evidence: .el files normally go through
1706 Vload_source_file_function -> load-with-code-conversion
1708 || EQ (readcharfun
, Qget_file_char
)
1709 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1712 if (MARKERP (readcharfun
))
1715 start
= readcharfun
;
1718 if (BUFFERP (readcharfun
))
1719 b
= XBUFFER (readcharfun
);
1720 else if (MARKERP (readcharfun
))
1721 b
= XMARKER (readcharfun
)->buffer
;
1723 /* We assume START is nil when input is not from a buffer. */
1724 if (! NILP (start
) && !b
)
1727 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1728 specbind (Qcurrent_load_list
, Qnil
);
1729 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1730 load_convert_to_unibyte
= !NILP (unibyte
);
1732 /* If lexical binding is active (either because it was specified in
1733 the file's header, or via a buffer-local variable), create an empty
1734 lexical environment, otherwise, turn off lexical binding. */
1735 lex_bound
= find_symbol_value (Qlexical_binding
);
1736 specbind (Qinternal_interpreter_environment
,
1737 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1738 ? Qnil
: Fcons (Qt
, Qnil
));
1740 GCPRO4 (sourcename
, readfun
, start
, end
);
1742 /* Try to ensure sourcename is a truename, except whilst preloading. */
1743 if (NILP (Vpurify_flag
)
1744 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1745 && !NILP (Ffboundp (Qfile_truename
)))
1746 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1748 LOADHIST_ATTACH (sourcename
);
1750 continue_reading_p
= 1;
1751 while (continue_reading_p
)
1753 ptrdiff_t count1
= SPECPDL_INDEX ();
1755 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1756 error ("Reading from killed buffer");
1760 /* Switch to the buffer we are reading from. */
1761 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1762 set_buffer_internal (b
);
1764 /* Save point in it. */
1765 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1766 /* Save ZV in it. */
1767 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1768 /* Those get unbound after we read one expression. */
1770 /* Set point and ZV around stuff to be read. */
1773 Fnarrow_to_region (make_number (BEGV
), end
);
1775 /* Just for cleanliness, convert END to a marker
1776 if it is an integer. */
1778 end
= Fpoint_max_marker ();
1781 /* On the first cycle, we can easily test here
1782 whether we are reading the whole buffer. */
1783 if (b
&& first_sexp
)
1784 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1791 while ((c
= READCHAR
) != '\n' && c
!= -1);
1796 unbind_to (count1
, Qnil
);
1800 /* Ignore whitespace here, so we can detect eof. */
1801 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1802 || c
== 0xa0) /* NBSP */
1805 if (!NILP (Vpurify_flag
) && c
== '(')
1807 val
= read_list (0, readcharfun
);
1812 read_objects
= Qnil
;
1813 if (!NILP (readfun
))
1815 val
= call1 (readfun
, readcharfun
);
1817 /* If READCHARFUN has set point to ZV, we should
1818 stop reading, even if the form read sets point
1819 to a different value when evaluated. */
1820 if (BUFFERP (readcharfun
))
1822 struct buffer
*buf
= XBUFFER (readcharfun
);
1823 if (BUF_PT (buf
) == BUF_ZV (buf
))
1824 continue_reading_p
= 0;
1827 else if (! NILP (Vload_read_function
))
1828 val
= call1 (Vload_read_function
, readcharfun
);
1830 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1833 if (!NILP (start
) && continue_reading_p
)
1834 start
= Fpoint_marker ();
1836 /* Restore saved point and BEGV. */
1837 unbind_to (count1
, Qnil
);
1839 /* Now eval what we just read. */
1840 if (!NILP (macroexpand
))
1841 val
= call1 (macroexpand
, val
);
1842 val
= eval_sub (val
);
1846 Vvalues
= Fcons (val
, Vvalues
);
1847 if (EQ (Vstandard_output
, Qt
))
1856 build_load_history (sourcename
,
1857 stream
|| whole_buffer
);
1861 unbind_to (count
, Qnil
);
1864 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1865 doc
: /* Execute the current buffer as Lisp code.
1866 When called from a Lisp program (i.e., not interactively), this
1867 function accepts up to five optional arguments:
1868 BUFFER is the buffer to evaluate (nil means use current buffer).
1869 PRINTFLAG controls printing of output:
1870 A value of nil means discard it; anything else is stream for print.
1871 FILENAME specifies the file name to use for `load-history'.
1872 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1874 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1875 functions should work normally even if PRINTFLAG is nil.
1877 This function preserves the position of point. */)
1878 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1880 ptrdiff_t count
= SPECPDL_INDEX ();
1881 Lisp_Object tem
, buf
;
1884 buf
= Fcurrent_buffer ();
1886 buf
= Fget_buffer (buffer
);
1888 error ("No such buffer");
1890 if (NILP (printflag
) && NILP (do_allow_print
))
1895 if (NILP (filename
))
1896 filename
= BVAR (XBUFFER (buf
), filename
);
1898 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1899 specbind (Qstandard_output
, tem
);
1900 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1901 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1902 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1903 readevalloop (buf
, 0, filename
,
1904 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1905 unbind_to (count
, Qnil
);
1910 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1911 doc
: /* Execute the region as Lisp code.
1912 When called from programs, expects two arguments,
1913 giving starting and ending indices in the current buffer
1914 of the text to be executed.
1915 Programs can pass third argument PRINTFLAG which controls output:
1916 A value of nil means discard it; anything else is stream for printing it.
1917 Also the fourth argument READ-FUNCTION, if non-nil, is used
1918 instead of `read' to read each expression. It gets one argument
1919 which is the input stream for reading characters.
1921 This function does not move point. */)
1922 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1924 /* FIXME: Do the eval-sexp-add-defvars dance! */
1925 ptrdiff_t count
= SPECPDL_INDEX ();
1926 Lisp_Object tem
, cbuf
;
1928 cbuf
= Fcurrent_buffer ();
1930 if (NILP (printflag
))
1934 specbind (Qstandard_output
, tem
);
1935 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1937 /* `readevalloop' calls functions which check the type of start and end. */
1938 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1939 !NILP (printflag
), Qnil
, read_function
,
1942 return unbind_to (count
, Qnil
);
1946 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1947 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1948 If STREAM is nil, use the value of `standard-input' (which see).
1949 STREAM or the value of `standard-input' may be:
1950 a buffer (read from point and advance it)
1951 a marker (read from where it points and advance it)
1952 a function (call it with no arguments for each character,
1953 call it with a char as argument to push a char back)
1954 a string (takes text from string, starting at the beginning)
1955 t (read text line using minibuffer and use it, or read from
1956 standard input in batch mode). */)
1957 (Lisp_Object stream
)
1960 stream
= Vstandard_input
;
1961 if (EQ (stream
, Qt
))
1962 stream
= Qread_char
;
1963 if (EQ (stream
, Qread_char
))
1964 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1966 return read_internal_start (stream
, Qnil
, Qnil
);
1969 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1970 doc
: /* Read one Lisp expression which is represented as text by STRING.
1971 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1972 FINAL-STRING-INDEX is an integer giving the position of the next
1973 remaining character in STRING.
1974 START and END optionally delimit a substring of STRING from which to read;
1975 they default to 0 and (length STRING) respectively. */)
1976 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1979 CHECK_STRING (string
);
1980 /* `read_internal_start' sets `read_from_string_index'. */
1981 ret
= read_internal_start (string
, start
, end
);
1982 return Fcons (ret
, make_number (read_from_string_index
));
1985 /* Function to set up the global context we need in toplevel read
1988 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1989 /* `start', `end' only used when stream is a string. */
1994 new_backquote_flag
= 0;
1995 read_objects
= Qnil
;
1996 if (EQ (Vread_with_symbol_positions
, Qt
)
1997 || EQ (Vread_with_symbol_positions
, stream
))
1998 Vread_symbol_positions_list
= Qnil
;
2000 if (STRINGP (stream
)
2001 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2003 ptrdiff_t startval
, endval
;
2006 if (STRINGP (stream
))
2009 string
= XCAR (stream
);
2012 endval
= SCHARS (string
);
2016 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2017 args_out_of_range (string
, end
);
2018 endval
= XINT (end
);
2025 CHECK_NUMBER (start
);
2026 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2027 args_out_of_range (string
, start
);
2028 startval
= XINT (start
);
2030 read_from_string_index
= startval
;
2031 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2032 read_from_string_limit
= endval
;
2035 retval
= read0 (stream
);
2036 if (EQ (Vread_with_symbol_positions
, Qt
)
2037 || EQ (Vread_with_symbol_positions
, stream
))
2038 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2043 /* Signal Qinvalid_read_syntax error.
2044 S is error string of length N (if > 0) */
2046 static _Noreturn
void
2047 invalid_syntax (const char *s
)
2049 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2053 /* Use this for recursive reads, in contexts where internal tokens
2057 read0 (Lisp_Object readcharfun
)
2059 register Lisp_Object val
;
2062 val
= read1 (readcharfun
, &c
, 0);
2066 xsignal1 (Qinvalid_read_syntax
,
2067 Fmake_string (make_number (1), make_number (c
)));
2070 static ptrdiff_t read_buffer_size
;
2071 static char *read_buffer
;
2073 /* Read a \-escape sequence, assuming we already read the `\'.
2074 If the escape sequence forces unibyte, return eight-bit char. */
2077 read_escape (Lisp_Object readcharfun
, bool stringp
)
2080 /* \u allows up to four hex digits, \U up to eight. Default to the
2081 behavior for \u, and change this value in the case that \U is seen. */
2082 int unicode_hex_count
= 4;
2087 end_of_file_error ();
2117 error ("Invalid escape character syntax");
2120 c
= read_escape (readcharfun
, 0);
2121 return c
| meta_modifier
;
2126 error ("Invalid escape character syntax");
2129 c
= read_escape (readcharfun
, 0);
2130 return c
| shift_modifier
;
2135 error ("Invalid escape character syntax");
2138 c
= read_escape (readcharfun
, 0);
2139 return c
| hyper_modifier
;
2144 error ("Invalid escape character syntax");
2147 c
= read_escape (readcharfun
, 0);
2148 return c
| alt_modifier
;
2152 if (stringp
|| c
!= '-')
2159 c
= read_escape (readcharfun
, 0);
2160 return c
| super_modifier
;
2165 error ("Invalid escape character syntax");
2169 c
= read_escape (readcharfun
, 0);
2170 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2171 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2172 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2173 return c
| ctrl_modifier
;
2174 /* ASCII control chars are made from letters (both cases),
2175 as well as the non-letters within 0100...0137. */
2176 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2177 return (c
& (037 | ~0177));
2178 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2179 return (c
& (037 | ~0177));
2181 return c
| ctrl_modifier
;
2191 /* An octal escape, as in ANSI C. */
2193 register int i
= c
- '0';
2194 register int count
= 0;
2197 if ((c
= READCHAR
) >= '0' && c
<= '7')
2209 if (i
>= 0x80 && i
< 0x100)
2210 i
= BYTE8_TO_CHAR (i
);
2215 /* A hex escape, as in ANSI C. */
2222 if (c
>= '0' && c
<= '9')
2227 else if ((c
>= 'a' && c
<= 'f')
2228 || (c
>= 'A' && c
<= 'F'))
2231 if (c
>= 'a' && c
<= 'f')
2241 /* Allow hex escapes as large as ?\xfffffff, because some
2242 packages use them to denote characters with modifiers. */
2243 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2244 error ("Hex character out of range: \\x%x...", i
);
2248 if (count
< 3 && i
>= 0x80)
2249 return BYTE8_TO_CHAR (i
);
2254 /* Post-Unicode-2.0: Up to eight hex chars. */
2255 unicode_hex_count
= 8;
2258 /* A Unicode escape. We only permit them in strings and characters,
2259 not arbitrarily in the source code, as in some other languages. */
2264 while (++count
<= unicode_hex_count
)
2267 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2269 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2270 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2271 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2273 error ("Non-hex digit used for Unicode escape");
2276 error ("Non-Unicode character: 0x%x", i
);
2285 /* Return the digit that CHARACTER stands for in the given BASE.
2286 Return -1 if CHARACTER is out of range for BASE,
2287 and -2 if CHARACTER is not valid for any supported BASE. */
2289 digit_to_number (int character
, int base
)
2293 if ('0' <= character
&& character
<= '9')
2294 digit
= character
- '0';
2295 else if ('a' <= character
&& character
<= 'z')
2296 digit
= character
- 'a' + 10;
2297 else if ('A' <= character
&& character
<= 'Z')
2298 digit
= character
- 'A' + 10;
2302 return digit
< base
? digit
: -1;
2305 /* Read an integer in radix RADIX using READCHARFUN to read
2306 characters. RADIX must be in the interval [2..36]; if it isn't, a
2307 read error is signaled . Value is the integer read. Signals an
2308 error if encountering invalid read syntax or if RADIX is out of
2312 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2314 /* Room for sign, leading 0, other digits, trailing null byte.
2315 Also, room for invalid syntax diagnostic. */
2316 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2317 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2319 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2321 if (radix
< 2 || radix
> 36)
2329 if (c
== '-' || c
== '+')
2340 /* Ignore redundant leading zeros, so the buffer doesn't
2341 fill up with them. */
2347 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2354 if (p
< buf
+ sizeof buf
- 1)
2368 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2369 invalid_syntax (buf
);
2372 return string_to_number (buf
, radix
, 0);
2376 /* If the next token is ')' or ']' or '.', we store that character
2377 in *PCH and the return value is not interesting. Else, we store
2378 zero in *PCH and we read and return one lisp object.
2380 FIRST_IN_LIST is true if this is the first element of a list. */
2383 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2386 bool uninterned_symbol
= 0;
2394 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2396 end_of_file_error ();
2401 return read_list (0, readcharfun
);
2404 return read_vector (readcharfun
, 0);
2420 /* Accept extended format for hashtables (extensible to
2422 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2423 Lisp_Object tmp
= read_list (0, readcharfun
);
2424 Lisp_Object head
= CAR_SAFE (tmp
);
2425 Lisp_Object data
= Qnil
;
2426 Lisp_Object val
= Qnil
;
2427 /* The size is 2 * number of allowed keywords to
2429 Lisp_Object params
[10];
2431 Lisp_Object key
= Qnil
;
2432 int param_count
= 0;
2434 if (!EQ (head
, Qhash_table
))
2435 error ("Invalid extended read marker at head of #s list "
2436 "(only hash-table allowed)");
2438 tmp
= CDR_SAFE (tmp
);
2440 /* This is repetitive but fast and simple. */
2441 params
[param_count
] = QCsize
;
2442 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2443 if (!NILP (params
[param_count
+ 1]))
2446 params
[param_count
] = QCtest
;
2447 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2448 if (!NILP (params
[param_count
+ 1]))
2451 params
[param_count
] = QCweakness
;
2452 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2453 if (!NILP (params
[param_count
+ 1]))
2456 params
[param_count
] = QCrehash_size
;
2457 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2458 if (!NILP (params
[param_count
+ 1]))
2461 params
[param_count
] = QCrehash_threshold
;
2462 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2463 if (!NILP (params
[param_count
+ 1]))
2466 /* This is the hashtable data. */
2467 data
= Fplist_get (tmp
, Qdata
);
2469 /* Now use params to make a new hashtable and fill it. */
2470 ht
= Fmake_hash_table (param_count
, params
);
2472 while (CONSP (data
))
2477 error ("Odd number of elements in hashtable data");
2480 Fputhash (key
, val
, ht
);
2486 invalid_syntax ("#");
2494 tmp
= read_vector (readcharfun
, 0);
2495 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2496 error ("Invalid size char-table");
2497 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2509 tmp
= read_vector (readcharfun
, 0);
2512 error ("Invalid size char-table");
2513 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2514 error ("Invalid depth in char-table");
2515 depth
= XINT (AREF (tmp
, 0));
2516 if (chartab_size
[depth
] != size
- 2)
2517 error ("Invalid size char-table");
2518 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2521 invalid_syntax ("#^^");
2523 invalid_syntax ("#^");
2528 length
= read1 (readcharfun
, pch
, first_in_list
);
2532 Lisp_Object tmp
, val
;
2533 EMACS_INT size_in_chars
2534 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2535 / BOOL_VECTOR_BITS_PER_CHAR
);
2538 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2539 if (STRING_MULTIBYTE (tmp
)
2540 || (size_in_chars
!= SCHARS (tmp
)
2541 /* We used to print 1 char too many
2542 when the number of bits was a multiple of 8.
2543 Accept such input in case it came from an old
2545 && ! (XFASTINT (length
)
2546 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2547 invalid_syntax ("#&...");
2549 val
= Fmake_bool_vector (length
, Qnil
);
2550 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2551 /* Clear the extraneous bits in the last byte. */
2552 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2553 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2554 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2557 invalid_syntax ("#&...");
2561 /* Accept compiled functions at read-time so that we don't have to
2562 build them using function calls. */
2564 tmp
= read_vector (readcharfun
, 1);
2565 make_byte_code (XVECTOR (tmp
));
2571 struct gcpro gcpro1
;
2574 /* Read the string itself. */
2575 tmp
= read1 (readcharfun
, &ch
, 0);
2576 if (ch
!= 0 || !STRINGP (tmp
))
2577 invalid_syntax ("#");
2579 /* Read the intervals and their properties. */
2582 Lisp_Object beg
, end
, plist
;
2584 beg
= read1 (readcharfun
, &ch
, 0);
2589 end
= read1 (readcharfun
, &ch
, 0);
2591 plist
= read1 (readcharfun
, &ch
, 0);
2593 invalid_syntax ("Invalid string property list");
2594 Fset_text_properties (beg
, end
, plist
, tmp
);
2600 /* #@NUMBER is used to skip NUMBER following characters.
2601 That's used in .elc files to skip over doc strings
2602 and function definitions. */
2605 enum { extra
= 100 };
2606 ptrdiff_t i
, nskip
= 0;
2609 /* Read a decimal integer. */
2610 while ((c
= READCHAR
) >= 0
2611 && c
>= '0' && c
<= '9')
2613 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2620 if (load_force_doc_strings
2621 && (EQ (readcharfun
, Qget_file_char
)
2622 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2624 /* If we are supposed to force doc strings into core right now,
2625 record the last string that we skipped,
2626 and record where in the file it comes from. */
2628 /* But first exchange saved_doc_string
2629 with prev_saved_doc_string, so we save two strings. */
2631 char *temp
= saved_doc_string
;
2632 ptrdiff_t temp_size
= saved_doc_string_size
;
2633 file_offset temp_pos
= saved_doc_string_position
;
2634 ptrdiff_t temp_len
= saved_doc_string_length
;
2636 saved_doc_string
= prev_saved_doc_string
;
2637 saved_doc_string_size
= prev_saved_doc_string_size
;
2638 saved_doc_string_position
= prev_saved_doc_string_position
;
2639 saved_doc_string_length
= prev_saved_doc_string_length
;
2641 prev_saved_doc_string
= temp
;
2642 prev_saved_doc_string_size
= temp_size
;
2643 prev_saved_doc_string_position
= temp_pos
;
2644 prev_saved_doc_string_length
= temp_len
;
2647 if (saved_doc_string_size
== 0)
2649 saved_doc_string
= xmalloc (nskip
+ extra
);
2650 saved_doc_string_size
= nskip
+ extra
;
2652 if (nskip
> saved_doc_string_size
)
2654 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2655 saved_doc_string_size
= nskip
+ extra
;
2658 saved_doc_string_position
= file_tell (instream
);
2660 /* Copy that many characters into saved_doc_string. */
2661 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2662 saved_doc_string
[i
] = c
= READCHAR
;
2664 saved_doc_string_length
= i
;
2668 /* Skip that many characters. */
2669 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2678 /* #! appears at the beginning of an executable file.
2679 Skip the first line. */
2680 while (c
!= '\n' && c
>= 0)
2685 return Vload_file_name
;
2687 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2688 /* #:foo is the uninterned symbol named foo. */
2691 uninterned_symbol
= 1;
2694 && c
!= 0xa0 /* NBSP */
2696 || strchr ("\"';()[]#`,", c
) == NULL
)))
2698 /* No symbol character follows, this is the empty
2701 return Fmake_symbol (empty_unibyte_string
);
2705 /* ## is the empty symbol. */
2707 return Fintern (empty_unibyte_string
, Qnil
);
2708 /* Reader forms that can reuse previously read objects. */
2709 if (c
>= '0' && c
<= '9')
2714 /* Read a non-negative integer. */
2715 while (c
>= '0' && c
<= '9')
2717 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2718 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2719 n
= MOST_POSITIVE_FIXNUM
+ 1;
2721 n
= n
* 10 + c
- '0';
2725 if (n
<= MOST_POSITIVE_FIXNUM
)
2727 if (c
== 'r' || c
== 'R')
2728 return read_integer (readcharfun
, n
);
2730 if (! NILP (Vread_circle
))
2732 /* #n=object returns object, but associates it with
2736 /* Make a placeholder for #n# to use temporarily. */
2737 Lisp_Object placeholder
;
2740 placeholder
= Fcons (Qnil
, Qnil
);
2741 cell
= Fcons (make_number (n
), placeholder
);
2742 read_objects
= Fcons (cell
, read_objects
);
2744 /* Read the object itself. */
2745 tem
= read0 (readcharfun
);
2747 /* Now put it everywhere the placeholder was... */
2748 substitute_object_in_subtree (tem
, placeholder
);
2750 /* ...and #n# will use the real value from now on. */
2751 Fsetcdr (cell
, tem
);
2756 /* #n# returns a previously read object. */
2759 tem
= Fassq (make_number (n
), read_objects
);
2765 /* Fall through to error message. */
2767 else if (c
== 'x' || c
== 'X')
2768 return read_integer (readcharfun
, 16);
2769 else if (c
== 'o' || c
== 'O')
2770 return read_integer (readcharfun
, 8);
2771 else if (c
== 'b' || c
== 'B')
2772 return read_integer (readcharfun
, 2);
2775 invalid_syntax ("#");
2778 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2783 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2788 int next_char
= READCHAR
;
2790 /* Transition from old-style to new-style:
2791 If we see "(`" it used to mean old-style, which usually works
2792 fine because ` should almost never appear in such a position
2793 for new-style. But occasionally we need "(`" to mean new
2794 style, so we try to distinguish the two by the fact that we
2795 can either write "( `foo" or "(` foo", where the first
2796 intends to use new-style whereas the second intends to use
2797 old-style. For Emacs-25, we should completely remove this
2798 first_in_list exception (old-style can still be obtained via
2800 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2802 Vold_style_backquotes
= Qt
;
2808 bool saved_new_backquote_flag
= new_backquote_flag
;
2810 new_backquote_flag
= 1;
2811 value
= read0 (readcharfun
);
2812 new_backquote_flag
= saved_new_backquote_flag
;
2814 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2819 int next_char
= READCHAR
;
2821 /* Transition from old-style to new-style:
2822 It used to be impossible to have a new-style , other than within
2823 a new-style `. This is sufficient when ` and , are used in the
2824 normal way, but ` and , can also appear in args to macros that
2825 will not interpret them in the usual way, in which case , may be
2826 used without any ` anywhere near.
2827 So we now use the same heuristic as for backquote: old-style
2828 unquotes are only recognized when first on a list, and when
2829 followed by a space.
2830 Because it's more difficult to peek 2 chars ahead, a new-style
2831 ,@ can still not be used outside of a `, unless it's in the middle
2833 if (new_backquote_flag
2835 || (next_char
!= ' ' && next_char
!= '@'))
2837 Lisp_Object comma_type
= Qnil
;
2842 comma_type
= Qcomma_at
;
2844 comma_type
= Qcomma_dot
;
2847 if (ch
>= 0) UNREAD (ch
);
2848 comma_type
= Qcomma
;
2851 value
= read0 (readcharfun
);
2852 return Fcons (comma_type
, Fcons (value
, Qnil
));
2856 Vold_style_backquotes
= Qt
;
2868 end_of_file_error ();
2870 /* Accept `single space' syntax like (list ? x) where the
2871 whitespace character is SPC or TAB.
2872 Other literal whitespace like NL, CR, and FF are not accepted,
2873 as there are well-established escape sequences for these. */
2874 if (c
== ' ' || c
== '\t')
2875 return make_number (c
);
2878 c
= read_escape (readcharfun
, 0);
2879 modifiers
= c
& CHAR_MODIFIER_MASK
;
2880 c
&= ~CHAR_MODIFIER_MASK
;
2881 if (CHAR_BYTE8_P (c
))
2882 c
= CHAR_TO_BYTE8 (c
);
2885 next_char
= READCHAR
;
2886 ok
= (next_char
<= 040
2887 || (next_char
< 0200
2888 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2891 return make_number (c
);
2893 invalid_syntax ("?");
2898 char *p
= read_buffer
;
2899 char *end
= read_buffer
+ read_buffer_size
;
2901 /* True if we saw an escape sequence specifying
2902 a multibyte character. */
2903 bool force_multibyte
= 0;
2904 /* True if we saw an escape sequence specifying
2905 a single-byte character. */
2906 bool force_singlebyte
= 0;
2908 ptrdiff_t nchars
= 0;
2910 while ((ch
= READCHAR
) >= 0
2913 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2915 ptrdiff_t offset
= p
- read_buffer
;
2916 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2917 memory_full (SIZE_MAX
);
2918 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
2919 read_buffer_size
*= 2;
2920 p
= read_buffer
+ offset
;
2921 end
= read_buffer
+ read_buffer_size
;
2928 ch
= read_escape (readcharfun
, 1);
2930 /* CH is -1 if \ newline has just been seen. */
2933 if (p
== read_buffer
)
2938 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2939 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2941 if (CHAR_BYTE8_P (ch
))
2942 force_singlebyte
= 1;
2943 else if (! ASCII_CHAR_P (ch
))
2944 force_multibyte
= 1;
2945 else /* I.e. ASCII_CHAR_P (ch). */
2947 /* Allow `\C- ' and `\C-?'. */
2948 if (modifiers
== CHAR_CTL
)
2951 ch
= 0, modifiers
= 0;
2953 ch
= 127, modifiers
= 0;
2955 if (modifiers
& CHAR_SHIFT
)
2957 /* Shift modifier is valid only with [A-Za-z]. */
2958 if (ch
>= 'A' && ch
<= 'Z')
2959 modifiers
&= ~CHAR_SHIFT
;
2960 else if (ch
>= 'a' && ch
<= 'z')
2961 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2964 if (modifiers
& CHAR_META
)
2966 /* Move the meta bit to the right place for a
2968 modifiers
&= ~CHAR_META
;
2969 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2970 force_singlebyte
= 1;
2974 /* Any modifiers remaining are invalid. */
2976 error ("Invalid modifier in string");
2977 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2981 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2982 if (CHAR_BYTE8_P (ch
))
2983 force_singlebyte
= 1;
2984 else if (! ASCII_CHAR_P (ch
))
2985 force_multibyte
= 1;
2991 end_of_file_error ();
2993 /* If purifying, and string starts with \ newline,
2994 return zero instead. This is for doc strings
2995 that we are really going to find in etc/DOC.nn.nn. */
2996 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2997 return make_number (0);
2999 if (! force_multibyte
&& force_singlebyte
)
3001 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3002 forms. Convert it to unibyte. */
3003 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3005 p
= read_buffer
+ nchars
;
3008 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3010 || (p
- read_buffer
!= nchars
)));
3015 int next_char
= READCHAR
;
3018 if (next_char
<= 040
3019 || (next_char
< 0200
3020 && strchr ("\"';([#?`,", next_char
) != NULL
))
3026 /* Otherwise, we fall through! Note that the atom-reading loop
3027 below will now loop at least once, assuring that we will not
3028 try to UNREAD two characters in a row. */
3032 if (c
<= 040) goto retry
;
3033 if (c
== 0xa0) /* NBSP */
3038 char *p
= read_buffer
;
3040 EMACS_INT start_position
= readchar_count
- 1;
3043 char *end
= read_buffer
+ read_buffer_size
;
3047 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3049 ptrdiff_t offset
= p
- read_buffer
;
3050 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3051 memory_full (SIZE_MAX
);
3052 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3053 read_buffer_size
*= 2;
3054 p
= read_buffer
+ offset
;
3055 end
= read_buffer
+ read_buffer_size
;
3062 end_of_file_error ();
3067 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3073 && c
!= 0xa0 /* NBSP */
3075 || strchr ("\"';()[]#`,", c
) == NULL
));
3079 ptrdiff_t offset
= p
- read_buffer
;
3080 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3081 memory_full (SIZE_MAX
);
3082 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3083 read_buffer_size
*= 2;
3084 p
= read_buffer
+ offset
;
3085 end
= read_buffer
+ read_buffer_size
;
3091 if (!quoted
&& !uninterned_symbol
)
3093 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3094 if (! NILP (result
))
3098 Lisp_Object name
, result
;
3099 ptrdiff_t nbytes
= p
- read_buffer
;
3102 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3106 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3107 ? make_pure_string
: make_specified_string
)
3108 (read_buffer
, nchars
, nbytes
, multibyte
));
3109 result
= (uninterned_symbol
? Fmake_symbol (name
)
3110 : Fintern (name
, Qnil
));
3112 if (EQ (Vread_with_symbol_positions
, Qt
)
3113 || EQ (Vread_with_symbol_positions
, readcharfun
))
3114 Vread_symbol_positions_list
3115 = Fcons (Fcons (result
, make_number (start_position
)),
3116 Vread_symbol_positions_list
);
3124 /* List of nodes we've seen during substitute_object_in_subtree. */
3125 static Lisp_Object seen_list
;
3128 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3130 Lisp_Object check_object
;
3132 /* We haven't seen any objects when we start. */
3135 /* Make all the substitutions. */
3137 = substitute_object_recurse (object
, placeholder
, object
);
3139 /* Clear seen_list because we're done with it. */
3142 /* The returned object here is expected to always eq the
3144 if (!EQ (check_object
, object
))
3145 error ("Unexpected mutation error in reader");
3148 /* Feval doesn't get called from here, so no gc protection is needed. */
3149 #define SUBSTITUTE(get_val, set_val) \
3151 Lisp_Object old_value = get_val; \
3152 Lisp_Object true_value \
3153 = substitute_object_recurse (object, placeholder, \
3156 if (!EQ (old_value, true_value)) \
3163 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3165 /* If we find the placeholder, return the target object. */
3166 if (EQ (placeholder
, subtree
))
3169 /* If we've been to this node before, don't explore it again. */
3170 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3173 /* If this node can be the entry point to a cycle, remember that
3174 we've seen it. It can only be such an entry point if it was made
3175 by #n=, which means that we can find it as a value in
3177 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3178 seen_list
= Fcons (subtree
, seen_list
);
3180 /* Recurse according to subtree's type.
3181 Every branch must return a Lisp_Object. */
3182 switch (XTYPE (subtree
))
3184 case Lisp_Vectorlike
:
3186 ptrdiff_t i
, length
= 0;
3187 if (BOOL_VECTOR_P (subtree
))
3188 return subtree
; /* No sub-objects anyway. */
3189 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3190 || COMPILEDP (subtree
))
3191 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3192 else if (VECTORP (subtree
))
3193 length
= ASIZE (subtree
);
3195 /* An unknown pseudovector may contain non-Lisp fields, so we
3196 can't just blindly traverse all its fields. We used to call
3197 `Flength' which signaled `sequencep', so I just preserved this
3199 wrong_type_argument (Qsequencep
, subtree
);
3201 for (i
= 0; i
< length
; i
++)
3202 SUBSTITUTE (AREF (subtree
, i
),
3203 ASET (subtree
, i
, true_value
));
3209 SUBSTITUTE (XCAR (subtree
),
3210 XSETCAR (subtree
, true_value
));
3211 SUBSTITUTE (XCDR (subtree
),
3212 XSETCDR (subtree
, true_value
));
3218 /* Check for text properties in each interval.
3219 substitute_in_interval contains part of the logic. */
3221 INTERVAL root_interval
= string_intervals (subtree
);
3222 Lisp_Object arg
= Fcons (object
, placeholder
);
3224 traverse_intervals_noorder (root_interval
,
3225 &substitute_in_interval
, arg
);
3230 /* Other types don't recurse any further. */
3236 /* Helper function for substitute_object_recurse. */
3238 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3240 Lisp_Object object
= Fcar (arg
);
3241 Lisp_Object placeholder
= Fcdr (arg
);
3243 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3253 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3254 integer syntax and fits in a fixnum, else return the nearest float if CP has
3255 either floating point or integer syntax and BASE is 10, else return nil. If
3256 IGNORE_TRAILING, consider just the longest prefix of CP that has
3257 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3258 number has integer syntax but does not fit. */
3261 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3264 char const *cp
= string
;
3266 bool float_syntax
= 0;
3269 /* Compute NaN and infinities using a variable, to cope with compilers that
3270 think they are smarter than we are. */
3273 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3274 IEEE floating point hosts, and works around a formerly-common bug where
3275 atof ("-0.0") drops the sign. */
3276 bool negative
= *cp
== '-';
3278 bool signedp
= negative
|| *cp
== '+';
3283 leading_digit
= digit_to_number (*cp
, base
);
3284 if (0 <= leading_digit
)
3289 while (0 <= digit_to_number (*cp
, base
));
3299 if ('0' <= *cp
&& *cp
<= '9')
3304 while ('0' <= *cp
&& *cp
<= '9');
3306 if (*cp
== 'e' || *cp
== 'E')
3308 char const *ecp
= cp
;
3310 if (*cp
== '+' || *cp
== '-')
3312 if ('0' <= *cp
&& *cp
<= '9')
3317 while ('0' <= *cp
&& *cp
<= '9');
3319 else if (cp
[-1] == '+'
3320 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3326 else if (cp
[-1] == '+'
3327 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3331 value
= zero
/ zero
;
3333 /* If that made a "negative" NaN, negate it. */
3336 union { double d
; char c
[sizeof (double)]; }
3337 u_data
, u_minus_zero
;
3339 u_minus_zero
.d
= -0.0;
3340 for (i
= 0; i
< sizeof (double); i
++)
3341 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3347 /* Now VALUE is a positive NaN. */
3353 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3354 || state
== (LEAD_INT
|E_EXP
));
3357 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3358 any prefix that matches. Otherwise, the entire string must match. */
3359 if (! (ignore_trailing
3360 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3361 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3364 /* If the number uses integer and not float syntax, and is in C-language
3365 range, use its value, preferably as a fixnum. */
3366 if (0 <= leading_digit
&& ! float_syntax
)
3370 /* Fast special case for single-digit integers. This also avoids a
3371 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3372 case some versions of strtoumax accept numbers like "0x1" that Emacs
3374 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3375 return make_number (negative
? -leading_digit
: leading_digit
);
3378 n
= strtoumax (string
+ signedp
, NULL
, base
);
3379 if (errno
== ERANGE
)
3381 /* Unfortunately there's no simple and accurate way to convert
3382 non-base-10 numbers that are out of C-language range. */
3384 xsignal1 (Qoverflow_error
, build_string (string
));
3386 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3388 EMACS_INT signed_n
= n
;
3389 return make_number (negative
? -signed_n
: signed_n
);
3395 /* Either the number uses float syntax, or it does not fit into a fixnum.
3396 Convert it from string to floating point, unless the value is already
3397 known because it is an infinity, a NAN, or its absolute value fits in
3400 value
= atof (string
+ signedp
);
3402 return make_float (negative
? -value
: value
);
3407 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3411 Lisp_Object tem
, item
, vector
;
3412 struct Lisp_Cons
*otem
;
3415 tem
= read_list (1, readcharfun
);
3416 len
= Flength (tem
);
3417 vector
= Fmake_vector (len
, Qnil
);
3419 size
= ASIZE (vector
);
3420 ptr
= XVECTOR (vector
)->contents
;
3421 for (i
= 0; i
< size
; i
++)
3424 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3425 bytecode object, the docstring containing the bytecode and
3426 constants values must be treated as unibyte and passed to
3427 Fread, to get the actual bytecode string and constants vector. */
3428 if (bytecodeflag
&& load_force_doc_strings
)
3430 if (i
== COMPILED_BYTECODE
)
3432 if (!STRINGP (item
))
3433 error ("Invalid byte code");
3435 /* Delay handling the bytecode slot until we know whether
3436 it is lazily-loaded (we can tell by whether the
3437 constants slot is nil). */
3438 ASET (vector
, COMPILED_CONSTANTS
, item
);
3441 else if (i
== COMPILED_CONSTANTS
)
3443 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3447 /* Coerce string to unibyte (like string-as-unibyte,
3448 but without generating extra garbage and
3449 guaranteeing no change in the contents). */
3450 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3451 STRING_SET_UNIBYTE (bytestr
);
3453 item
= Fread (Fcons (bytestr
, readcharfun
));
3455 error ("Invalid byte code");
3457 otem
= XCONS (item
);
3458 bytestr
= XCAR (item
);
3463 /* Now handle the bytecode slot. */
3464 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3466 else if (i
== COMPILED_DOC_STRING
3468 && ! STRING_MULTIBYTE (item
))
3470 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3471 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3473 item
= Fstring_as_multibyte (item
);
3476 ASET (vector
, i
, item
);
3484 /* FLAG means check for ] to terminate rather than ) and . */
3487 read_list (bool flag
, Lisp_Object readcharfun
)
3489 Lisp_Object val
, tail
;
3490 Lisp_Object elt
, tem
;
3491 struct gcpro gcpro1
, gcpro2
;
3492 /* 0 is the normal case.
3493 1 means this list is a doc reference; replace it with the number 0.
3494 2 means this list is a doc reference; replace it with the doc string. */
3495 int doc_reference
= 0;
3497 /* Initialize this to 1 if we are reading a list. */
3498 bool first_in_list
= flag
<= 0;
3507 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3512 /* While building, if the list starts with #$, treat it specially. */
3513 if (EQ (elt
, Vload_file_name
)
3515 && !NILP (Vpurify_flag
))
3517 if (NILP (Vdoc_file_name
))
3518 /* We have not yet called Snarf-documentation, so assume
3519 this file is described in the DOC-MM.NN file
3520 and Snarf-documentation will fill in the right value later.
3521 For now, replace the whole list with 0. */
3524 /* We have already called Snarf-documentation, so make a relative
3525 file name for this file, so it can be found properly
3526 in the installed Lisp directory.
3527 We don't use Fexpand_file_name because that would make
3528 the directory absolute now. */
3529 elt
= concat2 (build_string ("../lisp/"),
3530 Ffile_name_nondirectory (elt
));
3532 else if (EQ (elt
, Vload_file_name
)
3534 && load_force_doc_strings
)
3543 invalid_syntax (") or . in a vector");
3551 XSETCDR (tail
, read0 (readcharfun
));
3553 val
= read0 (readcharfun
);
3554 read1 (readcharfun
, &ch
, 0);
3558 if (doc_reference
== 1)
3559 return make_number (0);
3560 if (doc_reference
== 2)
3562 /* Get a doc string from the file we are loading.
3563 If it's in saved_doc_string, get it from there.
3565 Here, we don't know if the string is a
3566 bytecode string or a doc string. As a
3567 bytecode string must be unibyte, we always
3568 return a unibyte string. If it is actually a
3569 doc string, caller must make it
3572 EMACS_INT pos
= XINT (XCDR (val
));
3573 /* Position is negative for user variables. */
3574 if (pos
< 0) pos
= -pos
;
3575 if (pos
>= saved_doc_string_position
3576 && pos
< (saved_doc_string_position
3577 + saved_doc_string_length
))
3579 ptrdiff_t start
= pos
- saved_doc_string_position
;
3582 /* Process quoting with ^A,
3583 and find the end of the string,
3584 which is marked with ^_ (037). */
3585 for (from
= start
, to
= start
;
3586 saved_doc_string
[from
] != 037;)
3588 int c
= saved_doc_string
[from
++];
3591 c
= saved_doc_string
[from
++];
3593 saved_doc_string
[to
++] = c
;
3595 saved_doc_string
[to
++] = 0;
3597 saved_doc_string
[to
++] = 037;
3600 saved_doc_string
[to
++] = c
;
3603 return make_unibyte_string (saved_doc_string
+ start
,
3606 /* Look in prev_saved_doc_string the same way. */
3607 else if (pos
>= prev_saved_doc_string_position
3608 && pos
< (prev_saved_doc_string_position
3609 + prev_saved_doc_string_length
))
3612 pos
- prev_saved_doc_string_position
;
3615 /* Process quoting with ^A,
3616 and find the end of the string,
3617 which is marked with ^_ (037). */
3618 for (from
= start
, to
= start
;
3619 prev_saved_doc_string
[from
] != 037;)
3621 int c
= prev_saved_doc_string
[from
++];
3624 c
= prev_saved_doc_string
[from
++];
3626 prev_saved_doc_string
[to
++] = c
;
3628 prev_saved_doc_string
[to
++] = 0;
3630 prev_saved_doc_string
[to
++] = 037;
3633 prev_saved_doc_string
[to
++] = c
;
3636 return make_unibyte_string (prev_saved_doc_string
3641 return get_doc_string (val
, 1, 0);
3646 invalid_syntax (". in wrong context");
3648 invalid_syntax ("] in a list");
3650 tem
= Fcons (elt
, Qnil
);
3652 XSETCDR (tail
, tem
);
3659 static Lisp_Object initial_obarray
;
3661 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3663 static size_t oblookup_last_bucket_number
;
3665 /* Get an error if OBARRAY is not an obarray.
3666 If it is one, return it. */
3669 check_obarray (Lisp_Object obarray
)
3671 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3673 /* If Vobarray is now invalid, force it to be valid. */
3674 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3675 wrong_type_argument (Qvectorp
, obarray
);
3680 /* Intern the C string STR: return a symbol with that name,
3681 interned in the current obarray. */
3684 intern_1 (const char *str
, ptrdiff_t len
)
3686 Lisp_Object obarray
= check_obarray (Vobarray
);
3687 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3689 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3693 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3695 Lisp_Object obarray
= check_obarray (Vobarray
);
3696 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3701 if (NILP (Vpurify_flag
))
3702 /* Creating a non-pure string from a string literal not
3703 implemented yet. We could just use make_string here and live
3704 with the extra copy. */
3707 return Fintern (make_pure_c_string (str
, len
), obarray
);
3710 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3711 doc
: /* Return the canonical symbol whose name is STRING.
3712 If there is none, one is created by this function and returned.
3713 A second optional argument specifies the obarray to use;
3714 it defaults to the value of `obarray'. */)
3715 (Lisp_Object string
, Lisp_Object obarray
)
3717 register Lisp_Object tem
, sym
, *ptr
;
3719 if (NILP (obarray
)) obarray
= Vobarray
;
3720 obarray
= check_obarray (obarray
);
3722 CHECK_STRING (string
);
3724 tem
= oblookup (obarray
, SSDATA (string
),
3727 if (!INTEGERP (tem
))
3730 if (!NILP (Vpurify_flag
))
3731 string
= Fpurecopy (string
);
3732 sym
= Fmake_symbol (string
);
3734 if (EQ (obarray
, initial_obarray
))
3735 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3737 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3739 if ((SREF (string
, 0) == ':')
3740 && EQ (obarray
, initial_obarray
))
3742 XSYMBOL (sym
)->constant
= 1;
3743 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3744 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3747 ptr
= aref_addr (obarray
, XINT(tem
));
3749 set_symbol_next (sym
, XSYMBOL (*ptr
));
3751 set_symbol_next (sym
, NULL
);
3756 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3757 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3758 NAME may be a string or a symbol. If it is a symbol, that exact
3759 symbol is searched for.
3760 A second optional argument specifies the obarray to use;
3761 it defaults to the value of `obarray'. */)
3762 (Lisp_Object name
, Lisp_Object obarray
)
3764 register Lisp_Object tem
, string
;
3766 if (NILP (obarray
)) obarray
= Vobarray
;
3767 obarray
= check_obarray (obarray
);
3769 if (!SYMBOLP (name
))
3771 CHECK_STRING (name
);
3775 string
= SYMBOL_NAME (name
);
3777 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3778 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3784 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3785 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3786 The value is t if a symbol was found and deleted, nil otherwise.
3787 NAME may be a string or a symbol. If it is a symbol, that symbol
3788 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3789 OBARRAY defaults to the value of the variable `obarray'. */)
3790 (Lisp_Object name
, Lisp_Object obarray
)
3792 register Lisp_Object string
, tem
;
3795 if (NILP (obarray
)) obarray
= Vobarray
;
3796 obarray
= check_obarray (obarray
);
3799 string
= SYMBOL_NAME (name
);
3802 CHECK_STRING (name
);
3806 tem
= oblookup (obarray
, SSDATA (string
),
3811 /* If arg was a symbol, don't delete anything but that symbol itself. */
3812 if (SYMBOLP (name
) && !EQ (name
, tem
))
3815 /* There are plenty of other symbols which will screw up the Emacs
3816 session if we unintern them, as well as even more ways to use
3817 `setq' or `fset' or whatnot to make the Emacs session
3818 unusable. Let's not go down this silly road. --Stef */
3819 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3820 error ("Attempt to unintern t or nil"); */
3822 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3824 hash
= oblookup_last_bucket_number
;
3826 if (EQ (AREF (obarray
, hash
), tem
))
3828 if (XSYMBOL (tem
)->next
)
3831 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3832 ASET (obarray
, hash
, sym
);
3835 ASET (obarray
, hash
, make_number (0));
3839 Lisp_Object tail
, following
;
3841 for (tail
= AREF (obarray
, hash
);
3842 XSYMBOL (tail
)->next
;
3845 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3846 if (EQ (following
, tem
))
3848 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3857 /* Return the symbol in OBARRAY whose names matches the string
3858 of SIZE characters (SIZE_BYTE bytes) at PTR.
3859 If there is no such symbol in OBARRAY, return nil.
3861 Also store the bucket number in oblookup_last_bucket_number. */
3864 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3868 register Lisp_Object tail
;
3869 Lisp_Object bucket
, tem
;
3871 obarray
= check_obarray (obarray
);
3872 obsize
= ASIZE (obarray
);
3874 /* This is sometimes needed in the middle of GC. */
3875 obsize
&= ~ARRAY_MARK_FLAG
;
3876 hash
= hash_string (ptr
, size_byte
) % obsize
;
3877 bucket
= AREF (obarray
, hash
);
3878 oblookup_last_bucket_number
= hash
;
3879 if (EQ (bucket
, make_number (0)))
3881 else if (!SYMBOLP (bucket
))
3882 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3884 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3886 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3887 && SCHARS (SYMBOL_NAME (tail
)) == size
3888 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3890 else if (XSYMBOL (tail
)->next
== 0)
3893 XSETINT (tem
, hash
);
3898 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3901 register Lisp_Object tail
;
3902 CHECK_VECTOR (obarray
);
3903 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3905 tail
= AREF (obarray
, i
);
3910 if (XSYMBOL (tail
)->next
== 0)
3912 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3918 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3920 call1 (function
, sym
);
3923 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3924 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3925 OBARRAY defaults to the value of `obarray'. */)
3926 (Lisp_Object function
, Lisp_Object obarray
)
3928 if (NILP (obarray
)) obarray
= Vobarray
;
3929 obarray
= check_obarray (obarray
);
3931 map_obarray (obarray
, mapatoms_1
, function
);
3935 #define OBARRAY_SIZE 1511
3940 Lisp_Object oblength
;
3941 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3943 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3945 Vobarray
= Fmake_vector (oblength
, make_number (0));
3946 initial_obarray
= Vobarray
;
3947 staticpro (&initial_obarray
);
3949 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
3950 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3951 NILP (Vpurify_flag) check in intern_c_string. */
3952 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3953 Qnil
= intern_c_string ("nil");
3955 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3956 so those two need to be fixed manually. */
3957 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3958 set_symbol_function (Qunbound
, Qnil
);
3959 set_symbol_plist (Qunbound
, Qnil
);
3960 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3961 XSYMBOL (Qnil
)->constant
= 1;
3962 XSYMBOL (Qnil
)->declared_special
= 1;
3963 set_symbol_plist (Qnil
, Qnil
);
3964 set_symbol_function (Qnil
, Qnil
);
3966 Qt
= intern_c_string ("t");
3967 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3968 XSYMBOL (Qnil
)->declared_special
= 1;
3969 XSYMBOL (Qt
)->constant
= 1;
3971 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3974 DEFSYM (Qvariable_documentation
, "variable-documentation");
3976 read_buffer
= xmalloc (size
);
3977 read_buffer_size
= size
;
3981 defsubr (struct Lisp_Subr
*sname
)
3983 Lisp_Object sym
, tem
;
3984 sym
= intern_c_string (sname
->symbol_name
);
3985 XSETPVECTYPE (sname
, PVEC_SUBR
);
3986 XSETSUBR (tem
, sname
);
3987 set_symbol_function (sym
, tem
);
3990 #ifdef NOTDEF /* Use fset in subr.el now! */
3992 defalias (struct Lisp_Subr
*sname
, char *string
)
3995 sym
= intern (string
);
3996 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4000 /* Define an "integer variable"; a symbol whose value is forwarded to a
4001 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4002 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4004 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4005 const char *namestring
, EMACS_INT
*address
)
4008 sym
= intern_c_string (namestring
);
4009 i_fwd
->type
= Lisp_Fwd_Int
;
4010 i_fwd
->intvar
= address
;
4011 XSYMBOL (sym
)->declared_special
= 1;
4012 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4013 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4016 /* Similar but define a variable whose value is t if address contains 1,
4017 nil if address contains 0. */
4019 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4020 const char *namestring
, bool *address
)
4023 sym
= intern_c_string (namestring
);
4024 b_fwd
->type
= Lisp_Fwd_Bool
;
4025 b_fwd
->boolvar
= address
;
4026 XSYMBOL (sym
)->declared_special
= 1;
4027 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4028 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4029 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4032 /* Similar but define a variable whose value is the Lisp Object stored
4033 at address. Two versions: with and without gc-marking of the C
4034 variable. The nopro version is used when that variable will be
4035 gc-marked for some other reason, since marking the same slot twice
4036 can cause trouble with strings. */
4038 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4039 const char *namestring
, Lisp_Object
*address
)
4042 sym
= intern_c_string (namestring
);
4043 o_fwd
->type
= Lisp_Fwd_Obj
;
4044 o_fwd
->objvar
= address
;
4045 XSYMBOL (sym
)->declared_special
= 1;
4046 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4047 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4051 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4052 const char *namestring
, Lisp_Object
*address
)
4054 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4055 staticpro (address
);
4058 /* Similar but define a variable whose value is the Lisp Object stored
4059 at a particular offset in the current kboard object. */
4062 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4063 const char *namestring
, int offset
)
4066 sym
= intern_c_string (namestring
);
4067 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4068 ko_fwd
->offset
= offset
;
4069 XSYMBOL (sym
)->declared_special
= 1;
4070 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4071 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4074 /* Check that the elements of Vload_path exist. */
4077 load_path_check (void)
4079 Lisp_Object path_tail
;
4081 /* The only elements that might not exist are those from
4082 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4084 for (path_tail
= Vload_path
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4086 Lisp_Object dirfile
;
4087 dirfile
= Fcar (path_tail
);
4088 if (STRINGP (dirfile
))
4090 dirfile
= Fdirectory_file_name (dirfile
);
4091 if (! file_accessible_directory_p (SSDATA (dirfile
)))
4092 dir_warning ("Lisp directory", XCAR (path_tail
));
4097 /* Record the value of load-path used at the start of dumping
4098 so we can see if the site changed it later during dumping. */
4099 static Lisp_Object dump_path
;
4101 /* Compute the default Vload_path, with the following logic:
4103 use EMACSLOADPATH env-var if set; otherwise use PATH_LOADSEARCH,
4104 prepending PATH_SITELOADSEARCH unless --no-site-lisp.
4105 The remainder is what happens when dumping works:
4106 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4107 Otherwise use EMACSLOADPATH if set, else PATH_LOADSEARCH.
4109 If !initialized, then just set both Vload_path and dump_path.
4110 If initialized, then if Vload_path != dump_path, do nothing.
4111 (Presumably the load-path has already been changed by something.
4112 This can only be from a site-load file during dumping,
4113 or because EMACSLOADPATH is set.)
4114 If Vinstallation_directory is not nil (ie, running uninstalled):
4115 If installation-dir/lisp exists and not already a member,
4116 we must be running uninstalled. Reset the load-path
4117 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4118 refers to the eventual installation directories. Since we
4119 are not yet installed, we should not use them, even if they exist.)
4120 If installation-dir/lisp does not exist, just add dump_path at the
4122 Add installation-dir/leim (if exists and not already a member) at the front.
4123 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4124 and not already a member) at the front.
4125 If installation-dir != source-dir (ie running an uninstalled,
4126 out-of-tree build) AND install-dir/src/Makefile exists BUT
4127 install-dir/src/Makefile.in does NOT exist (this is a sanity
4128 check), then repeat the above steps for source-dir/lisp,
4130 Finally, add the site-lisp directories at the front (if !no_site_lisp).
4140 const char *loadpath
= ns_load_path ();
4143 normal
= PATH_LOADSEARCH
;
4145 Vload_path
= decode_env_path ("EMACSLOADPATH", loadpath
? loadpath
: normal
);
4147 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4152 /* FIXME CANNOT_DUMP platforms should get source-dir/lisp etc added
4153 to their load-path too, AFAICS. I don't think we can tell the
4154 difference between initialized and !initialized in this case,
4155 so we'll have to do it unconditionally when Vinstallation_directory
4157 if (!no_site_lisp
&& !egetenv ("EMACSLOADPATH"))
4159 Lisp_Object sitelisp
;
4160 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4161 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4163 #else /* !CANNOT_DUMP */
4164 if (NILP (Vpurify_flag
))
4166 normal
= PATH_LOADSEARCH
;
4167 /* If the EMACSLOADPATH environment variable is set, use its value.
4168 This doesn't apply if we're dumping. */
4169 if (egetenv ("EMACSLOADPATH"))
4170 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4173 normal
= PATH_DUMPLOADSEARCH
;
4175 /* In a dumped Emacs, we normally reset the value of Vload_path using
4176 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4177 the source directory, instead of the path of the installed elisp
4178 libraries. However, if it appears that Vload_path has already been
4179 changed from the default that was saved before dumping, don't
4180 change it further. Changes can only be due to EMACSLOADPATH, or
4181 site-lisp files that were processed during dumping. */
4184 if (NILP (Fequal (dump_path
, Vload_path
)))
4186 /* Do not make any changes, just check the elements exist. */
4187 /* Note: --no-site-lisp is ignored.
4188 I don't know what to do about this. */
4194 const char *loadpath
= ns_load_path ();
4195 Vload_path
= decode_env_path (0, loadpath
? loadpath
: normal
);
4197 Vload_path
= decode_env_path (0, normal
);
4199 if (!NILP (Vinstallation_directory
))
4201 Lisp_Object tem
, tem1
;
4203 /* Add to the path the lisp subdir of the installation
4204 dir, if it is accessible. Note: in out-of-tree builds,
4205 this directory is empty save for Makefile. */
4206 tem
= Fexpand_file_name (build_string ("lisp"),
4207 Vinstallation_directory
);
4208 tem1
= Ffile_accessible_directory_p (tem
);
4211 if (NILP (Fmember (tem
, Vload_path
)))
4213 /* We are running uninstalled. The default load-path
4214 points to the eventual installed lisp, leim
4215 directories. We should not use those now, even
4216 if they exist, so start over from a clean slate. */
4217 Vload_path
= Fcons (tem
, Qnil
);
4221 /* That dir doesn't exist, so add the build-time
4222 Lisp dirs instead. */
4223 Vload_path
= nconc2 (Vload_path
, dump_path
);
4225 /* Add leim under the installation dir, if it is accessible. */
4226 tem
= Fexpand_file_name (build_string ("leim"),
4227 Vinstallation_directory
);
4228 tem1
= Ffile_accessible_directory_p (tem
);
4231 if (NILP (Fmember (tem
, Vload_path
)))
4232 Vload_path
= Fcons (tem
, Vload_path
);
4235 /* Add site-lisp under the installation dir, if it exists. */
4238 tem
= Fexpand_file_name (build_string ("site-lisp"),
4239 Vinstallation_directory
);
4240 tem1
= Ffile_accessible_directory_p (tem
);
4243 if (NILP (Fmember (tem
, Vload_path
)))
4244 Vload_path
= Fcons (tem
, Vload_path
);
4248 /* If Emacs was not built in the source directory,
4249 and it is run from where it was built, add to load-path
4250 the lisp, leim and site-lisp dirs under that directory. */
4252 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4256 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4257 Vinstallation_directory
);
4258 tem1
= Ffile_exists_p (tem
);
4260 /* Don't be fooled if they moved the entire source tree
4261 AFTER dumping Emacs. If the build directory is indeed
4262 different from the source dir, src/Makefile.in and
4263 src/Makefile will not be found together. */
4264 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4265 Vinstallation_directory
);
4266 tem2
= Ffile_exists_p (tem
);
4267 if (!NILP (tem1
) && NILP (tem2
))
4269 tem
= Fexpand_file_name (build_string ("lisp"),
4272 if (NILP (Fmember (tem
, Vload_path
)))
4273 Vload_path
= Fcons (tem
, Vload_path
);
4275 tem
= Fexpand_file_name (build_string ("leim"),
4278 if (NILP (Fmember (tem
, Vload_path
)))
4279 Vload_path
= Fcons (tem
, Vload_path
);
4283 tem
= Fexpand_file_name (build_string ("site-lisp"),
4285 tem1
= Ffile_accessible_directory_p (tem
);
4288 if (NILP (Fmember (tem
, Vload_path
)))
4289 Vload_path
= Fcons (tem
, Vload_path
);
4293 } /* Vinstallation_directory != Vsource_directory */
4295 } /* if Vinstallation_directory */
4297 /* Check before adding the site-lisp directories.
4298 The install should have created them, but they are not
4299 required, so no need to warn if they are absent.
4300 Or we might be running before installation. */
4303 /* Add the site-lisp directories at the front. */
4306 Lisp_Object sitelisp
;
4307 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4308 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4310 } /* if dump_path == Vload_path */
4312 else /* !initialized */
4314 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4315 source directory. We used to add ../lisp (ie the lisp dir in
4316 the build directory) at the front here, but that caused trouble
4317 because it was copied from dump_path into Vload_path, above,
4318 when Vinstallation_directory was non-nil. It should not be
4319 necessary, since in out of tree builds lisp/ is empty, save
4321 Vload_path
= decode_env_path (0, normal
);
4322 dump_path
= Vload_path
;
4323 /* No point calling load_path_check; load-path only contains essential
4324 elements from the source directory at this point. They cannot
4325 be missing unless something went extremely (and improbably)
4326 wrong, in which case the build will fail in obvious ways. */
4328 #endif /* !CANNOT_DUMP */
4332 load_in_progress
= 0;
4333 Vload_file_name
= Qnil
;
4335 load_descriptor_list
= Qnil
;
4337 Vstandard_input
= Qt
;
4338 Vloads_in_progress
= Qnil
;
4341 /* Print a warning that directory intended for use USE and with name
4342 DIRNAME cannot be accessed. On entry, errno should correspond to
4343 the access failure. Print the warning on stderr and put it in
4347 dir_warning (char const *use
, Lisp_Object dirname
)
4349 static char const format
[] = "Warning: %s `%s': %s\n";
4350 int access_errno
= errno
;
4351 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4353 /* Don't log the warning before we've initialized!! */
4356 char const *diagnostic
= emacs_strerror (access_errno
);
4358 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4359 + strlen (use
) + SBYTES (dirname
)
4360 + strlen (diagnostic
));
4361 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4363 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4369 syms_of_lread (void)
4372 defsubr (&Sread_from_string
);
4374 defsubr (&Sintern_soft
);
4375 defsubr (&Sunintern
);
4376 defsubr (&Sget_load_suffixes
);
4378 defsubr (&Seval_buffer
);
4379 defsubr (&Seval_region
);
4380 defsubr (&Sread_char
);
4381 defsubr (&Sread_char_exclusive
);
4382 defsubr (&Sread_event
);
4383 defsubr (&Sget_file_char
);
4384 defsubr (&Smapatoms
);
4385 defsubr (&Slocate_file_internal
);
4387 DEFVAR_LISP ("obarray", Vobarray
,
4388 doc
: /* Symbol table for use by `intern' and `read'.
4389 It is a vector whose length ought to be prime for best results.
4390 The vector's contents don't make sense if examined from Lisp programs;
4391 to find all the symbols in an obarray, use `mapatoms'. */);
4393 DEFVAR_LISP ("values", Vvalues
,
4394 doc
: /* List of values of all expressions which were read, evaluated and printed.
4395 Order is reverse chronological. */);
4396 XSYMBOL (intern ("values"))->declared_special
= 0;
4398 DEFVAR_LISP ("standard-input", Vstandard_input
,
4399 doc
: /* Stream for read to get input from.
4400 See documentation of `read' for possible values. */);
4401 Vstandard_input
= Qt
;
4403 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4404 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4406 If this variable is a buffer, then only forms read from that buffer
4407 will be added to `read-symbol-positions-list'.
4408 If this variable is t, then all read forms will be added.
4409 The effect of all other values other than nil are not currently
4410 defined, although they may be in the future.
4412 The positions are relative to the last call to `read' or
4413 `read-from-string'. It is probably a bad idea to set this variable at
4414 the toplevel; bind it instead. */);
4415 Vread_with_symbol_positions
= Qnil
;
4417 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4418 doc
: /* A list mapping read symbols to their positions.
4419 This variable is modified during calls to `read' or
4420 `read-from-string', but only when `read-with-symbol-positions' is
4423 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4424 CHAR-POSITION is an integer giving the offset of that occurrence of the
4425 symbol from the position where `read' or `read-from-string' started.
4427 Note that a symbol will appear multiple times in this list, if it was
4428 read multiple times. The list is in the same order as the symbols
4430 Vread_symbol_positions_list
= Qnil
;
4432 DEFVAR_LISP ("read-circle", Vread_circle
,
4433 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4436 DEFVAR_LISP ("load-path", Vload_path
,
4437 doc
: /* List of directories to search for files to load.
4438 Each element is a string (directory name) or nil (try default directory).
4439 Initialized based on EMACSLOADPATH environment variable, if any,
4440 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4442 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4443 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4444 This list should not include the empty string.
4445 `load' and related functions try to append these suffixes, in order,
4446 to the specified file name if a Lisp suffix is allowed or required. */);
4447 Vload_suffixes
= Fcons (build_pure_c_string (".elc"),
4448 Fcons (build_pure_c_string (".el"), Qnil
));
4449 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4450 doc
: /* List of suffixes that indicate representations of \
4452 This list should normally start with the empty string.
4454 Enabling Auto Compression mode appends the suffixes in
4455 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4456 mode removes them again. `load' and related functions use this list to
4457 determine whether they should look for compressed versions of a file
4458 and, if so, which suffixes they should try to append to the file name
4459 in order to do so. However, if you want to customize which suffixes
4460 the loading functions recognize as compression suffixes, you should
4461 customize `jka-compr-load-suffixes' rather than the present variable. */);
4462 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4464 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4465 doc
: /* Non-nil if inside of `load'. */);
4466 DEFSYM (Qload_in_progress
, "load-in-progress");
4468 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4469 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4470 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4472 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4473 a symbol \(a feature name).
4475 When `load' is run and the file-name argument matches an element's
4476 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4477 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4479 An error in FORMS does not undo the load, but does prevent execution of
4480 the rest of the FORMS. */);
4481 Vafter_load_alist
= Qnil
;
4483 DEFVAR_LISP ("load-history", Vload_history
,
4484 doc
: /* Alist mapping loaded file names to symbols and features.
4485 Each alist element should be a list (FILE-NAME ENTRIES...), where
4486 FILE-NAME is the name of a file that has been loaded into Emacs.
4487 The file name is absolute and true (i.e. it doesn't contain symlinks).
4488 As an exception, one of the alist elements may have FILE-NAME nil,
4489 for symbols and features not associated with any file.
4491 The remaining ENTRIES in the alist element describe the functions and
4492 variables defined in that file, the features provided, and the
4493 features required. Each entry has the form `(provide . FEATURE)',
4494 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4495 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4496 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4497 autoload before this file redefined it as a function. In addition,
4498 entries may also be single symbols, which means that SYMBOL was
4499 defined by `defvar' or `defconst'.
4501 During preloading, the file name recorded is relative to the main Lisp
4502 directory. These file names are converted to absolute at startup. */);
4503 Vload_history
= Qnil
;
4505 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4506 doc
: /* Full name of file being loaded by `load'. */);
4507 Vload_file_name
= Qnil
;
4509 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4510 doc
: /* File name, including directory, of user's initialization file.
4511 If the file loaded had extension `.elc', and the corresponding source file
4512 exists, this variable contains the name of source file, suitable for use
4513 by functions like `custom-save-all' which edit the init file.
4514 While Emacs loads and evaluates the init file, value is the real name
4515 of the file, regardless of whether or not it has the `.elc' extension. */);
4516 Vuser_init_file
= Qnil
;
4518 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4519 doc
: /* Used for internal purposes by `load'. */);
4520 Vcurrent_load_list
= Qnil
;
4522 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4523 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4524 The default is nil, which means use the function `read'. */);
4525 Vload_read_function
= Qnil
;
4527 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4528 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4529 This function is for doing code conversion before reading the source file.
4530 If nil, loading is done without any code conversion.
4531 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4532 FULLNAME is the full name of FILE.
4533 See `load' for the meaning of the remaining arguments. */);
4534 Vload_source_file_function
= Qnil
;
4536 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4537 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4538 This is useful when the file being loaded is a temporary copy. */);
4539 load_force_doc_strings
= 0;
4541 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4542 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4543 This is normally bound by `load' and `eval-buffer' to control `read',
4544 and is not meant for users to change. */);
4545 load_convert_to_unibyte
= 0;
4547 DEFVAR_LISP ("source-directory", Vsource_directory
,
4548 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4549 You cannot count on them to still be there! */);
4551 = Fexpand_file_name (build_string ("../"),
4552 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4554 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4555 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4556 Vpreloaded_file_list
= Qnil
;
4558 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4559 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4560 Vbyte_boolean_vars
= Qnil
;
4562 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4563 doc
: /* Non-nil means load dangerous compiled Lisp files.
4564 Some versions of XEmacs use different byte codes than Emacs. These
4565 incompatible byte codes can make Emacs crash when it tries to execute
4567 load_dangerous_libraries
= 0;
4569 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4570 doc
: /* Non-nil means force printing messages when loading Lisp files.
4571 This overrides the value of the NOMESSAGE argument to `load'. */);
4572 force_load_messages
= 0;
4574 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4575 doc
: /* Regular expression matching safe to load compiled Lisp files.
4576 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4577 from the file, and matches them against this regular expression.
4578 When the regular expression matches, the file is considered to be safe
4579 to load. See also `load-dangerous-libraries'. */);
4580 Vbytecomp_version_regexp
4581 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4583 DEFSYM (Qlexical_binding
, "lexical-binding");
4584 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4585 doc
: /* Whether to use lexical binding when evaluating code.
4586 Non-nil means that the code in the current buffer should be evaluated
4587 with lexical binding.
4588 This variable is automatically set from the file variables of an
4589 interpreted Lisp file read using `load'. Unlike other file local
4590 variables, this must be set in the first line of a file. */);
4591 Vlexical_binding
= Qnil
;
4592 Fmake_variable_buffer_local (Qlexical_binding
);
4594 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4595 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4596 Veval_buffer_list
= Qnil
;
4598 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4599 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4600 Vold_style_backquotes
= Qnil
;
4601 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4603 /* Vsource_directory was initialized in init_lread. */
4605 load_descriptor_list
= Qnil
;
4606 staticpro (&load_descriptor_list
);
4608 DEFSYM (Qcurrent_load_list
, "current-load-list");
4609 DEFSYM (Qstandard_input
, "standard-input");
4610 DEFSYM (Qread_char
, "read-char");
4611 DEFSYM (Qget_file_char
, "get-file-char");
4612 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4613 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4615 DEFSYM (Qbackquote
, "`");
4616 DEFSYM (Qcomma
, ",");
4617 DEFSYM (Qcomma_at
, ",@");
4618 DEFSYM (Qcomma_dot
, ",.");
4620 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4621 DEFSYM (Qascii_character
, "ascii-character");
4622 DEFSYM (Qfunction
, "function");
4623 DEFSYM (Qload
, "load");
4624 DEFSYM (Qload_file_name
, "load-file-name");
4625 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4626 DEFSYM (Qfile_truename
, "file-truename");
4627 DEFSYM (Qdir_ok
, "dir-ok");
4628 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4630 staticpro (&dump_path
);
4632 staticpro (&read_objects
);
4633 read_objects
= Qnil
;
4634 staticpro (&seen_list
);
4637 Vloads_in_progress
= Qnil
;
4638 staticpro (&Vloads_in_progress
);
4640 DEFSYM (Qhash_table
, "hash-table");
4641 DEFSYM (Qdata
, "data");
4642 DEFSYM (Qtest
, "test");
4643 DEFSYM (Qsize
, "size");
4644 DEFSYM (Qweakness
, "weakness");
4645 DEFSYM (Qrehash_size
, "rehash-size");
4646 DEFSYM (Qrehash_threshold
, "rehash-threshold");