1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2014 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
28 #include <limits.h> /* For CHAR_BIT. */
29 #include <stat-time.h>
31 #include "intervals.h"
32 #include "character.h"
40 #include "termhooks.h"
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 /* File for get_file_char to read from. Use by load. */
99 static FILE *instream
;
101 /* For use within read-from-string (this reader is non-reentrant!!) */
102 static ptrdiff_t read_from_string_index
;
103 static ptrdiff_t read_from_string_index_byte
;
104 static ptrdiff_t read_from_string_limit
;
106 /* Number of characters read in the current call to Fread or
107 Fread_from_string. */
108 static EMACS_INT readchar_count
;
110 /* This contains the last string skipped with #@. */
111 static char *saved_doc_string
;
112 /* Length of buffer allocated in saved_doc_string. */
113 static ptrdiff_t saved_doc_string_size
;
114 /* Length of actual data in saved_doc_string. */
115 static ptrdiff_t saved_doc_string_length
;
116 /* This is the file position that string came from. */
117 static file_offset saved_doc_string_position
;
119 /* This contains the previous string skipped with #@.
120 We copy it from saved_doc_string when a new string
121 is put in saved_doc_string. */
122 static char *prev_saved_doc_string
;
123 /* Length of buffer allocated in prev_saved_doc_string. */
124 static ptrdiff_t prev_saved_doc_string_size
;
125 /* Length of actual data in prev_saved_doc_string. */
126 static ptrdiff_t prev_saved_doc_string_length
;
127 /* This is the file position that string came from. */
128 static file_offset prev_saved_doc_string_position
;
130 /* True means inside a new-style backquote
131 with no surrounding parentheses.
132 Fread initializes this to false, so we need not specbind it
133 or worry about what happens to it when there is an error. */
134 static bool new_backquote_flag
;
135 static Lisp_Object Qold_style_backquotes
;
137 /* A list of file names for files being loaded in Fload. Used to
138 check for recursive loads. */
140 static Lisp_Object Vloads_in_progress
;
142 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
145 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
146 Lisp_Object
, Lisp_Object
,
147 Lisp_Object
, Lisp_Object
);
149 /* Functions that read one byte from the current source READCHARFUN
150 or unreads one byte. If the integer argument C is -1, it returns
151 one read byte, or -1 when there's no more byte in the source. If C
152 is 0 or positive, it unreads C, and the return value is not
155 static int readbyte_for_lambda (int, Lisp_Object
);
156 static int readbyte_from_file (int, Lisp_Object
);
157 static int readbyte_from_string (int, Lisp_Object
);
159 /* Handle unreading and rereading of characters.
160 Write READCHAR to read a character,
161 UNREAD(c) to unread c to be read again.
163 These macros correctly read/unread multibyte characters. */
165 #define READCHAR readchar (readcharfun, NULL)
166 #define UNREAD(c) unreadchar (readcharfun, c)
168 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
169 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
171 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
172 Qlambda, or a cons, we use this to keep an unread character because
173 a file stream can't handle multibyte-char unreading. The value -1
174 means that there's no unread character. */
175 static int unread_char
;
178 readchar (Lisp_Object readcharfun
, bool *multibyte
)
182 int (*readbyte
) (int, Lisp_Object
);
183 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
185 bool emacs_mule_encoding
= 0;
192 if (BUFFERP (readcharfun
))
194 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
196 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
198 if (! BUFFER_LIVE_P (inbuffer
))
201 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
204 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
206 /* Fetch the character code from the buffer. */
207 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
208 BUF_INC_POS (inbuffer
, pt_byte
);
215 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
216 if (! ASCII_CHAR_P (c
))
217 c
= BYTE8_TO_CHAR (c
);
220 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
224 if (MARKERP (readcharfun
))
226 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
228 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
230 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
233 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
235 /* Fetch the character code from the buffer. */
236 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
237 BUF_INC_POS (inbuffer
, bytepos
);
244 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
245 if (! ASCII_CHAR_P (c
))
246 c
= BYTE8_TO_CHAR (c
);
250 XMARKER (readcharfun
)->bytepos
= bytepos
;
251 XMARKER (readcharfun
)->charpos
++;
256 if (EQ (readcharfun
, Qlambda
))
258 readbyte
= readbyte_for_lambda
;
262 if (EQ (readcharfun
, Qget_file_char
))
264 readbyte
= readbyte_from_file
;
268 if (STRINGP (readcharfun
))
270 if (read_from_string_index
>= read_from_string_limit
)
272 else if (STRING_MULTIBYTE (readcharfun
))
276 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
277 read_from_string_index
,
278 read_from_string_index_byte
);
282 c
= SREF (readcharfun
, read_from_string_index_byte
);
283 read_from_string_index
++;
284 read_from_string_index_byte
++;
289 if (CONSP (readcharfun
))
291 /* This is the case that read_vector is reading from a unibyte
292 string that contains a byte sequence previously skipped
293 because of #@NUMBER. The car part of readcharfun is that
294 string, and the cdr part is a value of readcharfun given to
296 readbyte
= readbyte_from_string
;
297 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
298 emacs_mule_encoding
= 1;
302 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
304 readbyte
= readbyte_from_file
;
305 emacs_mule_encoding
= 1;
309 tem
= call0 (readcharfun
);
316 if (unread_char
>= 0)
322 c
= (*readbyte
) (-1, readcharfun
);
327 if (ASCII_CHAR_P (c
))
329 if (emacs_mule_encoding
)
330 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
333 len
= BYTES_BY_CHAR_HEAD (c
);
336 c
= (*readbyte
) (-1, readcharfun
);
337 if (c
< 0 || ! TRAILING_CODE_P (c
))
340 (*readbyte
) (buf
[i
], readcharfun
);
341 return BYTE8_TO_CHAR (buf
[0]);
345 return STRING_CHAR (buf
);
348 #define FROM_FILE_P(readcharfun) \
349 (EQ (readcharfun, Qget_file_char) \
350 || EQ (readcharfun, Qget_emacs_mule_file_char))
353 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
355 if (FROM_FILE_P (readcharfun
))
357 block_input (); /* FIXME: Not sure if it's needed. */
358 fseek (instream
, n
, SEEK_CUR
);
362 { /* We're not reading directly from a file. In that case, it's difficult
363 to reliably count bytes, since these are usually meant for the file's
364 encoding, whereas we're now typically in the internal encoding.
365 But luckily, skip_dyn_bytes is used to skip over a single
366 dynamic-docstring (or dynamic byte-code) which is always quoted such
367 that \037 is the final char. */
371 } while (c
>= 0 && c
!= '\037');
376 skip_dyn_eof (Lisp_Object readcharfun
)
378 if (FROM_FILE_P (readcharfun
))
380 block_input (); /* FIXME: Not sure if it's needed. */
381 fseek (instream
, 0, SEEK_END
);
385 while (READCHAR
>= 0);
388 /* Unread the character C in the way appropriate for the stream READCHARFUN.
389 If the stream is a user function, call it with the char as argument. */
392 unreadchar (Lisp_Object readcharfun
, int c
)
396 /* Don't back up the pointer if we're unreading the end-of-input mark,
397 since readchar didn't advance it when we read it. */
399 else if (BUFFERP (readcharfun
))
401 struct buffer
*b
= XBUFFER (readcharfun
);
402 ptrdiff_t charpos
= BUF_PT (b
);
403 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
405 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
406 BUF_DEC_POS (b
, bytepos
);
410 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
412 else if (MARKERP (readcharfun
))
414 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
415 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
417 XMARKER (readcharfun
)->charpos
--;
418 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
419 BUF_DEC_POS (b
, bytepos
);
423 XMARKER (readcharfun
)->bytepos
= bytepos
;
425 else if (STRINGP (readcharfun
))
427 read_from_string_index
--;
428 read_from_string_index_byte
429 = string_char_to_byte (readcharfun
, read_from_string_index
);
431 else if (CONSP (readcharfun
))
435 else if (EQ (readcharfun
, Qlambda
))
439 else if (FROM_FILE_P (readcharfun
))
444 call1 (readcharfun
, make_number (c
));
448 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
450 return read_bytecode_char (c
>= 0);
455 readbyte_from_file (int c
, Lisp_Object readcharfun
)
460 ungetc (c
, instream
);
468 /* Interrupted reads have been observed while reading over the network. */
469 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
480 return (c
== EOF
? -1 : c
);
484 readbyte_from_string (int c
, Lisp_Object readcharfun
)
486 Lisp_Object string
= XCAR (readcharfun
);
490 read_from_string_index
--;
491 read_from_string_index_byte
492 = string_char_to_byte (string
, read_from_string_index
);
495 if (read_from_string_index
>= read_from_string_limit
)
498 FETCH_STRING_CHAR_ADVANCE (c
, string
,
499 read_from_string_index
,
500 read_from_string_index_byte
);
505 /* Read one non-ASCII character from INSTREAM. The character is
506 encoded in `emacs-mule' and the first byte is already read in
510 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
512 /* Emacs-mule coding uses at most 4-byte for one character. */
513 unsigned char buf
[4];
514 int len
= emacs_mule_bytes
[c
];
515 struct charset
*charset
;
520 /* C is not a valid leading-code of `emacs-mule'. */
521 return BYTE8_TO_CHAR (c
);
527 c
= (*readbyte
) (-1, readcharfun
);
531 (*readbyte
) (buf
[i
], readcharfun
);
532 return BYTE8_TO_CHAR (buf
[0]);
539 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
540 code
= buf
[1] & 0x7F;
544 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
545 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
547 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
548 code
= buf
[2] & 0x7F;
552 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
553 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
558 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
559 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
561 c
= DECODE_CHAR (charset
, code
);
563 Fsignal (Qinvalid_read_syntax
,
564 list1 (build_string ("invalid multibyte form")));
569 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
571 static Lisp_Object
read0 (Lisp_Object
);
572 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
574 static Lisp_Object
read_list (bool, Lisp_Object
);
575 static Lisp_Object
read_vector (Lisp_Object
, bool);
577 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
579 static void substitute_object_in_subtree (Lisp_Object
,
581 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
584 /* Get a character from the tty. */
586 /* Read input events until we get one that's acceptable for our purposes.
588 If NO_SWITCH_FRAME, switch-frame events are stashed
589 until we get a character we like, and then stuffed into
592 If ASCII_REQUIRED, check function key events to see
593 if the unmodified version of the symbol has a Qascii_character
594 property, and use that character, if present.
596 If ERROR_NONASCII, signal an error if the input we
597 get isn't an ASCII character with modifiers. If it's false but
598 ASCII_REQUIRED is true, just re-read until we get an ASCII
601 If INPUT_METHOD, invoke the current input method
602 if the character warrants that.
604 If SECONDS is a number, wait that many seconds for input, and
605 return Qnil if no input arrives within that time. */
608 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
609 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
611 Lisp_Object val
, delayed_switch_frame
;
612 struct timespec end_time
;
614 #ifdef HAVE_WINDOW_SYSTEM
615 if (display_hourglass_p
)
619 delayed_switch_frame
= Qnil
;
621 /* Compute timeout. */
622 if (NUMBERP (seconds
))
624 double duration
= extract_float (seconds
);
625 struct timespec wait_time
= dtotimespec (duration
);
626 end_time
= timespec_add (current_timespec (), wait_time
);
629 /* Read until we get an acceptable event. */
632 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
633 NUMBERP (seconds
) ? &end_time
: NULL
);
634 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
639 /* `switch-frame' events are put off until after the next ASCII
640 character. This is better than signaling an error just because
641 the last characters were typed to a separate minibuffer frame,
642 for example. Eventually, some code which can deal with
643 switch-frame events will read it and process it. */
645 && EVENT_HAS_PARAMETERS (val
)
646 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
648 delayed_switch_frame
= val
;
652 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
654 /* Convert certain symbols to their ASCII equivalents. */
657 Lisp_Object tem
, tem1
;
658 tem
= Fget (val
, Qevent_symbol_element_mask
);
661 tem1
= Fget (Fcar (tem
), Qascii_character
);
662 /* Merge this symbol's modifier bits
663 with the ASCII equivalent of its basic code. */
665 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
669 /* If we don't have a character now, deal with it appropriately. */
674 Vunread_command_events
= list1 (val
);
675 error ("Non-character input-event");
682 if (! NILP (delayed_switch_frame
))
683 unread_switch_frame
= delayed_switch_frame
;
687 #ifdef HAVE_WINDOW_SYSTEM
688 if (display_hourglass_p
)
697 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
698 doc
: /* Read a character from the command input (keyboard or macro).
699 It is returned as a number.
700 If the character has modifiers, they are resolved and reflected to the
701 character code if possible (e.g. C-SPC -> 0).
703 If the user generates an event which is not a character (i.e. a mouse
704 click or function key event), `read-char' signals an error. As an
705 exception, switch-frame events are put off until non-character events
707 If you want to read non-character events, or ignore them, call
708 `read-event' or `read-char-exclusive' instead.
710 If the optional argument PROMPT is non-nil, display that as a prompt.
711 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
712 input method is turned on in the current buffer, that input method
713 is used for reading a character.
714 If the optional argument SECONDS is non-nil, it should be a number
715 specifying the maximum number of seconds to wait for input. If no
716 input arrives in that time, return nil. SECONDS may be a
717 floating-point value. */)
718 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
723 message_with_string ("%s", prompt
, 0);
724 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
726 return (NILP (val
) ? Qnil
727 : make_number (char_resolve_modifier_mask (XINT (val
))));
730 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
731 doc
: /* Read an event object from the input stream.
732 If the optional argument PROMPT is non-nil, display that as a prompt.
733 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
734 input method is turned on in the current buffer, that input method
735 is used for reading a character.
736 If the optional argument SECONDS is non-nil, it should be a number
737 specifying the maximum number of seconds to wait for input. If no
738 input arrives in that time, return nil. SECONDS may be a
739 floating-point value. */)
740 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
743 message_with_string ("%s", prompt
, 0);
744 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
747 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
748 doc
: /* Read a character from the command input (keyboard or macro).
749 It is returned as a number. Non-character events are ignored.
750 If the character has modifiers, they are resolved and reflected to the
751 character code if possible (e.g. C-SPC -> 0).
753 If the optional argument PROMPT is non-nil, display that as a prompt.
754 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
755 input method is turned on in the current buffer, that input method
756 is used for reading a character.
757 If the optional argument SECONDS is non-nil, it should be a number
758 specifying the maximum number of seconds to wait for input. If no
759 input arrives in that time, return nil. SECONDS may be a
760 floating-point value. */)
761 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
766 message_with_string ("%s", prompt
, 0);
768 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
770 return (NILP (val
) ? Qnil
771 : make_number (char_resolve_modifier_mask (XINT (val
))));
774 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
775 doc
: /* Don't use this yourself. */)
778 register Lisp_Object val
;
780 XSETINT (val
, getc (instream
));
788 /* Return true if the lisp code read using READCHARFUN defines a non-nil
789 `lexical-binding' file variable. After returning, the stream is
790 positioned following the first line, if it is a comment or #! line,
791 otherwise nothing is read. */
794 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
807 while (ch
!= '\n' && ch
!= EOF
)
809 if (ch
== '\n') ch
= READCHAR
;
810 /* It is OK to leave the position after a #! line, since
811 that is what read1 does. */
815 /* The first line isn't a comment, just give up. */
821 /* Look for an appropriate file-variable in the first line. */
825 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
826 } beg_end_state
= NOMINAL
;
827 bool in_file_vars
= 0;
829 #define UPDATE_BEG_END_STATE(ch) \
830 if (beg_end_state == NOMINAL) \
831 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
832 else if (beg_end_state == AFTER_FIRST_DASH) \
833 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
834 else if (beg_end_state == AFTER_ASTERIX) \
837 in_file_vars = !in_file_vars; \
838 beg_end_state = NOMINAL; \
841 /* Skip until we get to the file vars, if any. */
845 UPDATE_BEG_END_STATE (ch
);
847 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
851 char var
[100], val
[100];
856 /* Read a variable name. */
857 while (ch
== ' ' || ch
== '\t')
861 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
863 if (i
< sizeof var
- 1)
865 UPDATE_BEG_END_STATE (ch
);
869 /* Stop scanning if no colon was found before end marker. */
870 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
873 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
879 /* Read a variable value. */
882 while (ch
== ' ' || ch
== '\t')
886 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
888 if (i
< sizeof val
- 1)
890 UPDATE_BEG_END_STATE (ch
);
894 /* The value was terminated by an end-marker, which remove. */
896 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
900 if (strcmp (var
, "lexical-binding") == 0)
903 rv
= (strcmp (val
, "nil") != 0);
909 while (ch
!= '\n' && ch
!= EOF
)
916 /* Value is a version number of byte compiled code if the file
917 associated with file descriptor FD is a compiled Lisp file that's
918 safe to load. Only files compiled with Emacs are safe to load.
919 Files compiled with XEmacs can lead to a crash in Fbyte_code
920 because of an incompatible change in the byte compiler. */
923 safe_to_load_version (int fd
)
929 /* Read the first few bytes from the file, and look for a line
930 specifying the byte compiler version used. */
931 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
934 /* Skip to the next newline, skipping over the initial `ELC'
935 with NUL bytes following it, but note the version. */
936 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
941 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
942 buf
+ i
, nbytes
- i
) < 0)
946 lseek (fd
, 0, SEEK_SET
);
951 /* Callback for record_unwind_protect. Restore the old load list OLD,
952 after loading a file successfully. */
955 record_load_unwind (Lisp_Object old
)
957 Vloads_in_progress
= old
;
960 /* This handler function is used via internal_condition_case_1. */
963 load_error_handler (Lisp_Object data
)
969 load_warn_old_style_backquotes (Lisp_Object file
)
971 if (!NILP (Vold_style_backquotes
))
974 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
980 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
981 doc
: /* Return the suffixes that `load' should try if a suffix is \
983 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
986 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
987 while (CONSP (suffixes
))
989 Lisp_Object exts
= Vload_file_rep_suffixes
;
990 suffix
= XCAR (suffixes
);
991 suffixes
= XCDR (suffixes
);
996 lst
= Fcons (concat2 (suffix
, ext
), lst
);
999 return Fnreverse (lst
);
1002 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1003 doc
: /* Execute a file of Lisp code named FILE.
1004 First try FILE with `.elc' appended, then try with `.el',
1005 then try FILE unmodified (the exact suffixes in the exact order are
1006 determined by `load-suffixes'). Environment variable references in
1007 FILE are replaced with their values by calling `substitute-in-file-name'.
1008 This function searches the directories in `load-path'.
1010 If optional second arg NOERROR is non-nil,
1011 report no error if FILE doesn't exist.
1012 Print messages at start and end of loading unless
1013 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1015 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1016 suffixes `.elc' or `.el' to the specified name FILE.
1017 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1018 the suffix `.elc' or `.el'; don't accept just FILE unless
1019 it ends in one of those suffixes or includes a directory name.
1021 If NOSUFFIX is nil, then if a file could not be found, try looking for
1022 a different representation of the file by adding non-empty suffixes to
1023 its name, before trying another file. Emacs uses this feature to find
1024 compressed versions of files when Auto Compression mode is enabled.
1025 If NOSUFFIX is non-nil, disable this feature.
1027 The suffixes that this function tries out, when NOSUFFIX is nil, are
1028 given by the return value of `get-load-suffixes' and the values listed
1029 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1030 return value of `get-load-suffixes' is used, i.e. the file name is
1031 required to have a non-empty suffix.
1033 When searching suffixes, this function normally stops at the first
1034 one that exists. If the option `load-prefer-newer' is non-nil,
1035 however, it tries all suffixes, and uses whichever file is the newest.
1037 Loading a file records its definitions, and its `provide' and
1038 `require' calls, in an element of `load-history' whose
1039 car is the file name loaded. See `load-history'.
1041 While the file is in the process of being loaded, the variable
1042 `load-in-progress' is non-nil and the variable `load-file-name'
1043 is bound to the file's name.
1045 Return t if the file exists and loads successfully. */)
1046 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1047 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1049 FILE *stream
= NULL
;
1052 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1053 Lisp_Object found
, efound
, hist_file_name
;
1054 /* True means we printed the ".el is newer" message. */
1056 /* True means we are loading a compiled file. */
1058 Lisp_Object handler
;
1060 const char *fmode
= "r";
1067 CHECK_STRING (file
);
1069 /* If file name is magic, call the handler. */
1070 /* This shouldn't be necessary any more now that `openp' handles it right.
1071 handler = Ffind_file_name_handler (file, Qload);
1072 if (!NILP (handler))
1073 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1075 /* Do this after the handler to avoid
1076 the need to gcpro noerror, nomessage and nosuffix.
1077 (Below here, we care only whether they are nil or not.)
1078 The presence of this call is the result of a historical accident:
1079 it used to be in every file-operation and when it got removed
1080 everywhere, it accidentally stayed here. Since then, enough people
1081 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1082 that it seemed risky to remove. */
1083 if (! NILP (noerror
))
1085 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1086 Qt
, load_error_handler
);
1093 file
= Fsubstitute_in_file_name (file
);
1095 /* Avoid weird lossage with null string as arg,
1096 since it would try to load a directory as a Lisp file. */
1097 if (SCHARS (file
) == 0)
1104 Lisp_Object suffixes
;
1106 GCPRO2 (file
, found
);
1108 if (! NILP (must_suffix
))
1110 /* Don't insist on adding a suffix if FILE already ends with one. */
1111 ptrdiff_t size
= SBYTES (file
);
1113 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1116 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1118 /* Don't insist on adding a suffix
1119 if the argument includes a directory name. */
1120 else if (! NILP (Ffile_name_directory (file
)))
1124 if (!NILP (nosuffix
))
1128 suffixes
= Fget_load_suffixes ();
1129 if (NILP (must_suffix
))
1133 arg
[1] = Vload_file_rep_suffixes
;
1134 suffixes
= Fappend (2, arg
);
1138 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1145 report_file_error ("Cannot open load file", file
);
1150 /* Tell startup.el whether or not we found the user's init file. */
1151 if (EQ (Qt
, Vuser_init_file
))
1152 Vuser_init_file
= found
;
1154 /* If FD is -2, that means openp found a magic file. */
1157 if (NILP (Fequal (found
, file
)))
1158 /* If FOUND is a different file name from FILE,
1159 find its handler even if we have already inhibited
1160 the `load' operation on FILE. */
1161 handler
= Ffind_file_name_handler (found
, Qt
);
1163 handler
= Ffind_file_name_handler (found
, Qload
);
1164 if (! NILP (handler
)) {
1166 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1169 /* Tramp has to deal with semi-broken packages that prepend
1170 drive letters to remote files. For that reason, Tramp
1171 catches file operations that test for file existence, which
1172 makes openp think X:/foo.elc files are remote. However,
1173 Tramp does not catch `load' operations for such files, so we
1174 end up with a nil as the `load' handler above. If we would
1175 continue with fd = -2, we will behave wrongly, and in
1176 particular try reading a .elc file in the "rt" mode instead
1177 of "rb". See bug #9311 for the results. To work around
1178 this, we try to open the file locally, and go with that if it
1180 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1188 record_unwind_protect_ptr (close_file_ptr_unwind
, &fd
);
1189 record_unwind_protect_ptr (fclose_ptr_unwind
, &stream
);
1192 /* Check if we're stuck in a recursive load cycle.
1194 2000-09-21: It's not possible to just check for the file loaded
1195 being a member of Vloads_in_progress. This fails because of the
1196 way the byte compiler currently works; `provide's are not
1197 evaluated, see font-lock.el/jit-lock.el as an example. This
1198 leads to a certain amount of ``normal'' recursion.
1200 Also, just loading a file recursively is not always an error in
1201 the general case; the second load may do something different. */
1205 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1206 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1207 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1208 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1209 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1212 /* All loads are by default dynamic, unless the file itself specifies
1213 otherwise using a file-variable in the first line. This is bound here
1214 so that it takes effect whether or not we use
1215 Vload_source_file_function. */
1216 specbind (Qlexical_binding
, Qnil
);
1218 /* Get the name for load-history. */
1219 hist_file_name
= (! NILP (Vpurify_flag
)
1220 ? concat2 (Ffile_name_directory (file
),
1221 Ffile_name_nondirectory (found
))
1226 /* Check for the presence of old-style quotes and warn about them. */
1227 specbind (Qold_style_backquotes
, Qnil
);
1228 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1230 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1231 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1232 /* Load .elc files directly, but not when they are
1233 remote and have no handler! */
1240 GCPRO3 (file
, found
, hist_file_name
);
1243 && ! (version
= safe_to_load_version (fd
)))
1246 if (!load_dangerous_libraries
)
1247 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1248 else if (!NILP (nomessage
) && !force_load_messages
)
1249 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1254 efound
= ENCODE_FILE (found
);
1260 /* openp already checked for newness, no point doing it again.
1261 FIXME would be nice to get a message when openp
1262 ignores suffix order due to load_prefer_newer. */
1263 if (!load_prefer_newer
)
1265 result
= stat (SSDATA (efound
), &s1
);
1268 SSET (efound
, SBYTES (efound
) - 1, 0);
1269 result
= stat (SSDATA (efound
), &s2
);
1270 SSET (efound
, SBYTES (efound
) - 1, 'c');
1274 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1276 /* Make the progress messages mention that source is newer. */
1279 /* If we won't print another message, mention this anyway. */
1280 if (!NILP (nomessage
) && !force_load_messages
)
1282 Lisp_Object msg_file
;
1283 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1284 message_with_string ("Source file `%s' newer than byte-compiled file",
1288 } /* !load_prefer_newer */
1294 /* We are loading a source file (*.el). */
1295 if (!NILP (Vload_source_file_function
))
1304 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1305 NILP (noerror
) ? Qnil
: Qt
,
1306 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1312 GCPRO3 (file
, found
, hist_file_name
);
1316 /* We somehow got here with fd == -2, meaning the file is deemed
1317 to be remote. Don't even try to reopen the file locally;
1318 just force a failure. */
1327 efound
= ENCODE_FILE (found
);
1328 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1330 stream
= fdopen (fd
, fmode
);
1334 report_file_error ("Opening stdio stream", file
);
1336 if (! NILP (Vpurify_flag
))
1337 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1339 if (NILP (nomessage
) || force_load_messages
)
1342 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1345 message_with_string ("Loading %s (source)...", file
, 1);
1347 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1349 else /* The typical case; compiled file newer than source file. */
1350 message_with_string ("Loading %s...", file
, 1);
1353 specbind (Qload_file_name
, found
);
1354 specbind (Qinhibit_file_name_operation
, Qnil
);
1355 specbind (Qload_in_progress
, Qt
);
1358 if (lisp_file_lexically_bound_p (Qget_file_char
))
1359 Fset (Qlexical_binding
, Qt
);
1361 if (! version
|| version
>= 22)
1362 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1363 0, Qnil
, Qnil
, Qnil
, Qnil
);
1366 /* We can't handle a file which was compiled with
1367 byte-compile-dynamic by older version of Emacs. */
1368 specbind (Qload_force_doc_strings
, Qt
);
1369 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1370 0, Qnil
, Qnil
, Qnil
, Qnil
);
1374 /* Run any eval-after-load forms for this file. */
1375 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1376 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1380 xfree (saved_doc_string
);
1381 saved_doc_string
= 0;
1382 saved_doc_string_size
= 0;
1384 xfree (prev_saved_doc_string
);
1385 prev_saved_doc_string
= 0;
1386 prev_saved_doc_string_size
= 0;
1388 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1391 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1394 message_with_string ("Loading %s (source)...done", file
, 1);
1396 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1398 else /* The typical case; compiled file newer than source file. */
1399 message_with_string ("Loading %s...done", file
, 1);
1406 complete_filename_p (Lisp_Object pathname
)
1408 const unsigned char *s
= SDATA (pathname
);
1409 return (IS_DIRECTORY_SEP (s
[0])
1410 || (SCHARS (pathname
) > 2
1411 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1414 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1415 doc
: /* Search for FILENAME through PATH.
1416 Returns the file's name in absolute form, or nil if not found.
1417 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1418 file name when searching.
1419 If non-nil, PREDICATE is used instead of `file-readable-p'.
1420 PREDICATE can also be an integer to pass to the faccessat(2) function,
1421 in which case file-name-handlers are ignored.
1422 This function will normally skip directories, so if you want it to find
1423 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1424 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1427 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1428 if (NILP (predicate
) && fd
>= 0)
1433 static Lisp_Object Qdir_ok
;
1435 /* Search for a file whose name is STR, looking in directories
1436 in the Lisp list PATH, and trying suffixes from SUFFIX.
1437 On success, return a file descriptor (or 1 or -2 as described below).
1438 On failure, return -1 and set errno.
1440 SUFFIXES is a list of strings containing possible suffixes.
1441 The empty suffix is automatically added if the list is empty.
1443 PREDICATE non-nil means don't open the files,
1444 just look for one that satisfies the predicate. In this case,
1445 return 1 on success. The predicate can be a lisp function or
1446 an integer to pass to `access' (in which case file-name-handlers
1449 If STOREPTR is nonzero, it points to a slot where the name of
1450 the file actually found should be stored as a Lisp string.
1451 nil is stored there on failure.
1453 If the file we find is remote, return -2
1454 but store the found remote file name in *STOREPTR.
1456 If NEWER is true, try all SUFFIXes and return the result for the
1457 newest file that exists. Does not apply to remote files,
1458 or if PREDICATE is specified. */
1461 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1462 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1464 ptrdiff_t fn_size
= 100;
1468 ptrdiff_t want_length
;
1469 Lisp_Object filename
;
1470 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
, gcpro7
;
1471 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1472 ptrdiff_t max_suffix_len
= 0;
1473 int last_errno
= ENOENT
;
1476 /* The last-modified time of the newest matching file found.
1477 Initialize it to something less than all valid timestamps. */
1478 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1482 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1484 CHECK_STRING_CAR (tail
);
1485 max_suffix_len
= max (max_suffix_len
,
1486 SBYTES (XCAR (tail
)));
1489 string
= filename
= encoded_fn
= save_string
= Qnil
;
1490 GCPRO7 (str
, string
, save_string
, filename
, path
, suffixes
, encoded_fn
);
1495 absolute
= complete_filename_p (str
);
1497 for (; CONSP (path
); path
= XCDR (path
))
1499 filename
= Fexpand_file_name (str
, XCAR (path
));
1500 if (!complete_filename_p (filename
))
1501 /* If there are non-absolute elts in PATH (eg "."). */
1502 /* Of course, this could conceivably lose if luser sets
1503 default-directory to be something non-absolute... */
1505 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1506 if (!complete_filename_p (filename
))
1507 /* Give up on this path element! */
1511 /* Calculate maximum length of any filename made from
1512 this path element/specified file name and any possible suffix. */
1513 want_length
= max_suffix_len
+ SBYTES (filename
);
1514 if (fn_size
<= want_length
)
1515 fn
= alloca (fn_size
= 100 + want_length
);
1517 /* Loop over suffixes. */
1518 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1519 CONSP (tail
); tail
= XCDR (tail
))
1521 Lisp_Object suffix
= XCAR (tail
);
1522 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1523 Lisp_Object handler
;
1525 /* Concatenate path element/specified name with the suffix.
1526 If the directory starts with /:, remove that. */
1527 int prefixlen
= ((SCHARS (filename
) > 2
1528 && SREF (filename
, 0) == '/'
1529 && SREF (filename
, 1) == ':')
1531 fnlen
= SBYTES (filename
) - prefixlen
;
1532 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1533 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1535 /* Check that the file exists and is not a directory. */
1536 /* We used to only check for handlers on non-absolute file names:
1540 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1541 It's not clear why that was the case and it breaks things like
1542 (load "/bar.el") where the file is actually "/bar.el.gz". */
1543 /* make_string has its own ideas on when to return a unibyte
1544 string and when a multibyte string, but we know better.
1545 We must have a unibyte string when dumping, since
1546 file-name encoding is shaky at best at that time, and in
1547 particular default-file-name-coding-system is reset
1548 several times during loadup. We therefore don't want to
1549 encode the file before passing it to file I/O library
1551 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1552 string
= make_unibyte_string (fn
, fnlen
);
1554 string
= make_string (fn
, fnlen
);
1555 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1556 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1559 if (NILP (predicate
))
1560 exists
= !NILP (Ffile_readable_p (string
));
1563 Lisp_Object tmp
= call1 (predicate
, string
);
1566 else if (EQ (tmp
, Qdir_ok
)
1567 || NILP (Ffile_directory_p (string
)))
1572 last_errno
= EISDIR
;
1578 /* We succeeded; return this descriptor and filename. */
1591 encoded_fn
= ENCODE_FILE (string
);
1592 pfn
= SSDATA (encoded_fn
);
1594 /* Check that we can access or open it. */
1595 if (NATNUMP (predicate
))
1598 if (INT_MAX
< XFASTINT (predicate
))
1599 last_errno
= EINVAL
;
1600 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1604 if (file_directory_p (pfn
))
1605 last_errno
= EISDIR
;
1612 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1615 if (errno
!= ENOENT
)
1620 int err
= (fstat (fd
, &st
) != 0 ? errno
1621 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1633 if (newer
&& !NATNUMP (predicate
))
1635 struct timespec mtime
= get_stat_mtime (&st
);
1637 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1642 emacs_close (save_fd
);
1645 save_string
= string
;
1650 /* We succeeded; return this descriptor and filename. */
1658 /* No more suffixes. Return the newest. */
1659 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1662 *storeptr
= save_string
;
1678 /* Merge the list we've accumulated of globals from the current input source
1679 into the load_history variable. The details depend on whether
1680 the source has an associated file name or not.
1682 FILENAME is the file name that we are loading from.
1684 ENTIRE is true if loading that entire file, false if evaluating
1688 build_load_history (Lisp_Object filename
, bool entire
)
1690 Lisp_Object tail
, prev
, newelt
;
1691 Lisp_Object tem
, tem2
;
1694 tail
= Vload_history
;
1697 while (CONSP (tail
))
1701 /* Find the feature's previous assoc list... */
1702 if (!NILP (Fequal (filename
, Fcar (tem
))))
1706 /* If we're loading the entire file, remove old data. */
1710 Vload_history
= XCDR (tail
);
1712 Fsetcdr (prev
, XCDR (tail
));
1715 /* Otherwise, cons on new symbols that are not already members. */
1718 tem2
= Vcurrent_load_list
;
1720 while (CONSP (tem2
))
1722 newelt
= XCAR (tem2
);
1724 if (NILP (Fmember (newelt
, tem
)))
1725 Fsetcar (tail
, Fcons (XCAR (tem
),
1726 Fcons (newelt
, XCDR (tem
))));
1739 /* If we're loading an entire file, cons the new assoc onto the
1740 front of load-history, the most-recently-loaded position. Also
1741 do this if we didn't find an existing member for the file. */
1742 if (entire
|| !foundit
)
1743 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1748 readevalloop_1 (int old
)
1750 load_convert_to_unibyte
= old
;
1753 /* Signal an `end-of-file' error, if possible with file name
1756 static _Noreturn
void
1757 end_of_file_error (void)
1759 if (STRINGP (Vload_file_name
))
1760 xsignal1 (Qend_of_file
, Vload_file_name
);
1762 xsignal0 (Qend_of_file
);
1766 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1768 /* If we macroexpand the toplevel form non-recursively and it ends
1769 up being a `progn' (or if it was a progn to start), treat each
1770 form in the progn as a top-level form. This way, if one form in
1771 the progn defines a macro, that macro is in effect when we expand
1772 the remaining forms. See similar code in bytecomp.el. */
1773 val
= call2 (macroexpand
, val
, Qnil
);
1774 if (EQ (CAR_SAFE (val
), Qprogn
))
1776 Lisp_Object subforms
= XCDR (val
);
1778 for (; CONSP (subforms
); subforms
= XCDR (subforms
))
1779 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1783 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1788 /* UNIBYTE specifies how to set load_convert_to_unibyte
1789 for this invocation.
1790 READFUN, if non-nil, is used instead of `read'.
1792 START, END specify region to read in current buffer (from eval-region).
1793 If the input is not from a buffer, they must be nil. */
1796 readevalloop (Lisp_Object readcharfun
,
1798 Lisp_Object sourcename
,
1800 Lisp_Object unibyte
, Lisp_Object readfun
,
1801 Lisp_Object start
, Lisp_Object end
)
1804 register Lisp_Object val
;
1806 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1807 struct buffer
*b
= 0;
1808 bool continue_reading_p
;
1809 Lisp_Object lex_bound
;
1810 /* True if reading an entire buffer. */
1811 bool whole_buffer
= 0;
1812 /* True on the first time around. */
1813 bool first_sexp
= 1;
1814 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1816 if (NILP (Ffboundp (macroexpand
))
1817 /* Don't macroexpand in .elc files, since it should have been done
1818 already. We actually don't know whether we're in a .elc file or not,
1819 so we use circumstantial evidence: .el files normally go through
1820 Vload_source_file_function -> load-with-code-conversion
1822 || EQ (readcharfun
, Qget_file_char
)
1823 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1826 if (MARKERP (readcharfun
))
1829 start
= readcharfun
;
1832 if (BUFFERP (readcharfun
))
1833 b
= XBUFFER (readcharfun
);
1834 else if (MARKERP (readcharfun
))
1835 b
= XMARKER (readcharfun
)->buffer
;
1837 /* We assume START is nil when input is not from a buffer. */
1838 if (! NILP (start
) && !b
)
1841 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1842 specbind (Qcurrent_load_list
, Qnil
);
1843 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1844 load_convert_to_unibyte
= !NILP (unibyte
);
1846 /* If lexical binding is active (either because it was specified in
1847 the file's header, or via a buffer-local variable), create an empty
1848 lexical environment, otherwise, turn off lexical binding. */
1849 lex_bound
= find_symbol_value (Qlexical_binding
);
1850 specbind (Qinternal_interpreter_environment
,
1851 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1852 ? Qnil
: list1 (Qt
)));
1854 GCPRO4 (sourcename
, readfun
, start
, end
);
1856 /* Try to ensure sourcename is a truename, except whilst preloading. */
1857 if (NILP (Vpurify_flag
)
1858 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1859 && !NILP (Ffboundp (Qfile_truename
)))
1860 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1862 LOADHIST_ATTACH (sourcename
);
1864 continue_reading_p
= 1;
1865 while (continue_reading_p
)
1869 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1870 error ("Reading from killed buffer");
1874 /* Switch to the buffer we are reading from. */
1875 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1876 set_buffer_internal (b
);
1878 /* Save point in it. */
1879 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1880 /* Save ZV in it. */
1881 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1882 /* Those get unbound after we read one expression. */
1884 /* Set point and ZV around stuff to be read. */
1887 Fnarrow_to_region (make_number (BEGV
), end
);
1889 /* Just for cleanliness, convert END to a marker
1890 if it is an integer. */
1892 end
= Fpoint_max_marker ();
1895 /* On the first cycle, we can easily test here
1896 whether we are reading the whole buffer. */
1897 if (b
&& first_sexp
)
1898 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1905 while ((c
= READCHAR
) != '\n' && c
!= -1);
1914 /* Ignore whitespace here, so we can detect eof. */
1915 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1916 || c
== 0xa0) /* NBSP */
1919 if (!NILP (Vpurify_flag
) && c
== '(')
1921 val
= read_list (0, readcharfun
);
1926 read_objects
= Qnil
;
1927 if (!NILP (readfun
))
1929 val
= call1 (readfun
, readcharfun
);
1931 /* If READCHARFUN has set point to ZV, we should
1932 stop reading, even if the form read sets point
1933 to a different value when evaluated. */
1934 if (BUFFERP (readcharfun
))
1936 struct buffer
*buf
= XBUFFER (readcharfun
);
1937 if (BUF_PT (buf
) == BUF_ZV (buf
))
1938 continue_reading_p
= 0;
1941 else if (! NILP (Vload_read_function
))
1942 val
= call1 (Vload_read_function
, readcharfun
);
1944 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1947 if (!NILP (start
) && continue_reading_p
)
1948 start
= Fpoint_marker ();
1950 /* Restore saved point and BEGV. */
1953 /* Now eval what we just read. */
1954 if (!NILP (macroexpand
))
1955 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1957 val
= eval_sub (val
);
1961 Vvalues
= Fcons (val
, Vvalues
);
1962 if (EQ (Vstandard_output
, Qt
))
1971 build_load_history (sourcename
,
1972 stream
|| whole_buffer
);
1979 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1980 doc
: /* Execute the current buffer as Lisp code.
1981 When called from a Lisp program (i.e., not interactively), this
1982 function accepts up to five optional arguments:
1983 BUFFER is the buffer to evaluate (nil means use current buffer).
1984 PRINTFLAG controls printing of output:
1985 A value of nil means discard it; anything else is stream for print.
1986 FILENAME specifies the file name to use for `load-history'.
1987 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1989 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1990 functions should work normally even if PRINTFLAG is nil.
1992 This function preserves the position of point. */)
1993 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1996 Lisp_Object tem
, buf
;
1999 buf
= Fcurrent_buffer ();
2001 buf
= Fget_buffer (buffer
);
2003 error ("No such buffer");
2005 if (NILP (printflag
) && NILP (do_allow_print
))
2010 if (NILP (filename
))
2011 filename
= BVAR (XBUFFER (buf
), filename
);
2013 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
2014 specbind (Qstandard_output
, tem
);
2015 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
2016 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2017 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
2018 readevalloop (buf
, 0, filename
,
2019 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
2025 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2026 doc
: /* Execute the region as Lisp code.
2027 When called from programs, expects two arguments,
2028 giving starting and ending indices in the current buffer
2029 of the text to be executed.
2030 Programs can pass third argument PRINTFLAG which controls output:
2031 A value of nil means discard it; anything else is stream for printing it.
2032 Also the fourth argument READ-FUNCTION, if non-nil, is used
2033 instead of `read' to read each expression. It gets one argument
2034 which is the input stream for reading characters.
2036 This function does not move point. */)
2037 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2039 /* FIXME: Do the eval-sexp-add-defvars dance! */
2041 Lisp_Object tem
, cbuf
;
2043 cbuf
= Fcurrent_buffer ();
2045 if (NILP (printflag
))
2049 specbind (Qstandard_output
, tem
);
2050 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2052 /* `readevalloop' calls functions which check the type of start and end. */
2053 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2054 !NILP (printflag
), Qnil
, read_function
,
2062 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2063 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2064 If STREAM is nil, use the value of `standard-input' (which see).
2065 STREAM or the value of `standard-input' may be:
2066 a buffer (read from point and advance it)
2067 a marker (read from where it points and advance it)
2068 a function (call it with no arguments for each character,
2069 call it with a char as argument to push a char back)
2070 a string (takes text from string, starting at the beginning)
2071 t (read text line using minibuffer and use it, or read from
2072 standard input in batch mode). */)
2073 (Lisp_Object stream
)
2076 stream
= Vstandard_input
;
2077 if (EQ (stream
, Qt
))
2078 stream
= Qread_char
;
2079 if (EQ (stream
, Qread_char
))
2080 /* FIXME: ?! When is this used !? */
2081 return call1 (intern ("read-minibuffer"),
2082 build_string ("Lisp expression: "));
2084 return read_internal_start (stream
, Qnil
, Qnil
);
2087 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2088 doc
: /* Read one Lisp expression which is represented as text by STRING.
2089 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2090 FINAL-STRING-INDEX is an integer giving the position of the next
2091 remaining character in STRING.
2092 START and END optionally delimit a substring of STRING from which to read;
2093 they default to 0 and (length STRING) respectively. */)
2094 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2097 CHECK_STRING (string
);
2098 /* `read_internal_start' sets `read_from_string_index'. */
2099 ret
= read_internal_start (string
, start
, end
);
2100 return Fcons (ret
, make_number (read_from_string_index
));
2103 /* Function to set up the global context we need in toplevel read
2106 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2107 /* `start', `end' only used when stream is a string. */
2112 new_backquote_flag
= 0;
2113 read_objects
= Qnil
;
2114 if (EQ (Vread_with_symbol_positions
, Qt
)
2115 || EQ (Vread_with_symbol_positions
, stream
))
2116 Vread_symbol_positions_list
= Qnil
;
2118 if (STRINGP (stream
)
2119 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2121 ptrdiff_t startval
, endval
;
2124 if (STRINGP (stream
))
2127 string
= XCAR (stream
);
2130 endval
= SCHARS (string
);
2134 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2135 args_out_of_range (string
, end
);
2136 endval
= XINT (end
);
2143 CHECK_NUMBER (start
);
2144 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2145 args_out_of_range (string
, start
);
2146 startval
= XINT (start
);
2148 read_from_string_index
= startval
;
2149 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2150 read_from_string_limit
= endval
;
2153 retval
= read0 (stream
);
2154 if (EQ (Vread_with_symbol_positions
, Qt
)
2155 || EQ (Vread_with_symbol_positions
, stream
))
2156 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2161 /* Signal Qinvalid_read_syntax error.
2162 S is error string of length N (if > 0) */
2164 static _Noreturn
void
2165 invalid_syntax (const char *s
)
2167 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2171 /* Use this for recursive reads, in contexts where internal tokens
2175 read0 (Lisp_Object readcharfun
)
2177 register Lisp_Object val
;
2180 val
= read1 (readcharfun
, &c
, 0);
2184 xsignal1 (Qinvalid_read_syntax
,
2185 Fmake_string (make_number (1), make_number (c
)));
2188 static ptrdiff_t read_buffer_size
;
2189 static char *read_buffer
;
2191 /* Read a \-escape sequence, assuming we already read the `\'.
2192 If the escape sequence forces unibyte, return eight-bit char. */
2195 read_escape (Lisp_Object readcharfun
, bool stringp
)
2198 /* \u allows up to four hex digits, \U up to eight. Default to the
2199 behavior for \u, and change this value in the case that \U is seen. */
2200 int unicode_hex_count
= 4;
2205 end_of_file_error ();
2235 error ("Invalid escape character syntax");
2238 c
= read_escape (readcharfun
, 0);
2239 return c
| meta_modifier
;
2244 error ("Invalid escape character syntax");
2247 c
= read_escape (readcharfun
, 0);
2248 return c
| shift_modifier
;
2253 error ("Invalid escape character syntax");
2256 c
= read_escape (readcharfun
, 0);
2257 return c
| hyper_modifier
;
2262 error ("Invalid escape character syntax");
2265 c
= read_escape (readcharfun
, 0);
2266 return c
| alt_modifier
;
2270 if (stringp
|| c
!= '-')
2277 c
= read_escape (readcharfun
, 0);
2278 return c
| super_modifier
;
2283 error ("Invalid escape character syntax");
2287 c
= read_escape (readcharfun
, 0);
2288 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2289 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2290 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2291 return c
| ctrl_modifier
;
2292 /* ASCII control chars are made from letters (both cases),
2293 as well as the non-letters within 0100...0137. */
2294 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2295 return (c
& (037 | ~0177));
2296 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2297 return (c
& (037 | ~0177));
2299 return c
| ctrl_modifier
;
2309 /* An octal escape, as in ANSI C. */
2311 register int i
= c
- '0';
2312 register int count
= 0;
2315 if ((c
= READCHAR
) >= '0' && c
<= '7')
2327 if (i
>= 0x80 && i
< 0x100)
2328 i
= BYTE8_TO_CHAR (i
);
2333 /* A hex escape, as in ANSI C. */
2340 if (c
>= '0' && c
<= '9')
2345 else if ((c
>= 'a' && c
<= 'f')
2346 || (c
>= 'A' && c
<= 'F'))
2349 if (c
>= 'a' && c
<= 'f')
2359 /* Allow hex escapes as large as ?\xfffffff, because some
2360 packages use them to denote characters with modifiers. */
2361 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2362 error ("Hex character out of range: \\x%x...", i
);
2366 if (count
< 3 && i
>= 0x80)
2367 return BYTE8_TO_CHAR (i
);
2372 /* Post-Unicode-2.0: Up to eight hex chars. */
2373 unicode_hex_count
= 8;
2376 /* A Unicode escape. We only permit them in strings and characters,
2377 not arbitrarily in the source code, as in some other languages. */
2382 while (++count
<= unicode_hex_count
)
2385 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2387 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2388 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2389 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2391 error ("Non-hex digit used for Unicode escape");
2394 error ("Non-Unicode character: 0x%x", i
);
2403 /* Return the digit that CHARACTER stands for in the given BASE.
2404 Return -1 if CHARACTER is out of range for BASE,
2405 and -2 if CHARACTER is not valid for any supported BASE. */
2407 digit_to_number (int character
, int base
)
2411 if ('0' <= character
&& character
<= '9')
2412 digit
= character
- '0';
2413 else if ('a' <= character
&& character
<= 'z')
2414 digit
= character
- 'a' + 10;
2415 else if ('A' <= character
&& character
<= 'Z')
2416 digit
= character
- 'A' + 10;
2420 return digit
< base
? digit
: -1;
2423 /* Read an integer in radix RADIX using READCHARFUN to read
2424 characters. RADIX must be in the interval [2..36]; if it isn't, a
2425 read error is signaled . Value is the integer read. Signals an
2426 error if encountering invalid read syntax or if RADIX is out of
2430 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2432 /* Room for sign, leading 0, other digits, trailing null byte.
2433 Also, room for invalid syntax diagnostic. */
2434 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2435 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2437 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2439 if (radix
< 2 || radix
> 36)
2447 if (c
== '-' || c
== '+')
2458 /* Ignore redundant leading zeros, so the buffer doesn't
2459 fill up with them. */
2465 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2472 if (p
< buf
+ sizeof buf
- 1)
2486 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2487 invalid_syntax (buf
);
2490 return string_to_number (buf
, radix
, 0);
2494 /* If the next token is ')' or ']' or '.', we store that character
2495 in *PCH and the return value is not interesting. Else, we store
2496 zero in *PCH and we read and return one lisp object.
2498 FIRST_IN_LIST is true if this is the first element of a list. */
2501 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2504 bool uninterned_symbol
= 0;
2511 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2513 end_of_file_error ();
2518 return read_list (0, readcharfun
);
2521 return read_vector (readcharfun
, 0);
2537 /* Accept extended format for hashtables (extensible to
2539 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2540 Lisp_Object tmp
= read_list (0, readcharfun
);
2541 Lisp_Object head
= CAR_SAFE (tmp
);
2542 Lisp_Object data
= Qnil
;
2543 Lisp_Object val
= Qnil
;
2544 /* The size is 2 * number of allowed keywords to
2546 Lisp_Object params
[10];
2548 Lisp_Object key
= Qnil
;
2549 int param_count
= 0;
2551 if (!EQ (head
, Qhash_table
))
2552 error ("Invalid extended read marker at head of #s list "
2553 "(only hash-table allowed)");
2555 tmp
= CDR_SAFE (tmp
);
2557 /* This is repetitive but fast and simple. */
2558 params
[param_count
] = QCsize
;
2559 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2560 if (!NILP (params
[param_count
+ 1]))
2563 params
[param_count
] = QCtest
;
2564 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2565 if (!NILP (params
[param_count
+ 1]))
2568 params
[param_count
] = QCweakness
;
2569 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2570 if (!NILP (params
[param_count
+ 1]))
2573 params
[param_count
] = QCrehash_size
;
2574 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2575 if (!NILP (params
[param_count
+ 1]))
2578 params
[param_count
] = QCrehash_threshold
;
2579 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2580 if (!NILP (params
[param_count
+ 1]))
2583 /* This is the hashtable data. */
2584 data
= Fplist_get (tmp
, Qdata
);
2586 /* Now use params to make a new hashtable and fill it. */
2587 ht
= Fmake_hash_table (param_count
, params
);
2589 while (CONSP (data
))
2594 error ("Odd number of elements in hashtable data");
2597 Fputhash (key
, val
, ht
);
2603 invalid_syntax ("#");
2611 tmp
= read_vector (readcharfun
, 0);
2612 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2613 error ("Invalid size char-table");
2614 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2626 tmp
= read_vector (readcharfun
, 0);
2629 error ("Invalid size char-table");
2630 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2631 error ("Invalid depth in char-table");
2632 depth
= XINT (AREF (tmp
, 0));
2633 if (chartab_size
[depth
] != size
- 2)
2634 error ("Invalid size char-table");
2635 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2638 invalid_syntax ("#^" "^");
2640 invalid_syntax ("#^");
2645 length
= read1 (readcharfun
, pch
, first_in_list
);
2649 Lisp_Object tmp
, val
;
2650 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2651 unsigned char *data
;
2654 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2655 if (STRING_MULTIBYTE (tmp
)
2656 || (size_in_chars
!= SCHARS (tmp
)
2657 /* We used to print 1 char too many
2658 when the number of bits was a multiple of 8.
2659 Accept such input in case it came from an old
2661 && ! (XFASTINT (length
)
2662 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2663 invalid_syntax ("#&...");
2665 val
= make_uninit_bool_vector (XFASTINT (length
));
2666 data
= bool_vector_uchar_data (val
);
2667 memcpy (data
, SDATA (tmp
), size_in_chars
);
2668 /* Clear the extraneous bits in the last byte. */
2669 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2670 data
[size_in_chars
- 1]
2671 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2674 invalid_syntax ("#&...");
2678 /* Accept compiled functions at read-time so that we don't have to
2679 build them using function calls. */
2681 struct Lisp_Vector
*vec
;
2682 tmp
= read_vector (readcharfun
, 1);
2683 vec
= XVECTOR (tmp
);
2684 if (vec
->header
.size
== 0)
2685 invalid_syntax ("Empty byte-code object");
2686 make_byte_code (vec
);
2692 struct gcpro gcpro1
;
2695 /* Read the string itself. */
2696 tmp
= read1 (readcharfun
, &ch
, 0);
2697 if (ch
!= 0 || !STRINGP (tmp
))
2698 invalid_syntax ("#");
2700 /* Read the intervals and their properties. */
2703 Lisp_Object beg
, end
, plist
;
2705 beg
= read1 (readcharfun
, &ch
, 0);
2710 end
= read1 (readcharfun
, &ch
, 0);
2712 plist
= read1 (readcharfun
, &ch
, 0);
2714 invalid_syntax ("Invalid string property list");
2715 Fset_text_properties (beg
, end
, plist
, tmp
);
2721 /* #@NUMBER is used to skip NUMBER following bytes.
2722 That's used in .elc files to skip over doc strings
2723 and function definitions. */
2726 enum { extra
= 100 };
2727 ptrdiff_t i
, nskip
= 0, digits
= 0;
2729 /* Read a decimal integer. */
2730 while ((c
= READCHAR
) >= 0
2731 && c
>= '0' && c
<= '9')
2733 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2738 if (digits
== 2 && nskip
== 0)
2739 { /* We've just seen #@00, which means "skip to end". */
2740 skip_dyn_eof (readcharfun
);
2745 /* We can't use UNREAD here, because in the code below we side-step
2746 READCHAR. Instead, assume the first char after #@NNN occupies
2747 a single byte, which is the case normally since it's just
2753 if (load_force_doc_strings
2754 && (FROM_FILE_P (readcharfun
)))
2756 /* If we are supposed to force doc strings into core right now,
2757 record the last string that we skipped,
2758 and record where in the file it comes from. */
2760 /* But first exchange saved_doc_string
2761 with prev_saved_doc_string, so we save two strings. */
2763 char *temp
= saved_doc_string
;
2764 ptrdiff_t temp_size
= saved_doc_string_size
;
2765 file_offset temp_pos
= saved_doc_string_position
;
2766 ptrdiff_t temp_len
= saved_doc_string_length
;
2768 saved_doc_string
= prev_saved_doc_string
;
2769 saved_doc_string_size
= prev_saved_doc_string_size
;
2770 saved_doc_string_position
= prev_saved_doc_string_position
;
2771 saved_doc_string_length
= prev_saved_doc_string_length
;
2773 prev_saved_doc_string
= temp
;
2774 prev_saved_doc_string_size
= temp_size
;
2775 prev_saved_doc_string_position
= temp_pos
;
2776 prev_saved_doc_string_length
= temp_len
;
2779 if (saved_doc_string_size
== 0)
2781 saved_doc_string
= xmalloc_atomic (nskip
+ extra
);
2782 saved_doc_string_size
= nskip
+ extra
;
2784 if (nskip
> saved_doc_string_size
)
2786 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2787 saved_doc_string_size
= nskip
+ extra
;
2790 saved_doc_string_position
= file_tell (instream
);
2792 /* Copy that many characters into saved_doc_string. */
2794 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2795 saved_doc_string
[i
] = c
= getc (instream
);
2798 saved_doc_string_length
= i
;
2801 /* Skip that many bytes. */
2802 skip_dyn_bytes (readcharfun
, nskip
);
2808 /* #! appears at the beginning of an executable file.
2809 Skip the first line. */
2810 while (c
!= '\n' && c
>= 0)
2815 return Vload_file_name
;
2817 return list2 (Qfunction
, read0 (readcharfun
));
2818 /* #:foo is the uninterned symbol named foo. */
2821 uninterned_symbol
= 1;
2824 && c
!= 0xa0 /* NBSP */
2826 || strchr ("\"';()[]#`,", c
) == NULL
)))
2828 /* No symbol character follows, this is the empty
2831 return Fmake_symbol (empty_unibyte_string
);
2835 /* ## is the empty symbol. */
2837 return Fintern (empty_unibyte_string
, Qnil
);
2838 /* Reader forms that can reuse previously read objects. */
2839 if (c
>= '0' && c
<= '9')
2844 /* Read a non-negative integer. */
2845 while (c
>= '0' && c
<= '9')
2847 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2848 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2849 n
= MOST_POSITIVE_FIXNUM
+ 1;
2851 n
= n
* 10 + c
- '0';
2855 if (n
<= MOST_POSITIVE_FIXNUM
)
2857 if (c
== 'r' || c
== 'R')
2858 return read_integer (readcharfun
, n
);
2860 if (! NILP (Vread_circle
))
2862 /* #n=object returns object, but associates it with
2866 /* Make a placeholder for #n# to use temporarily. */
2867 Lisp_Object placeholder
;
2870 placeholder
= Fcons (Qnil
, Qnil
);
2871 cell
= Fcons (make_number (n
), placeholder
);
2872 read_objects
= Fcons (cell
, read_objects
);
2874 /* Read the object itself. */
2875 tem
= read0 (readcharfun
);
2877 /* Now put it everywhere the placeholder was... */
2878 substitute_object_in_subtree (tem
, placeholder
);
2880 /* ...and #n# will use the real value from now on. */
2881 Fsetcdr (cell
, tem
);
2886 /* #n# returns a previously read object. */
2889 tem
= Fassq (make_number (n
), read_objects
);
2895 /* Fall through to error message. */
2897 else if (c
== 'x' || c
== 'X')
2898 return read_integer (readcharfun
, 16);
2899 else if (c
== 'o' || c
== 'O')
2900 return read_integer (readcharfun
, 8);
2901 else if (c
== 'b' || c
== 'B')
2902 return read_integer (readcharfun
, 2);
2905 invalid_syntax ("#");
2908 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2912 return list2 (Qquote
, read0 (readcharfun
));
2916 int next_char
= READCHAR
;
2918 /* Transition from old-style to new-style:
2919 If we see "(`" it used to mean old-style, which usually works
2920 fine because ` should almost never appear in such a position
2921 for new-style. But occasionally we need "(`" to mean new
2922 style, so we try to distinguish the two by the fact that we
2923 can either write "( `foo" or "(` foo", where the first
2924 intends to use new-style whereas the second intends to use
2925 old-style. For Emacs-25, we should completely remove this
2926 first_in_list exception (old-style can still be obtained via
2928 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2930 Vold_style_backquotes
= Qt
;
2936 bool saved_new_backquote_flag
= new_backquote_flag
;
2938 new_backquote_flag
= 1;
2939 value
= read0 (readcharfun
);
2940 new_backquote_flag
= saved_new_backquote_flag
;
2942 return list2 (Qbackquote
, value
);
2947 int next_char
= READCHAR
;
2949 /* Transition from old-style to new-style:
2950 It used to be impossible to have a new-style , other than within
2951 a new-style `. This is sufficient when ` and , are used in the
2952 normal way, but ` and , can also appear in args to macros that
2953 will not interpret them in the usual way, in which case , may be
2954 used without any ` anywhere near.
2955 So we now use the same heuristic as for backquote: old-style
2956 unquotes are only recognized when first on a list, and when
2957 followed by a space.
2958 Because it's more difficult to peek 2 chars ahead, a new-style
2959 ,@ can still not be used outside of a `, unless it's in the middle
2961 if (new_backquote_flag
2963 || (next_char
!= ' ' && next_char
!= '@'))
2965 Lisp_Object comma_type
= Qnil
;
2970 comma_type
= Qcomma_at
;
2972 comma_type
= Qcomma_dot
;
2975 if (ch
>= 0) UNREAD (ch
);
2976 comma_type
= Qcomma
;
2979 value
= read0 (readcharfun
);
2980 return list2 (comma_type
, value
);
2984 Vold_style_backquotes
= Qt
;
2996 end_of_file_error ();
2998 /* Accept `single space' syntax like (list ? x) where the
2999 whitespace character is SPC or TAB.
3000 Other literal whitespace like NL, CR, and FF are not accepted,
3001 as there are well-established escape sequences for these. */
3002 if (c
== ' ' || c
== '\t')
3003 return make_number (c
);
3006 c
= read_escape (readcharfun
, 0);
3007 modifiers
= c
& CHAR_MODIFIER_MASK
;
3008 c
&= ~CHAR_MODIFIER_MASK
;
3009 if (CHAR_BYTE8_P (c
))
3010 c
= CHAR_TO_BYTE8 (c
);
3013 next_char
= READCHAR
;
3014 ok
= (next_char
<= 040
3015 || (next_char
< 0200
3016 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3019 return make_number (c
);
3021 invalid_syntax ("?");
3026 char *p
= read_buffer
;
3027 char *end
= read_buffer
+ read_buffer_size
;
3029 /* True if we saw an escape sequence specifying
3030 a multibyte character. */
3031 bool force_multibyte
= 0;
3032 /* True if we saw an escape sequence specifying
3033 a single-byte character. */
3034 bool force_singlebyte
= 0;
3036 ptrdiff_t nchars
= 0;
3038 while ((ch
= READCHAR
) >= 0
3041 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3043 ptrdiff_t offset
= p
- read_buffer
;
3044 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3045 memory_full (SIZE_MAX
);
3046 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3047 read_buffer_size
*= 2;
3048 p
= read_buffer
+ offset
;
3049 end
= read_buffer
+ read_buffer_size
;
3056 ch
= read_escape (readcharfun
, 1);
3058 /* CH is -1 if \ newline has just been seen. */
3061 if (p
== read_buffer
)
3066 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3067 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3069 if (CHAR_BYTE8_P (ch
))
3070 force_singlebyte
= 1;
3071 else if (! ASCII_CHAR_P (ch
))
3072 force_multibyte
= 1;
3073 else /* I.e. ASCII_CHAR_P (ch). */
3075 /* Allow `\C- ' and `\C-?'. */
3076 if (modifiers
== CHAR_CTL
)
3079 ch
= 0, modifiers
= 0;
3081 ch
= 127, modifiers
= 0;
3083 if (modifiers
& CHAR_SHIFT
)
3085 /* Shift modifier is valid only with [A-Za-z]. */
3086 if (ch
>= 'A' && ch
<= 'Z')
3087 modifiers
&= ~CHAR_SHIFT
;
3088 else if (ch
>= 'a' && ch
<= 'z')
3089 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3092 if (modifiers
& CHAR_META
)
3094 /* Move the meta bit to the right place for a
3096 modifiers
&= ~CHAR_META
;
3097 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3098 force_singlebyte
= 1;
3102 /* Any modifiers remaining are invalid. */
3104 error ("Invalid modifier in string");
3105 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3109 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3110 if (CHAR_BYTE8_P (ch
))
3111 force_singlebyte
= 1;
3112 else if (! ASCII_CHAR_P (ch
))
3113 force_multibyte
= 1;
3119 end_of_file_error ();
3121 /* If purifying, and string starts with \ newline,
3122 return zero instead. This is for doc strings
3123 that we are really going to find in etc/DOC.nn.nn. */
3124 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3125 return make_number (0);
3127 if (! force_multibyte
&& force_singlebyte
)
3129 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3130 forms. Convert it to unibyte. */
3131 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3133 p
= read_buffer
+ nchars
;
3136 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3138 || (p
- read_buffer
!= nchars
)));
3143 int next_char
= READCHAR
;
3146 if (next_char
<= 040
3147 || (next_char
< 0200
3148 && strchr ("\"';([#?`,", next_char
) != NULL
))
3154 /* Otherwise, we fall through! Note that the atom-reading loop
3155 below will now loop at least once, assuring that we will not
3156 try to UNREAD two characters in a row. */
3160 if (c
<= 040) goto retry
;
3161 if (c
== 0xa0) /* NBSP */
3166 char *p
= read_buffer
;
3168 EMACS_INT start_position
= readchar_count
- 1;
3171 char *end
= read_buffer
+ read_buffer_size
;
3175 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3177 ptrdiff_t offset
= p
- read_buffer
;
3178 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3179 memory_full (SIZE_MAX
);
3180 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3181 read_buffer_size
*= 2;
3182 p
= read_buffer
+ offset
;
3183 end
= read_buffer
+ read_buffer_size
;
3190 end_of_file_error ();
3195 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3201 && c
!= 0xa0 /* NBSP */
3203 || strchr ("\"';()[]#`,", c
) == NULL
));
3207 ptrdiff_t offset
= p
- read_buffer
;
3208 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3209 memory_full (SIZE_MAX
);
3210 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3211 read_buffer_size
*= 2;
3212 p
= read_buffer
+ offset
;
3213 end
= read_buffer
+ read_buffer_size
;
3219 if (!quoted
&& !uninterned_symbol
)
3221 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3222 if (! NILP (result
))
3226 Lisp_Object name
, result
;
3227 ptrdiff_t nbytes
= p
- read_buffer
;
3230 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3234 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3235 ? make_pure_string
: make_specified_string
)
3236 (read_buffer
, nchars
, nbytes
, multibyte
));
3237 result
= (uninterned_symbol
? Fmake_symbol (name
)
3238 : Fintern (name
, Qnil
));
3240 if (EQ (Vread_with_symbol_positions
, Qt
)
3241 || EQ (Vread_with_symbol_positions
, readcharfun
))
3242 Vread_symbol_positions_list
3243 = Fcons (Fcons (result
, make_number (start_position
)),
3244 Vread_symbol_positions_list
);
3252 /* List of nodes we've seen during substitute_object_in_subtree. */
3253 static Lisp_Object seen_list
;
3256 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3258 Lisp_Object check_object
;
3260 /* We haven't seen any objects when we start. */
3263 /* Make all the substitutions. */
3265 = substitute_object_recurse (object
, placeholder
, object
);
3267 /* Clear seen_list because we're done with it. */
3270 /* The returned object here is expected to always eq the
3272 if (!EQ (check_object
, object
))
3273 error ("Unexpected mutation error in reader");
3276 /* Feval doesn't get called from here, so no gc protection is needed. */
3277 #define SUBSTITUTE(get_val, set_val) \
3279 Lisp_Object old_value = get_val; \
3280 Lisp_Object true_value \
3281 = substitute_object_recurse (object, placeholder, \
3284 if (!EQ (old_value, true_value)) \
3291 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3293 /* If we find the placeholder, return the target object. */
3294 if (EQ (placeholder
, subtree
))
3297 /* If we've been to this node before, don't explore it again. */
3298 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3301 /* If this node can be the entry point to a cycle, remember that
3302 we've seen it. It can only be such an entry point if it was made
3303 by #n=, which means that we can find it as a value in
3305 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3306 seen_list
= Fcons (subtree
, seen_list
);
3308 /* Recurse according to subtree's type.
3309 Every branch must return a Lisp_Object. */
3310 if (VECTORLIKEP (subtree
))
3312 ptrdiff_t i
, length
= 0;
3313 if (BOOL_VECTOR_P (subtree
))
3314 return subtree
; /* No sub-objects anyway. */
3315 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3316 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3317 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3318 else if (VECTORP (subtree
))
3319 length
= ASIZE (subtree
);
3321 /* An unknown pseudovector may contain non-Lisp fields, so we
3322 can't just blindly traverse all its fields. We used to call
3323 `Flength' which signaled `sequencep', so I just preserved this
3325 wrong_type_argument (Qsequencep
, subtree
);
3327 for (i
= 0; i
< length
; i
++)
3328 SUBSTITUTE (AREF (subtree
, i
),
3329 ASET (subtree
, i
, true_value
));
3332 else if (CONSP (subtree
))
3334 SUBSTITUTE (XCAR (subtree
),
3335 XSETCAR (subtree
, true_value
));
3336 SUBSTITUTE (XCDR (subtree
),
3337 XSETCDR (subtree
, true_value
));
3340 else if (STRINGP (subtree
))
3342 /* Check for text properties in each interval.
3343 substitute_in_interval contains part of the logic. */
3345 INTERVAL root_interval
= string_intervals (subtree
);
3346 Lisp_Object arg
= Fcons (object
, placeholder
);
3348 traverse_intervals_noorder (root_interval
,
3349 &substitute_in_interval
, arg
);
3354 /* Other types don't recurse any further. */
3358 /* Helper function for substitute_object_recurse. */
3360 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3362 Lisp_Object object
= Fcar (arg
);
3363 Lisp_Object placeholder
= Fcdr (arg
);
3365 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3375 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3376 integer syntax and fits in a fixnum, else return the nearest float if CP has
3377 either floating point or integer syntax and BASE is 10, else return nil. If
3378 IGNORE_TRAILING, consider just the longest prefix of CP that has
3379 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3380 number has integer syntax but does not fit. */
3383 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3386 char const *cp
= string
;
3388 bool float_syntax
= 0;
3391 /* Compute NaN and infinities using a variable, to cope with compilers that
3392 think they are smarter than we are. */
3395 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3396 IEEE floating point hosts, and works around a formerly-common bug where
3397 atof ("-0.0") drops the sign. */
3398 bool negative
= *cp
== '-';
3400 bool signedp
= negative
|| *cp
== '+';
3405 leading_digit
= digit_to_number (*cp
, base
);
3406 if (leading_digit
>= 0)
3411 while (digit_to_number (*cp
, base
) >= 0);
3421 if ('0' <= *cp
&& *cp
<= '9')
3426 while ('0' <= *cp
&& *cp
<= '9');
3428 if (*cp
== 'e' || *cp
== 'E')
3430 char const *ecp
= cp
;
3432 if (*cp
== '+' || *cp
== '-')
3434 if ('0' <= *cp
&& *cp
<= '9')
3439 while ('0' <= *cp
&& *cp
<= '9');
3441 else if (cp
[-1] == '+'
3442 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3448 else if (cp
[-1] == '+'
3449 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3453 value
= zero
/ zero
;
3455 /* If that made a "negative" NaN, negate it. */
3458 union { double d
; char c
[sizeof (double)]; }
3459 u_data
, u_minus_zero
;
3461 u_minus_zero
.d
= -0.0;
3462 for (i
= 0; i
< sizeof (double); i
++)
3463 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3469 /* Now VALUE is a positive NaN. */
3475 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3476 || state
== (LEAD_INT
|E_EXP
));
3479 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3480 any prefix that matches. Otherwise, the entire string must match. */
3481 if (! (ignore_trailing
3482 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3483 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3486 /* If the number uses integer and not float syntax, and is in C-language
3487 range, use its value, preferably as a fixnum. */
3488 if (leading_digit
>= 0 && ! float_syntax
)
3492 /* Fast special case for single-digit integers. This also avoids a
3493 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3494 case some versions of strtoumax accept numbers like "0x1" that Emacs
3496 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3497 return make_number (negative
? -leading_digit
: leading_digit
);
3500 n
= strtoumax (string
+ signedp
, NULL
, base
);
3501 if (errno
== ERANGE
)
3503 /* Unfortunately there's no simple and accurate way to convert
3504 non-base-10 numbers that are out of C-language range. */
3506 xsignal1 (Qoverflow_error
, build_string (string
));
3508 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3510 EMACS_INT signed_n
= n
;
3511 return make_number (negative
? -signed_n
: signed_n
);
3517 /* Either the number uses float syntax, or it does not fit into a fixnum.
3518 Convert it from string to floating point, unless the value is already
3519 known because it is an infinity, a NAN, or its absolute value fits in
3522 value
= atof (string
+ signedp
);
3524 return make_float (negative
? -value
: value
);
3529 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3533 Lisp_Object tem
, item
, vector
;
3536 tem
= read_list (1, readcharfun
);
3537 len
= Flength (tem
);
3538 vector
= Fmake_vector (len
, Qnil
);
3540 size
= ASIZE (vector
);
3541 ptr
= XVECTOR (vector
)->contents
;
3542 for (i
= 0; i
< size
; i
++)
3545 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3546 bytecode object, the docstring containing the bytecode and
3547 constants values must be treated as unibyte and passed to
3548 Fread, to get the actual bytecode string and constants vector. */
3549 if (bytecodeflag
&& load_force_doc_strings
)
3551 if (i
== COMPILED_BYTECODE
)
3553 if (!STRINGP (item
))
3554 error ("Invalid byte code");
3556 /* Delay handling the bytecode slot until we know whether
3557 it is lazily-loaded (we can tell by whether the
3558 constants slot is nil). */
3559 ASET (vector
, COMPILED_CONSTANTS
, item
);
3562 else if (i
== COMPILED_CONSTANTS
)
3564 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3568 /* Coerce string to unibyte (like string-as-unibyte,
3569 but without generating extra garbage and
3570 guaranteeing no change in the contents). */
3571 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3572 STRING_SET_UNIBYTE (bytestr
);
3574 item
= Fread (Fcons (bytestr
, readcharfun
));
3576 error ("Invalid byte code");
3578 bytestr
= XCAR (item
);
3582 /* Now handle the bytecode slot. */
3583 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3585 else if (i
== COMPILED_DOC_STRING
3587 && ! STRING_MULTIBYTE (item
))
3589 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3590 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3592 item
= Fstring_as_multibyte (item
);
3595 ASET (vector
, i
, item
);
3601 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3604 read_list (bool flag
, Lisp_Object readcharfun
)
3606 Lisp_Object val
, tail
;
3607 Lisp_Object elt
, tem
;
3608 struct gcpro gcpro1
, gcpro2
;
3609 /* 0 is the normal case.
3610 1 means this list is a doc reference; replace it with the number 0.
3611 2 means this list is a doc reference; replace it with the doc string. */
3612 int doc_reference
= 0;
3614 /* Initialize this to 1 if we are reading a list. */
3615 bool first_in_list
= flag
<= 0;
3624 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3629 /* While building, if the list starts with #$, treat it specially. */
3630 if (EQ (elt
, Vload_file_name
)
3632 && !NILP (Vpurify_flag
))
3634 if (NILP (Vdoc_file_name
))
3635 /* We have not yet called Snarf-documentation, so assume
3636 this file is described in the DOC file
3637 and Snarf-documentation will fill in the right value later.
3638 For now, replace the whole list with 0. */
3641 /* We have already called Snarf-documentation, so make a relative
3642 file name for this file, so it can be found properly
3643 in the installed Lisp directory.
3644 We don't use Fexpand_file_name because that would make
3645 the directory absolute now. */
3646 elt
= concat2 (build_string ("../lisp/"),
3647 Ffile_name_nondirectory (elt
));
3649 else if (EQ (elt
, Vload_file_name
)
3651 && load_force_doc_strings
)
3660 invalid_syntax (") or . in a vector");
3668 XSETCDR (tail
, read0 (readcharfun
));
3670 val
= read0 (readcharfun
);
3671 read1 (readcharfun
, &ch
, 0);
3675 if (doc_reference
== 1)
3676 return make_number (0);
3677 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3680 file_offset saved_position
;
3681 /* Get a doc string from the file we are loading.
3682 If it's in saved_doc_string, get it from there.
3684 Here, we don't know if the string is a
3685 bytecode string or a doc string. As a
3686 bytecode string must be unibyte, we always
3687 return a unibyte string. If it is actually a
3688 doc string, caller must make it
3691 /* Position is negative for user variables. */
3692 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3693 if (pos
>= saved_doc_string_position
3694 && pos
< (saved_doc_string_position
3695 + saved_doc_string_length
))
3697 saved
= saved_doc_string
;
3698 saved_position
= saved_doc_string_position
;
3700 /* Look in prev_saved_doc_string the same way. */
3701 else if (pos
>= prev_saved_doc_string_position
3702 && pos
< (prev_saved_doc_string_position
3703 + prev_saved_doc_string_length
))
3705 saved
= prev_saved_doc_string
;
3706 saved_position
= prev_saved_doc_string_position
;
3710 ptrdiff_t start
= pos
- saved_position
;
3713 /* Process quoting with ^A,
3714 and find the end of the string,
3715 which is marked with ^_ (037). */
3716 for (from
= start
, to
= start
;
3717 saved
[from
] != 037;)
3719 int c
= saved
[from
++];
3723 saved
[to
++] = (c
== 1 ? c
3732 return make_unibyte_string (saved
+ start
,
3736 return get_doc_string (val
, 1, 0);
3741 invalid_syntax (". in wrong context");
3743 invalid_syntax ("] in a list");
3747 XSETCDR (tail
, tem
);
3754 static Lisp_Object initial_obarray
;
3756 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3758 static size_t oblookup_last_bucket_number
;
3760 /* Get an error if OBARRAY is not an obarray.
3761 If it is one, return it. */
3764 check_obarray (Lisp_Object obarray
)
3766 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3768 /* If Vobarray is now invalid, force it to be valid. */
3769 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3770 wrong_type_argument (Qvectorp
, obarray
);
3775 /* Intern the C string STR: return a symbol with that name,
3776 interned in the current obarray. */
3779 intern_1 (const char *str
, ptrdiff_t len
)
3781 Lisp_Object obarray
= check_obarray (Vobarray
);
3782 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3784 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3788 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3790 Lisp_Object obarray
= check_obarray (Vobarray
);
3791 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3796 if (NILP (Vpurify_flag
))
3797 /* Creating a non-pure string from a string literal not
3798 implemented yet. We could just use make_string here and live
3799 with the extra copy. */
3802 return Fintern (make_pure_c_string (str
, len
), obarray
);
3805 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3806 doc
: /* Return the canonical symbol whose name is STRING.
3807 If there is none, one is created by this function and returned.
3808 A second optional argument specifies the obarray to use;
3809 it defaults to the value of `obarray'. */)
3810 (Lisp_Object string
, Lisp_Object obarray
)
3812 register Lisp_Object tem
, sym
, *ptr
;
3814 if (NILP (obarray
)) obarray
= Vobarray
;
3815 obarray
= check_obarray (obarray
);
3817 CHECK_STRING (string
);
3819 tem
= oblookup (obarray
, SSDATA (string
),
3822 if (!INTEGERP (tem
))
3825 if (!NILP (Vpurify_flag
))
3826 string
= Fpurecopy (string
);
3827 sym
= Fmake_symbol (string
);
3829 if (EQ (obarray
, initial_obarray
))
3830 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3832 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3834 if ((SREF (string
, 0) == ':')
3835 && EQ (obarray
, initial_obarray
))
3837 XSYMBOL (sym
)->constant
= 1;
3838 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3839 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3842 ptr
= aref_addr (obarray
, XINT (tem
));
3844 set_symbol_next (sym
, XSYMBOL (*ptr
));
3846 set_symbol_next (sym
, NULL
);
3851 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3852 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3853 NAME may be a string or a symbol. If it is a symbol, that exact
3854 symbol is searched for.
3855 A second optional argument specifies the obarray to use;
3856 it defaults to the value of `obarray'. */)
3857 (Lisp_Object name
, Lisp_Object obarray
)
3859 register Lisp_Object tem
, string
;
3861 if (NILP (obarray
)) obarray
= Vobarray
;
3862 obarray
= check_obarray (obarray
);
3864 if (!SYMBOLP (name
))
3866 CHECK_STRING (name
);
3870 string
= SYMBOL_NAME (name
);
3872 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3873 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3879 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3880 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3881 The value is t if a symbol was found and deleted, nil otherwise.
3882 NAME may be a string or a symbol. If it is a symbol, that symbol
3883 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3884 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3885 usage: (unintern NAME OBARRAY) */)
3886 (Lisp_Object name
, Lisp_Object obarray
)
3888 register Lisp_Object string
, tem
;
3891 if (NILP (obarray
)) obarray
= Vobarray
;
3892 obarray
= check_obarray (obarray
);
3895 string
= SYMBOL_NAME (name
);
3898 CHECK_STRING (name
);
3902 tem
= oblookup (obarray
, SSDATA (string
),
3907 /* If arg was a symbol, don't delete anything but that symbol itself. */
3908 if (SYMBOLP (name
) && !EQ (name
, tem
))
3911 /* There are plenty of other symbols which will screw up the Emacs
3912 session if we unintern them, as well as even more ways to use
3913 `setq' or `fset' or whatnot to make the Emacs session
3914 unusable. Let's not go down this silly road. --Stef */
3915 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3916 error ("Attempt to unintern t or nil"); */
3918 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3920 hash
= oblookup_last_bucket_number
;
3922 if (EQ (AREF (obarray
, hash
), tem
))
3924 if (XSYMBOL (tem
)->next
)
3927 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3928 ASET (obarray
, hash
, sym
);
3931 ASET (obarray
, hash
, make_number (0));
3935 Lisp_Object tail
, following
;
3937 for (tail
= AREF (obarray
, hash
);
3938 XSYMBOL (tail
)->next
;
3941 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3942 if (EQ (following
, tem
))
3944 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3953 /* Return the symbol in OBARRAY whose names matches the string
3954 of SIZE characters (SIZE_BYTE bytes) at PTR.
3955 If there is no such symbol, return the integer bucket number of
3956 where the symbol would be if it were present.
3958 Also store the bucket number in oblookup_last_bucket_number. */
3961 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3965 register Lisp_Object tail
;
3966 Lisp_Object bucket
, tem
;
3968 obarray
= check_obarray (obarray
);
3969 obsize
= ASIZE (obarray
);
3970 hash
= hash_string (ptr
, size_byte
) % obsize
;
3971 bucket
= AREF (obarray
, hash
);
3972 oblookup_last_bucket_number
= hash
;
3973 if (EQ (bucket
, make_number (0)))
3975 else if (!SYMBOLP (bucket
))
3976 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3978 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3980 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3981 && SCHARS (SYMBOL_NAME (tail
)) == size
3982 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3984 else if (XSYMBOL (tail
)->next
== 0)
3987 XSETINT (tem
, hash
);
3992 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3995 register Lisp_Object tail
;
3996 CHECK_VECTOR (obarray
);
3997 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3999 tail
= AREF (obarray
, i
);
4004 if (XSYMBOL (tail
)->next
== 0)
4006 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4012 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4014 call1 (function
, sym
);
4017 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4018 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4019 OBARRAY defaults to the value of `obarray'. */)
4020 (Lisp_Object function
, Lisp_Object obarray
)
4022 if (NILP (obarray
)) obarray
= Vobarray
;
4023 obarray
= check_obarray (obarray
);
4025 map_obarray (obarray
, mapatoms_1
, function
);
4029 #define OBARRAY_SIZE 1511
4034 Lisp_Object oblength
;
4035 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4037 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4039 Vobarray
= Fmake_vector (oblength
, make_number (0));
4040 initial_obarray
= Vobarray
;
4041 staticpro (&initial_obarray
);
4043 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
4044 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
4045 NILP (Vpurify_flag) check in intern_c_string. */
4046 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
4047 Qnil
= intern_c_string ("nil");
4049 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
4050 so those two need to be fixed manually. */
4051 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
4052 set_symbol_function (Qunbound
, Qnil
);
4053 set_symbol_plist (Qunbound
, Qnil
);
4054 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4055 XSYMBOL (Qnil
)->constant
= 1;
4056 XSYMBOL (Qnil
)->declared_special
= 1;
4057 set_symbol_plist (Qnil
, Qnil
);
4058 set_symbol_function (Qnil
, Qnil
);
4060 Qt
= intern_c_string ("t");
4061 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4062 XSYMBOL (Qnil
)->declared_special
= 1;
4063 XSYMBOL (Qt
)->constant
= 1;
4065 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4068 DEFSYM (Qvariable_documentation
, "variable-documentation");
4070 read_buffer
= xmalloc_atomic (size
);
4071 read_buffer_size
= size
;
4075 defsubr (struct Lisp_Subr
*sname
)
4077 Lisp_Object sym
, tem
;
4078 sym
= intern_c_string (sname
->symbol_name
);
4079 SCM_NEWSMOB (sname
->header
.self
, lisp_vectorlike_tag
, sname
);
4080 XSETPVECTYPE (sname
, PVEC_SUBR
);
4081 XSETSUBR (tem
, sname
);
4082 set_symbol_function (sym
, tem
);
4085 /* Define an "integer variable"; a symbol whose value is forwarded to a
4086 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4087 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4089 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4090 const char *namestring
, EMACS_INT
*address
)
4093 sym
= intern_c_string (namestring
);
4094 i_fwd
->type
= Lisp_Fwd_Int
;
4095 i_fwd
->intvar
= address
;
4096 XSYMBOL (sym
)->declared_special
= 1;
4097 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4098 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4101 /* Similar but define a variable whose value is t if address contains 1,
4102 nil if address contains 0. */
4104 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4105 const char *namestring
, bool *address
)
4108 sym
= intern_c_string (namestring
);
4109 b_fwd
->type
= Lisp_Fwd_Bool
;
4110 b_fwd
->boolvar
= address
;
4111 XSYMBOL (sym
)->declared_special
= 1;
4112 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4113 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4114 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4117 /* Similar but define a variable whose value is the Lisp Object stored
4118 at address. Two versions: with and without gc-marking of the C
4119 variable. The nopro version is used when that variable will be
4120 gc-marked for some other reason, since marking the same slot twice
4121 can cause trouble with strings. */
4123 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4124 const char *namestring
, Lisp_Object
*address
)
4127 sym
= intern_c_string (namestring
);
4128 o_fwd
->type
= Lisp_Fwd_Obj
;
4129 o_fwd
->objvar
= address
;
4130 XSYMBOL (sym
)->declared_special
= 1;
4131 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4132 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4136 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4137 const char *namestring
, Lisp_Object
*address
)
4139 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4140 staticpro (address
);
4143 /* Similar but define a variable whose value is the Lisp Object stored
4144 at a particular offset in the current kboard object. */
4147 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4148 const char *namestring
, int offset
)
4151 sym
= intern_c_string (namestring
);
4152 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4153 ko_fwd
->offset
= offset
;
4154 XSYMBOL (sym
)->declared_special
= 1;
4155 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4156 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4159 /* Check that the elements of lpath exist. */
4162 load_path_check (Lisp_Object lpath
)
4164 Lisp_Object path_tail
;
4166 /* The only elements that might not exist are those from
4167 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4169 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4171 Lisp_Object dirfile
;
4172 dirfile
= Fcar (path_tail
);
4173 if (STRINGP (dirfile
))
4175 dirfile
= Fdirectory_file_name (dirfile
);
4176 if (! file_accessible_directory_p (SSDATA (dirfile
)))
4177 dir_warning ("Lisp directory", XCAR (path_tail
));
4182 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4183 This does not include the standard site-lisp directories
4184 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4185 but it does (unless no_site_lisp is set) include site-lisp
4186 directories in the source/build directories if those exist and we
4187 are running uninstalled.
4189 Uses the following logic:
4190 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4191 The remainder is what happens when dumping works:
4192 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4193 Otherwise use PATH_LOADSEARCH.
4195 If !initialized, then just return PATH_DUMPLOADSEARCH.
4197 If Vinstallation_directory is not nil (ie, running uninstalled):
4198 If installation-dir/lisp exists and not already a member,
4199 we must be running uninstalled. Reset the load-path
4200 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4201 refers to the eventual installation directories. Since we
4202 are not yet installed, we should not use them, even if they exist.)
4203 If installation-dir/lisp does not exist, just add
4204 PATH_DUMPLOADSEARCH at the end instead.
4205 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4206 and not already a member) at the front.
4207 If installation-dir != source-dir (ie running an uninstalled,
4208 out-of-tree build) AND install-dir/src/Makefile exists BUT
4209 install-dir/src/Makefile.in does NOT exist (this is a sanity
4210 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4213 load_path_default (void)
4215 Lisp_Object lpath
= Qnil
;
4220 const char *loadpath
= ns_load_path ();
4223 normal
= PATH_LOADSEARCH
;
4225 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4227 lpath
= decode_env_path (0, normal
, 0);
4230 #else /* !CANNOT_DUMP */
4232 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4237 const char *loadpath
= ns_load_path ();
4238 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4240 lpath
= decode_env_path (0, normal
, 0);
4242 if (!NILP (Vinstallation_directory
))
4244 Lisp_Object tem
, tem1
;
4246 /* Add to the path the lisp subdir of the installation
4247 dir, if it is accessible. Note: in out-of-tree builds,
4248 this directory is empty save for Makefile. */
4249 tem
= Fexpand_file_name (build_string ("lisp"),
4250 Vinstallation_directory
);
4251 tem1
= Ffile_accessible_directory_p (tem
);
4254 if (NILP (Fmember (tem
, lpath
)))
4256 /* We are running uninstalled. The default load-path
4257 points to the eventual installed lisp directories.
4258 We should not use those now, even if they exist,
4259 so start over from a clean slate. */
4260 lpath
= list1 (tem
);
4264 /* That dir doesn't exist, so add the build-time
4265 Lisp dirs instead. */
4267 Lisp_Object dump_path
=
4268 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4269 lpath
= nconc2 (lpath
, dump_path
);
4272 /* Add site-lisp under the installation dir, if it exists. */
4275 tem
= Fexpand_file_name (build_string ("site-lisp"),
4276 Vinstallation_directory
);
4277 tem1
= Ffile_accessible_directory_p (tem
);
4280 if (NILP (Fmember (tem
, lpath
)))
4281 lpath
= Fcons (tem
, lpath
);
4285 /* If Emacs was not built in the source directory,
4286 and it is run from where it was built, add to load-path
4287 the lisp and site-lisp dirs under that directory. */
4289 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4293 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4294 Vinstallation_directory
);
4295 tem1
= Ffile_exists_p (tem
);
4297 /* Don't be fooled if they moved the entire source tree
4298 AFTER dumping Emacs. If the build directory is indeed
4299 different from the source dir, src/Makefile.in and
4300 src/Makefile will not be found together. */
4301 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4302 Vinstallation_directory
);
4303 tem2
= Ffile_exists_p (tem
);
4304 if (!NILP (tem1
) && NILP (tem2
))
4306 tem
= Fexpand_file_name (build_string ("lisp"),
4309 if (NILP (Fmember (tem
, lpath
)))
4310 lpath
= Fcons (tem
, lpath
);
4314 tem
= Fexpand_file_name (build_string ("site-lisp"),
4316 tem1
= Ffile_accessible_directory_p (tem
);
4319 if (NILP (Fmember (tem
, lpath
)))
4320 lpath
= Fcons (tem
, lpath
);
4324 } /* Vinstallation_directory != Vsource_directory */
4326 } /* if Vinstallation_directory */
4328 else /* !initialized */
4330 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4331 source directory. We used to add ../lisp (ie the lisp dir in
4332 the build directory) at the front here, but that should not
4333 be necessary, since in out of tree builds lisp/ is empty, save
4335 lpath
= decode_env_path (0, normal
, 0);
4337 #endif /* !CANNOT_DUMP */
4345 /* First, set Vload_path. */
4347 /* Ignore EMACSLOADPATH when dumping. */
4349 bool use_loadpath
= true;
4351 bool use_loadpath
= NILP (Vpurify_flag
);
4354 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4356 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4358 /* Check (non-nil) user-supplied elements. */
4359 load_path_check (Vload_path
);
4361 /* If no nils in the environment variable, use as-is.
4362 Otherwise, replace any nils with the default. */
4363 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4365 Lisp_Object elem
, elpath
= Vload_path
;
4366 Lisp_Object default_lpath
= load_path_default ();
4368 /* Check defaults, before adding site-lisp. */
4369 load_path_check (default_lpath
);
4371 /* Add the site-lisp directories to the front of the default. */
4374 Lisp_Object sitelisp
;
4375 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4376 if (! NILP (sitelisp
))
4377 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4382 /* Replace nils from EMACSLOADPATH by default. */
4383 while (CONSP (elpath
))
4386 elem
= XCAR (elpath
);
4387 elpath
= XCDR (elpath
);
4388 arg
[0] = Vload_path
;
4389 arg
[1] = NILP (elem
) ? default_lpath
: Fcons (elem
, Qnil
);
4390 Vload_path
= Fappend (2, arg
);
4392 } /* Fmemq (Qnil, Vload_path) */
4396 Vload_path
= load_path_default ();
4398 /* Check before adding site-lisp directories.
4399 The install should have created them, but they are not
4400 required, so no need to warn if they are absent.
4401 Or we might be running before installation. */
4402 load_path_check (Vload_path
);
4404 /* Add the site-lisp directories at the front. */
4405 if (initialized
&& !no_site_lisp
)
4407 Lisp_Object sitelisp
;
4408 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4409 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4415 load_in_progress
= 0;
4416 Vload_file_name
= Qnil
;
4417 Vstandard_input
= Qt
;
4418 Vloads_in_progress
= Qnil
;
4421 /* Print a warning that directory intended for use USE and with name
4422 DIRNAME cannot be accessed. On entry, errno should correspond to
4423 the access failure. Print the warning on stderr and put it in
4427 dir_warning (char const *use
, Lisp_Object dirname
)
4429 static char const format
[] = "Warning: %s `%s': %s\n";
4430 int access_errno
= errno
;
4431 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4433 /* Don't log the warning before we've initialized!! */
4436 char const *diagnostic
= emacs_strerror (access_errno
);
4438 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4439 + strlen (use
) + SBYTES (dirname
)
4440 + strlen (diagnostic
));
4441 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4443 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4449 syms_of_lread (void)
4453 DEFVAR_LISP ("obarray", Vobarray
,
4454 doc
: /* Symbol table for use by `intern' and `read'.
4455 It is a vector whose length ought to be prime for best results.
4456 The vector's contents don't make sense if examined from Lisp programs;
4457 to find all the symbols in an obarray, use `mapatoms'. */);
4459 DEFVAR_LISP ("values", Vvalues
,
4460 doc
: /* List of values of all expressions which were read, evaluated and printed.
4461 Order is reverse chronological. */);
4462 XSYMBOL (intern ("values"))->declared_special
= 0;
4464 DEFVAR_LISP ("standard-input", Vstandard_input
,
4465 doc
: /* Stream for read to get input from.
4466 See documentation of `read' for possible values. */);
4467 Vstandard_input
= Qt
;
4469 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4470 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4472 If this variable is a buffer, then only forms read from that buffer
4473 will be added to `read-symbol-positions-list'.
4474 If this variable is t, then all read forms will be added.
4475 The effect of all other values other than nil are not currently
4476 defined, although they may be in the future.
4478 The positions are relative to the last call to `read' or
4479 `read-from-string'. It is probably a bad idea to set this variable at
4480 the toplevel; bind it instead. */);
4481 Vread_with_symbol_positions
= Qnil
;
4483 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4484 doc
: /* A list mapping read symbols to their positions.
4485 This variable is modified during calls to `read' or
4486 `read-from-string', but only when `read-with-symbol-positions' is
4489 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4490 CHAR-POSITION is an integer giving the offset of that occurrence of the
4491 symbol from the position where `read' or `read-from-string' started.
4493 Note that a symbol will appear multiple times in this list, if it was
4494 read multiple times. The list is in the same order as the symbols
4496 Vread_symbol_positions_list
= Qnil
;
4498 DEFVAR_LISP ("read-circle", Vread_circle
,
4499 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4502 DEFVAR_LISP ("load-path", Vload_path
,
4503 doc
: /* List of directories to search for files to load.
4504 Each element is a string (directory name) or nil (meaning `default-directory').
4505 Initialized during startup as described in Info node `(elisp)Library Search'. */);
4507 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4508 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4509 This list should not include the empty string.
4510 `load' and related functions try to append these suffixes, in order,
4511 to the specified file name if a Lisp suffix is allowed or required. */);
4512 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4513 build_pure_c_string (".el"));
4514 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4515 doc
: /* List of suffixes that indicate representations of \
4517 This list should normally start with the empty string.
4519 Enabling Auto Compression mode appends the suffixes in
4520 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4521 mode removes them again. `load' and related functions use this list to
4522 determine whether they should look for compressed versions of a file
4523 and, if so, which suffixes they should try to append to the file name
4524 in order to do so. However, if you want to customize which suffixes
4525 the loading functions recognize as compression suffixes, you should
4526 customize `jka-compr-load-suffixes' rather than the present variable. */);
4527 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4529 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4530 doc
: /* Non-nil if inside of `load'. */);
4531 DEFSYM (Qload_in_progress
, "load-in-progress");
4533 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4534 doc
: /* An alist of functions to be evalled when particular files are loaded.
4535 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4537 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4538 a symbol \(a feature name).
4540 When `load' is run and the file-name argument matches an element's
4541 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4542 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4544 An error in FORMS does not undo the load, but does prevent execution of
4545 the rest of the FORMS. */);
4546 Vafter_load_alist
= Qnil
;
4548 DEFVAR_LISP ("load-history", Vload_history
,
4549 doc
: /* Alist mapping loaded file names to symbols and features.
4550 Each alist element should be a list (FILE-NAME ENTRIES...), where
4551 FILE-NAME is the name of a file that has been loaded into Emacs.
4552 The file name is absolute and true (i.e. it doesn't contain symlinks).
4553 As an exception, one of the alist elements may have FILE-NAME nil,
4554 for symbols and features not associated with any file.
4556 The remaining ENTRIES in the alist element describe the functions and
4557 variables defined in that file, the features provided, and the
4558 features required. Each entry has the form `(provide . FEATURE)',
4559 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4560 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4561 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4562 autoload before this file redefined it as a function. In addition,
4563 entries may also be single symbols, which means that SYMBOL was
4564 defined by `defvar' or `defconst'.
4566 During preloading, the file name recorded is relative to the main Lisp
4567 directory. These file names are converted to absolute at startup. */);
4568 Vload_history
= Qnil
;
4570 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4571 doc
: /* Full name of file being loaded by `load'. */);
4572 Vload_file_name
= Qnil
;
4574 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4575 doc
: /* File name, including directory, of user's initialization file.
4576 If the file loaded had extension `.elc', and the corresponding source file
4577 exists, this variable contains the name of source file, suitable for use
4578 by functions like `custom-save-all' which edit the init file.
4579 While Emacs loads and evaluates the init file, value is the real name
4580 of the file, regardless of whether or not it has the `.elc' extension. */);
4581 Vuser_init_file
= Qnil
;
4583 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4584 doc
: /* Used for internal purposes by `load'. */);
4585 Vcurrent_load_list
= Qnil
;
4587 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4588 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4589 The default is nil, which means use the function `read'. */);
4590 Vload_read_function
= Qnil
;
4592 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4593 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4594 The value should be a function for doing code conversion before
4595 reading a source file. It can also be nil, in which case loading is
4596 done without any code conversion.
4598 If the value is a function, it is called with four arguments,
4599 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4600 the file to load, FILE is the non-absolute name (for messages etc.),
4601 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4602 `load'. The function should return t if the file was loaded. */);
4603 Vload_source_file_function
= Qnil
;
4605 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4606 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4607 This is useful when the file being loaded is a temporary copy. */);
4608 load_force_doc_strings
= 0;
4610 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4611 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4612 This is normally bound by `load' and `eval-buffer' to control `read',
4613 and is not meant for users to change. */);
4614 load_convert_to_unibyte
= 0;
4616 DEFVAR_LISP ("source-directory", Vsource_directory
,
4617 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4618 You cannot count on them to still be there! */);
4620 = Fexpand_file_name (build_string ("../"),
4621 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4623 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4624 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4625 Vpreloaded_file_list
= Qnil
;
4627 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4628 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4629 Vbyte_boolean_vars
= Qnil
;
4631 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4632 doc
: /* Non-nil means load dangerous compiled Lisp files.
4633 Some versions of XEmacs use different byte codes than Emacs. These
4634 incompatible byte codes can make Emacs crash when it tries to execute
4636 load_dangerous_libraries
= 0;
4638 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4639 doc
: /* Non-nil means force printing messages when loading Lisp files.
4640 This overrides the value of the NOMESSAGE argument to `load'. */);
4641 force_load_messages
= 0;
4643 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4644 doc
: /* Regular expression matching safe to load compiled Lisp files.
4645 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4646 from the file, and matches them against this regular expression.
4647 When the regular expression matches, the file is considered to be safe
4648 to load. See also `load-dangerous-libraries'. */);
4649 Vbytecomp_version_regexp
4650 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4652 DEFSYM (Qlexical_binding
, "lexical-binding");
4653 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4654 doc
: /* Whether to use lexical binding when evaluating code.
4655 Non-nil means that the code in the current buffer should be evaluated
4656 with lexical binding.
4657 This variable is automatically set from the file variables of an
4658 interpreted Lisp file read using `load'. Unlike other file local
4659 variables, this must be set in the first line of a file. */);
4660 Vlexical_binding
= Qnil
;
4661 Fmake_variable_buffer_local (Qlexical_binding
);
4663 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4664 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4665 Veval_buffer_list
= Qnil
;
4667 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4668 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4669 Vold_style_backquotes
= Qnil
;
4670 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4672 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4673 doc
: /* Non-nil means `load' prefers the newest version of a file.
4674 This applies when a filename suffix is not explicitly specified and
4675 `load' is trying various possible suffixes (see `load-suffixes' and
4676 `load-file-rep-suffixes'). Normally, it stops at the first file
4677 that exists unless you explicitly specify one or the other. If this
4678 option is non-nil, it checks all suffixes and uses whichever file is
4680 Note that if you customize this, obviously it will not affect files
4681 that are loaded before your customizations are read! */);
4682 load_prefer_newer
= 0;
4684 /* Vsource_directory was initialized in init_lread. */
4686 DEFSYM (Qcurrent_load_list
, "current-load-list");
4687 DEFSYM (Qstandard_input
, "standard-input");
4688 DEFSYM (Qread_char
, "read-char");
4689 DEFSYM (Qget_file_char
, "get-file-char");
4690 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4691 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4693 DEFSYM (Qbackquote
, "`");
4694 DEFSYM (Qcomma
, ",");
4695 DEFSYM (Qcomma_at
, ",@");
4696 DEFSYM (Qcomma_dot
, ",.");
4698 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4699 DEFSYM (Qascii_character
, "ascii-character");
4700 DEFSYM (Qfunction
, "function");
4701 DEFSYM (Qload
, "load");
4702 DEFSYM (Qload_file_name
, "load-file-name");
4703 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4704 DEFSYM (Qfile_truename
, "file-truename");
4705 DEFSYM (Qdir_ok
, "dir-ok");
4706 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4708 staticpro (&read_objects
);
4709 read_objects
= Qnil
;
4710 staticpro (&seen_list
);
4713 Vloads_in_progress
= Qnil
;
4714 staticpro (&Vloads_in_progress
);
4716 DEFSYM (Qhash_table
, "hash-table");
4717 DEFSYM (Qdata
, "data");
4718 DEFSYM (Qtest
, "test");
4719 DEFSYM (Qsize
, "size");
4720 DEFSYM (Qweakness
, "weakness");
4721 DEFSYM (Qrehash_size
, "rehash-size");
4722 DEFSYM (Qrehash_threshold
, "rehash-threshold");