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
;
1051 ptrdiff_t count
= SPECPDL_INDEX ();
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
);
1091 file
= Fsubstitute_in_file_name (file
);
1093 /* Avoid weird lossage with null string as arg,
1094 since it would try to load a directory as a Lisp file. */
1095 if (SCHARS (file
) == 0)
1102 Lisp_Object suffixes
;
1104 GCPRO2 (file
, found
);
1106 if (! NILP (must_suffix
))
1108 /* Don't insist on adding a suffix if FILE already ends with one. */
1109 ptrdiff_t size
= SBYTES (file
);
1111 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1114 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1116 /* Don't insist on adding a suffix
1117 if the argument includes a directory name. */
1118 else if (! NILP (Ffile_name_directory (file
)))
1122 if (!NILP (nosuffix
))
1126 suffixes
= Fget_load_suffixes ();
1127 if (NILP (must_suffix
))
1131 arg
[1] = Vload_file_rep_suffixes
;
1132 suffixes
= Fappend (2, arg
);
1136 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1143 report_file_error ("Cannot open load file", file
);
1147 /* Tell startup.el whether or not we found the user's init file. */
1148 if (EQ (Qt
, Vuser_init_file
))
1149 Vuser_init_file
= found
;
1151 /* If FD is -2, that means openp found a magic file. */
1154 if (NILP (Fequal (found
, file
)))
1155 /* If FOUND is a different file name from FILE,
1156 find its handler even if we have already inhibited
1157 the `load' operation on FILE. */
1158 handler
= Ffind_file_name_handler (found
, Qt
);
1160 handler
= Ffind_file_name_handler (found
, Qload
);
1161 if (! NILP (handler
))
1162 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1164 /* Tramp has to deal with semi-broken packages that prepend
1165 drive letters to remote files. For that reason, Tramp
1166 catches file operations that test for file existence, which
1167 makes openp think X:/foo.elc files are remote. However,
1168 Tramp does not catch `load' operations for such files, so we
1169 end up with a nil as the `load' handler above. If we would
1170 continue with fd = -2, we will behave wrongly, and in
1171 particular try reading a .elc file in the "rt" mode instead
1172 of "rb". See bug #9311 for the results. To work around
1173 this, we try to open the file locally, and go with that if it
1175 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1183 record_unwind_protect_ptr (close_file_ptr_unwind
, &fd
);
1184 record_unwind_protect_ptr (fclose_ptr_unwind
, &stream
);
1187 /* Check if we're stuck in a recursive load cycle.
1189 2000-09-21: It's not possible to just check for the file loaded
1190 being a member of Vloads_in_progress. This fails because of the
1191 way the byte compiler currently works; `provide's are not
1192 evaluated, see font-lock.el/jit-lock.el as an example. This
1193 leads to a certain amount of ``normal'' recursion.
1195 Also, just loading a file recursively is not always an error in
1196 the general case; the second load may do something different. */
1200 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1201 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1202 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1203 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1204 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1207 /* All loads are by default dynamic, unless the file itself specifies
1208 otherwise using a file-variable in the first line. This is bound here
1209 so that it takes effect whether or not we use
1210 Vload_source_file_function. */
1211 specbind (Qlexical_binding
, Qnil
);
1213 /* Get the name for load-history. */
1214 hist_file_name
= (! NILP (Vpurify_flag
)
1215 ? concat2 (Ffile_name_directory (file
),
1216 Ffile_name_nondirectory (found
))
1221 /* Check for the presence of old-style quotes and warn about them. */
1222 specbind (Qold_style_backquotes
, Qnil
);
1223 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1225 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1226 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1227 /* Load .elc files directly, but not when they are
1228 remote and have no handler! */
1235 GCPRO3 (file
, found
, hist_file_name
);
1238 && ! (version
= safe_to_load_version (fd
)))
1241 if (!load_dangerous_libraries
)
1242 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1243 else if (!NILP (nomessage
) && !force_load_messages
)
1244 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1249 efound
= ENCODE_FILE (found
);
1255 /* openp already checked for newness, no point doing it again.
1256 FIXME would be nice to get a message when openp
1257 ignores suffix order due to load_prefer_newer. */
1258 if (!load_prefer_newer
)
1260 result
= stat (SSDATA (efound
), &s1
);
1263 SSET (efound
, SBYTES (efound
) - 1, 0);
1264 result
= stat (SSDATA (efound
), &s2
);
1265 SSET (efound
, SBYTES (efound
) - 1, 'c');
1269 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1271 /* Make the progress messages mention that source is newer. */
1274 /* If we won't print another message, mention this anyway. */
1275 if (!NILP (nomessage
) && !force_load_messages
)
1277 Lisp_Object msg_file
;
1278 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1279 message_with_string ("Source file `%s' newer than byte-compiled file",
1283 } /* !load_prefer_newer */
1289 /* We are loading a source file (*.el). */
1290 if (!NILP (Vload_source_file_function
))
1299 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1300 NILP (noerror
) ? Qnil
: Qt
,
1301 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1302 return unbind_to (count
, val
);
1306 GCPRO3 (file
, found
, hist_file_name
);
1310 /* We somehow got here with fd == -2, meaning the file is deemed
1311 to be remote. Don't even try to reopen the file locally;
1312 just force a failure. */
1321 efound
= ENCODE_FILE (found
);
1322 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1324 stream
= fdopen (fd
, fmode
);
1328 report_file_error ("Opening stdio stream", file
);
1330 if (! NILP (Vpurify_flag
))
1331 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1333 if (NILP (nomessage
) || force_load_messages
)
1336 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1339 message_with_string ("Loading %s (source)...", file
, 1);
1341 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1343 else /* The typical case; compiled file newer than source file. */
1344 message_with_string ("Loading %s...", file
, 1);
1347 specbind (Qload_file_name
, found
);
1348 specbind (Qinhibit_file_name_operation
, Qnil
);
1349 specbind (Qload_in_progress
, Qt
);
1352 if (lisp_file_lexically_bound_p (Qget_file_char
))
1353 Fset (Qlexical_binding
, Qt
);
1355 if (! version
|| version
>= 22)
1356 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1357 0, Qnil
, Qnil
, Qnil
, Qnil
);
1360 /* We can't handle a file which was compiled with
1361 byte-compile-dynamic by older version of Emacs. */
1362 specbind (Qload_force_doc_strings
, Qt
);
1363 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1364 0, Qnil
, Qnil
, Qnil
, Qnil
);
1366 unbind_to (count
, Qnil
);
1368 /* Run any eval-after-load forms for this file. */
1369 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1370 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1374 xfree (saved_doc_string
);
1375 saved_doc_string
= 0;
1376 saved_doc_string_size
= 0;
1378 xfree (prev_saved_doc_string
);
1379 prev_saved_doc_string
= 0;
1380 prev_saved_doc_string_size
= 0;
1382 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1385 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1388 message_with_string ("Loading %s (source)...done", file
, 1);
1390 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1392 else /* The typical case; compiled file newer than source file. */
1393 message_with_string ("Loading %s...done", file
, 1);
1400 complete_filename_p (Lisp_Object pathname
)
1402 const unsigned char *s
= SDATA (pathname
);
1403 return (IS_DIRECTORY_SEP (s
[0])
1404 || (SCHARS (pathname
) > 2
1405 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1408 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1409 doc
: /* Search for FILENAME through PATH.
1410 Returns the file's name in absolute form, or nil if not found.
1411 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1412 file name when searching.
1413 If non-nil, PREDICATE is used instead of `file-readable-p'.
1414 PREDICATE can also be an integer to pass to the faccessat(2) function,
1415 in which case file-name-handlers are ignored.
1416 This function will normally skip directories, so if you want it to find
1417 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1418 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1421 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1422 if (NILP (predicate
) && fd
>= 0)
1427 static Lisp_Object Qdir_ok
;
1429 /* Search for a file whose name is STR, looking in directories
1430 in the Lisp list PATH, and trying suffixes from SUFFIX.
1431 On success, return a file descriptor (or 1 or -2 as described below).
1432 On failure, return -1 and set errno.
1434 SUFFIXES is a list of strings containing possible suffixes.
1435 The empty suffix is automatically added if the list is empty.
1437 PREDICATE non-nil means don't open the files,
1438 just look for one that satisfies the predicate. In this case,
1439 return 1 on success. The predicate can be a lisp function or
1440 an integer to pass to `access' (in which case file-name-handlers
1443 If STOREPTR is nonzero, it points to a slot where the name of
1444 the file actually found should be stored as a Lisp string.
1445 nil is stored there on failure.
1447 If the file we find is remote, return -2
1448 but store the found remote file name in *STOREPTR.
1450 If NEWER is true, try all SUFFIXes and return the result for the
1451 newest file that exists. Does not apply to remote files,
1452 or if PREDICATE is specified. */
1455 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1456 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1458 ptrdiff_t fn_size
= 100;
1462 ptrdiff_t want_length
;
1463 Lisp_Object filename
;
1464 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
, gcpro7
;
1465 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1466 ptrdiff_t max_suffix_len
= 0;
1467 int last_errno
= ENOENT
;
1470 /* The last-modified time of the newest matching file found.
1471 Initialize it to something less than all valid timestamps. */
1472 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1476 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1478 CHECK_STRING_CAR (tail
);
1479 max_suffix_len
= max (max_suffix_len
,
1480 SBYTES (XCAR (tail
)));
1483 string
= filename
= encoded_fn
= save_string
= Qnil
;
1484 GCPRO7 (str
, string
, save_string
, filename
, path
, suffixes
, encoded_fn
);
1489 absolute
= complete_filename_p (str
);
1491 for (; CONSP (path
); path
= XCDR (path
))
1493 filename
= Fexpand_file_name (str
, XCAR (path
));
1494 if (!complete_filename_p (filename
))
1495 /* If there are non-absolute elts in PATH (eg "."). */
1496 /* Of course, this could conceivably lose if luser sets
1497 default-directory to be something non-absolute... */
1499 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1500 if (!complete_filename_p (filename
))
1501 /* Give up on this path element! */
1505 /* Calculate maximum length of any filename made from
1506 this path element/specified file name and any possible suffix. */
1507 want_length
= max_suffix_len
+ SBYTES (filename
);
1508 if (fn_size
<= want_length
)
1509 fn
= alloca (fn_size
= 100 + want_length
);
1511 /* Loop over suffixes. */
1512 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1513 CONSP (tail
); tail
= XCDR (tail
))
1515 Lisp_Object suffix
= XCAR (tail
);
1516 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1517 Lisp_Object handler
;
1519 /* Concatenate path element/specified name with the suffix.
1520 If the directory starts with /:, remove that. */
1521 int prefixlen
= ((SCHARS (filename
) > 2
1522 && SREF (filename
, 0) == '/'
1523 && SREF (filename
, 1) == ':')
1525 fnlen
= SBYTES (filename
) - prefixlen
;
1526 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1527 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1529 /* Check that the file exists and is not a directory. */
1530 /* We used to only check for handlers on non-absolute file names:
1534 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1535 It's not clear why that was the case and it breaks things like
1536 (load "/bar.el") where the file is actually "/bar.el.gz". */
1537 /* make_string has its own ideas on when to return a unibyte
1538 string and when a multibyte string, but we know better.
1539 We must have a unibyte string when dumping, since
1540 file-name encoding is shaky at best at that time, and in
1541 particular default-file-name-coding-system is reset
1542 several times during loadup. We therefore don't want to
1543 encode the file before passing it to file I/O library
1545 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1546 string
= make_unibyte_string (fn
, fnlen
);
1548 string
= make_string (fn
, fnlen
);
1549 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1550 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1553 if (NILP (predicate
))
1554 exists
= !NILP (Ffile_readable_p (string
));
1557 Lisp_Object tmp
= call1 (predicate
, string
);
1560 else if (EQ (tmp
, Qdir_ok
)
1561 || NILP (Ffile_directory_p (string
)))
1566 last_errno
= EISDIR
;
1572 /* We succeeded; return this descriptor and filename. */
1585 encoded_fn
= ENCODE_FILE (string
);
1586 pfn
= SSDATA (encoded_fn
);
1588 /* Check that we can access or open it. */
1589 if (NATNUMP (predicate
))
1592 if (INT_MAX
< XFASTINT (predicate
))
1593 last_errno
= EINVAL
;
1594 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1598 if (file_directory_p (pfn
))
1599 last_errno
= EISDIR
;
1606 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1609 if (errno
!= ENOENT
)
1614 int err
= (fstat (fd
, &st
) != 0 ? errno
1615 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1627 if (newer
&& !NATNUMP (predicate
))
1629 struct timespec mtime
= get_stat_mtime (&st
);
1631 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1636 emacs_close (save_fd
);
1639 save_string
= string
;
1644 /* We succeeded; return this descriptor and filename. */
1652 /* No more suffixes. Return the newest. */
1653 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1656 *storeptr
= save_string
;
1672 /* Merge the list we've accumulated of globals from the current input source
1673 into the load_history variable. The details depend on whether
1674 the source has an associated file name or not.
1676 FILENAME is the file name that we are loading from.
1678 ENTIRE is true if loading that entire file, false if evaluating
1682 build_load_history (Lisp_Object filename
, bool entire
)
1684 Lisp_Object tail
, prev
, newelt
;
1685 Lisp_Object tem
, tem2
;
1688 tail
= Vload_history
;
1691 while (CONSP (tail
))
1695 /* Find the feature's previous assoc list... */
1696 if (!NILP (Fequal (filename
, Fcar (tem
))))
1700 /* If we're loading the entire file, remove old data. */
1704 Vload_history
= XCDR (tail
);
1706 Fsetcdr (prev
, XCDR (tail
));
1709 /* Otherwise, cons on new symbols that are not already members. */
1712 tem2
= Vcurrent_load_list
;
1714 while (CONSP (tem2
))
1716 newelt
= XCAR (tem2
);
1718 if (NILP (Fmember (newelt
, tem
)))
1719 Fsetcar (tail
, Fcons (XCAR (tem
),
1720 Fcons (newelt
, XCDR (tem
))));
1733 /* If we're loading an entire file, cons the new assoc onto the
1734 front of load-history, the most-recently-loaded position. Also
1735 do this if we didn't find an existing member for the file. */
1736 if (entire
|| !foundit
)
1737 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1742 readevalloop_1 (int old
)
1744 load_convert_to_unibyte
= old
;
1747 /* Signal an `end-of-file' error, if possible with file name
1750 static _Noreturn
void
1751 end_of_file_error (void)
1753 if (STRINGP (Vload_file_name
))
1754 xsignal1 (Qend_of_file
, Vload_file_name
);
1756 xsignal0 (Qend_of_file
);
1760 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1762 /* If we macroexpand the toplevel form non-recursively and it ends
1763 up being a `progn' (or if it was a progn to start), treat each
1764 form in the progn as a top-level form. This way, if one form in
1765 the progn defines a macro, that macro is in effect when we expand
1766 the remaining forms. See similar code in bytecomp.el. */
1767 val
= call2 (macroexpand
, val
, Qnil
);
1768 if (EQ (CAR_SAFE (val
), Qprogn
))
1770 Lisp_Object subforms
= XCDR (val
);
1772 for (; CONSP (subforms
); subforms
= XCDR (subforms
))
1773 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1777 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1782 /* UNIBYTE specifies how to set load_convert_to_unibyte
1783 for this invocation.
1784 READFUN, if non-nil, is used instead of `read'.
1786 START, END specify region to read in current buffer (from eval-region).
1787 If the input is not from a buffer, they must be nil. */
1790 readevalloop (Lisp_Object readcharfun
,
1792 Lisp_Object sourcename
,
1794 Lisp_Object unibyte
, Lisp_Object readfun
,
1795 Lisp_Object start
, Lisp_Object end
)
1798 register Lisp_Object val
;
1799 ptrdiff_t count
= SPECPDL_INDEX ();
1800 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1801 struct buffer
*b
= 0;
1802 bool continue_reading_p
;
1803 Lisp_Object lex_bound
;
1804 /* True if reading an entire buffer. */
1805 bool whole_buffer
= 0;
1806 /* True on the first time around. */
1807 bool first_sexp
= 1;
1808 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1810 if (NILP (Ffboundp (macroexpand
))
1811 /* Don't macroexpand in .elc files, since it should have been done
1812 already. We actually don't know whether we're in a .elc file or not,
1813 so we use circumstantial evidence: .el files normally go through
1814 Vload_source_file_function -> load-with-code-conversion
1816 || EQ (readcharfun
, Qget_file_char
)
1817 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1820 if (MARKERP (readcharfun
))
1823 start
= readcharfun
;
1826 if (BUFFERP (readcharfun
))
1827 b
= XBUFFER (readcharfun
);
1828 else if (MARKERP (readcharfun
))
1829 b
= XMARKER (readcharfun
)->buffer
;
1831 /* We assume START is nil when input is not from a buffer. */
1832 if (! NILP (start
) && !b
)
1835 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1836 specbind (Qcurrent_load_list
, Qnil
);
1837 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1838 load_convert_to_unibyte
= !NILP (unibyte
);
1840 /* If lexical binding is active (either because it was specified in
1841 the file's header, or via a buffer-local variable), create an empty
1842 lexical environment, otherwise, turn off lexical binding. */
1843 lex_bound
= find_symbol_value (Qlexical_binding
);
1844 specbind (Qinternal_interpreter_environment
,
1845 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1846 ? Qnil
: list1 (Qt
)));
1848 GCPRO4 (sourcename
, readfun
, start
, end
);
1850 /* Try to ensure sourcename is a truename, except whilst preloading. */
1851 if (NILP (Vpurify_flag
)
1852 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1853 && !NILP (Ffboundp (Qfile_truename
)))
1854 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1856 LOADHIST_ATTACH (sourcename
);
1858 continue_reading_p
= 1;
1859 while (continue_reading_p
)
1861 ptrdiff_t count1
= SPECPDL_INDEX ();
1863 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1864 error ("Reading from killed buffer");
1868 /* Switch to the buffer we are reading from. */
1869 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1870 set_buffer_internal (b
);
1872 /* Save point in it. */
1873 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1874 /* Save ZV in it. */
1875 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1876 /* Those get unbound after we read one expression. */
1878 /* Set point and ZV around stuff to be read. */
1881 Fnarrow_to_region (make_number (BEGV
), end
);
1883 /* Just for cleanliness, convert END to a marker
1884 if it is an integer. */
1886 end
= Fpoint_max_marker ();
1889 /* On the first cycle, we can easily test here
1890 whether we are reading the whole buffer. */
1891 if (b
&& first_sexp
)
1892 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1899 while ((c
= READCHAR
) != '\n' && c
!= -1);
1904 unbind_to (count1
, Qnil
);
1908 /* Ignore whitespace here, so we can detect eof. */
1909 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1910 || c
== 0xa0) /* NBSP */
1913 if (!NILP (Vpurify_flag
) && c
== '(')
1915 val
= read_list (0, readcharfun
);
1920 read_objects
= Qnil
;
1921 if (!NILP (readfun
))
1923 val
= call1 (readfun
, readcharfun
);
1925 /* If READCHARFUN has set point to ZV, we should
1926 stop reading, even if the form read sets point
1927 to a different value when evaluated. */
1928 if (BUFFERP (readcharfun
))
1930 struct buffer
*buf
= XBUFFER (readcharfun
);
1931 if (BUF_PT (buf
) == BUF_ZV (buf
))
1932 continue_reading_p
= 0;
1935 else if (! NILP (Vload_read_function
))
1936 val
= call1 (Vload_read_function
, readcharfun
);
1938 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1941 if (!NILP (start
) && continue_reading_p
)
1942 start
= Fpoint_marker ();
1944 /* Restore saved point and BEGV. */
1945 unbind_to (count1
, Qnil
);
1947 /* Now eval what we just read. */
1948 if (!NILP (macroexpand
))
1949 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1951 val
= eval_sub (val
);
1955 Vvalues
= Fcons (val
, Vvalues
);
1956 if (EQ (Vstandard_output
, Qt
))
1965 build_load_history (sourcename
,
1966 stream
|| whole_buffer
);
1970 unbind_to (count
, Qnil
);
1973 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1974 doc
: /* Execute the current buffer as Lisp code.
1975 When called from a Lisp program (i.e., not interactively), this
1976 function accepts up to five optional arguments:
1977 BUFFER is the buffer to evaluate (nil means use current buffer).
1978 PRINTFLAG controls printing of output:
1979 A value of nil means discard it; anything else is stream for print.
1980 FILENAME specifies the file name to use for `load-history'.
1981 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1983 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1984 functions should work normally even if PRINTFLAG is nil.
1986 This function preserves the position of point. */)
1987 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1989 ptrdiff_t count
= SPECPDL_INDEX ();
1990 Lisp_Object tem
, buf
;
1993 buf
= Fcurrent_buffer ();
1995 buf
= Fget_buffer (buffer
);
1997 error ("No such buffer");
1999 if (NILP (printflag
) && NILP (do_allow_print
))
2004 if (NILP (filename
))
2005 filename
= BVAR (XBUFFER (buf
), filename
);
2007 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
2008 specbind (Qstandard_output
, tem
);
2009 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
2010 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2011 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
2012 readevalloop (buf
, 0, filename
,
2013 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
2014 unbind_to (count
, Qnil
);
2019 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2020 doc
: /* Execute the region as Lisp code.
2021 When called from programs, expects two arguments,
2022 giving starting and ending indices in the current buffer
2023 of the text to be executed.
2024 Programs can pass third argument PRINTFLAG which controls output:
2025 A value of nil means discard it; anything else is stream for printing it.
2026 Also the fourth argument READ-FUNCTION, if non-nil, is used
2027 instead of `read' to read each expression. It gets one argument
2028 which is the input stream for reading characters.
2030 This function does not move point. */)
2031 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2033 /* FIXME: Do the eval-sexp-add-defvars dance! */
2034 ptrdiff_t count
= SPECPDL_INDEX ();
2035 Lisp_Object tem
, cbuf
;
2037 cbuf
= Fcurrent_buffer ();
2039 if (NILP (printflag
))
2043 specbind (Qstandard_output
, tem
);
2044 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2046 /* `readevalloop' calls functions which check the type of start and end. */
2047 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2048 !NILP (printflag
), Qnil
, read_function
,
2051 return unbind_to (count
, Qnil
);
2055 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2056 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2057 If STREAM is nil, use the value of `standard-input' (which see).
2058 STREAM or the value of `standard-input' may be:
2059 a buffer (read from point and advance it)
2060 a marker (read from where it points and advance it)
2061 a function (call it with no arguments for each character,
2062 call it with a char as argument to push a char back)
2063 a string (takes text from string, starting at the beginning)
2064 t (read text line using minibuffer and use it, or read from
2065 standard input in batch mode). */)
2066 (Lisp_Object stream
)
2069 stream
= Vstandard_input
;
2070 if (EQ (stream
, Qt
))
2071 stream
= Qread_char
;
2072 if (EQ (stream
, Qread_char
))
2073 /* FIXME: ?! When is this used !? */
2074 return call1 (intern ("read-minibuffer"),
2075 build_string ("Lisp expression: "));
2077 return read_internal_start (stream
, Qnil
, Qnil
);
2080 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2081 doc
: /* Read one Lisp expression which is represented as text by STRING.
2082 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2083 FINAL-STRING-INDEX is an integer giving the position of the next
2084 remaining character in STRING.
2085 START and END optionally delimit a substring of STRING from which to read;
2086 they default to 0 and (length STRING) respectively. */)
2087 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2090 CHECK_STRING (string
);
2091 /* `read_internal_start' sets `read_from_string_index'. */
2092 ret
= read_internal_start (string
, start
, end
);
2093 return Fcons (ret
, make_number (read_from_string_index
));
2096 /* Function to set up the global context we need in toplevel read
2099 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2100 /* `start', `end' only used when stream is a string. */
2105 new_backquote_flag
= 0;
2106 read_objects
= Qnil
;
2107 if (EQ (Vread_with_symbol_positions
, Qt
)
2108 || EQ (Vread_with_symbol_positions
, stream
))
2109 Vread_symbol_positions_list
= Qnil
;
2111 if (STRINGP (stream
)
2112 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2114 ptrdiff_t startval
, endval
;
2117 if (STRINGP (stream
))
2120 string
= XCAR (stream
);
2123 endval
= SCHARS (string
);
2127 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2128 args_out_of_range (string
, end
);
2129 endval
= XINT (end
);
2136 CHECK_NUMBER (start
);
2137 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2138 args_out_of_range (string
, start
);
2139 startval
= XINT (start
);
2141 read_from_string_index
= startval
;
2142 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2143 read_from_string_limit
= endval
;
2146 retval
= read0 (stream
);
2147 if (EQ (Vread_with_symbol_positions
, Qt
)
2148 || EQ (Vread_with_symbol_positions
, stream
))
2149 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2154 /* Signal Qinvalid_read_syntax error.
2155 S is error string of length N (if > 0) */
2157 static _Noreturn
void
2158 invalid_syntax (const char *s
)
2160 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2164 /* Use this for recursive reads, in contexts where internal tokens
2168 read0 (Lisp_Object readcharfun
)
2170 register Lisp_Object val
;
2173 val
= read1 (readcharfun
, &c
, 0);
2177 xsignal1 (Qinvalid_read_syntax
,
2178 Fmake_string (make_number (1), make_number (c
)));
2181 static ptrdiff_t read_buffer_size
;
2182 static char *read_buffer
;
2184 /* Read a \-escape sequence, assuming we already read the `\'.
2185 If the escape sequence forces unibyte, return eight-bit char. */
2188 read_escape (Lisp_Object readcharfun
, bool stringp
)
2191 /* \u allows up to four hex digits, \U up to eight. Default to the
2192 behavior for \u, and change this value in the case that \U is seen. */
2193 int unicode_hex_count
= 4;
2198 end_of_file_error ();
2228 error ("Invalid escape character syntax");
2231 c
= read_escape (readcharfun
, 0);
2232 return c
| meta_modifier
;
2237 error ("Invalid escape character syntax");
2240 c
= read_escape (readcharfun
, 0);
2241 return c
| shift_modifier
;
2246 error ("Invalid escape character syntax");
2249 c
= read_escape (readcharfun
, 0);
2250 return c
| hyper_modifier
;
2255 error ("Invalid escape character syntax");
2258 c
= read_escape (readcharfun
, 0);
2259 return c
| alt_modifier
;
2263 if (stringp
|| c
!= '-')
2270 c
= read_escape (readcharfun
, 0);
2271 return c
| super_modifier
;
2276 error ("Invalid escape character syntax");
2280 c
= read_escape (readcharfun
, 0);
2281 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2282 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2283 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2284 return c
| ctrl_modifier
;
2285 /* ASCII control chars are made from letters (both cases),
2286 as well as the non-letters within 0100...0137. */
2287 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2288 return (c
& (037 | ~0177));
2289 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2290 return (c
& (037 | ~0177));
2292 return c
| ctrl_modifier
;
2302 /* An octal escape, as in ANSI C. */
2304 register int i
= c
- '0';
2305 register int count
= 0;
2308 if ((c
= READCHAR
) >= '0' && c
<= '7')
2320 if (i
>= 0x80 && i
< 0x100)
2321 i
= BYTE8_TO_CHAR (i
);
2326 /* A hex escape, as in ANSI C. */
2333 if (c
>= '0' && c
<= '9')
2338 else if ((c
>= 'a' && c
<= 'f')
2339 || (c
>= 'A' && c
<= 'F'))
2342 if (c
>= 'a' && c
<= 'f')
2352 /* Allow hex escapes as large as ?\xfffffff, because some
2353 packages use them to denote characters with modifiers. */
2354 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2355 error ("Hex character out of range: \\x%x...", i
);
2359 if (count
< 3 && i
>= 0x80)
2360 return BYTE8_TO_CHAR (i
);
2365 /* Post-Unicode-2.0: Up to eight hex chars. */
2366 unicode_hex_count
= 8;
2369 /* A Unicode escape. We only permit them in strings and characters,
2370 not arbitrarily in the source code, as in some other languages. */
2375 while (++count
<= unicode_hex_count
)
2378 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2380 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2381 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2382 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2384 error ("Non-hex digit used for Unicode escape");
2387 error ("Non-Unicode character: 0x%x", i
);
2396 /* Return the digit that CHARACTER stands for in the given BASE.
2397 Return -1 if CHARACTER is out of range for BASE,
2398 and -2 if CHARACTER is not valid for any supported BASE. */
2400 digit_to_number (int character
, int base
)
2404 if ('0' <= character
&& character
<= '9')
2405 digit
= character
- '0';
2406 else if ('a' <= character
&& character
<= 'z')
2407 digit
= character
- 'a' + 10;
2408 else if ('A' <= character
&& character
<= 'Z')
2409 digit
= character
- 'A' + 10;
2413 return digit
< base
? digit
: -1;
2416 /* Read an integer in radix RADIX using READCHARFUN to read
2417 characters. RADIX must be in the interval [2..36]; if it isn't, a
2418 read error is signaled . Value is the integer read. Signals an
2419 error if encountering invalid read syntax or if RADIX is out of
2423 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2425 /* Room for sign, leading 0, other digits, trailing null byte.
2426 Also, room for invalid syntax diagnostic. */
2427 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2428 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2430 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2432 if (radix
< 2 || radix
> 36)
2440 if (c
== '-' || c
== '+')
2451 /* Ignore redundant leading zeros, so the buffer doesn't
2452 fill up with them. */
2458 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2465 if (p
< buf
+ sizeof buf
- 1)
2479 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2480 invalid_syntax (buf
);
2483 return string_to_number (buf
, radix
, 0);
2487 /* If the next token is ')' or ']' or '.', we store that character
2488 in *PCH and the return value is not interesting. Else, we store
2489 zero in *PCH and we read and return one lisp object.
2491 FIRST_IN_LIST is true if this is the first element of a list. */
2494 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2497 bool uninterned_symbol
= 0;
2504 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2506 end_of_file_error ();
2511 return read_list (0, readcharfun
);
2514 return read_vector (readcharfun
, 0);
2530 /* Accept extended format for hashtables (extensible to
2532 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2533 Lisp_Object tmp
= read_list (0, readcharfun
);
2534 Lisp_Object head
= CAR_SAFE (tmp
);
2535 Lisp_Object data
= Qnil
;
2536 Lisp_Object val
= Qnil
;
2537 /* The size is 2 * number of allowed keywords to
2539 Lisp_Object params
[10];
2541 Lisp_Object key
= Qnil
;
2542 int param_count
= 0;
2544 if (!EQ (head
, Qhash_table
))
2545 error ("Invalid extended read marker at head of #s list "
2546 "(only hash-table allowed)");
2548 tmp
= CDR_SAFE (tmp
);
2550 /* This is repetitive but fast and simple. */
2551 params
[param_count
] = QCsize
;
2552 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2553 if (!NILP (params
[param_count
+ 1]))
2556 params
[param_count
] = QCtest
;
2557 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2558 if (!NILP (params
[param_count
+ 1]))
2561 params
[param_count
] = QCweakness
;
2562 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2563 if (!NILP (params
[param_count
+ 1]))
2566 params
[param_count
] = QCrehash_size
;
2567 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2568 if (!NILP (params
[param_count
+ 1]))
2571 params
[param_count
] = QCrehash_threshold
;
2572 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2573 if (!NILP (params
[param_count
+ 1]))
2576 /* This is the hashtable data. */
2577 data
= Fplist_get (tmp
, Qdata
);
2579 /* Now use params to make a new hashtable and fill it. */
2580 ht
= Fmake_hash_table (param_count
, params
);
2582 while (CONSP (data
))
2587 error ("Odd number of elements in hashtable data");
2590 Fputhash (key
, val
, ht
);
2596 invalid_syntax ("#");
2604 tmp
= read_vector (readcharfun
, 0);
2605 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2606 error ("Invalid size char-table");
2607 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2619 tmp
= read_vector (readcharfun
, 0);
2622 error ("Invalid size char-table");
2623 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2624 error ("Invalid depth in char-table");
2625 depth
= XINT (AREF (tmp
, 0));
2626 if (chartab_size
[depth
] != size
- 2)
2627 error ("Invalid size char-table");
2628 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2631 invalid_syntax ("#^" "^");
2633 invalid_syntax ("#^");
2638 length
= read1 (readcharfun
, pch
, first_in_list
);
2642 Lisp_Object tmp
, val
;
2643 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2644 unsigned char *data
;
2647 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2648 if (STRING_MULTIBYTE (tmp
)
2649 || (size_in_chars
!= SCHARS (tmp
)
2650 /* We used to print 1 char too many
2651 when the number of bits was a multiple of 8.
2652 Accept such input in case it came from an old
2654 && ! (XFASTINT (length
)
2655 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2656 invalid_syntax ("#&...");
2658 val
= make_uninit_bool_vector (XFASTINT (length
));
2659 data
= bool_vector_uchar_data (val
);
2660 memcpy (data
, SDATA (tmp
), size_in_chars
);
2661 /* Clear the extraneous bits in the last byte. */
2662 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2663 data
[size_in_chars
- 1]
2664 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2667 invalid_syntax ("#&...");
2671 /* Accept compiled functions at read-time so that we don't have to
2672 build them using function calls. */
2674 struct Lisp_Vector
*vec
;
2675 tmp
= read_vector (readcharfun
, 1);
2676 vec
= XVECTOR (tmp
);
2677 if (vec
->header
.size
== 0)
2678 invalid_syntax ("Empty byte-code object");
2679 make_byte_code (vec
);
2685 struct gcpro gcpro1
;
2688 /* Read the string itself. */
2689 tmp
= read1 (readcharfun
, &ch
, 0);
2690 if (ch
!= 0 || !STRINGP (tmp
))
2691 invalid_syntax ("#");
2693 /* Read the intervals and their properties. */
2696 Lisp_Object beg
, end
, plist
;
2698 beg
= read1 (readcharfun
, &ch
, 0);
2703 end
= read1 (readcharfun
, &ch
, 0);
2705 plist
= read1 (readcharfun
, &ch
, 0);
2707 invalid_syntax ("Invalid string property list");
2708 Fset_text_properties (beg
, end
, plist
, tmp
);
2714 /* #@NUMBER is used to skip NUMBER following bytes.
2715 That's used in .elc files to skip over doc strings
2716 and function definitions. */
2719 enum { extra
= 100 };
2720 ptrdiff_t i
, nskip
= 0, digits
= 0;
2722 /* Read a decimal integer. */
2723 while ((c
= READCHAR
) >= 0
2724 && c
>= '0' && c
<= '9')
2726 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2731 if (digits
== 2 && nskip
== 0)
2732 { /* We've just seen #@00, which means "skip to end". */
2733 skip_dyn_eof (readcharfun
);
2738 /* We can't use UNREAD here, because in the code below we side-step
2739 READCHAR. Instead, assume the first char after #@NNN occupies
2740 a single byte, which is the case normally since it's just
2746 if (load_force_doc_strings
2747 && (FROM_FILE_P (readcharfun
)))
2749 /* If we are supposed to force doc strings into core right now,
2750 record the last string that we skipped,
2751 and record where in the file it comes from. */
2753 /* But first exchange saved_doc_string
2754 with prev_saved_doc_string, so we save two strings. */
2756 char *temp
= saved_doc_string
;
2757 ptrdiff_t temp_size
= saved_doc_string_size
;
2758 file_offset temp_pos
= saved_doc_string_position
;
2759 ptrdiff_t temp_len
= saved_doc_string_length
;
2761 saved_doc_string
= prev_saved_doc_string
;
2762 saved_doc_string_size
= prev_saved_doc_string_size
;
2763 saved_doc_string_position
= prev_saved_doc_string_position
;
2764 saved_doc_string_length
= prev_saved_doc_string_length
;
2766 prev_saved_doc_string
= temp
;
2767 prev_saved_doc_string_size
= temp_size
;
2768 prev_saved_doc_string_position
= temp_pos
;
2769 prev_saved_doc_string_length
= temp_len
;
2772 if (saved_doc_string_size
== 0)
2774 saved_doc_string
= xmalloc_atomic (nskip
+ extra
);
2775 saved_doc_string_size
= nskip
+ extra
;
2777 if (nskip
> saved_doc_string_size
)
2779 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2780 saved_doc_string_size
= nskip
+ extra
;
2783 saved_doc_string_position
= file_tell (instream
);
2785 /* Copy that many characters into saved_doc_string. */
2787 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2788 saved_doc_string
[i
] = c
= getc (instream
);
2791 saved_doc_string_length
= i
;
2794 /* Skip that many bytes. */
2795 skip_dyn_bytes (readcharfun
, nskip
);
2801 /* #! appears at the beginning of an executable file.
2802 Skip the first line. */
2803 while (c
!= '\n' && c
>= 0)
2808 return Vload_file_name
;
2810 return list2 (Qfunction
, read0 (readcharfun
));
2811 /* #:foo is the uninterned symbol named foo. */
2814 uninterned_symbol
= 1;
2817 && c
!= 0xa0 /* NBSP */
2819 || strchr ("\"';()[]#`,", c
) == NULL
)))
2821 /* No symbol character follows, this is the empty
2824 return Fmake_symbol (empty_unibyte_string
);
2828 /* ## is the empty symbol. */
2830 return Fintern (empty_unibyte_string
, Qnil
);
2831 /* Reader forms that can reuse previously read objects. */
2832 if (c
>= '0' && c
<= '9')
2837 /* Read a non-negative integer. */
2838 while (c
>= '0' && c
<= '9')
2840 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2841 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2842 n
= MOST_POSITIVE_FIXNUM
+ 1;
2844 n
= n
* 10 + c
- '0';
2848 if (n
<= MOST_POSITIVE_FIXNUM
)
2850 if (c
== 'r' || c
== 'R')
2851 return read_integer (readcharfun
, n
);
2853 if (! NILP (Vread_circle
))
2855 /* #n=object returns object, but associates it with
2859 /* Make a placeholder for #n# to use temporarily. */
2860 Lisp_Object placeholder
;
2863 placeholder
= Fcons (Qnil
, Qnil
);
2864 cell
= Fcons (make_number (n
), placeholder
);
2865 read_objects
= Fcons (cell
, read_objects
);
2867 /* Read the object itself. */
2868 tem
= read0 (readcharfun
);
2870 /* Now put it everywhere the placeholder was... */
2871 substitute_object_in_subtree (tem
, placeholder
);
2873 /* ...and #n# will use the real value from now on. */
2874 Fsetcdr (cell
, tem
);
2879 /* #n# returns a previously read object. */
2882 tem
= Fassq (make_number (n
), read_objects
);
2888 /* Fall through to error message. */
2890 else if (c
== 'x' || c
== 'X')
2891 return read_integer (readcharfun
, 16);
2892 else if (c
== 'o' || c
== 'O')
2893 return read_integer (readcharfun
, 8);
2894 else if (c
== 'b' || c
== 'B')
2895 return read_integer (readcharfun
, 2);
2898 invalid_syntax ("#");
2901 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2905 return list2 (Qquote
, read0 (readcharfun
));
2909 int next_char
= READCHAR
;
2911 /* Transition from old-style to new-style:
2912 If we see "(`" it used to mean old-style, which usually works
2913 fine because ` should almost never appear in such a position
2914 for new-style. But occasionally we need "(`" to mean new
2915 style, so we try to distinguish the two by the fact that we
2916 can either write "( `foo" or "(` foo", where the first
2917 intends to use new-style whereas the second intends to use
2918 old-style. For Emacs-25, we should completely remove this
2919 first_in_list exception (old-style can still be obtained via
2921 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2923 Vold_style_backquotes
= Qt
;
2929 bool saved_new_backquote_flag
= new_backquote_flag
;
2931 new_backquote_flag
= 1;
2932 value
= read0 (readcharfun
);
2933 new_backquote_flag
= saved_new_backquote_flag
;
2935 return list2 (Qbackquote
, value
);
2940 int next_char
= READCHAR
;
2942 /* Transition from old-style to new-style:
2943 It used to be impossible to have a new-style , other than within
2944 a new-style `. This is sufficient when ` and , are used in the
2945 normal way, but ` and , can also appear in args to macros that
2946 will not interpret them in the usual way, in which case , may be
2947 used without any ` anywhere near.
2948 So we now use the same heuristic as for backquote: old-style
2949 unquotes are only recognized when first on a list, and when
2950 followed by a space.
2951 Because it's more difficult to peek 2 chars ahead, a new-style
2952 ,@ can still not be used outside of a `, unless it's in the middle
2954 if (new_backquote_flag
2956 || (next_char
!= ' ' && next_char
!= '@'))
2958 Lisp_Object comma_type
= Qnil
;
2963 comma_type
= Qcomma_at
;
2965 comma_type
= Qcomma_dot
;
2968 if (ch
>= 0) UNREAD (ch
);
2969 comma_type
= Qcomma
;
2972 value
= read0 (readcharfun
);
2973 return list2 (comma_type
, value
);
2977 Vold_style_backquotes
= Qt
;
2989 end_of_file_error ();
2991 /* Accept `single space' syntax like (list ? x) where the
2992 whitespace character is SPC or TAB.
2993 Other literal whitespace like NL, CR, and FF are not accepted,
2994 as there are well-established escape sequences for these. */
2995 if (c
== ' ' || c
== '\t')
2996 return make_number (c
);
2999 c
= read_escape (readcharfun
, 0);
3000 modifiers
= c
& CHAR_MODIFIER_MASK
;
3001 c
&= ~CHAR_MODIFIER_MASK
;
3002 if (CHAR_BYTE8_P (c
))
3003 c
= CHAR_TO_BYTE8 (c
);
3006 next_char
= READCHAR
;
3007 ok
= (next_char
<= 040
3008 || (next_char
< 0200
3009 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3012 return make_number (c
);
3014 invalid_syntax ("?");
3019 char *p
= read_buffer
;
3020 char *end
= read_buffer
+ read_buffer_size
;
3022 /* True if we saw an escape sequence specifying
3023 a multibyte character. */
3024 bool force_multibyte
= 0;
3025 /* True if we saw an escape sequence specifying
3026 a single-byte character. */
3027 bool force_singlebyte
= 0;
3029 ptrdiff_t nchars
= 0;
3031 while ((ch
= READCHAR
) >= 0
3034 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3036 ptrdiff_t offset
= p
- read_buffer
;
3037 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3038 memory_full (SIZE_MAX
);
3039 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3040 read_buffer_size
*= 2;
3041 p
= read_buffer
+ offset
;
3042 end
= read_buffer
+ read_buffer_size
;
3049 ch
= read_escape (readcharfun
, 1);
3051 /* CH is -1 if \ newline has just been seen. */
3054 if (p
== read_buffer
)
3059 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3060 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3062 if (CHAR_BYTE8_P (ch
))
3063 force_singlebyte
= 1;
3064 else if (! ASCII_CHAR_P (ch
))
3065 force_multibyte
= 1;
3066 else /* I.e. ASCII_CHAR_P (ch). */
3068 /* Allow `\C- ' and `\C-?'. */
3069 if (modifiers
== CHAR_CTL
)
3072 ch
= 0, modifiers
= 0;
3074 ch
= 127, modifiers
= 0;
3076 if (modifiers
& CHAR_SHIFT
)
3078 /* Shift modifier is valid only with [A-Za-z]. */
3079 if (ch
>= 'A' && ch
<= 'Z')
3080 modifiers
&= ~CHAR_SHIFT
;
3081 else if (ch
>= 'a' && ch
<= 'z')
3082 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3085 if (modifiers
& CHAR_META
)
3087 /* Move the meta bit to the right place for a
3089 modifiers
&= ~CHAR_META
;
3090 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3091 force_singlebyte
= 1;
3095 /* Any modifiers remaining are invalid. */
3097 error ("Invalid modifier in string");
3098 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3102 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3103 if (CHAR_BYTE8_P (ch
))
3104 force_singlebyte
= 1;
3105 else if (! ASCII_CHAR_P (ch
))
3106 force_multibyte
= 1;
3112 end_of_file_error ();
3114 /* If purifying, and string starts with \ newline,
3115 return zero instead. This is for doc strings
3116 that we are really going to find in etc/DOC.nn.nn. */
3117 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3118 return make_number (0);
3120 if (! force_multibyte
&& force_singlebyte
)
3122 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3123 forms. Convert it to unibyte. */
3124 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3126 p
= read_buffer
+ nchars
;
3129 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3131 || (p
- read_buffer
!= nchars
)));
3136 int next_char
= READCHAR
;
3139 if (next_char
<= 040
3140 || (next_char
< 0200
3141 && strchr ("\"';([#?`,", next_char
) != NULL
))
3147 /* Otherwise, we fall through! Note that the atom-reading loop
3148 below will now loop at least once, assuring that we will not
3149 try to UNREAD two characters in a row. */
3153 if (c
<= 040) goto retry
;
3154 if (c
== 0xa0) /* NBSP */
3159 char *p
= read_buffer
;
3161 EMACS_INT start_position
= readchar_count
- 1;
3164 char *end
= read_buffer
+ read_buffer_size
;
3168 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3170 ptrdiff_t offset
= p
- read_buffer
;
3171 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3172 memory_full (SIZE_MAX
);
3173 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3174 read_buffer_size
*= 2;
3175 p
= read_buffer
+ offset
;
3176 end
= read_buffer
+ read_buffer_size
;
3183 end_of_file_error ();
3188 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3194 && c
!= 0xa0 /* NBSP */
3196 || strchr ("\"';()[]#`,", c
) == NULL
));
3200 ptrdiff_t offset
= p
- read_buffer
;
3201 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3202 memory_full (SIZE_MAX
);
3203 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3204 read_buffer_size
*= 2;
3205 p
= read_buffer
+ offset
;
3206 end
= read_buffer
+ read_buffer_size
;
3212 if (!quoted
&& !uninterned_symbol
)
3214 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3215 if (! NILP (result
))
3219 Lisp_Object name
, result
;
3220 ptrdiff_t nbytes
= p
- read_buffer
;
3223 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3227 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3228 ? make_pure_string
: make_specified_string
)
3229 (read_buffer
, nchars
, nbytes
, multibyte
));
3230 result
= (uninterned_symbol
? Fmake_symbol (name
)
3231 : Fintern (name
, Qnil
));
3233 if (EQ (Vread_with_symbol_positions
, Qt
)
3234 || EQ (Vread_with_symbol_positions
, readcharfun
))
3235 Vread_symbol_positions_list
3236 = Fcons (Fcons (result
, make_number (start_position
)),
3237 Vread_symbol_positions_list
);
3245 /* List of nodes we've seen during substitute_object_in_subtree. */
3246 static Lisp_Object seen_list
;
3249 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3251 Lisp_Object check_object
;
3253 /* We haven't seen any objects when we start. */
3256 /* Make all the substitutions. */
3258 = substitute_object_recurse (object
, placeholder
, object
);
3260 /* Clear seen_list because we're done with it. */
3263 /* The returned object here is expected to always eq the
3265 if (!EQ (check_object
, object
))
3266 error ("Unexpected mutation error in reader");
3269 /* Feval doesn't get called from here, so no gc protection is needed. */
3270 #define SUBSTITUTE(get_val, set_val) \
3272 Lisp_Object old_value = get_val; \
3273 Lisp_Object true_value \
3274 = substitute_object_recurse (object, placeholder, \
3277 if (!EQ (old_value, true_value)) \
3284 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3286 /* If we find the placeholder, return the target object. */
3287 if (EQ (placeholder
, subtree
))
3290 /* If we've been to this node before, don't explore it again. */
3291 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3294 /* If this node can be the entry point to a cycle, remember that
3295 we've seen it. It can only be such an entry point if it was made
3296 by #n=, which means that we can find it as a value in
3298 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3299 seen_list
= Fcons (subtree
, seen_list
);
3301 /* Recurse according to subtree's type.
3302 Every branch must return a Lisp_Object. */
3303 if (VECTORLIKEP (subtree
))
3305 ptrdiff_t i
, length
= 0;
3306 if (BOOL_VECTOR_P (subtree
))
3307 return subtree
; /* No sub-objects anyway. */
3308 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3309 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3310 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3311 else if (VECTORP (subtree
))
3312 length
= ASIZE (subtree
);
3314 /* An unknown pseudovector may contain non-Lisp fields, so we
3315 can't just blindly traverse all its fields. We used to call
3316 `Flength' which signaled `sequencep', so I just preserved this
3318 wrong_type_argument (Qsequencep
, subtree
);
3320 for (i
= 0; i
< length
; i
++)
3321 SUBSTITUTE (AREF (subtree
, i
),
3322 ASET (subtree
, i
, true_value
));
3325 else if (CONSP (subtree
))
3327 SUBSTITUTE (XCAR (subtree
),
3328 XSETCAR (subtree
, true_value
));
3329 SUBSTITUTE (XCDR (subtree
),
3330 XSETCDR (subtree
, true_value
));
3333 else if (STRINGP (subtree
))
3335 /* Check for text properties in each interval.
3336 substitute_in_interval contains part of the logic. */
3338 INTERVAL root_interval
= string_intervals (subtree
);
3339 Lisp_Object arg
= Fcons (object
, placeholder
);
3341 traverse_intervals_noorder (root_interval
,
3342 &substitute_in_interval
, arg
);
3347 /* Other types don't recurse any further. */
3351 /* Helper function for substitute_object_recurse. */
3353 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3355 Lisp_Object object
= Fcar (arg
);
3356 Lisp_Object placeholder
= Fcdr (arg
);
3358 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3368 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3369 integer syntax and fits in a fixnum, else return the nearest float if CP has
3370 either floating point or integer syntax and BASE is 10, else return nil. If
3371 IGNORE_TRAILING, consider just the longest prefix of CP that has
3372 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3373 number has integer syntax but does not fit. */
3376 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3379 char const *cp
= string
;
3381 bool float_syntax
= 0;
3384 /* Compute NaN and infinities using a variable, to cope with compilers that
3385 think they are smarter than we are. */
3388 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3389 IEEE floating point hosts, and works around a formerly-common bug where
3390 atof ("-0.0") drops the sign. */
3391 bool negative
= *cp
== '-';
3393 bool signedp
= negative
|| *cp
== '+';
3398 leading_digit
= digit_to_number (*cp
, base
);
3399 if (leading_digit
>= 0)
3404 while (digit_to_number (*cp
, base
) >= 0);
3414 if ('0' <= *cp
&& *cp
<= '9')
3419 while ('0' <= *cp
&& *cp
<= '9');
3421 if (*cp
== 'e' || *cp
== 'E')
3423 char const *ecp
= cp
;
3425 if (*cp
== '+' || *cp
== '-')
3427 if ('0' <= *cp
&& *cp
<= '9')
3432 while ('0' <= *cp
&& *cp
<= '9');
3434 else if (cp
[-1] == '+'
3435 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3441 else if (cp
[-1] == '+'
3442 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3446 value
= zero
/ zero
;
3448 /* If that made a "negative" NaN, negate it. */
3451 union { double d
; char c
[sizeof (double)]; }
3452 u_data
, u_minus_zero
;
3454 u_minus_zero
.d
= -0.0;
3455 for (i
= 0; i
< sizeof (double); i
++)
3456 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3462 /* Now VALUE is a positive NaN. */
3468 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3469 || state
== (LEAD_INT
|E_EXP
));
3472 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3473 any prefix that matches. Otherwise, the entire string must match. */
3474 if (! (ignore_trailing
3475 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3476 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3479 /* If the number uses integer and not float syntax, and is in C-language
3480 range, use its value, preferably as a fixnum. */
3481 if (leading_digit
>= 0 && ! float_syntax
)
3485 /* Fast special case for single-digit integers. This also avoids a
3486 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3487 case some versions of strtoumax accept numbers like "0x1" that Emacs
3489 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3490 return make_number (negative
? -leading_digit
: leading_digit
);
3493 n
= strtoumax (string
+ signedp
, NULL
, base
);
3494 if (errno
== ERANGE
)
3496 /* Unfortunately there's no simple and accurate way to convert
3497 non-base-10 numbers that are out of C-language range. */
3499 xsignal1 (Qoverflow_error
, build_string (string
));
3501 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3503 EMACS_INT signed_n
= n
;
3504 return make_number (negative
? -signed_n
: signed_n
);
3510 /* Either the number uses float syntax, or it does not fit into a fixnum.
3511 Convert it from string to floating point, unless the value is already
3512 known because it is an infinity, a NAN, or its absolute value fits in
3515 value
= atof (string
+ signedp
);
3517 return make_float (negative
? -value
: value
);
3522 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3526 Lisp_Object tem
, item
, vector
;
3529 tem
= read_list (1, readcharfun
);
3530 len
= Flength (tem
);
3531 vector
= Fmake_vector (len
, Qnil
);
3533 size
= ASIZE (vector
);
3534 ptr
= XVECTOR (vector
)->contents
;
3535 for (i
= 0; i
< size
; i
++)
3538 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3539 bytecode object, the docstring containing the bytecode and
3540 constants values must be treated as unibyte and passed to
3541 Fread, to get the actual bytecode string and constants vector. */
3542 if (bytecodeflag
&& load_force_doc_strings
)
3544 if (i
== COMPILED_BYTECODE
)
3546 if (!STRINGP (item
))
3547 error ("Invalid byte code");
3549 /* Delay handling the bytecode slot until we know whether
3550 it is lazily-loaded (we can tell by whether the
3551 constants slot is nil). */
3552 ASET (vector
, COMPILED_CONSTANTS
, item
);
3555 else if (i
== COMPILED_CONSTANTS
)
3557 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3561 /* Coerce string to unibyte (like string-as-unibyte,
3562 but without generating extra garbage and
3563 guaranteeing no change in the contents). */
3564 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3565 STRING_SET_UNIBYTE (bytestr
);
3567 item
= Fread (Fcons (bytestr
, readcharfun
));
3569 error ("Invalid byte code");
3571 bytestr
= XCAR (item
);
3575 /* Now handle the bytecode slot. */
3576 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3578 else if (i
== COMPILED_DOC_STRING
3580 && ! STRING_MULTIBYTE (item
))
3582 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3583 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3585 item
= Fstring_as_multibyte (item
);
3588 ASET (vector
, i
, item
);
3594 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3597 read_list (bool flag
, Lisp_Object readcharfun
)
3599 Lisp_Object val
, tail
;
3600 Lisp_Object elt
, tem
;
3601 struct gcpro gcpro1
, gcpro2
;
3602 /* 0 is the normal case.
3603 1 means this list is a doc reference; replace it with the number 0.
3604 2 means this list is a doc reference; replace it with the doc string. */
3605 int doc_reference
= 0;
3607 /* Initialize this to 1 if we are reading a list. */
3608 bool first_in_list
= flag
<= 0;
3617 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3622 /* While building, if the list starts with #$, treat it specially. */
3623 if (EQ (elt
, Vload_file_name
)
3625 && !NILP (Vpurify_flag
))
3627 if (NILP (Vdoc_file_name
))
3628 /* We have not yet called Snarf-documentation, so assume
3629 this file is described in the DOC file
3630 and Snarf-documentation will fill in the right value later.
3631 For now, replace the whole list with 0. */
3634 /* We have already called Snarf-documentation, so make a relative
3635 file name for this file, so it can be found properly
3636 in the installed Lisp directory.
3637 We don't use Fexpand_file_name because that would make
3638 the directory absolute now. */
3639 elt
= concat2 (build_string ("../lisp/"),
3640 Ffile_name_nondirectory (elt
));
3642 else if (EQ (elt
, Vload_file_name
)
3644 && load_force_doc_strings
)
3653 invalid_syntax (") or . in a vector");
3661 XSETCDR (tail
, read0 (readcharfun
));
3663 val
= read0 (readcharfun
);
3664 read1 (readcharfun
, &ch
, 0);
3668 if (doc_reference
== 1)
3669 return make_number (0);
3670 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3673 file_offset saved_position
;
3674 /* Get a doc string from the file we are loading.
3675 If it's in saved_doc_string, get it from there.
3677 Here, we don't know if the string is a
3678 bytecode string or a doc string. As a
3679 bytecode string must be unibyte, we always
3680 return a unibyte string. If it is actually a
3681 doc string, caller must make it
3684 /* Position is negative for user variables. */
3685 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3686 if (pos
>= saved_doc_string_position
3687 && pos
< (saved_doc_string_position
3688 + saved_doc_string_length
))
3690 saved
= saved_doc_string
;
3691 saved_position
= saved_doc_string_position
;
3693 /* Look in prev_saved_doc_string the same way. */
3694 else if (pos
>= prev_saved_doc_string_position
3695 && pos
< (prev_saved_doc_string_position
3696 + prev_saved_doc_string_length
))
3698 saved
= prev_saved_doc_string
;
3699 saved_position
= prev_saved_doc_string_position
;
3703 ptrdiff_t start
= pos
- saved_position
;
3706 /* Process quoting with ^A,
3707 and find the end of the string,
3708 which is marked with ^_ (037). */
3709 for (from
= start
, to
= start
;
3710 saved
[from
] != 037;)
3712 int c
= saved
[from
++];
3716 saved
[to
++] = (c
== 1 ? c
3725 return make_unibyte_string (saved
+ start
,
3729 return get_doc_string (val
, 1, 0);
3734 invalid_syntax (". in wrong context");
3736 invalid_syntax ("] in a list");
3740 XSETCDR (tail
, tem
);
3747 static Lisp_Object initial_obarray
;
3749 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3751 static size_t oblookup_last_bucket_number
;
3753 /* Get an error if OBARRAY is not an obarray.
3754 If it is one, return it. */
3757 check_obarray (Lisp_Object obarray
)
3759 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3761 /* If Vobarray is now invalid, force it to be valid. */
3762 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3763 wrong_type_argument (Qvectorp
, obarray
);
3768 /* Intern the C string STR: return a symbol with that name,
3769 interned in the current obarray. */
3772 intern_1 (const char *str
, ptrdiff_t len
)
3774 Lisp_Object obarray
= check_obarray (Vobarray
);
3775 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3777 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3781 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3783 Lisp_Object obarray
= check_obarray (Vobarray
);
3784 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3789 if (NILP (Vpurify_flag
))
3790 /* Creating a non-pure string from a string literal not
3791 implemented yet. We could just use make_string here and live
3792 with the extra copy. */
3795 return Fintern (make_pure_c_string (str
, len
), obarray
);
3798 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3799 doc
: /* Return the canonical symbol whose name is STRING.
3800 If there is none, one is created by this function and returned.
3801 A second optional argument specifies the obarray to use;
3802 it defaults to the value of `obarray'. */)
3803 (Lisp_Object string
, Lisp_Object obarray
)
3805 register Lisp_Object tem
, sym
, *ptr
;
3807 if (NILP (obarray
)) obarray
= Vobarray
;
3808 obarray
= check_obarray (obarray
);
3810 CHECK_STRING (string
);
3812 tem
= oblookup (obarray
, SSDATA (string
),
3815 if (!INTEGERP (tem
))
3818 if (!NILP (Vpurify_flag
))
3819 string
= Fpurecopy (string
);
3820 sym
= Fmake_symbol (string
);
3822 if (EQ (obarray
, initial_obarray
))
3823 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3825 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3827 if ((SREF (string
, 0) == ':')
3828 && EQ (obarray
, initial_obarray
))
3830 XSYMBOL (sym
)->constant
= 1;
3831 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3832 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3835 ptr
= aref_addr (obarray
, XINT (tem
));
3837 set_symbol_next (sym
, XSYMBOL (*ptr
));
3839 set_symbol_next (sym
, NULL
);
3844 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3845 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3846 NAME may be a string or a symbol. If it is a symbol, that exact
3847 symbol is searched for.
3848 A second optional argument specifies the obarray to use;
3849 it defaults to the value of `obarray'. */)
3850 (Lisp_Object name
, Lisp_Object obarray
)
3852 register Lisp_Object tem
, string
;
3854 if (NILP (obarray
)) obarray
= Vobarray
;
3855 obarray
= check_obarray (obarray
);
3857 if (!SYMBOLP (name
))
3859 CHECK_STRING (name
);
3863 string
= SYMBOL_NAME (name
);
3865 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3866 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3872 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3873 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3874 The value is t if a symbol was found and deleted, nil otherwise.
3875 NAME may be a string or a symbol. If it is a symbol, that symbol
3876 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3877 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3878 usage: (unintern NAME OBARRAY) */)
3879 (Lisp_Object name
, Lisp_Object obarray
)
3881 register Lisp_Object string
, tem
;
3884 if (NILP (obarray
)) obarray
= Vobarray
;
3885 obarray
= check_obarray (obarray
);
3888 string
= SYMBOL_NAME (name
);
3891 CHECK_STRING (name
);
3895 tem
= oblookup (obarray
, SSDATA (string
),
3900 /* If arg was a symbol, don't delete anything but that symbol itself. */
3901 if (SYMBOLP (name
) && !EQ (name
, tem
))
3904 /* There are plenty of other symbols which will screw up the Emacs
3905 session if we unintern them, as well as even more ways to use
3906 `setq' or `fset' or whatnot to make the Emacs session
3907 unusable. Let's not go down this silly road. --Stef */
3908 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3909 error ("Attempt to unintern t or nil"); */
3911 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3913 hash
= oblookup_last_bucket_number
;
3915 if (EQ (AREF (obarray
, hash
), tem
))
3917 if (XSYMBOL (tem
)->next
)
3920 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3921 ASET (obarray
, hash
, sym
);
3924 ASET (obarray
, hash
, make_number (0));
3928 Lisp_Object tail
, following
;
3930 for (tail
= AREF (obarray
, hash
);
3931 XSYMBOL (tail
)->next
;
3934 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3935 if (EQ (following
, tem
))
3937 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3946 /* Return the symbol in OBARRAY whose names matches the string
3947 of SIZE characters (SIZE_BYTE bytes) at PTR.
3948 If there is no such symbol, return the integer bucket number of
3949 where the symbol would be if it were present.
3951 Also store the bucket number in oblookup_last_bucket_number. */
3954 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3958 register Lisp_Object tail
;
3959 Lisp_Object bucket
, tem
;
3961 obarray
= check_obarray (obarray
);
3962 obsize
= ASIZE (obarray
);
3963 hash
= hash_string (ptr
, size_byte
) % obsize
;
3964 bucket
= AREF (obarray
, hash
);
3965 oblookup_last_bucket_number
= hash
;
3966 if (EQ (bucket
, make_number (0)))
3968 else if (!SYMBOLP (bucket
))
3969 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3971 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3973 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3974 && SCHARS (SYMBOL_NAME (tail
)) == size
3975 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3977 else if (XSYMBOL (tail
)->next
== 0)
3980 XSETINT (tem
, hash
);
3985 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3988 register Lisp_Object tail
;
3989 CHECK_VECTOR (obarray
);
3990 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3992 tail
= AREF (obarray
, i
);
3997 if (XSYMBOL (tail
)->next
== 0)
3999 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4005 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4007 call1 (function
, sym
);
4010 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4011 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4012 OBARRAY defaults to the value of `obarray'. */)
4013 (Lisp_Object function
, Lisp_Object obarray
)
4015 if (NILP (obarray
)) obarray
= Vobarray
;
4016 obarray
= check_obarray (obarray
);
4018 map_obarray (obarray
, mapatoms_1
, function
);
4022 #define OBARRAY_SIZE 1511
4027 Lisp_Object oblength
;
4028 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4030 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4032 Vobarray
= Fmake_vector (oblength
, make_number (0));
4033 initial_obarray
= Vobarray
;
4034 staticpro (&initial_obarray
);
4036 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
4037 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
4038 NILP (Vpurify_flag) check in intern_c_string. */
4039 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
4040 Qnil
= intern_c_string ("nil");
4042 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
4043 so those two need to be fixed manually. */
4044 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
4045 set_symbol_function (Qunbound
, Qnil
);
4046 set_symbol_plist (Qunbound
, Qnil
);
4047 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4048 XSYMBOL (Qnil
)->constant
= 1;
4049 XSYMBOL (Qnil
)->declared_special
= 1;
4050 set_symbol_plist (Qnil
, Qnil
);
4051 set_symbol_function (Qnil
, Qnil
);
4053 Qt
= intern_c_string ("t");
4054 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4055 XSYMBOL (Qnil
)->declared_special
= 1;
4056 XSYMBOL (Qt
)->constant
= 1;
4058 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4061 DEFSYM (Qvariable_documentation
, "variable-documentation");
4063 read_buffer
= xmalloc_atomic (size
);
4064 read_buffer_size
= size
;
4068 defsubr (struct Lisp_Subr
*sname
)
4070 Lisp_Object sym
, tem
;
4071 sym
= intern_c_string (sname
->symbol_name
);
4072 SCM_NEWSMOB (sname
->header
.self
, lisp_vectorlike_tag
, sname
);
4073 XSETPVECTYPE (sname
, PVEC_SUBR
);
4074 XSETSUBR (tem
, sname
);
4075 set_symbol_function (sym
, tem
);
4078 /* Define an "integer variable"; a symbol whose value is forwarded to a
4079 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4080 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4082 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4083 const char *namestring
, EMACS_INT
*address
)
4086 sym
= intern_c_string (namestring
);
4087 i_fwd
->type
= Lisp_Fwd_Int
;
4088 i_fwd
->intvar
= address
;
4089 XSYMBOL (sym
)->declared_special
= 1;
4090 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4091 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4094 /* Similar but define a variable whose value is t if address contains 1,
4095 nil if address contains 0. */
4097 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4098 const char *namestring
, bool *address
)
4101 sym
= intern_c_string (namestring
);
4102 b_fwd
->type
= Lisp_Fwd_Bool
;
4103 b_fwd
->boolvar
= address
;
4104 XSYMBOL (sym
)->declared_special
= 1;
4105 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4106 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4107 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4110 /* Similar but define a variable whose value is the Lisp Object stored
4111 at address. Two versions: with and without gc-marking of the C
4112 variable. The nopro version is used when that variable will be
4113 gc-marked for some other reason, since marking the same slot twice
4114 can cause trouble with strings. */
4116 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4117 const char *namestring
, Lisp_Object
*address
)
4120 sym
= intern_c_string (namestring
);
4121 o_fwd
->type
= Lisp_Fwd_Obj
;
4122 o_fwd
->objvar
= address
;
4123 XSYMBOL (sym
)->declared_special
= 1;
4124 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4125 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4129 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4130 const char *namestring
, Lisp_Object
*address
)
4132 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4133 staticpro (address
);
4136 /* Similar but define a variable whose value is the Lisp Object stored
4137 at a particular offset in the current kboard object. */
4140 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4141 const char *namestring
, int offset
)
4144 sym
= intern_c_string (namestring
);
4145 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4146 ko_fwd
->offset
= offset
;
4147 XSYMBOL (sym
)->declared_special
= 1;
4148 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4149 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4152 /* Check that the elements of lpath exist. */
4155 load_path_check (Lisp_Object lpath
)
4157 Lisp_Object path_tail
;
4159 /* The only elements that might not exist are those from
4160 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4162 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4164 Lisp_Object dirfile
;
4165 dirfile
= Fcar (path_tail
);
4166 if (STRINGP (dirfile
))
4168 dirfile
= Fdirectory_file_name (dirfile
);
4169 if (! file_accessible_directory_p (SSDATA (dirfile
)))
4170 dir_warning ("Lisp directory", XCAR (path_tail
));
4175 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4176 This does not include the standard site-lisp directories
4177 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4178 but it does (unless no_site_lisp is set) include site-lisp
4179 directories in the source/build directories if those exist and we
4180 are running uninstalled.
4182 Uses the following logic:
4183 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4184 The remainder is what happens when dumping works:
4185 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4186 Otherwise use PATH_LOADSEARCH.
4188 If !initialized, then just return PATH_DUMPLOADSEARCH.
4190 If Vinstallation_directory is not nil (ie, running uninstalled):
4191 If installation-dir/lisp exists and not already a member,
4192 we must be running uninstalled. Reset the load-path
4193 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4194 refers to the eventual installation directories. Since we
4195 are not yet installed, we should not use them, even if they exist.)
4196 If installation-dir/lisp does not exist, just add
4197 PATH_DUMPLOADSEARCH at the end instead.
4198 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4199 and not already a member) at the front.
4200 If installation-dir != source-dir (ie running an uninstalled,
4201 out-of-tree build) AND install-dir/src/Makefile exists BUT
4202 install-dir/src/Makefile.in does NOT exist (this is a sanity
4203 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4206 load_path_default (void)
4208 Lisp_Object lpath
= Qnil
;
4213 const char *loadpath
= ns_load_path ();
4216 normal
= PATH_LOADSEARCH
;
4218 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4220 lpath
= decode_env_path (0, normal
, 0);
4223 #else /* !CANNOT_DUMP */
4225 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4230 const char *loadpath
= ns_load_path ();
4231 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4233 lpath
= decode_env_path (0, normal
, 0);
4235 if (!NILP (Vinstallation_directory
))
4237 Lisp_Object tem
, tem1
;
4239 /* Add to the path the lisp subdir of the installation
4240 dir, if it is accessible. Note: in out-of-tree builds,
4241 this directory is empty save for Makefile. */
4242 tem
= Fexpand_file_name (build_string ("lisp"),
4243 Vinstallation_directory
);
4244 tem1
= Ffile_accessible_directory_p (tem
);
4247 if (NILP (Fmember (tem
, lpath
)))
4249 /* We are running uninstalled. The default load-path
4250 points to the eventual installed lisp directories.
4251 We should not use those now, even if they exist,
4252 so start over from a clean slate. */
4253 lpath
= list1 (tem
);
4257 /* That dir doesn't exist, so add the build-time
4258 Lisp dirs instead. */
4260 Lisp_Object dump_path
=
4261 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4262 lpath
= nconc2 (lpath
, dump_path
);
4265 /* Add site-lisp under the installation dir, if it exists. */
4268 tem
= Fexpand_file_name (build_string ("site-lisp"),
4269 Vinstallation_directory
);
4270 tem1
= Ffile_accessible_directory_p (tem
);
4273 if (NILP (Fmember (tem
, lpath
)))
4274 lpath
= Fcons (tem
, lpath
);
4278 /* If Emacs was not built in the source directory,
4279 and it is run from where it was built, add to load-path
4280 the lisp and site-lisp dirs under that directory. */
4282 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4286 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4287 Vinstallation_directory
);
4288 tem1
= Ffile_exists_p (tem
);
4290 /* Don't be fooled if they moved the entire source tree
4291 AFTER dumping Emacs. If the build directory is indeed
4292 different from the source dir, src/Makefile.in and
4293 src/Makefile will not be found together. */
4294 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4295 Vinstallation_directory
);
4296 tem2
= Ffile_exists_p (tem
);
4297 if (!NILP (tem1
) && NILP (tem2
))
4299 tem
= Fexpand_file_name (build_string ("lisp"),
4302 if (NILP (Fmember (tem
, lpath
)))
4303 lpath
= Fcons (tem
, lpath
);
4307 tem
= Fexpand_file_name (build_string ("site-lisp"),
4309 tem1
= Ffile_accessible_directory_p (tem
);
4312 if (NILP (Fmember (tem
, lpath
)))
4313 lpath
= Fcons (tem
, lpath
);
4317 } /* Vinstallation_directory != Vsource_directory */
4319 } /* if Vinstallation_directory */
4321 else /* !initialized */
4323 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4324 source directory. We used to add ../lisp (ie the lisp dir in
4325 the build directory) at the front here, but that should not
4326 be necessary, since in out of tree builds lisp/ is empty, save
4328 lpath
= decode_env_path (0, normal
, 0);
4330 #endif /* !CANNOT_DUMP */
4338 /* First, set Vload_path. */
4340 /* Ignore EMACSLOADPATH when dumping. */
4342 bool use_loadpath
= true;
4344 bool use_loadpath
= NILP (Vpurify_flag
);
4347 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4349 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4351 /* Check (non-nil) user-supplied elements. */
4352 load_path_check (Vload_path
);
4354 /* If no nils in the environment variable, use as-is.
4355 Otherwise, replace any nils with the default. */
4356 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4358 Lisp_Object elem
, elpath
= Vload_path
;
4359 Lisp_Object default_lpath
= load_path_default ();
4361 /* Check defaults, before adding site-lisp. */
4362 load_path_check (default_lpath
);
4364 /* Add the site-lisp directories to the front of the default. */
4367 Lisp_Object sitelisp
;
4368 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4369 if (! NILP (sitelisp
))
4370 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4375 /* Replace nils from EMACSLOADPATH by default. */
4376 while (CONSP (elpath
))
4379 elem
= XCAR (elpath
);
4380 elpath
= XCDR (elpath
);
4381 arg
[0] = Vload_path
;
4382 arg
[1] = NILP (elem
) ? default_lpath
: Fcons (elem
, Qnil
);
4383 Vload_path
= Fappend (2, arg
);
4385 } /* Fmemq (Qnil, Vload_path) */
4389 Vload_path
= load_path_default ();
4391 /* Check before adding site-lisp directories.
4392 The install should have created them, but they are not
4393 required, so no need to warn if they are absent.
4394 Or we might be running before installation. */
4395 load_path_check (Vload_path
);
4397 /* Add the site-lisp directories at the front. */
4398 if (initialized
&& !no_site_lisp
)
4400 Lisp_Object sitelisp
;
4401 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4402 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4408 load_in_progress
= 0;
4409 Vload_file_name
= Qnil
;
4410 Vstandard_input
= Qt
;
4411 Vloads_in_progress
= Qnil
;
4414 /* Print a warning that directory intended for use USE and with name
4415 DIRNAME cannot be accessed. On entry, errno should correspond to
4416 the access failure. Print the warning on stderr and put it in
4420 dir_warning (char const *use
, Lisp_Object dirname
)
4422 static char const format
[] = "Warning: %s `%s': %s\n";
4423 int access_errno
= errno
;
4424 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4426 /* Don't log the warning before we've initialized!! */
4429 char const *diagnostic
= emacs_strerror (access_errno
);
4431 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4432 + strlen (use
) + SBYTES (dirname
)
4433 + strlen (diagnostic
));
4434 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4436 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4442 syms_of_lread (void)
4446 DEFVAR_LISP ("obarray", Vobarray
,
4447 doc
: /* Symbol table for use by `intern' and `read'.
4448 It is a vector whose length ought to be prime for best results.
4449 The vector's contents don't make sense if examined from Lisp programs;
4450 to find all the symbols in an obarray, use `mapatoms'. */);
4452 DEFVAR_LISP ("values", Vvalues
,
4453 doc
: /* List of values of all expressions which were read, evaluated and printed.
4454 Order is reverse chronological. */);
4455 XSYMBOL (intern ("values"))->declared_special
= 0;
4457 DEFVAR_LISP ("standard-input", Vstandard_input
,
4458 doc
: /* Stream for read to get input from.
4459 See documentation of `read' for possible values. */);
4460 Vstandard_input
= Qt
;
4462 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4463 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4465 If this variable is a buffer, then only forms read from that buffer
4466 will be added to `read-symbol-positions-list'.
4467 If this variable is t, then all read forms will be added.
4468 The effect of all other values other than nil are not currently
4469 defined, although they may be in the future.
4471 The positions are relative to the last call to `read' or
4472 `read-from-string'. It is probably a bad idea to set this variable at
4473 the toplevel; bind it instead. */);
4474 Vread_with_symbol_positions
= Qnil
;
4476 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4477 doc
: /* A list mapping read symbols to their positions.
4478 This variable is modified during calls to `read' or
4479 `read-from-string', but only when `read-with-symbol-positions' is
4482 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4483 CHAR-POSITION is an integer giving the offset of that occurrence of the
4484 symbol from the position where `read' or `read-from-string' started.
4486 Note that a symbol will appear multiple times in this list, if it was
4487 read multiple times. The list is in the same order as the symbols
4489 Vread_symbol_positions_list
= Qnil
;
4491 DEFVAR_LISP ("read-circle", Vread_circle
,
4492 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4495 DEFVAR_LISP ("load-path", Vload_path
,
4496 doc
: /* List of directories to search for files to load.
4497 Each element is a string (directory name) or nil (meaning `default-directory').
4498 Initialized during startup as described in Info node `(elisp)Library Search'. */);
4500 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4501 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4502 This list should not include the empty string.
4503 `load' and related functions try to append these suffixes, in order,
4504 to the specified file name if a Lisp suffix is allowed or required. */);
4505 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4506 build_pure_c_string (".el"));
4507 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4508 doc
: /* List of suffixes that indicate representations of \
4510 This list should normally start with the empty string.
4512 Enabling Auto Compression mode appends the suffixes in
4513 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4514 mode removes them again. `load' and related functions use this list to
4515 determine whether they should look for compressed versions of a file
4516 and, if so, which suffixes they should try to append to the file name
4517 in order to do so. However, if you want to customize which suffixes
4518 the loading functions recognize as compression suffixes, you should
4519 customize `jka-compr-load-suffixes' rather than the present variable. */);
4520 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4522 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4523 doc
: /* Non-nil if inside of `load'. */);
4524 DEFSYM (Qload_in_progress
, "load-in-progress");
4526 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4527 doc
: /* An alist of functions to be evalled when particular files are loaded.
4528 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4530 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4531 a symbol \(a feature name).
4533 When `load' is run and the file-name argument matches an element's
4534 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4535 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4537 An error in FORMS does not undo the load, but does prevent execution of
4538 the rest of the FORMS. */);
4539 Vafter_load_alist
= Qnil
;
4541 DEFVAR_LISP ("load-history", Vload_history
,
4542 doc
: /* Alist mapping loaded file names to symbols and features.
4543 Each alist element should be a list (FILE-NAME ENTRIES...), where
4544 FILE-NAME is the name of a file that has been loaded into Emacs.
4545 The file name is absolute and true (i.e. it doesn't contain symlinks).
4546 As an exception, one of the alist elements may have FILE-NAME nil,
4547 for symbols and features not associated with any file.
4549 The remaining ENTRIES in the alist element describe the functions and
4550 variables defined in that file, the features provided, and the
4551 features required. Each entry has the form `(provide . FEATURE)',
4552 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4553 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4554 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4555 autoload before this file redefined it as a function. In addition,
4556 entries may also be single symbols, which means that SYMBOL was
4557 defined by `defvar' or `defconst'.
4559 During preloading, the file name recorded is relative to the main Lisp
4560 directory. These file names are converted to absolute at startup. */);
4561 Vload_history
= Qnil
;
4563 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4564 doc
: /* Full name of file being loaded by `load'. */);
4565 Vload_file_name
= Qnil
;
4567 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4568 doc
: /* File name, including directory, of user's initialization file.
4569 If the file loaded had extension `.elc', and the corresponding source file
4570 exists, this variable contains the name of source file, suitable for use
4571 by functions like `custom-save-all' which edit the init file.
4572 While Emacs loads and evaluates the init file, value is the real name
4573 of the file, regardless of whether or not it has the `.elc' extension. */);
4574 Vuser_init_file
= Qnil
;
4576 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4577 doc
: /* Used for internal purposes by `load'. */);
4578 Vcurrent_load_list
= Qnil
;
4580 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4581 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4582 The default is nil, which means use the function `read'. */);
4583 Vload_read_function
= Qnil
;
4585 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4586 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4587 The value should be a function for doing code conversion before
4588 reading a source file. It can also be nil, in which case loading is
4589 done without any code conversion.
4591 If the value is a function, it is called with four arguments,
4592 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4593 the file to load, FILE is the non-absolute name (for messages etc.),
4594 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4595 `load'. The function should return t if the file was loaded. */);
4596 Vload_source_file_function
= Qnil
;
4598 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4599 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4600 This is useful when the file being loaded is a temporary copy. */);
4601 load_force_doc_strings
= 0;
4603 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4604 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4605 This is normally bound by `load' and `eval-buffer' to control `read',
4606 and is not meant for users to change. */);
4607 load_convert_to_unibyte
= 0;
4609 DEFVAR_LISP ("source-directory", Vsource_directory
,
4610 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4611 You cannot count on them to still be there! */);
4613 = Fexpand_file_name (build_string ("../"),
4614 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4616 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4617 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4618 Vpreloaded_file_list
= Qnil
;
4620 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4621 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4622 Vbyte_boolean_vars
= Qnil
;
4624 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4625 doc
: /* Non-nil means load dangerous compiled Lisp files.
4626 Some versions of XEmacs use different byte codes than Emacs. These
4627 incompatible byte codes can make Emacs crash when it tries to execute
4629 load_dangerous_libraries
= 0;
4631 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4632 doc
: /* Non-nil means force printing messages when loading Lisp files.
4633 This overrides the value of the NOMESSAGE argument to `load'. */);
4634 force_load_messages
= 0;
4636 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4637 doc
: /* Regular expression matching safe to load compiled Lisp files.
4638 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4639 from the file, and matches them against this regular expression.
4640 When the regular expression matches, the file is considered to be safe
4641 to load. See also `load-dangerous-libraries'. */);
4642 Vbytecomp_version_regexp
4643 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4645 DEFSYM (Qlexical_binding
, "lexical-binding");
4646 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4647 doc
: /* Whether to use lexical binding when evaluating code.
4648 Non-nil means that the code in the current buffer should be evaluated
4649 with lexical binding.
4650 This variable is automatically set from the file variables of an
4651 interpreted Lisp file read using `load'. Unlike other file local
4652 variables, this must be set in the first line of a file. */);
4653 Vlexical_binding
= Qnil
;
4654 Fmake_variable_buffer_local (Qlexical_binding
);
4656 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4657 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4658 Veval_buffer_list
= Qnil
;
4660 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4661 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4662 Vold_style_backquotes
= Qnil
;
4663 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4665 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4666 doc
: /* Non-nil means `load' prefers the newest version of a file.
4667 This applies when a filename suffix is not explicitly specified and
4668 `load' is trying various possible suffixes (see `load-suffixes' and
4669 `load-file-rep-suffixes'). Normally, it stops at the first file
4670 that exists unless you explicitly specify one or the other. If this
4671 option is non-nil, it checks all suffixes and uses whichever file is
4673 Note that if you customize this, obviously it will not affect files
4674 that are loaded before your customizations are read! */);
4675 load_prefer_newer
= 0;
4677 /* Vsource_directory was initialized in init_lread. */
4679 DEFSYM (Qcurrent_load_list
, "current-load-list");
4680 DEFSYM (Qstandard_input
, "standard-input");
4681 DEFSYM (Qread_char
, "read-char");
4682 DEFSYM (Qget_file_char
, "get-file-char");
4683 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4684 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4686 DEFSYM (Qbackquote
, "`");
4687 DEFSYM (Qcomma
, ",");
4688 DEFSYM (Qcomma_at
, ",@");
4689 DEFSYM (Qcomma_dot
, ",.");
4691 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4692 DEFSYM (Qascii_character
, "ascii-character");
4693 DEFSYM (Qfunction
, "function");
4694 DEFSYM (Qload
, "load");
4695 DEFSYM (Qload_file_name
, "load-file-name");
4696 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4697 DEFSYM (Qfile_truename
, "file-truename");
4698 DEFSYM (Qdir_ok
, "dir-ok");
4699 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4701 staticpro (&read_objects
);
4702 read_objects
= Qnil
;
4703 staticpro (&seen_list
);
4706 Vloads_in_progress
= Qnil
;
4707 staticpro (&Vloads_in_progress
);
4709 DEFSYM (Qhash_table
, "hash-table");
4710 DEFSYM (Qdata
, "data");
4711 DEFSYM (Qtest
, "test");
4712 DEFSYM (Qsize
, "size");
4713 DEFSYM (Qweakness
, "weakness");
4714 DEFSYM (Qrehash_size
, "rehash-size");
4715 DEFSYM (Qrehash_threshold
, "rehash-threshold");