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
71 /* Hash table read constants. */
72 static Lisp_Object Qhash_table
, Qdata
;
73 static Lisp_Object Qtest
;
75 static Lisp_Object Qweakness
;
76 static Lisp_Object Qrehash_size
;
77 static Lisp_Object Qrehash_threshold
;
79 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
80 Lisp_Object Qstandard_input
;
81 Lisp_Object Qvariable_documentation
;
82 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
83 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
84 static Lisp_Object Qinhibit_file_name_operation
;
85 static Lisp_Object Qeval_buffer_list
;
86 Lisp_Object Qlexical_binding
;
87 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
89 /* Used instead of Qget_file_char while loading *.elc files compiled
90 by Emacs 21 or older. */
91 static Lisp_Object Qget_emacs_mule_file_char
;
93 static Lisp_Object Qload_force_doc_strings
;
95 static Lisp_Object Qload_in_progress
;
97 /* The association list of objects read with the #n=object form.
98 Each member of the list has the form (n . object), and is used to
99 look up the object for the corresponding #n# construct.
100 It must be set to nil before all top-level calls to read0. */
101 static Lisp_Object read_objects
;
103 /* File for get_file_char to read from. Use by load. */
104 static FILE *instream
;
106 /* For use within read-from-string (this reader is non-reentrant!!) */
107 static ptrdiff_t read_from_string_index
;
108 static ptrdiff_t read_from_string_index_byte
;
109 static ptrdiff_t read_from_string_limit
;
111 /* Number of characters read in the current call to Fread or
112 Fread_from_string. */
113 static EMACS_INT readchar_count
;
115 /* This contains the last string skipped with #@. */
116 static char *saved_doc_string
;
117 /* Length of buffer allocated in saved_doc_string. */
118 static ptrdiff_t saved_doc_string_size
;
119 /* Length of actual data in saved_doc_string. */
120 static ptrdiff_t saved_doc_string_length
;
121 /* This is the file position that string came from. */
122 static file_offset saved_doc_string_position
;
124 /* This contains the previous string skipped with #@.
125 We copy it from saved_doc_string when a new string
126 is put in saved_doc_string. */
127 static char *prev_saved_doc_string
;
128 /* Length of buffer allocated in prev_saved_doc_string. */
129 static ptrdiff_t prev_saved_doc_string_size
;
130 /* Length of actual data in prev_saved_doc_string. */
131 static ptrdiff_t prev_saved_doc_string_length
;
132 /* This is the file position that string came from. */
133 static file_offset prev_saved_doc_string_position
;
135 /* True means inside a new-style backquote
136 with no surrounding parentheses.
137 Fread initializes this to false, so we need not specbind it
138 or worry about what happens to it when there is an error. */
139 static bool new_backquote_flag
;
140 static Lisp_Object Qold_style_backquotes
;
142 /* A list of file names for files being loaded in Fload. Used to
143 check for recursive loads. */
145 static Lisp_Object Vloads_in_progress
;
147 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
150 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
151 Lisp_Object
, Lisp_Object
,
152 Lisp_Object
, Lisp_Object
);
154 /* Functions that read one byte from the current source READCHARFUN
155 or unreads one byte. If the integer argument C is -1, it returns
156 one read byte, or -1 when there's no more byte in the source. If C
157 is 0 or positive, it unreads C, and the return value is not
160 static int readbyte_for_lambda (int, Lisp_Object
);
161 static int readbyte_from_file (int, Lisp_Object
);
162 static int readbyte_from_string (int, Lisp_Object
);
164 /* Handle unreading and rereading of characters.
165 Write READCHAR to read a character,
166 UNREAD(c) to unread c to be read again.
168 These macros correctly read/unread multibyte characters. */
170 #define READCHAR readchar (readcharfun, NULL)
171 #define UNREAD(c) unreadchar (readcharfun, c)
173 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
174 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
176 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
177 Qlambda, or a cons, we use this to keep an unread character because
178 a file stream can't handle multibyte-char unreading. The value -1
179 means that there's no unread character. */
180 static int unread_char
;
183 readchar (Lisp_Object readcharfun
, bool *multibyte
)
187 int (*readbyte
) (int, Lisp_Object
);
188 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
190 bool emacs_mule_encoding
= 0;
197 if (BUFFERP (readcharfun
))
199 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
201 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
203 if (! BUFFER_LIVE_P (inbuffer
))
206 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
209 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
211 /* Fetch the character code from the buffer. */
212 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
213 BUF_INC_POS (inbuffer
, pt_byte
);
220 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
221 if (! ASCII_CHAR_P (c
))
222 c
= BYTE8_TO_CHAR (c
);
225 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
229 if (MARKERP (readcharfun
))
231 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
233 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
235 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
238 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
240 /* Fetch the character code from the buffer. */
241 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
242 BUF_INC_POS (inbuffer
, bytepos
);
249 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
250 if (! ASCII_CHAR_P (c
))
251 c
= BYTE8_TO_CHAR (c
);
255 XMARKER (readcharfun
)->bytepos
= bytepos
;
256 XMARKER (readcharfun
)->charpos
++;
261 if (EQ (readcharfun
, Qlambda
))
263 readbyte
= readbyte_for_lambda
;
267 if (EQ (readcharfun
, Qget_file_char
))
269 readbyte
= readbyte_from_file
;
273 if (STRINGP (readcharfun
))
275 if (read_from_string_index
>= read_from_string_limit
)
277 else if (STRING_MULTIBYTE (readcharfun
))
281 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
282 read_from_string_index
,
283 read_from_string_index_byte
);
287 c
= SREF (readcharfun
, read_from_string_index_byte
);
288 read_from_string_index
++;
289 read_from_string_index_byte
++;
294 if (CONSP (readcharfun
))
296 /* This is the case that read_vector is reading from a unibyte
297 string that contains a byte sequence previously skipped
298 because of #@NUMBER. The car part of readcharfun is that
299 string, and the cdr part is a value of readcharfun given to
301 readbyte
= readbyte_from_string
;
302 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
303 emacs_mule_encoding
= 1;
307 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
309 readbyte
= readbyte_from_file
;
310 emacs_mule_encoding
= 1;
314 tem
= call0 (readcharfun
);
321 if (unread_char
>= 0)
327 c
= (*readbyte
) (-1, readcharfun
);
332 if (ASCII_CHAR_P (c
))
334 if (emacs_mule_encoding
)
335 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
338 len
= BYTES_BY_CHAR_HEAD (c
);
341 c
= (*readbyte
) (-1, readcharfun
);
342 if (c
< 0 || ! TRAILING_CODE_P (c
))
345 (*readbyte
) (buf
[i
], readcharfun
);
346 return BYTE8_TO_CHAR (buf
[0]);
350 return STRING_CHAR (buf
);
353 #define FROM_FILE_P(readcharfun) \
354 (EQ (readcharfun, Qget_file_char) \
355 || EQ (readcharfun, Qget_emacs_mule_file_char))
358 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
360 if (FROM_FILE_P (readcharfun
))
362 block_input (); /* FIXME: Not sure if it's needed. */
363 fseek (instream
, n
, SEEK_CUR
);
367 { /* We're not reading directly from a file. In that case, it's difficult
368 to reliably count bytes, since these are usually meant for the file's
369 encoding, whereas we're now typically in the internal encoding.
370 But luckily, skip_dyn_bytes is used to skip over a single
371 dynamic-docstring (or dynamic byte-code) which is always quoted such
372 that \037 is the final char. */
376 } while (c
>= 0 && c
!= '\037');
381 skip_dyn_eof (Lisp_Object readcharfun
)
383 if (FROM_FILE_P (readcharfun
))
385 block_input (); /* FIXME: Not sure if it's needed. */
386 fseek (instream
, 0, SEEK_END
);
390 while (READCHAR
>= 0);
393 /* Unread the character C in the way appropriate for the stream READCHARFUN.
394 If the stream is a user function, call it with the char as argument. */
397 unreadchar (Lisp_Object readcharfun
, int c
)
401 /* Don't back up the pointer if we're unreading the end-of-input mark,
402 since readchar didn't advance it when we read it. */
404 else if (BUFFERP (readcharfun
))
406 struct buffer
*b
= XBUFFER (readcharfun
);
407 ptrdiff_t charpos
= BUF_PT (b
);
408 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
410 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
411 BUF_DEC_POS (b
, bytepos
);
415 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
417 else if (MARKERP (readcharfun
))
419 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
420 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
422 XMARKER (readcharfun
)->charpos
--;
423 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
424 BUF_DEC_POS (b
, bytepos
);
428 XMARKER (readcharfun
)->bytepos
= bytepos
;
430 else if (STRINGP (readcharfun
))
432 read_from_string_index
--;
433 read_from_string_index_byte
434 = string_char_to_byte (readcharfun
, read_from_string_index
);
436 else if (CONSP (readcharfun
))
440 else if (EQ (readcharfun
, Qlambda
))
444 else if (FROM_FILE_P (readcharfun
))
449 call1 (readcharfun
, make_number (c
));
453 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
455 return read_bytecode_char (c
>= 0);
460 readbyte_from_file (int c
, Lisp_Object readcharfun
)
465 ungetc (c
, instream
);
473 /* Interrupted reads have been observed while reading over the network. */
474 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
485 return (c
== EOF
? -1 : c
);
489 readbyte_from_string (int c
, Lisp_Object readcharfun
)
491 Lisp_Object string
= XCAR (readcharfun
);
495 read_from_string_index
--;
496 read_from_string_index_byte
497 = string_char_to_byte (string
, read_from_string_index
);
500 if (read_from_string_index
>= read_from_string_limit
)
503 FETCH_STRING_CHAR_ADVANCE (c
, string
,
504 read_from_string_index
,
505 read_from_string_index_byte
);
510 /* Read one non-ASCII character from INSTREAM. The character is
511 encoded in `emacs-mule' and the first byte is already read in
515 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
517 /* Emacs-mule coding uses at most 4-byte for one character. */
518 unsigned char buf
[4];
519 int len
= emacs_mule_bytes
[c
];
520 struct charset
*charset
;
525 /* C is not a valid leading-code of `emacs-mule'. */
526 return BYTE8_TO_CHAR (c
);
532 c
= (*readbyte
) (-1, readcharfun
);
536 (*readbyte
) (buf
[i
], readcharfun
);
537 return BYTE8_TO_CHAR (buf
[0]);
544 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
545 code
= buf
[1] & 0x7F;
549 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
550 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
552 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
553 code
= buf
[2] & 0x7F;
557 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
558 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
563 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
564 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
566 c
= DECODE_CHAR (charset
, code
);
568 Fsignal (Qinvalid_read_syntax
,
569 list1 (build_string ("invalid multibyte form")));
574 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
576 static Lisp_Object
read0 (Lisp_Object
);
577 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
579 static Lisp_Object
read_list (bool, Lisp_Object
);
580 static Lisp_Object
read_vector (Lisp_Object
, bool);
582 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
584 static void substitute_object_in_subtree (Lisp_Object
,
586 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
589 /* Get a character from the tty. */
591 /* Read input events until we get one that's acceptable for our purposes.
593 If NO_SWITCH_FRAME, switch-frame events are stashed
594 until we get a character we like, and then stuffed into
597 If ASCII_REQUIRED, check function key events to see
598 if the unmodified version of the symbol has a Qascii_character
599 property, and use that character, if present.
601 If ERROR_NONASCII, signal an error if the input we
602 get isn't an ASCII character with modifiers. If it's false but
603 ASCII_REQUIRED is true, just re-read until we get an ASCII
606 If INPUT_METHOD, invoke the current input method
607 if the character warrants that.
609 If SECONDS is a number, wait that many seconds for input, and
610 return Qnil if no input arrives within that time. */
613 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
614 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
616 Lisp_Object val
, delayed_switch_frame
;
617 struct timespec end_time
;
619 #ifdef HAVE_WINDOW_SYSTEM
620 if (display_hourglass_p
)
624 delayed_switch_frame
= Qnil
;
626 /* Compute timeout. */
627 if (NUMBERP (seconds
))
629 double duration
= extract_float (seconds
);
630 struct timespec wait_time
= dtotimespec (duration
);
631 end_time
= timespec_add (current_timespec (), wait_time
);
634 /* Read until we get an acceptable event. */
637 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
638 NUMBERP (seconds
) ? &end_time
: NULL
);
639 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
644 /* `switch-frame' events are put off until after the next ASCII
645 character. This is better than signaling an error just because
646 the last characters were typed to a separate minibuffer frame,
647 for example. Eventually, some code which can deal with
648 switch-frame events will read it and process it. */
650 && EVENT_HAS_PARAMETERS (val
)
651 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
653 delayed_switch_frame
= val
;
657 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
659 /* Convert certain symbols to their ASCII equivalents. */
662 Lisp_Object tem
, tem1
;
663 tem
= Fget (val
, Qevent_symbol_element_mask
);
666 tem1
= Fget (Fcar (tem
), Qascii_character
);
667 /* Merge this symbol's modifier bits
668 with the ASCII equivalent of its basic code. */
670 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
674 /* If we don't have a character now, deal with it appropriately. */
679 Vunread_command_events
= list1 (val
);
680 error ("Non-character input-event");
687 if (! NILP (delayed_switch_frame
))
688 unread_switch_frame
= delayed_switch_frame
;
692 #ifdef HAVE_WINDOW_SYSTEM
693 if (display_hourglass_p
)
702 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
703 doc
: /* Read a character from the command input (keyboard or macro).
704 It is returned as a number.
705 If the character has modifiers, they are resolved and reflected to the
706 character code if possible (e.g. C-SPC -> 0).
708 If the user generates an event which is not a character (i.e. a mouse
709 click or function key event), `read-char' signals an error. As an
710 exception, switch-frame events are put off until non-character events
712 If you want to read non-character events, or ignore them, call
713 `read-event' or `read-char-exclusive' instead.
715 If the optional argument PROMPT is non-nil, display that as a prompt.
716 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
717 input method is turned on in the current buffer, that input method
718 is used for reading a character.
719 If the optional argument SECONDS is non-nil, it should be a number
720 specifying the maximum number of seconds to wait for input. If no
721 input arrives in that time, return nil. SECONDS may be a
722 floating-point value. */)
723 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
728 message_with_string ("%s", prompt
, 0);
729 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
731 return (NILP (val
) ? Qnil
732 : make_number (char_resolve_modifier_mask (XINT (val
))));
735 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
736 doc
: /* Read an event object from the input stream.
737 If the optional argument PROMPT is non-nil, display that as a prompt.
738 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
739 input method is turned on in the current buffer, that input method
740 is used for reading a character.
741 If the optional argument SECONDS is non-nil, it should be a number
742 specifying the maximum number of seconds to wait for input. If no
743 input arrives in that time, return nil. SECONDS may be a
744 floating-point value. */)
745 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
748 message_with_string ("%s", prompt
, 0);
749 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
752 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
753 doc
: /* Read a character from the command input (keyboard or macro).
754 It is returned as a number. Non-character events are ignored.
755 If the character has modifiers, they are resolved and reflected to the
756 character code if possible (e.g. C-SPC -> 0).
758 If the optional argument PROMPT is non-nil, display that as a prompt.
759 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
760 input method is turned on in the current buffer, that input method
761 is used for reading a character.
762 If the optional argument SECONDS is non-nil, it should be a number
763 specifying the maximum number of seconds to wait for input. If no
764 input arrives in that time, return nil. SECONDS may be a
765 floating-point value. */)
766 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
771 message_with_string ("%s", prompt
, 0);
773 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
775 return (NILP (val
) ? Qnil
776 : make_number (char_resolve_modifier_mask (XINT (val
))));
779 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
780 doc
: /* Don't use this yourself. */)
783 register Lisp_Object val
;
785 XSETINT (val
, getc (instream
));
793 /* Return true if the lisp code read using READCHARFUN defines a non-nil
794 `lexical-binding' file variable. After returning, the stream is
795 positioned following the first line, if it is a comment or #! line,
796 otherwise nothing is read. */
799 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
812 while (ch
!= '\n' && ch
!= EOF
)
814 if (ch
== '\n') ch
= READCHAR
;
815 /* It is OK to leave the position after a #! line, since
816 that is what read1 does. */
820 /* The first line isn't a comment, just give up. */
826 /* Look for an appropriate file-variable in the first line. */
830 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
831 } beg_end_state
= NOMINAL
;
832 bool in_file_vars
= 0;
834 #define UPDATE_BEG_END_STATE(ch) \
835 if (beg_end_state == NOMINAL) \
836 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
837 else if (beg_end_state == AFTER_FIRST_DASH) \
838 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
839 else if (beg_end_state == AFTER_ASTERIX) \
842 in_file_vars = !in_file_vars; \
843 beg_end_state = NOMINAL; \
846 /* Skip until we get to the file vars, if any. */
850 UPDATE_BEG_END_STATE (ch
);
852 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
856 char var
[100], val
[100];
861 /* Read a variable name. */
862 while (ch
== ' ' || ch
== '\t')
866 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
868 if (i
< sizeof var
- 1)
870 UPDATE_BEG_END_STATE (ch
);
874 /* Stop scanning if no colon was found before end marker. */
875 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
878 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
884 /* Read a variable value. */
887 while (ch
== ' ' || ch
== '\t')
891 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
893 if (i
< sizeof val
- 1)
895 UPDATE_BEG_END_STATE (ch
);
899 /* The value was terminated by an end-marker, which remove. */
901 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
905 if (strcmp (var
, "lexical-binding") == 0)
908 rv
= (strcmp (val
, "nil") != 0);
914 while (ch
!= '\n' && ch
!= EOF
)
921 /* Value is a version number of byte compiled code if the file
922 associated with file descriptor FD is a compiled Lisp file that's
923 safe to load. Only files compiled with Emacs are safe to load.
924 Files compiled with XEmacs can lead to a crash in Fbyte_code
925 because of an incompatible change in the byte compiler. */
928 safe_to_load_version (int fd
)
934 /* Read the first few bytes from the file, and look for a line
935 specifying the byte compiler version used. */
936 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
939 /* Skip to the next newline, skipping over the initial `ELC'
940 with NUL bytes following it, but note the version. */
941 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
946 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
947 buf
+ i
, nbytes
- i
) < 0)
951 lseek (fd
, 0, SEEK_SET
);
956 /* Callback for record_unwind_protect. Restore the old load list OLD,
957 after loading a file successfully. */
960 record_load_unwind (Lisp_Object old
)
962 Vloads_in_progress
= old
;
965 /* This handler function is used via internal_condition_case_1. */
968 load_error_handler (Lisp_Object data
)
974 load_warn_old_style_backquotes (Lisp_Object file
)
976 if (!NILP (Vold_style_backquotes
))
978 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
979 Fmessage (2, (Lisp_Object
[]) {format
, file
});
983 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
984 doc
: /* Return the suffixes that `load' should try if a suffix is \
986 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
989 Lisp_Object lst
= Qnil
, suffixes
, suffix
, ext
;
991 /* module suffixes, then regular elisp suffixes */
994 args
[0] = Vload_module_suffixes
;
995 args
[1] = Vload_suffixes
;
996 suffixes
= Fappend (2, args
);
998 while (CONSP (suffixes
))
1000 Lisp_Object exts
= Vload_file_rep_suffixes
;
1001 suffix
= XCAR (suffixes
);
1002 suffixes
= XCDR (suffixes
);
1003 while (CONSP (exts
))
1007 lst
= Fcons (concat2 (suffix
, ext
), lst
);
1010 return Fnreverse (lst
);
1013 DEFUN ("load-module", Fload_module
, Sload_module
, 1, 1, 0,
1014 doc
: /* Dymamically load a compiled module. */)
1018 static int lt_init_done
= 0;
1020 void (*module_init
) ();
1022 Lisp_Object doc_name
, args
[2];
1024 /* init libtool once per emacs process */
1027 int ret
= lt_dlinit ();
1030 const char* s
= lt_dlerror ();
1031 error ("ltdl init fail: %s", s
);
1036 CHECK_STRING (file
);
1038 handle
= lt_dlopen (SDATA (file
));
1040 error ("Cannot load file %s", SDATA (file
));
1042 gpl_sym
= lt_dlsym (handle
, "plugin_is_GPL_compatible");
1044 error ("Module %s is not GPL compatible", SDATA (file
));
1046 module_init
= (void (*) ()) lt_dlsym (handle
, "init");
1048 error ("Module %s does not have an init function.", SDATA (file
));
1052 /* build doc file path and install it */
1053 args
[0] = Fsubstring (file
, make_number (0), make_number (-3));
1054 args
[1] = build_string (".doc");
1055 doc_name
= Fconcat (2, args
);
1056 Fsnarf_documentation (doc_name
, Qt
);
1065 /* Return true if STRING ends with SUFFIX. */
1066 static bool string_suffix_p (Lisp_Object string
, const char *suffix
)
1068 const ptrdiff_t len
= strlen (suffix
);
1069 return memcmp (SDATA (string
) + SBYTES (string
) - len
, suffix
, len
) == 0;
1072 /* Return true if STRING ends with any element of SUFFIXES. */
1073 static bool string_suffixes_p (Lisp_Object string
, Lisp_Object suffixes
)
1075 ptrdiff_t length
= SBYTES (string
), suflen
;
1076 Lisp_Object tail
, suffix
;
1078 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1080 suffix
= XCAR (tail
);
1081 suflen
= SBYTES (suffix
);
1083 if (suflen
<= length
)
1085 if (memcmp (SDATA (string
) + length
- suflen
, SDATA (suffix
), suflen
) == 0)
1093 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1094 doc
: /* Execute a file of Lisp code named FILE.
1095 First try FILE with `.elc' appended, then try with `.el',
1096 then try FILE unmodified (the exact suffixes in the exact order are
1097 determined by `load-suffixes'). Environment variable references in
1098 FILE are replaced with their values by calling `substitute-in-file-name'.
1099 This function searches the directories in `load-path'.
1101 If optional second arg NOERROR is non-nil,
1102 report no error if FILE doesn't exist.
1103 Print messages at start and end of loading unless
1104 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1106 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1107 suffixes `.elc' or `.el' to the specified name FILE.
1108 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1109 the suffix `.elc' or `.el'; don't accept just FILE unless
1110 it ends in one of those suffixes or includes a directory name.
1112 If NOSUFFIX is nil, then if a file could not be found, try looking for
1113 a different representation of the file by adding non-empty suffixes to
1114 its name, before trying another file. Emacs uses this feature to find
1115 compressed versions of files when Auto Compression mode is enabled.
1116 If NOSUFFIX is non-nil, disable this feature.
1118 The suffixes that this function tries out, when NOSUFFIX is nil, are
1119 given by the return value of `get-load-suffixes' and the values listed
1120 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1121 return value of `get-load-suffixes' is used, i.e. the file name is
1122 required to have a non-empty suffix.
1124 When searching suffixes, this function normally stops at the first
1125 one that exists. If the option `load-prefer-newer' is non-nil,
1126 however, it tries all suffixes, and uses whichever file is the newest.
1128 Loading a file records its definitions, and its `provide' and
1129 `require' calls, in an element of `load-history' whose
1130 car is the file name loaded. See `load-history'.
1132 While the file is in the process of being loaded, the variable
1133 `load-in-progress' is non-nil and the variable `load-file-name'
1134 is bound to the file's name.
1136 Return t if the file exists and loads successfully. */)
1137 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1138 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1143 ptrdiff_t count
= SPECPDL_INDEX ();
1144 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1145 Lisp_Object found
, efound
, hist_file_name
;
1146 /* True means we printed the ".el is newer" message. */
1148 /* True means we are loading a compiled file. */
1150 /* True means we are loading a dynamic module. */
1152 Lisp_Object handler
;
1154 const char *fmode
= "r";
1161 CHECK_STRING (file
);
1163 /* If file name is magic, call the handler. */
1164 /* This shouldn't be necessary any more now that `openp' handles it right.
1165 handler = Ffind_file_name_handler (file, Qload);
1166 if (!NILP (handler))
1167 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1169 /* Do this after the handler to avoid
1170 the need to gcpro noerror, nomessage and nosuffix.
1171 (Below here, we care only whether they are nil or not.)
1172 The presence of this call is the result of a historical accident:
1173 it used to be in every file-operation and when it got removed
1174 everywhere, it accidentally stayed here. Since then, enough people
1175 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1176 that it seemed risky to remove. */
1177 if (! NILP (noerror
))
1179 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1180 Qt
, load_error_handler
);
1185 file
= Fsubstitute_in_file_name (file
);
1187 /* Avoid weird lossage with null string as arg,
1188 since it would try to load a directory as a Lisp file. */
1189 if (SCHARS (file
) == 0)
1196 Lisp_Object suffixes
;
1198 GCPRO2 (file
, found
);
1200 if (! NILP (must_suffix
))
1202 /* Don't insist on adding a suffix if FILE already ends with
1203 one or if FILE includes a directory name. */
1204 if (string_suffixes_p (file
, Vload_module_suffixes
)
1205 || string_suffixes_p (file
, Vload_suffixes
)
1206 || ! NILP (Ffile_name_directory (file
)))
1212 if (!NILP (nosuffix
))
1216 suffixes
= Fget_load_suffixes ();
1217 if (NILP (must_suffix
))
1221 arg
[1] = Vload_file_rep_suffixes
;
1222 suffixes
= Fappend (2, arg
);
1226 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1233 report_file_error ("Cannot open load file", file
);
1237 /* Tell startup.el whether or not we found the user's init file. */
1238 if (EQ (Qt
, Vuser_init_file
))
1239 Vuser_init_file
= found
;
1241 /* If FD is -2, that means openp found a magic file. */
1244 if (NILP (Fequal (found
, file
)))
1245 /* If FOUND is a different file name from FILE,
1246 find its handler even if we have already inhibited
1247 the `load' operation on FILE. */
1248 handler
= Ffind_file_name_handler (found
, Qt
);
1250 handler
= Ffind_file_name_handler (found
, Qload
);
1251 if (! NILP (handler
))
1252 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1254 /* Tramp has to deal with semi-broken packages that prepend
1255 drive letters to remote files. For that reason, Tramp
1256 catches file operations that test for file existence, which
1257 makes openp think X:/foo.elc files are remote. However,
1258 Tramp does not catch `load' operations for such files, so we
1259 end up with a nil as the `load' handler above. If we would
1260 continue with fd = -2, we will behave wrongly, and in
1261 particular try reading a .elc file in the "rt" mode instead
1262 of "rb". See bug #9311 for the results. To work around
1263 this, we try to open the file locally, and go with that if it
1265 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1273 /* Pacify older GCC with --enable-gcc-warnings. */
1274 IF_LINT (fd_index
= 0);
1278 fd_index
= SPECPDL_INDEX ();
1279 record_unwind_protect_int (close_file_unwind
, fd
);
1282 /* Check if we're stuck in a recursive load cycle.
1284 2000-09-21: It's not possible to just check for the file loaded
1285 being a member of Vloads_in_progress. This fails because of the
1286 way the byte compiler currently works; `provide's are not
1287 evaluated, see font-lock.el/jit-lock.el as an example. This
1288 leads to a certain amount of ``normal'' recursion.
1290 Also, just loading a file recursively is not always an error in
1291 the general case; the second load may do something different. */
1295 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1296 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1297 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1298 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1299 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1302 /* All loads are by default dynamic, unless the file itself specifies
1303 otherwise using a file-variable in the first line. This is bound here
1304 so that it takes effect whether or not we use
1305 Vload_source_file_function. */
1306 specbind (Qlexical_binding
, Qnil
);
1308 /* Get the name for load-history. */
1309 hist_file_name
= (! NILP (Vpurify_flag
)
1310 ? concat2 (Ffile_name_directory (file
),
1311 Ffile_name_nondirectory (found
))
1316 /* Check for the presence of old-style quotes and warn about them. */
1317 specbind (Qold_style_backquotes
, Qnil
);
1318 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1320 if (string_suffix_p (found
, ".elc")
1321 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1322 /* Load .elc files directly, but not when they are
1323 remote and have no handler! */
1330 GCPRO3 (file
, found
, hist_file_name
);
1333 && ! (version
= safe_to_load_version (fd
)))
1336 if (!load_dangerous_libraries
)
1337 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1338 else if (!NILP (nomessage
) && !force_load_messages
)
1339 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1344 efound
= ENCODE_FILE (found
);
1350 /* openp already checked for newness, no point doing it again.
1351 FIXME would be nice to get a message when openp
1352 ignores suffix order due to load_prefer_newer. */
1353 if (!load_prefer_newer
)
1355 result
= stat (SSDATA (efound
), &s1
);
1358 SSET (efound
, SBYTES (efound
) - 1, 0);
1359 result
= stat (SSDATA (efound
), &s2
);
1360 SSET (efound
, SBYTES (efound
) - 1, 'c');
1364 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1366 /* Make the progress messages mention that source is newer. */
1369 /* If we won't print another message, mention this anyway. */
1370 if (!NILP (nomessage
) && !force_load_messages
)
1372 Lisp_Object msg_file
;
1373 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1374 message_with_string ("Source file `%s' newer than byte-compiled file",
1378 } /* !load_prefer_newer */
1383 else if (string_suffixes_p (found
, Vload_module_suffixes
))
1390 /* We are loading a source file (*.el). */
1391 if (!NILP (Vload_source_file_function
))
1398 clear_unwind_protect (fd_index
);
1400 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1401 NILP (noerror
) ? Qnil
: Qt
,
1402 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1403 return unbind_to (count
, val
);
1407 GCPRO3 (file
, found
, hist_file_name
);
1411 /* We somehow got here with fd == -2, meaning the file is deemed
1412 to be remote. Don't even try to reopen the file locally;
1413 just force a failure. */
1421 clear_unwind_protect (fd_index
);
1422 efound
= ENCODE_FILE (found
);
1423 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1425 stream
= fdopen (fd
, fmode
);
1429 report_file_error ("Opening stdio stream", file
);
1430 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1432 if (! NILP (Vpurify_flag
))
1433 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1435 if (NILP (nomessage
) || force_load_messages
)
1438 message_with_string ("Loading %s (dymamic module)...", file
, 1);
1440 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1443 message_with_string ("Loading %s (source)...", file
, 1);
1445 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1447 else /* The typical case; compiled file newer than source file. */
1448 message_with_string ("Loading %s...", file
, 1);
1451 specbind (Qload_file_name
, found
);
1452 specbind (Qinhibit_file_name_operation
, Qnil
);
1453 specbind (Qload_in_progress
, Qt
);
1456 if (lisp_file_lexically_bound_p (Qget_file_char
))
1457 Fset (Qlexical_binding
, Qt
);
1462 /* XXX: should the fd/stream be closed before loading the module? */
1463 Fload_module (found
);
1466 else if (! version
|| version
>= 22)
1467 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1468 0, Qnil
, Qnil
, Qnil
, Qnil
);
1471 /* We can't handle a file which was compiled with
1472 byte-compile-dynamic by older version of Emacs. */
1473 specbind (Qload_force_doc_strings
, Qt
);
1474 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1475 0, Qnil
, Qnil
, Qnil
, Qnil
);
1477 unbind_to (count
, Qnil
);
1479 /* Run any eval-after-load forms for this file. */
1480 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1481 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1485 xfree (saved_doc_string
);
1486 saved_doc_string
= 0;
1487 saved_doc_string_size
= 0;
1489 xfree (prev_saved_doc_string
);
1490 prev_saved_doc_string
= 0;
1491 prev_saved_doc_string_size
= 0;
1493 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1496 message_with_string ("Loading %s (dymamic module)...done", file
, 1);
1498 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1501 message_with_string ("Loading %s (source)...done", file
, 1);
1503 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1505 else /* The typical case; compiled file newer than source file. */
1506 message_with_string ("Loading %s...done", file
, 1);
1513 complete_filename_p (Lisp_Object pathname
)
1515 const unsigned char *s
= SDATA (pathname
);
1516 return (IS_DIRECTORY_SEP (s
[0])
1517 || (SCHARS (pathname
) > 2
1518 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1521 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1522 doc
: /* Search for FILENAME through PATH.
1523 Returns the file's name in absolute form, or nil if not found.
1524 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1525 file name when searching.
1526 If non-nil, PREDICATE is used instead of `file-readable-p'.
1527 PREDICATE can also be an integer to pass to the faccessat(2) function,
1528 in which case file-name-handlers are ignored.
1529 This function will normally skip directories, so if you want it to find
1530 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1531 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1534 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1535 if (NILP (predicate
) && fd
>= 0)
1540 static Lisp_Object Qdir_ok
;
1542 /* Search for a file whose name is STR, looking in directories
1543 in the Lisp list PATH, and trying suffixes from SUFFIX.
1544 On success, return a file descriptor (or 1 or -2 as described below).
1545 On failure, return -1 and set errno.
1547 SUFFIXES is a list of strings containing possible suffixes.
1548 The empty suffix is automatically added if the list is empty.
1550 PREDICATE non-nil means don't open the files,
1551 just look for one that satisfies the predicate. In this case,
1552 return 1 on success. The predicate can be a lisp function or
1553 an integer to pass to `access' (in which case file-name-handlers
1556 If STOREPTR is nonzero, it points to a slot where the name of
1557 the file actually found should be stored as a Lisp string.
1558 nil is stored there on failure.
1560 If the file we find is remote, return -2
1561 but store the found remote file name in *STOREPTR.
1563 If NEWER is true, try all SUFFIXes and return the result for the
1564 newest file that exists. Does not apply to remote files,
1565 or if PREDICATE is specified. */
1568 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1569 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1571 ptrdiff_t fn_size
= 100;
1575 ptrdiff_t want_length
;
1576 Lisp_Object filename
;
1577 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
, gcpro7
;
1578 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1579 ptrdiff_t max_suffix_len
= 0;
1580 int last_errno
= ENOENT
;
1584 /* The last-modified time of the newest matching file found.
1585 Initialize it to something less than all valid timestamps. */
1586 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1590 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1592 CHECK_STRING_CAR (tail
);
1593 max_suffix_len
= max (max_suffix_len
,
1594 SBYTES (XCAR (tail
)));
1597 string
= filename
= encoded_fn
= save_string
= Qnil
;
1598 GCPRO7 (str
, string
, save_string
, filename
, path
, suffixes
, encoded_fn
);
1603 absolute
= complete_filename_p (str
);
1605 for (; CONSP (path
); path
= XCDR (path
))
1607 filename
= Fexpand_file_name (str
, XCAR (path
));
1608 if (!complete_filename_p (filename
))
1609 /* If there are non-absolute elts in PATH (eg "."). */
1610 /* Of course, this could conceivably lose if luser sets
1611 default-directory to be something non-absolute... */
1613 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1614 if (!complete_filename_p (filename
))
1615 /* Give up on this path element! */
1619 /* Calculate maximum length of any filename made from
1620 this path element/specified file name and any possible suffix. */
1621 want_length
= max_suffix_len
+ SBYTES (filename
);
1622 if (fn_size
<= want_length
)
1624 fn_size
= 100 + want_length
;
1625 fn
= SAFE_ALLOCA (fn_size
);
1628 /* Loop over suffixes. */
1629 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1630 CONSP (tail
); tail
= XCDR (tail
))
1632 Lisp_Object suffix
= XCAR (tail
);
1633 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1634 Lisp_Object handler
;
1636 /* Concatenate path element/specified name with the suffix.
1637 If the directory starts with /:, remove that. */
1638 int prefixlen
= ((SCHARS (filename
) > 2
1639 && SREF (filename
, 0) == '/'
1640 && SREF (filename
, 1) == ':')
1642 fnlen
= SBYTES (filename
) - prefixlen
;
1643 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1644 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1646 /* Check that the file exists and is not a directory. */
1647 /* We used to only check for handlers on non-absolute file names:
1651 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1652 It's not clear why that was the case and it breaks things like
1653 (load "/bar.el") where the file is actually "/bar.el.gz". */
1654 /* make_string has its own ideas on when to return a unibyte
1655 string and when a multibyte string, but we know better.
1656 We must have a unibyte string when dumping, since
1657 file-name encoding is shaky at best at that time, and in
1658 particular default-file-name-coding-system is reset
1659 several times during loadup. We therefore don't want to
1660 encode the file before passing it to file I/O library
1662 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1663 string
= make_unibyte_string (fn
, fnlen
);
1665 string
= make_string (fn
, fnlen
);
1666 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1667 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1670 if (NILP (predicate
))
1671 exists
= !NILP (Ffile_readable_p (string
));
1674 Lisp_Object tmp
= call1 (predicate
, string
);
1677 else if (EQ (tmp
, Qdir_ok
)
1678 || NILP (Ffile_directory_p (string
)))
1683 last_errno
= EISDIR
;
1689 /* We succeeded; return this descriptor and filename. */
1703 encoded_fn
= ENCODE_FILE (string
);
1704 pfn
= SSDATA (encoded_fn
);
1706 /* Check that we can access or open it. */
1707 if (NATNUMP (predicate
))
1710 if (INT_MAX
< XFASTINT (predicate
))
1711 last_errno
= EINVAL
;
1712 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1716 if (file_directory_p (pfn
))
1717 last_errno
= EISDIR
;
1724 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1727 if (errno
!= ENOENT
)
1732 int err
= (fstat (fd
, &st
) != 0 ? errno
1733 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1745 if (newer
&& !NATNUMP (predicate
))
1747 struct timespec mtime
= get_stat_mtime (&st
);
1749 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1754 emacs_close (save_fd
);
1757 save_string
= string
;
1762 /* We succeeded; return this descriptor and filename. */
1771 /* No more suffixes. Return the newest. */
1772 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1775 *storeptr
= save_string
;
1793 /* Merge the list we've accumulated of globals from the current input source
1794 into the load_history variable. The details depend on whether
1795 the source has an associated file name or not.
1797 FILENAME is the file name that we are loading from.
1799 ENTIRE is true if loading that entire file, false if evaluating
1803 build_load_history (Lisp_Object filename
, bool entire
)
1805 Lisp_Object tail
, prev
, newelt
;
1806 Lisp_Object tem
, tem2
;
1809 tail
= Vload_history
;
1812 while (CONSP (tail
))
1816 /* Find the feature's previous assoc list... */
1817 if (!NILP (Fequal (filename
, Fcar (tem
))))
1821 /* If we're loading the entire file, remove old data. */
1825 Vload_history
= XCDR (tail
);
1827 Fsetcdr (prev
, XCDR (tail
));
1830 /* Otherwise, cons on new symbols that are not already members. */
1833 tem2
= Vcurrent_load_list
;
1835 while (CONSP (tem2
))
1837 newelt
= XCAR (tem2
);
1839 if (NILP (Fmember (newelt
, tem
)))
1840 Fsetcar (tail
, Fcons (XCAR (tem
),
1841 Fcons (newelt
, XCDR (tem
))));
1854 /* If we're loading an entire file, cons the new assoc onto the
1855 front of load-history, the most-recently-loaded position. Also
1856 do this if we didn't find an existing member for the file. */
1857 if (entire
|| !foundit
)
1858 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1863 readevalloop_1 (int old
)
1865 load_convert_to_unibyte
= old
;
1868 /* Signal an `end-of-file' error, if possible with file name
1871 static _Noreturn
void
1872 end_of_file_error (void)
1874 if (STRINGP (Vload_file_name
))
1875 xsignal1 (Qend_of_file
, Vload_file_name
);
1877 xsignal0 (Qend_of_file
);
1881 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1883 /* If we macroexpand the toplevel form non-recursively and it ends
1884 up being a `progn' (or if it was a progn to start), treat each
1885 form in the progn as a top-level form. This way, if one form in
1886 the progn defines a macro, that macro is in effect when we expand
1887 the remaining forms. See similar code in bytecomp.el. */
1888 val
= call2 (macroexpand
, val
, Qnil
);
1889 if (EQ (CAR_SAFE (val
), Qprogn
))
1891 struct gcpro gcpro1
;
1892 Lisp_Object subforms
= XCDR (val
);
1895 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1896 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1901 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1905 /* UNIBYTE specifies how to set load_convert_to_unibyte
1906 for this invocation.
1907 READFUN, if non-nil, is used instead of `read'.
1909 START, END specify region to read in current buffer (from eval-region).
1910 If the input is not from a buffer, they must be nil. */
1913 readevalloop (Lisp_Object readcharfun
,
1915 Lisp_Object sourcename
,
1917 Lisp_Object unibyte
, Lisp_Object readfun
,
1918 Lisp_Object start
, Lisp_Object end
)
1921 register Lisp_Object val
;
1922 ptrdiff_t count
= SPECPDL_INDEX ();
1923 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1924 struct buffer
*b
= 0;
1925 bool continue_reading_p
;
1926 Lisp_Object lex_bound
;
1927 /* True if reading an entire buffer. */
1928 bool whole_buffer
= 0;
1929 /* True on the first time around. */
1930 bool first_sexp
= 1;
1931 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1933 if (NILP (Ffboundp (macroexpand
))
1934 /* Don't macroexpand in .elc files, since it should have been done
1935 already. We actually don't know whether we're in a .elc file or not,
1936 so we use circumstantial evidence: .el files normally go through
1937 Vload_source_file_function -> load-with-code-conversion
1939 || EQ (readcharfun
, Qget_file_char
)
1940 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1943 if (MARKERP (readcharfun
))
1946 start
= readcharfun
;
1949 if (BUFFERP (readcharfun
))
1950 b
= XBUFFER (readcharfun
);
1951 else if (MARKERP (readcharfun
))
1952 b
= XMARKER (readcharfun
)->buffer
;
1954 /* We assume START is nil when input is not from a buffer. */
1955 if (! NILP (start
) && !b
)
1958 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1959 specbind (Qcurrent_load_list
, Qnil
);
1960 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1961 load_convert_to_unibyte
= !NILP (unibyte
);
1963 /* If lexical binding is active (either because it was specified in
1964 the file's header, or via a buffer-local variable), create an empty
1965 lexical environment, otherwise, turn off lexical binding. */
1966 lex_bound
= find_symbol_value (Qlexical_binding
);
1967 specbind (Qinternal_interpreter_environment
,
1968 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1969 ? Qnil
: list1 (Qt
)));
1971 GCPRO4 (sourcename
, readfun
, start
, end
);
1973 /* Try to ensure sourcename is a truename, except whilst preloading. */
1974 if (NILP (Vpurify_flag
)
1975 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1976 && !NILP (Ffboundp (Qfile_truename
)))
1977 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1979 LOADHIST_ATTACH (sourcename
);
1981 continue_reading_p
= 1;
1982 while (continue_reading_p
)
1984 ptrdiff_t count1
= SPECPDL_INDEX ();
1986 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1987 error ("Reading from killed buffer");
1991 /* Switch to the buffer we are reading from. */
1992 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1993 set_buffer_internal (b
);
1995 /* Save point in it. */
1996 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1997 /* Save ZV in it. */
1998 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1999 /* Those get unbound after we read one expression. */
2001 /* Set point and ZV around stuff to be read. */
2004 Fnarrow_to_region (make_number (BEGV
), end
);
2006 /* Just for cleanliness, convert END to a marker
2007 if it is an integer. */
2009 end
= Fpoint_max_marker ();
2012 /* On the first cycle, we can easily test here
2013 whether we are reading the whole buffer. */
2014 if (b
&& first_sexp
)
2015 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
2022 while ((c
= READCHAR
) != '\n' && c
!= -1);
2027 unbind_to (count1
, Qnil
);
2031 /* Ignore whitespace here, so we can detect eof. */
2032 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
2033 || c
== 0xa0) /* NBSP */
2036 if (!NILP (Vpurify_flag
) && c
== '(')
2038 val
= read_list (0, readcharfun
);
2043 read_objects
= Qnil
;
2044 if (!NILP (readfun
))
2046 val
= call1 (readfun
, readcharfun
);
2048 /* If READCHARFUN has set point to ZV, we should
2049 stop reading, even if the form read sets point
2050 to a different value when evaluated. */
2051 if (BUFFERP (readcharfun
))
2053 struct buffer
*buf
= XBUFFER (readcharfun
);
2054 if (BUF_PT (buf
) == BUF_ZV (buf
))
2055 continue_reading_p
= 0;
2058 else if (! NILP (Vload_read_function
))
2059 val
= call1 (Vload_read_function
, readcharfun
);
2061 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
2064 if (!NILP (start
) && continue_reading_p
)
2065 start
= Fpoint_marker ();
2067 /* Restore saved point and BEGV. */
2068 unbind_to (count1
, Qnil
);
2070 /* Now eval what we just read. */
2071 if (!NILP (macroexpand
))
2072 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
2074 val
= eval_sub (val
);
2078 Vvalues
= Fcons (val
, Vvalues
);
2079 if (EQ (Vstandard_output
, Qt
))
2088 build_load_history (sourcename
,
2089 stream
|| whole_buffer
);
2093 unbind_to (count
, Qnil
);
2096 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
2097 doc
: /* Execute the current buffer as Lisp code.
2098 When called from a Lisp program (i.e., not interactively), this
2099 function accepts up to five optional arguments:
2100 BUFFER is the buffer to evaluate (nil means use current buffer).
2101 PRINTFLAG controls printing of output:
2102 A value of nil means discard it; anything else is stream for print.
2103 FILENAME specifies the file name to use for `load-history'.
2104 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
2106 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
2107 functions should work normally even if PRINTFLAG is nil.
2109 This function preserves the position of point. */)
2110 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
2112 ptrdiff_t count
= SPECPDL_INDEX ();
2113 Lisp_Object tem
, buf
;
2116 buf
= Fcurrent_buffer ();
2118 buf
= Fget_buffer (buffer
);
2120 error ("No such buffer");
2122 if (NILP (printflag
) && NILP (do_allow_print
))
2127 if (NILP (filename
))
2128 filename
= BVAR (XBUFFER (buf
), filename
);
2130 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
2131 specbind (Qstandard_output
, tem
);
2132 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
2133 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2134 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
2135 readevalloop (buf
, 0, filename
,
2136 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
2137 unbind_to (count
, Qnil
);
2142 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2143 doc
: /* Execute the region as Lisp code.
2144 When called from programs, expects two arguments,
2145 giving starting and ending indices in the current buffer
2146 of the text to be executed.
2147 Programs can pass third argument PRINTFLAG which controls output:
2148 A value of nil means discard it; anything else is stream for printing it.
2149 Also the fourth argument READ-FUNCTION, if non-nil, is used
2150 instead of `read' to read each expression. It gets one argument
2151 which is the input stream for reading characters.
2153 This function does not move point. */)
2154 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2156 /* FIXME: Do the eval-sexp-add-defvars dance! */
2157 ptrdiff_t count
= SPECPDL_INDEX ();
2158 Lisp_Object tem
, cbuf
;
2160 cbuf
= Fcurrent_buffer ();
2162 if (NILP (printflag
))
2166 specbind (Qstandard_output
, tem
);
2167 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2169 /* `readevalloop' calls functions which check the type of start and end. */
2170 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2171 !NILP (printflag
), Qnil
, read_function
,
2174 return unbind_to (count
, Qnil
);
2178 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2179 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2180 If STREAM is nil, use the value of `standard-input' (which see).
2181 STREAM or the value of `standard-input' may be:
2182 a buffer (read from point and advance it)
2183 a marker (read from where it points and advance it)
2184 a function (call it with no arguments for each character,
2185 call it with a char as argument to push a char back)
2186 a string (takes text from string, starting at the beginning)
2187 t (read text line using minibuffer and use it, or read from
2188 standard input in batch mode). */)
2189 (Lisp_Object stream
)
2192 stream
= Vstandard_input
;
2193 if (EQ (stream
, Qt
))
2194 stream
= Qread_char
;
2195 if (EQ (stream
, Qread_char
))
2196 /* FIXME: ?! When is this used !? */
2197 return call1 (intern ("read-minibuffer"),
2198 build_string ("Lisp expression: "));
2200 return read_internal_start (stream
, Qnil
, Qnil
);
2203 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2204 doc
: /* Read one Lisp expression which is represented as text by STRING.
2205 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2206 FINAL-STRING-INDEX is an integer giving the position of the next
2207 remaining character in STRING. START and END optionally delimit
2208 a substring of STRING from which to read; they default to 0 and
2209 (length STRING) respectively. Negative values are counted from
2210 the end of STRING. */)
2211 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2214 CHECK_STRING (string
);
2215 /* `read_internal_start' sets `read_from_string_index'. */
2216 ret
= read_internal_start (string
, start
, end
);
2217 return Fcons (ret
, make_number (read_from_string_index
));
2220 /* Function to set up the global context we need in toplevel read
2221 calls. START and END only used when STREAM is a string. */
2223 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2228 new_backquote_flag
= 0;
2229 read_objects
= Qnil
;
2230 if (EQ (Vread_with_symbol_positions
, Qt
)
2231 || EQ (Vread_with_symbol_positions
, stream
))
2232 Vread_symbol_positions_list
= Qnil
;
2234 if (STRINGP (stream
)
2235 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2237 ptrdiff_t startval
, endval
;
2240 if (STRINGP (stream
))
2243 string
= XCAR (stream
);
2245 validate_subarray (string
, start
, end
, SCHARS (string
),
2246 &startval
, &endval
);
2248 read_from_string_index
= startval
;
2249 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2250 read_from_string_limit
= endval
;
2253 retval
= read0 (stream
);
2254 if (EQ (Vread_with_symbol_positions
, Qt
)
2255 || EQ (Vread_with_symbol_positions
, stream
))
2256 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2261 /* Signal Qinvalid_read_syntax error.
2262 S is error string of length N (if > 0) */
2264 static _Noreturn
void
2265 invalid_syntax (const char *s
)
2267 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2271 /* Use this for recursive reads, in contexts where internal tokens
2275 read0 (Lisp_Object readcharfun
)
2277 register Lisp_Object val
;
2280 val
= read1 (readcharfun
, &c
, 0);
2284 xsignal1 (Qinvalid_read_syntax
,
2285 Fmake_string (make_number (1), make_number (c
)));
2288 static ptrdiff_t read_buffer_size
;
2289 static char *read_buffer
;
2291 /* Read a \-escape sequence, assuming we already read the `\'.
2292 If the escape sequence forces unibyte, return eight-bit char. */
2295 read_escape (Lisp_Object readcharfun
, bool stringp
)
2298 /* \u allows up to four hex digits, \U up to eight. Default to the
2299 behavior for \u, and change this value in the case that \U is seen. */
2300 int unicode_hex_count
= 4;
2305 end_of_file_error ();
2335 error ("Invalid escape character syntax");
2338 c
= read_escape (readcharfun
, 0);
2339 return c
| meta_modifier
;
2344 error ("Invalid escape character syntax");
2347 c
= read_escape (readcharfun
, 0);
2348 return c
| shift_modifier
;
2353 error ("Invalid escape character syntax");
2356 c
= read_escape (readcharfun
, 0);
2357 return c
| hyper_modifier
;
2362 error ("Invalid escape character syntax");
2365 c
= read_escape (readcharfun
, 0);
2366 return c
| alt_modifier
;
2370 if (stringp
|| c
!= '-')
2377 c
= read_escape (readcharfun
, 0);
2378 return c
| super_modifier
;
2383 error ("Invalid escape character syntax");
2387 c
= read_escape (readcharfun
, 0);
2388 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2389 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2390 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2391 return c
| ctrl_modifier
;
2392 /* ASCII control chars are made from letters (both cases),
2393 as well as the non-letters within 0100...0137. */
2394 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2395 return (c
& (037 | ~0177));
2396 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2397 return (c
& (037 | ~0177));
2399 return c
| ctrl_modifier
;
2409 /* An octal escape, as in ANSI C. */
2411 register int i
= c
- '0';
2412 register int count
= 0;
2415 if ((c
= READCHAR
) >= '0' && c
<= '7')
2427 if (i
>= 0x80 && i
< 0x100)
2428 i
= BYTE8_TO_CHAR (i
);
2433 /* A hex escape, as in ANSI C. */
2440 if (c
>= '0' && c
<= '9')
2445 else if ((c
>= 'a' && c
<= 'f')
2446 || (c
>= 'A' && c
<= 'F'))
2449 if (c
>= 'a' && c
<= 'f')
2459 /* Allow hex escapes as large as ?\xfffffff, because some
2460 packages use them to denote characters with modifiers. */
2461 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2462 error ("Hex character out of range: \\x%x...", i
);
2466 if (count
< 3 && i
>= 0x80)
2467 return BYTE8_TO_CHAR (i
);
2472 /* Post-Unicode-2.0: Up to eight hex chars. */
2473 unicode_hex_count
= 8;
2476 /* A Unicode escape. We only permit them in strings and characters,
2477 not arbitrarily in the source code, as in some other languages. */
2482 while (++count
<= unicode_hex_count
)
2485 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2487 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2488 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2489 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2491 error ("Non-hex digit used for Unicode escape");
2494 error ("Non-Unicode character: 0x%x", i
);
2503 /* Return the digit that CHARACTER stands for in the given BASE.
2504 Return -1 if CHARACTER is out of range for BASE,
2505 and -2 if CHARACTER is not valid for any supported BASE. */
2507 digit_to_number (int character
, int base
)
2511 if ('0' <= character
&& character
<= '9')
2512 digit
= character
- '0';
2513 else if ('a' <= character
&& character
<= 'z')
2514 digit
= character
- 'a' + 10;
2515 else if ('A' <= character
&& character
<= 'Z')
2516 digit
= character
- 'A' + 10;
2520 return digit
< base
? digit
: -1;
2523 /* Read an integer in radix RADIX using READCHARFUN to read
2524 characters. RADIX must be in the interval [2..36]; if it isn't, a
2525 read error is signaled . Value is the integer read. Signals an
2526 error if encountering invalid read syntax or if RADIX is out of
2530 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2532 /* Room for sign, leading 0, other digits, trailing null byte.
2533 Also, room for invalid syntax diagnostic. */
2534 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2535 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2537 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2539 if (radix
< 2 || radix
> 36)
2547 if (c
== '-' || c
== '+')
2558 /* Ignore redundant leading zeros, so the buffer doesn't
2559 fill up with them. */
2565 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2572 if (p
< buf
+ sizeof buf
- 1)
2586 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2587 invalid_syntax (buf
);
2590 return string_to_number (buf
, radix
, 0);
2594 /* If the next token is ')' or ']' or '.', we store that character
2595 in *PCH and the return value is not interesting. Else, we store
2596 zero in *PCH and we read and return one lisp object.
2598 FIRST_IN_LIST is true if this is the first element of a list. */
2601 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2604 bool uninterned_symbol
= 0;
2611 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2613 end_of_file_error ();
2618 return read_list (0, readcharfun
);
2621 return read_vector (readcharfun
, 0);
2637 /* Accept extended format for hashtables (extensible to
2639 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2640 Lisp_Object tmp
= read_list (0, readcharfun
);
2641 Lisp_Object head
= CAR_SAFE (tmp
);
2642 Lisp_Object data
= Qnil
;
2643 Lisp_Object val
= Qnil
;
2644 /* The size is 2 * number of allowed keywords to
2646 Lisp_Object params
[10];
2648 Lisp_Object key
= Qnil
;
2649 int param_count
= 0;
2651 if (!EQ (head
, Qhash_table
))
2652 error ("Invalid extended read marker at head of #s list "
2653 "(only hash-table allowed)");
2655 tmp
= CDR_SAFE (tmp
);
2657 /* This is repetitive but fast and simple. */
2658 params
[param_count
] = QCsize
;
2659 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2660 if (!NILP (params
[param_count
+ 1]))
2663 params
[param_count
] = QCtest
;
2664 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2665 if (!NILP (params
[param_count
+ 1]))
2668 params
[param_count
] = QCweakness
;
2669 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2670 if (!NILP (params
[param_count
+ 1]))
2673 params
[param_count
] = QCrehash_size
;
2674 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2675 if (!NILP (params
[param_count
+ 1]))
2678 params
[param_count
] = QCrehash_threshold
;
2679 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2680 if (!NILP (params
[param_count
+ 1]))
2683 /* This is the hashtable data. */
2684 data
= Fplist_get (tmp
, Qdata
);
2686 /* Now use params to make a new hashtable and fill it. */
2687 ht
= Fmake_hash_table (param_count
, params
);
2689 while (CONSP (data
))
2694 error ("Odd number of elements in hashtable data");
2697 Fputhash (key
, val
, ht
);
2703 invalid_syntax ("#");
2711 tmp
= read_vector (readcharfun
, 0);
2712 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2713 error ("Invalid size char-table");
2714 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2722 /* Sub char-table can't be read as a regular
2723 vector because of a two C integer fields. */
2724 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2725 ptrdiff_t size
= XINT (Flength (tmp
));
2726 int i
, depth
, min_char
;
2727 struct Lisp_Cons
*cell
;
2730 error ("Zero-sized sub char-table");
2732 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2733 error ("Invalid depth in sub char-table");
2734 depth
= XINT (XCAR (tmp
));
2735 if (chartab_size
[depth
] != size
- 2)
2736 error ("Invalid size in sub char-table");
2737 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2740 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2741 error ("Invalid minimum character in sub-char-table");
2742 min_char
= XINT (XCAR (tmp
));
2743 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2746 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2747 for (i
= 0; i
< size
; i
++)
2749 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2750 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2755 invalid_syntax ("#^^");
2757 invalid_syntax ("#^");
2762 length
= read1 (readcharfun
, pch
, first_in_list
);
2766 Lisp_Object tmp
, val
;
2767 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2768 unsigned char *data
;
2771 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2772 if (STRING_MULTIBYTE (tmp
)
2773 || (size_in_chars
!= SCHARS (tmp
)
2774 /* We used to print 1 char too many
2775 when the number of bits was a multiple of 8.
2776 Accept such input in case it came from an old
2778 && ! (XFASTINT (length
)
2779 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2780 invalid_syntax ("#&...");
2782 val
= make_uninit_bool_vector (XFASTINT (length
));
2783 data
= bool_vector_uchar_data (val
);
2784 memcpy (data
, SDATA (tmp
), size_in_chars
);
2785 /* Clear the extraneous bits in the last byte. */
2786 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2787 data
[size_in_chars
- 1]
2788 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2791 invalid_syntax ("#&...");
2795 /* Accept compiled functions at read-time so that we don't have to
2796 build them using function calls. */
2798 struct Lisp_Vector
*vec
;
2799 tmp
= read_vector (readcharfun
, 1);
2800 vec
= XVECTOR (tmp
);
2801 if (vec
->header
.size
== 0)
2802 invalid_syntax ("Empty byte-code object");
2803 make_byte_code (vec
);
2809 struct gcpro gcpro1
;
2812 /* Read the string itself. */
2813 tmp
= read1 (readcharfun
, &ch
, 0);
2814 if (ch
!= 0 || !STRINGP (tmp
))
2815 invalid_syntax ("#");
2817 /* Read the intervals and their properties. */
2820 Lisp_Object beg
, end
, plist
;
2822 beg
= read1 (readcharfun
, &ch
, 0);
2827 end
= read1 (readcharfun
, &ch
, 0);
2829 plist
= read1 (readcharfun
, &ch
, 0);
2831 invalid_syntax ("Invalid string property list");
2832 Fset_text_properties (beg
, end
, plist
, tmp
);
2838 /* #@NUMBER is used to skip NUMBER following bytes.
2839 That's used in .elc files to skip over doc strings
2840 and function definitions. */
2843 enum { extra
= 100 };
2844 ptrdiff_t i
, nskip
= 0, digits
= 0;
2846 /* Read a decimal integer. */
2847 while ((c
= READCHAR
) >= 0
2848 && c
>= '0' && c
<= '9')
2850 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2855 if (digits
== 2 && nskip
== 0)
2856 { /* We've just seen #@00, which means "skip to end". */
2857 skip_dyn_eof (readcharfun
);
2862 /* We can't use UNREAD here, because in the code below we side-step
2863 READCHAR. Instead, assume the first char after #@NNN occupies
2864 a single byte, which is the case normally since it's just
2870 if (load_force_doc_strings
2871 && (FROM_FILE_P (readcharfun
)))
2873 /* If we are supposed to force doc strings into core right now,
2874 record the last string that we skipped,
2875 and record where in the file it comes from. */
2877 /* But first exchange saved_doc_string
2878 with prev_saved_doc_string, so we save two strings. */
2880 char *temp
= saved_doc_string
;
2881 ptrdiff_t temp_size
= saved_doc_string_size
;
2882 file_offset temp_pos
= saved_doc_string_position
;
2883 ptrdiff_t temp_len
= saved_doc_string_length
;
2885 saved_doc_string
= prev_saved_doc_string
;
2886 saved_doc_string_size
= prev_saved_doc_string_size
;
2887 saved_doc_string_position
= prev_saved_doc_string_position
;
2888 saved_doc_string_length
= prev_saved_doc_string_length
;
2890 prev_saved_doc_string
= temp
;
2891 prev_saved_doc_string_size
= temp_size
;
2892 prev_saved_doc_string_position
= temp_pos
;
2893 prev_saved_doc_string_length
= temp_len
;
2896 if (saved_doc_string_size
== 0)
2898 saved_doc_string
= xmalloc (nskip
+ extra
);
2899 saved_doc_string_size
= nskip
+ extra
;
2901 if (nskip
> saved_doc_string_size
)
2903 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2904 saved_doc_string_size
= nskip
+ extra
;
2907 saved_doc_string_position
= file_tell (instream
);
2909 /* Copy that many characters into saved_doc_string. */
2911 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2912 saved_doc_string
[i
] = c
= getc (instream
);
2915 saved_doc_string_length
= i
;
2918 /* Skip that many bytes. */
2919 skip_dyn_bytes (readcharfun
, nskip
);
2925 /* #! appears at the beginning of an executable file.
2926 Skip the first line. */
2927 while (c
!= '\n' && c
>= 0)
2932 return Vload_file_name
;
2934 return list2 (Qfunction
, read0 (readcharfun
));
2935 /* #:foo is the uninterned symbol named foo. */
2938 uninterned_symbol
= 1;
2941 && c
!= 0xa0 /* NBSP */
2943 || strchr ("\"';()[]#`,", c
) == NULL
)))
2945 /* No symbol character follows, this is the empty
2948 return Fmake_symbol (empty_unibyte_string
);
2952 /* ## is the empty symbol. */
2954 return Fintern (empty_unibyte_string
, Qnil
);
2955 /* Reader forms that can reuse previously read objects. */
2956 if (c
>= '0' && c
<= '9')
2961 /* Read a non-negative integer. */
2962 while (c
>= '0' && c
<= '9')
2964 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2965 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2966 n
= MOST_POSITIVE_FIXNUM
+ 1;
2968 n
= n
* 10 + c
- '0';
2972 if (n
<= MOST_POSITIVE_FIXNUM
)
2974 if (c
== 'r' || c
== 'R')
2975 return read_integer (readcharfun
, n
);
2977 if (! NILP (Vread_circle
))
2979 /* #n=object returns object, but associates it with
2983 /* Make a placeholder for #n# to use temporarily. */
2984 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2985 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2986 read_objects
= Fcons (cell
, read_objects
);
2988 /* Read the object itself. */
2989 tem
= read0 (readcharfun
);
2991 /* Now put it everywhere the placeholder was... */
2992 substitute_object_in_subtree (tem
, placeholder
);
2994 /* ...and #n# will use the real value from now on. */
2995 Fsetcdr (cell
, tem
);
3000 /* #n# returns a previously read object. */
3003 tem
= Fassq (make_number (n
), read_objects
);
3009 /* Fall through to error message. */
3011 else if (c
== 'x' || c
== 'X')
3012 return read_integer (readcharfun
, 16);
3013 else if (c
== 'o' || c
== 'O')
3014 return read_integer (readcharfun
, 8);
3015 else if (c
== 'b' || c
== 'B')
3016 return read_integer (readcharfun
, 2);
3019 invalid_syntax ("#");
3022 while ((c
= READCHAR
) >= 0 && c
!= '\n');
3026 return list2 (Qquote
, read0 (readcharfun
));
3030 int next_char
= READCHAR
;
3032 /* Transition from old-style to new-style:
3033 If we see "(`" it used to mean old-style, which usually works
3034 fine because ` should almost never appear in such a position
3035 for new-style. But occasionally we need "(`" to mean new
3036 style, so we try to distinguish the two by the fact that we
3037 can either write "( `foo" or "(` foo", where the first
3038 intends to use new-style whereas the second intends to use
3039 old-style. For Emacs-25, we should completely remove this
3040 first_in_list exception (old-style can still be obtained via
3042 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
3044 Vold_style_backquotes
= Qt
;
3050 bool saved_new_backquote_flag
= new_backquote_flag
;
3052 new_backquote_flag
= 1;
3053 value
= read0 (readcharfun
);
3054 new_backquote_flag
= saved_new_backquote_flag
;
3056 return list2 (Qbackquote
, value
);
3061 int next_char
= READCHAR
;
3063 /* Transition from old-style to new-style:
3064 It used to be impossible to have a new-style , other than within
3065 a new-style `. This is sufficient when ` and , are used in the
3066 normal way, but ` and , can also appear in args to macros that
3067 will not interpret them in the usual way, in which case , may be
3068 used without any ` anywhere near.
3069 So we now use the same heuristic as for backquote: old-style
3070 unquotes are only recognized when first on a list, and when
3071 followed by a space.
3072 Because it's more difficult to peek 2 chars ahead, a new-style
3073 ,@ can still not be used outside of a `, unless it's in the middle
3075 if (new_backquote_flag
3077 || (next_char
!= ' ' && next_char
!= '@'))
3079 Lisp_Object comma_type
= Qnil
;
3084 comma_type
= Qcomma_at
;
3086 comma_type
= Qcomma_dot
;
3089 if (ch
>= 0) UNREAD (ch
);
3090 comma_type
= Qcomma
;
3093 value
= read0 (readcharfun
);
3094 return list2 (comma_type
, value
);
3098 Vold_style_backquotes
= Qt
;
3110 end_of_file_error ();
3112 /* Accept `single space' syntax like (list ? x) where the
3113 whitespace character is SPC or TAB.
3114 Other literal whitespace like NL, CR, and FF are not accepted,
3115 as there are well-established escape sequences for these. */
3116 if (c
== ' ' || c
== '\t')
3117 return make_number (c
);
3120 c
= read_escape (readcharfun
, 0);
3121 modifiers
= c
& CHAR_MODIFIER_MASK
;
3122 c
&= ~CHAR_MODIFIER_MASK
;
3123 if (CHAR_BYTE8_P (c
))
3124 c
= CHAR_TO_BYTE8 (c
);
3127 next_char
= READCHAR
;
3128 ok
= (next_char
<= 040
3129 || (next_char
< 0200
3130 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3133 return make_number (c
);
3135 invalid_syntax ("?");
3140 char *p
= read_buffer
;
3141 char *end
= read_buffer
+ read_buffer_size
;
3143 /* True if we saw an escape sequence specifying
3144 a multibyte character. */
3145 bool force_multibyte
= 0;
3146 /* True if we saw an escape sequence specifying
3147 a single-byte character. */
3148 bool force_singlebyte
= 0;
3150 ptrdiff_t nchars
= 0;
3152 while ((ch
= READCHAR
) >= 0
3155 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3157 ptrdiff_t offset
= p
- read_buffer
;
3158 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3159 memory_full (SIZE_MAX
);
3160 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3161 read_buffer_size
*= 2;
3162 p
= read_buffer
+ offset
;
3163 end
= read_buffer
+ read_buffer_size
;
3170 ch
= read_escape (readcharfun
, 1);
3172 /* CH is -1 if \ newline has just been seen. */
3175 if (p
== read_buffer
)
3180 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3181 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3183 if (CHAR_BYTE8_P (ch
))
3184 force_singlebyte
= 1;
3185 else if (! ASCII_CHAR_P (ch
))
3186 force_multibyte
= 1;
3187 else /* I.e. ASCII_CHAR_P (ch). */
3189 /* Allow `\C- ' and `\C-?'. */
3190 if (modifiers
== CHAR_CTL
)
3193 ch
= 0, modifiers
= 0;
3195 ch
= 127, modifiers
= 0;
3197 if (modifiers
& CHAR_SHIFT
)
3199 /* Shift modifier is valid only with [A-Za-z]. */
3200 if (ch
>= 'A' && ch
<= 'Z')
3201 modifiers
&= ~CHAR_SHIFT
;
3202 else if (ch
>= 'a' && ch
<= 'z')
3203 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3206 if (modifiers
& CHAR_META
)
3208 /* Move the meta bit to the right place for a
3210 modifiers
&= ~CHAR_META
;
3211 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3212 force_singlebyte
= 1;
3216 /* Any modifiers remaining are invalid. */
3218 error ("Invalid modifier in string");
3219 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3223 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3224 if (CHAR_BYTE8_P (ch
))
3225 force_singlebyte
= 1;
3226 else if (! ASCII_CHAR_P (ch
))
3227 force_multibyte
= 1;
3233 end_of_file_error ();
3235 /* If purifying, and string starts with \ newline,
3236 return zero instead. This is for doc strings
3237 that we are really going to find in etc/DOC.nn.nn. */
3238 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3239 return make_number (0);
3241 if (! force_multibyte
&& force_singlebyte
)
3243 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3244 forms. Convert it to unibyte. */
3245 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3247 p
= read_buffer
+ nchars
;
3250 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3252 || (p
- read_buffer
!= nchars
)));
3257 int next_char
= READCHAR
;
3260 if (next_char
<= 040
3261 || (next_char
< 0200
3262 && strchr ("\"';([#?`,", next_char
) != NULL
))
3268 /* Otherwise, we fall through! Note that the atom-reading loop
3269 below will now loop at least once, assuring that we will not
3270 try to UNREAD two characters in a row. */
3274 if (c
<= 040) goto retry
;
3275 if (c
== 0xa0) /* NBSP */
3280 char *p
= read_buffer
;
3282 EMACS_INT start_position
= readchar_count
- 1;
3285 char *end
= read_buffer
+ read_buffer_size
;
3289 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3291 ptrdiff_t offset
= p
- read_buffer
;
3292 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3293 memory_full (SIZE_MAX
);
3294 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3295 read_buffer_size
*= 2;
3296 p
= read_buffer
+ offset
;
3297 end
= read_buffer
+ read_buffer_size
;
3304 end_of_file_error ();
3309 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3315 && c
!= 0xa0 /* NBSP */
3317 || strchr ("\"';()[]#`,", c
) == NULL
));
3321 ptrdiff_t offset
= p
- read_buffer
;
3322 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3323 memory_full (SIZE_MAX
);
3324 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3325 read_buffer_size
*= 2;
3326 p
= read_buffer
+ offset
;
3327 end
= read_buffer
+ read_buffer_size
;
3333 if (!quoted
&& !uninterned_symbol
)
3335 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3336 if (! NILP (result
))
3340 Lisp_Object name
, result
;
3341 ptrdiff_t nbytes
= p
- read_buffer
;
3344 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3348 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3349 ? make_pure_string
: make_specified_string
)
3350 (read_buffer
, nchars
, nbytes
, multibyte
));
3351 result
= (uninterned_symbol
? Fmake_symbol (name
)
3352 : Fintern (name
, Qnil
));
3354 if (EQ (Vread_with_symbol_positions
, Qt
)
3355 || EQ (Vread_with_symbol_positions
, readcharfun
))
3356 Vread_symbol_positions_list
3357 = Fcons (Fcons (result
, make_number (start_position
)),
3358 Vread_symbol_positions_list
);
3366 /* List of nodes we've seen during substitute_object_in_subtree. */
3367 static Lisp_Object seen_list
;
3370 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3372 Lisp_Object check_object
;
3374 /* We haven't seen any objects when we start. */
3377 /* Make all the substitutions. */
3379 = substitute_object_recurse (object
, placeholder
, object
);
3381 /* Clear seen_list because we're done with it. */
3384 /* The returned object here is expected to always eq the
3386 if (!EQ (check_object
, object
))
3387 error ("Unexpected mutation error in reader");
3390 /* Feval doesn't get called from here, so no gc protection is needed. */
3391 #define SUBSTITUTE(get_val, set_val) \
3393 Lisp_Object old_value = get_val; \
3394 Lisp_Object true_value \
3395 = substitute_object_recurse (object, placeholder, \
3398 if (!EQ (old_value, true_value)) \
3405 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3407 /* If we find the placeholder, return the target object. */
3408 if (EQ (placeholder
, subtree
))
3411 /* If we've been to this node before, don't explore it again. */
3412 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3415 /* If this node can be the entry point to a cycle, remember that
3416 we've seen it. It can only be such an entry point if it was made
3417 by #n=, which means that we can find it as a value in
3419 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3420 seen_list
= Fcons (subtree
, seen_list
);
3422 /* Recurse according to subtree's type.
3423 Every branch must return a Lisp_Object. */
3424 switch (XTYPE (subtree
))
3426 case Lisp_Vectorlike
:
3428 ptrdiff_t i
, length
= 0;
3429 if (BOOL_VECTOR_P (subtree
))
3430 return subtree
; /* No sub-objects anyway. */
3431 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3432 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3433 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3434 else if (VECTORP (subtree
))
3435 length
= ASIZE (subtree
);
3437 /* An unknown pseudovector may contain non-Lisp fields, so we
3438 can't just blindly traverse all its fields. We used to call
3439 `Flength' which signaled `sequencep', so I just preserved this
3441 wrong_type_argument (Qsequencep
, subtree
);
3443 for (i
= 0; i
< length
; i
++)
3444 SUBSTITUTE (AREF (subtree
, i
),
3445 ASET (subtree
, i
, true_value
));
3451 SUBSTITUTE (XCAR (subtree
),
3452 XSETCAR (subtree
, true_value
));
3453 SUBSTITUTE (XCDR (subtree
),
3454 XSETCDR (subtree
, true_value
));
3460 /* Check for text properties in each interval.
3461 substitute_in_interval contains part of the logic. */
3463 INTERVAL root_interval
= string_intervals (subtree
);
3464 AUTO_CONS (arg
, object
, placeholder
);
3466 traverse_intervals_noorder (root_interval
,
3467 &substitute_in_interval
, arg
);
3472 /* Other types don't recurse any further. */
3478 /* Helper function for substitute_object_recurse. */
3480 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3482 Lisp_Object object
= Fcar (arg
);
3483 Lisp_Object placeholder
= Fcdr (arg
);
3485 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3495 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3496 integer syntax and fits in a fixnum, else return the nearest float if CP has
3497 either floating point or integer syntax and BASE is 10, else return nil. If
3498 IGNORE_TRAILING, consider just the longest prefix of CP that has
3499 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3500 number has integer syntax but does not fit. */
3503 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3506 char const *cp
= string
;
3508 bool float_syntax
= 0;
3511 /* Compute NaN and infinities using a variable, to cope with compilers that
3512 think they are smarter than we are. */
3515 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3516 IEEE floating point hosts, and works around a formerly-common bug where
3517 atof ("-0.0") drops the sign. */
3518 bool negative
= *cp
== '-';
3520 bool signedp
= negative
|| *cp
== '+';
3525 leading_digit
= digit_to_number (*cp
, base
);
3526 if (leading_digit
>= 0)
3531 while (digit_to_number (*cp
, base
) >= 0);
3541 if ('0' <= *cp
&& *cp
<= '9')
3546 while ('0' <= *cp
&& *cp
<= '9');
3548 if (*cp
== 'e' || *cp
== 'E')
3550 char const *ecp
= cp
;
3552 if (*cp
== '+' || *cp
== '-')
3554 if ('0' <= *cp
&& *cp
<= '9')
3559 while ('0' <= *cp
&& *cp
<= '9');
3561 else if (cp
[-1] == '+'
3562 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3568 else if (cp
[-1] == '+'
3569 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3573 value
= zero
/ zero
;
3575 /* If that made a "negative" NaN, negate it. */
3578 union { double d
; char c
[sizeof (double)]; }
3579 u_data
, u_minus_zero
;
3581 u_minus_zero
.d
= -0.0;
3582 for (i
= 0; i
< sizeof (double); i
++)
3583 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3589 /* Now VALUE is a positive NaN. */
3595 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3596 || state
== (LEAD_INT
|E_EXP
));
3599 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3600 any prefix that matches. Otherwise, the entire string must match. */
3601 if (! (ignore_trailing
3602 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3603 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3606 /* If the number uses integer and not float syntax, and is in C-language
3607 range, use its value, preferably as a fixnum. */
3608 if (leading_digit
>= 0 && ! float_syntax
)
3612 /* Fast special case for single-digit integers. This also avoids a
3613 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3614 case some versions of strtoumax accept numbers like "0x1" that Emacs
3616 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3617 return make_number (negative
? -leading_digit
: leading_digit
);
3620 n
= strtoumax (string
+ signedp
, NULL
, base
);
3621 if (errno
== ERANGE
)
3623 /* Unfortunately there's no simple and accurate way to convert
3624 non-base-10 numbers that are out of C-language range. */
3626 xsignal1 (Qoverflow_error
, build_string (string
));
3628 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3630 EMACS_INT signed_n
= n
;
3631 return make_number (negative
? -signed_n
: signed_n
);
3637 /* Either the number uses float syntax, or it does not fit into a fixnum.
3638 Convert it from string to floating point, unless the value is already
3639 known because it is an infinity, a NAN, or its absolute value fits in
3642 value
= atof (string
+ signedp
);
3644 return make_float (negative
? -value
: value
);
3649 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3653 Lisp_Object tem
, item
, vector
;
3654 struct Lisp_Cons
*otem
;
3657 tem
= read_list (1, readcharfun
);
3658 len
= Flength (tem
);
3659 vector
= Fmake_vector (len
, Qnil
);
3661 size
= ASIZE (vector
);
3662 ptr
= XVECTOR (vector
)->contents
;
3663 for (i
= 0; i
< size
; i
++)
3666 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3667 bytecode object, the docstring containing the bytecode and
3668 constants values must be treated as unibyte and passed to
3669 Fread, to get the actual bytecode string and constants vector. */
3670 if (bytecodeflag
&& load_force_doc_strings
)
3672 if (i
== COMPILED_BYTECODE
)
3674 if (!STRINGP (item
))
3675 error ("Invalid byte code");
3677 /* Delay handling the bytecode slot until we know whether
3678 it is lazily-loaded (we can tell by whether the
3679 constants slot is nil). */
3680 ASET (vector
, COMPILED_CONSTANTS
, item
);
3683 else if (i
== COMPILED_CONSTANTS
)
3685 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3689 /* Coerce string to unibyte (like string-as-unibyte,
3690 but without generating extra garbage and
3691 guaranteeing no change in the contents). */
3692 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3693 STRING_SET_UNIBYTE (bytestr
);
3695 item
= Fread (Fcons (bytestr
, readcharfun
));
3697 error ("Invalid byte code");
3699 otem
= XCONS (item
);
3700 bytestr
= XCAR (item
);
3705 /* Now handle the bytecode slot. */
3706 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3708 else if (i
== COMPILED_DOC_STRING
3710 && ! STRING_MULTIBYTE (item
))
3712 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3713 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3715 item
= Fstring_as_multibyte (item
);
3718 ASET (vector
, i
, item
);
3726 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3729 read_list (bool flag
, Lisp_Object readcharfun
)
3731 Lisp_Object val
, tail
;
3732 Lisp_Object elt
, tem
;
3733 struct gcpro gcpro1
, gcpro2
;
3734 /* 0 is the normal case.
3735 1 means this list is a doc reference; replace it with the number 0.
3736 2 means this list is a doc reference; replace it with the doc string. */
3737 int doc_reference
= 0;
3739 /* Initialize this to 1 if we are reading a list. */
3740 bool first_in_list
= flag
<= 0;
3749 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3754 /* While building, if the list starts with #$, treat it specially. */
3755 if (EQ (elt
, Vload_file_name
)
3757 && !NILP (Vpurify_flag
))
3759 if (NILP (Vdoc_file_name
))
3760 /* We have not yet called Snarf-documentation, so assume
3761 this file is described in the DOC file
3762 and Snarf-documentation will fill in the right value later.
3763 For now, replace the whole list with 0. */
3766 /* We have already called Snarf-documentation, so make a relative
3767 file name for this file, so it can be found properly
3768 in the installed Lisp directory.
3769 We don't use Fexpand_file_name because that would make
3770 the directory absolute now. */
3772 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3773 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3776 else if (EQ (elt
, Vload_file_name
)
3778 && load_force_doc_strings
)
3787 invalid_syntax (") or . in a vector");
3795 XSETCDR (tail
, read0 (readcharfun
));
3797 val
= read0 (readcharfun
);
3798 read1 (readcharfun
, &ch
, 0);
3802 if (doc_reference
== 1)
3803 return make_number (0);
3804 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3807 file_offset saved_position
;
3808 /* Get a doc string from the file we are loading.
3809 If it's in saved_doc_string, get it from there.
3811 Here, we don't know if the string is a
3812 bytecode string or a doc string. As a
3813 bytecode string must be unibyte, we always
3814 return a unibyte string. If it is actually a
3815 doc string, caller must make it
3818 /* Position is negative for user variables. */
3819 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3820 if (pos
>= saved_doc_string_position
3821 && pos
< (saved_doc_string_position
3822 + saved_doc_string_length
))
3824 saved
= saved_doc_string
;
3825 saved_position
= saved_doc_string_position
;
3827 /* Look in prev_saved_doc_string the same way. */
3828 else if (pos
>= prev_saved_doc_string_position
3829 && pos
< (prev_saved_doc_string_position
3830 + prev_saved_doc_string_length
))
3832 saved
= prev_saved_doc_string
;
3833 saved_position
= prev_saved_doc_string_position
;
3837 ptrdiff_t start
= pos
- saved_position
;
3840 /* Process quoting with ^A,
3841 and find the end of the string,
3842 which is marked with ^_ (037). */
3843 for (from
= start
, to
= start
;
3844 saved
[from
] != 037;)
3846 int c
= saved
[from
++];
3850 saved
[to
++] = (c
== 1 ? c
3859 return make_unibyte_string (saved
+ start
,
3863 return get_doc_string (val
, 1, 0);
3868 invalid_syntax (". in wrong context");
3870 invalid_syntax ("] in a list");
3874 XSETCDR (tail
, tem
);
3881 static Lisp_Object initial_obarray
;
3883 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3885 static size_t oblookup_last_bucket_number
;
3887 /* Get an error if OBARRAY is not an obarray.
3888 If it is one, return it. */
3891 check_obarray (Lisp_Object obarray
)
3893 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3895 /* If Vobarray is now invalid, force it to be valid. */
3896 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3897 wrong_type_argument (Qvectorp
, obarray
);
3902 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3905 intern_driver (Lisp_Object string
, Lisp_Object obarray
, ptrdiff_t index
)
3907 Lisp_Object
*ptr
, sym
= Fmake_symbol (string
);
3909 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3910 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3913 if ((SREF (string
, 0) == ':') && EQ (obarray
, initial_obarray
))
3915 XSYMBOL (sym
)->constant
= 1;
3916 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3917 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3920 ptr
= aref_addr (obarray
, index
);
3921 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3926 /* Intern the C string STR: return a symbol with that name,
3927 interned in the current obarray. */
3930 intern_1 (const char *str
, ptrdiff_t len
)
3932 Lisp_Object obarray
= check_obarray (Vobarray
);
3933 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3935 return SYMBOLP (tem
) ? tem
: intern_driver (make_string (str
, len
),
3936 obarray
, XINT (tem
));
3940 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3942 Lisp_Object obarray
= check_obarray (Vobarray
);
3943 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3947 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, XINT (tem
));
3952 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3953 doc
: /* Return the canonical symbol whose name is STRING.
3954 If there is none, one is created by this function and returned.
3955 A second optional argument specifies the obarray to use;
3956 it defaults to the value of `obarray'. */)
3957 (Lisp_Object string
, Lisp_Object obarray
)
3961 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3962 CHECK_STRING (string
);
3964 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3966 tem
= intern_driver (NILP (Vpurify_flag
) ? string
3967 : Fpurecopy (string
), obarray
, XINT (tem
));
3971 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3972 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3973 NAME may be a string or a symbol. If it is a symbol, that exact
3974 symbol is searched for.
3975 A second optional argument specifies the obarray to use;
3976 it defaults to the value of `obarray'. */)
3977 (Lisp_Object name
, Lisp_Object obarray
)
3979 register Lisp_Object tem
, string
;
3981 if (NILP (obarray
)) obarray
= Vobarray
;
3982 obarray
= check_obarray (obarray
);
3984 if (!SYMBOLP (name
))
3986 CHECK_STRING (name
);
3990 string
= SYMBOL_NAME (name
);
3992 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3993 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3999 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
4000 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
4001 The value is t if a symbol was found and deleted, nil otherwise.
4002 NAME may be a string or a symbol. If it is a symbol, that symbol
4003 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
4004 OBARRAY, if nil, defaults to the value of the variable `obarray'.
4005 usage: (unintern NAME OBARRAY) */)
4006 (Lisp_Object name
, Lisp_Object obarray
)
4008 register Lisp_Object string
, tem
;
4011 if (NILP (obarray
)) obarray
= Vobarray
;
4012 obarray
= check_obarray (obarray
);
4015 string
= SYMBOL_NAME (name
);
4018 CHECK_STRING (name
);
4022 tem
= oblookup (obarray
, SSDATA (string
),
4027 /* If arg was a symbol, don't delete anything but that symbol itself. */
4028 if (SYMBOLP (name
) && !EQ (name
, tem
))
4031 /* There are plenty of other symbols which will screw up the Emacs
4032 session if we unintern them, as well as even more ways to use
4033 `setq' or `fset' or whatnot to make the Emacs session
4034 unusable. Let's not go down this silly road. --Stef */
4035 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
4036 error ("Attempt to unintern t or nil"); */
4038 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
4040 hash
= oblookup_last_bucket_number
;
4042 if (EQ (AREF (obarray
, hash
), tem
))
4044 if (XSYMBOL (tem
)->next
)
4047 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
4048 ASET (obarray
, hash
, sym
);
4051 ASET (obarray
, hash
, make_number (0));
4055 Lisp_Object tail
, following
;
4057 for (tail
= AREF (obarray
, hash
);
4058 XSYMBOL (tail
)->next
;
4061 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
4062 if (EQ (following
, tem
))
4064 set_symbol_next (tail
, XSYMBOL (following
)->next
);
4073 /* Return the symbol in OBARRAY whose names matches the string
4074 of SIZE characters (SIZE_BYTE bytes) at PTR.
4075 If there is no such symbol, return the integer bucket number of
4076 where the symbol would be if it were present.
4078 Also store the bucket number in oblookup_last_bucket_number. */
4081 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
4085 register Lisp_Object tail
;
4086 Lisp_Object bucket
, tem
;
4088 obarray
= check_obarray (obarray
);
4089 obsize
= ASIZE (obarray
);
4091 /* This is sometimes needed in the middle of GC. */
4092 obsize
&= ~ARRAY_MARK_FLAG
;
4093 hash
= hash_string (ptr
, size_byte
) % obsize
;
4094 bucket
= AREF (obarray
, hash
);
4095 oblookup_last_bucket_number
= hash
;
4096 if (EQ (bucket
, make_number (0)))
4098 else if (!SYMBOLP (bucket
))
4099 error ("Bad data in guts of obarray"); /* Like CADR error message. */
4101 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
4103 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
4104 && SCHARS (SYMBOL_NAME (tail
)) == size
4105 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
4107 else if (XSYMBOL (tail
)->next
== 0)
4110 XSETINT (tem
, hash
);
4115 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
4118 register Lisp_Object tail
;
4119 CHECK_VECTOR (obarray
);
4120 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
4122 tail
= AREF (obarray
, i
);
4127 if (XSYMBOL (tail
)->next
== 0)
4129 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4135 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4137 call1 (function
, sym
);
4140 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4141 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4142 OBARRAY defaults to the value of `obarray'. */)
4143 (Lisp_Object function
, Lisp_Object obarray
)
4145 if (NILP (obarray
)) obarray
= Vobarray
;
4146 obarray
= check_obarray (obarray
);
4148 map_obarray (obarray
, mapatoms_1
, function
);
4152 #define OBARRAY_SIZE 1511
4157 Lisp_Object oblength
;
4158 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4160 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4162 Vobarray
= Fmake_vector (oblength
, make_number (0));
4163 initial_obarray
= Vobarray
;
4164 staticpro (&initial_obarray
);
4166 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
4167 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
4168 NILP (Vpurify_flag) check in intern_c_string. */
4169 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
4170 Qnil
= intern_c_string ("nil");
4172 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
4173 so those two need to be fixed manually. */
4174 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
4175 set_symbol_function (Qunbound
, Qnil
);
4176 set_symbol_plist (Qunbound
, Qnil
);
4177 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4178 XSYMBOL (Qnil
)->constant
= 1;
4179 XSYMBOL (Qnil
)->declared_special
= 1;
4180 set_symbol_plist (Qnil
, Qnil
);
4181 set_symbol_function (Qnil
, Qnil
);
4183 Qt
= intern_c_string ("t");
4184 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4185 XSYMBOL (Qnil
)->declared_special
= 1;
4186 XSYMBOL (Qt
)->constant
= 1;
4188 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4191 DEFSYM (Qvariable_documentation
, "variable-documentation");
4193 read_buffer
= xmalloc (size
);
4194 read_buffer_size
= size
;
4198 defsubr (struct Lisp_Subr
*sname
)
4200 Lisp_Object sym
, tem
;
4202 sym
= intern_c_string (sname
->symbol_name
);
4203 XSETPVECTYPE (sname
, PVEC_SUBR
);
4204 XSETSUBR (tem
, sname
);
4205 set_symbol_function (sym
, tem
);
4208 #ifdef NOTDEF /* Use fset in subr.el now! */
4210 defalias (struct Lisp_Subr
*sname
, char *string
)
4213 sym
= intern (string
);
4214 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4218 /* Define an "integer variable"; a symbol whose value is forwarded to a
4219 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4220 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4222 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4223 const char *namestring
, EMACS_INT
*address
)
4226 sym
= intern_c_string (namestring
);
4227 i_fwd
->type
= Lisp_Fwd_Int
;
4228 i_fwd
->intvar
= address
;
4229 XSYMBOL (sym
)->declared_special
= 1;
4230 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4231 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4234 /* Similar but define a variable whose value is t if address contains 1,
4235 nil if address contains 0. */
4237 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4238 const char *namestring
, bool *address
)
4241 sym
= intern_c_string (namestring
);
4242 b_fwd
->type
= Lisp_Fwd_Bool
;
4243 b_fwd
->boolvar
= address
;
4244 XSYMBOL (sym
)->declared_special
= 1;
4245 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4246 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4247 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4250 /* Similar but define a variable whose value is the Lisp Object stored
4251 at address. Two versions: with and without gc-marking of the C
4252 variable. The nopro version is used when that variable will be
4253 gc-marked for some other reason, since marking the same slot twice
4254 can cause trouble with strings. */
4256 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4257 const char *namestring
, Lisp_Object
*address
)
4260 sym
= intern_c_string (namestring
);
4261 o_fwd
->type
= Lisp_Fwd_Obj
;
4262 o_fwd
->objvar
= address
;
4263 XSYMBOL (sym
)->declared_special
= 1;
4264 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4265 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4269 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4270 const char *namestring
, Lisp_Object
*address
)
4272 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4273 staticpro (address
);
4276 /* Similar but define a variable whose value is the Lisp Object stored
4277 at a particular offset in the current kboard object. */
4280 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4281 const char *namestring
, int offset
)
4284 sym
= intern_c_string (namestring
);
4285 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4286 ko_fwd
->offset
= offset
;
4287 XSYMBOL (sym
)->declared_special
= 1;
4288 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4289 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4292 /* Check that the elements of lpath exist. */
4295 load_path_check (Lisp_Object lpath
)
4297 Lisp_Object path_tail
;
4299 /* The only elements that might not exist are those from
4300 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4302 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4304 Lisp_Object dirfile
;
4305 dirfile
= Fcar (path_tail
);
4306 if (STRINGP (dirfile
))
4308 dirfile
= Fdirectory_file_name (dirfile
);
4309 if (! file_accessible_directory_p (dirfile
))
4310 dir_warning ("Lisp directory", XCAR (path_tail
));
4315 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4316 This does not include the standard site-lisp directories
4317 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4318 but it does (unless no_site_lisp is set) include site-lisp
4319 directories in the source/build directories if those exist and we
4320 are running uninstalled.
4322 Uses the following logic:
4323 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4324 The remainder is what happens when dumping works:
4325 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4326 Otherwise use PATH_LOADSEARCH.
4328 If !initialized, then just return PATH_DUMPLOADSEARCH.
4330 If Vinstallation_directory is not nil (ie, running uninstalled):
4331 If installation-dir/lisp exists and not already a member,
4332 we must be running uninstalled. Reset the load-path
4333 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4334 refers to the eventual installation directories. Since we
4335 are not yet installed, we should not use them, even if they exist.)
4336 If installation-dir/lisp does not exist, just add
4337 PATH_DUMPLOADSEARCH at the end instead.
4338 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4339 and not already a member) at the front.
4340 If installation-dir != source-dir (ie running an uninstalled,
4341 out-of-tree build) AND install-dir/src/Makefile exists BUT
4342 install-dir/src/Makefile.in does NOT exist (this is a sanity
4343 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4346 load_path_default (void)
4348 Lisp_Object lpath
= Qnil
;
4353 const char *loadpath
= ns_load_path ();
4356 normal
= PATH_LOADSEARCH
;
4358 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4360 lpath
= decode_env_path (0, normal
, 0);
4363 #else /* !CANNOT_DUMP */
4365 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4370 const char *loadpath
= ns_load_path ();
4371 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4373 lpath
= decode_env_path (0, normal
, 0);
4375 if (!NILP (Vinstallation_directory
))
4377 Lisp_Object tem
, tem1
;
4379 /* Add to the path the lisp subdir of the installation
4380 dir, if it is accessible. Note: in out-of-tree builds,
4381 this directory is empty save for Makefile. */
4382 tem
= Fexpand_file_name (build_string ("lisp"),
4383 Vinstallation_directory
);
4384 tem1
= Ffile_accessible_directory_p (tem
);
4387 if (NILP (Fmember (tem
, lpath
)))
4389 /* We are running uninstalled. The default load-path
4390 points to the eventual installed lisp directories.
4391 We should not use those now, even if they exist,
4392 so start over from a clean slate. */
4393 lpath
= list1 (tem
);
4397 /* That dir doesn't exist, so add the build-time
4398 Lisp dirs instead. */
4400 Lisp_Object dump_path
=
4401 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4402 lpath
= nconc2 (lpath
, dump_path
);
4405 /* Add site-lisp under the installation dir, if it exists. */
4408 tem
= Fexpand_file_name (build_string ("site-lisp"),
4409 Vinstallation_directory
);
4410 tem1
= Ffile_accessible_directory_p (tem
);
4413 if (NILP (Fmember (tem
, lpath
)))
4414 lpath
= Fcons (tem
, lpath
);
4418 /* If Emacs was not built in the source directory,
4419 and it is run from where it was built, add to load-path
4420 the lisp and site-lisp dirs under that directory. */
4422 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4426 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4427 Vinstallation_directory
);
4428 tem1
= Ffile_exists_p (tem
);
4430 /* Don't be fooled if they moved the entire source tree
4431 AFTER dumping Emacs. If the build directory is indeed
4432 different from the source dir, src/Makefile.in and
4433 src/Makefile will not be found together. */
4434 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4435 Vinstallation_directory
);
4436 tem2
= Ffile_exists_p (tem
);
4437 if (!NILP (tem1
) && NILP (tem2
))
4439 tem
= Fexpand_file_name (build_string ("lisp"),
4442 if (NILP (Fmember (tem
, lpath
)))
4443 lpath
= Fcons (tem
, lpath
);
4447 tem
= Fexpand_file_name (build_string ("site-lisp"),
4449 tem1
= Ffile_accessible_directory_p (tem
);
4452 if (NILP (Fmember (tem
, lpath
)))
4453 lpath
= Fcons (tem
, lpath
);
4457 } /* Vinstallation_directory != Vsource_directory */
4459 } /* if Vinstallation_directory */
4461 else /* !initialized */
4463 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4464 source directory. We used to add ../lisp (ie the lisp dir in
4465 the build directory) at the front here, but that should not
4466 be necessary, since in out of tree builds lisp/ is empty, save
4468 lpath
= decode_env_path (0, normal
, 0);
4470 #endif /* !CANNOT_DUMP */
4478 /* First, set Vload_path. */
4480 /* Ignore EMACSLOADPATH when dumping. */
4482 bool use_loadpath
= true;
4484 bool use_loadpath
= NILP (Vpurify_flag
);
4487 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4489 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4491 /* Check (non-nil) user-supplied elements. */
4492 load_path_check (Vload_path
);
4494 /* If no nils in the environment variable, use as-is.
4495 Otherwise, replace any nils with the default. */
4496 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4498 Lisp_Object elem
, elpath
= Vload_path
;
4499 Lisp_Object default_lpath
= load_path_default ();
4501 /* Check defaults, before adding site-lisp. */
4502 load_path_check (default_lpath
);
4504 /* Add the site-lisp directories to the front of the default. */
4507 Lisp_Object sitelisp
;
4508 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4509 if (! NILP (sitelisp
))
4510 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4515 /* Replace nils from EMACSLOADPATH by default. */
4516 while (CONSP (elpath
))
4519 elem
= XCAR (elpath
);
4520 elpath
= XCDR (elpath
);
4521 arg
[0] = Vload_path
;
4522 arg
[1] = NILP (elem
) ? default_lpath
: Fcons (elem
, Qnil
);
4523 Vload_path
= Fappend (2, arg
);
4525 } /* Fmemq (Qnil, Vload_path) */
4529 Vload_path
= load_path_default ();
4531 /* Check before adding site-lisp directories.
4532 The install should have created them, but they are not
4533 required, so no need to warn if they are absent.
4534 Or we might be running before installation. */
4535 load_path_check (Vload_path
);
4537 /* Add the site-lisp directories at the front. */
4538 if (initialized
&& !no_site_lisp
)
4540 Lisp_Object sitelisp
;
4541 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4542 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4548 load_in_progress
= 0;
4549 Vload_file_name
= Qnil
;
4550 Vstandard_input
= Qt
;
4551 Vloads_in_progress
= Qnil
;
4554 /* Print a warning that directory intended for use USE and with name
4555 DIRNAME cannot be accessed. On entry, errno should correspond to
4556 the access failure. Print the warning on stderr and put it in
4560 dir_warning (char const *use
, Lisp_Object dirname
)
4562 static char const format
[] = "Warning: %s `%s': %s\n";
4563 int access_errno
= errno
;
4564 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4566 /* Don't log the warning before we've initialized!! */
4569 char const *diagnostic
= emacs_strerror (access_errno
);
4571 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4572 + strlen (use
) + SBYTES (dirname
)
4573 + strlen (diagnostic
));
4574 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4576 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4582 syms_of_lread (void)
4585 defsubr (&Sread_from_string
);
4587 defsubr (&Sintern_soft
);
4588 defsubr (&Sunintern
);
4589 defsubr (&Sget_load_suffixes
);
4591 defsubr (&Seval_buffer
);
4592 defsubr (&Seval_region
);
4593 defsubr (&Sread_char
);
4594 defsubr (&Sread_char_exclusive
);
4595 defsubr (&Sread_event
);
4596 defsubr (&Sget_file_char
);
4597 defsubr (&Smapatoms
);
4598 defsubr (&Slocate_file_internal
);
4599 defsubr (&Sload_module
);
4601 DEFVAR_LISP ("obarray", Vobarray
,
4602 doc
: /* Symbol table for use by `intern' and `read'.
4603 It is a vector whose length ought to be prime for best results.
4604 The vector's contents don't make sense if examined from Lisp programs;
4605 to find all the symbols in an obarray, use `mapatoms'. */);
4607 DEFVAR_LISP ("values", Vvalues
,
4608 doc
: /* List of values of all expressions which were read, evaluated and printed.
4609 Order is reverse chronological. */);
4610 XSYMBOL (intern ("values"))->declared_special
= 0;
4612 DEFVAR_LISP ("standard-input", Vstandard_input
,
4613 doc
: /* Stream for read to get input from.
4614 See documentation of `read' for possible values. */);
4615 Vstandard_input
= Qt
;
4617 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4618 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4620 If this variable is a buffer, then only forms read from that buffer
4621 will be added to `read-symbol-positions-list'.
4622 If this variable is t, then all read forms will be added.
4623 The effect of all other values other than nil are not currently
4624 defined, although they may be in the future.
4626 The positions are relative to the last call to `read' or
4627 `read-from-string'. It is probably a bad idea to set this variable at
4628 the toplevel; bind it instead. */);
4629 Vread_with_symbol_positions
= Qnil
;
4631 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4632 doc
: /* A list mapping read symbols to their positions.
4633 This variable is modified during calls to `read' or
4634 `read-from-string', but only when `read-with-symbol-positions' is
4637 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4638 CHAR-POSITION is an integer giving the offset of that occurrence of the
4639 symbol from the position where `read' or `read-from-string' started.
4641 Note that a symbol will appear multiple times in this list, if it was
4642 read multiple times. The list is in the same order as the symbols
4644 Vread_symbol_positions_list
= Qnil
;
4646 DEFVAR_LISP ("read-circle", Vread_circle
,
4647 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4650 DEFVAR_LISP ("load-path", Vload_path
,
4651 doc
: /* List of directories to search for files to load.
4652 Each element is a string (directory name) or nil (meaning `default-directory').
4653 Initialized during startup as described in Info node `(elisp)Library Search'. */);
4655 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4656 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4657 This list should not include the empty string.
4658 `load' and related functions try to append these suffixes, in order,
4659 to the specified file name if a Lisp suffix is allowed or required. */);
4661 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4662 build_pure_c_string (".el"));
4664 DEFVAR_LISP ("load-module-suffixes", Vload_module_suffixes
,
4665 doc
: /* List of suffixes for modules files.
4666 This list should not include the empty string. See `load-suffixes'. */);
4669 Vload_module_suffixes
= list3 (build_pure_c_string (".dll"),
4670 build_pure_c_string (".so"),
4671 build_pure_c_string (".dylib"));
4673 Vload_module_suffixes
= Qnil
;
4676 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4677 doc
: /* List of suffixes that indicate representations of \
4679 This list should normally start with the empty string.
4681 Enabling Auto Compression mode appends the suffixes in
4682 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4683 mode removes them again. `load' and related functions use this list to
4684 determine whether they should look for compressed versions of a file
4685 and, if so, which suffixes they should try to append to the file name
4686 in order to do so. However, if you want to customize which suffixes
4687 the loading functions recognize as compression suffixes, you should
4688 customize `jka-compr-load-suffixes' rather than the present variable. */);
4689 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4691 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4692 doc
: /* Non-nil if inside of `load'. */);
4693 DEFSYM (Qload_in_progress
, "load-in-progress");
4695 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4696 doc
: /* An alist of functions to be evalled when particular files are loaded.
4697 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4699 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4700 a symbol \(a feature name).
4702 When `load' is run and the file-name argument matches an element's
4703 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4704 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4706 An error in FORMS does not undo the load, but does prevent execution of
4707 the rest of the FORMS. */);
4708 Vafter_load_alist
= Qnil
;
4710 DEFVAR_LISP ("load-history", Vload_history
,
4711 doc
: /* Alist mapping loaded file names to symbols and features.
4712 Each alist element should be a list (FILE-NAME ENTRIES...), where
4713 FILE-NAME is the name of a file that has been loaded into Emacs.
4714 The file name is absolute and true (i.e. it doesn't contain symlinks).
4715 As an exception, one of the alist elements may have FILE-NAME nil,
4716 for symbols and features not associated with any file.
4718 The remaining ENTRIES in the alist element describe the functions and
4719 variables defined in that file, the features provided, and the
4720 features required. Each entry has the form `(provide . FEATURE)',
4721 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4722 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4723 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4724 autoload before this file redefined it as a function. In addition,
4725 entries may also be single symbols, which means that SYMBOL was
4726 defined by `defvar' or `defconst'.
4728 During preloading, the file name recorded is relative to the main Lisp
4729 directory. These file names are converted to absolute at startup. */);
4730 Vload_history
= Qnil
;
4732 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4733 doc
: /* Full name of file being loaded by `load'. */);
4734 Vload_file_name
= Qnil
;
4736 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4737 doc
: /* File name, including directory, of user's initialization file.
4738 If the file loaded had extension `.elc', and the corresponding source file
4739 exists, this variable contains the name of source file, suitable for use
4740 by functions like `custom-save-all' which edit the init file.
4741 While Emacs loads and evaluates the init file, value is the real name
4742 of the file, regardless of whether or not it has the `.elc' extension. */);
4743 Vuser_init_file
= Qnil
;
4745 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4746 doc
: /* Used for internal purposes by `load'. */);
4747 Vcurrent_load_list
= Qnil
;
4749 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4750 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4751 The default is nil, which means use the function `read'. */);
4752 Vload_read_function
= Qnil
;
4754 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4755 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4756 The value should be a function for doing code conversion before
4757 reading a source file. It can also be nil, in which case loading is
4758 done without any code conversion.
4760 If the value is a function, it is called with four arguments,
4761 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4762 the file to load, FILE is the non-absolute name (for messages etc.),
4763 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4764 `load'. The function should return t if the file was loaded. */);
4765 Vload_source_file_function
= Qnil
;
4767 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4768 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4769 This is useful when the file being loaded is a temporary copy. */);
4770 load_force_doc_strings
= 0;
4772 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4773 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4774 This is normally bound by `load' and `eval-buffer' to control `read',
4775 and is not meant for users to change. */);
4776 load_convert_to_unibyte
= 0;
4778 DEFVAR_LISP ("source-directory", Vsource_directory
,
4779 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4780 You cannot count on them to still be there! */);
4782 = Fexpand_file_name (build_string ("../"),
4783 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4785 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4786 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4787 Vpreloaded_file_list
= Qnil
;
4789 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4790 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4791 Vbyte_boolean_vars
= Qnil
;
4793 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4794 doc
: /* Non-nil means load dangerous compiled Lisp files.
4795 Some versions of XEmacs use different byte codes than Emacs. These
4796 incompatible byte codes can make Emacs crash when it tries to execute
4798 load_dangerous_libraries
= 0;
4800 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4801 doc
: /* Non-nil means force printing messages when loading Lisp files.
4802 This overrides the value of the NOMESSAGE argument to `load'. */);
4803 force_load_messages
= 0;
4805 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4806 doc
: /* Regular expression matching safe to load compiled Lisp files.
4807 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4808 from the file, and matches them against this regular expression.
4809 When the regular expression matches, the file is considered to be safe
4810 to load. See also `load-dangerous-libraries'. */);
4811 Vbytecomp_version_regexp
4812 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4814 DEFSYM (Qlexical_binding
, "lexical-binding");
4815 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4816 doc
: /* Whether to use lexical binding when evaluating code.
4817 Non-nil means that the code in the current buffer should be evaluated
4818 with lexical binding.
4819 This variable is automatically set from the file variables of an
4820 interpreted Lisp file read using `load'. Unlike other file local
4821 variables, this must be set in the first line of a file. */);
4822 Vlexical_binding
= Qnil
;
4823 Fmake_variable_buffer_local (Qlexical_binding
);
4825 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4826 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4827 Veval_buffer_list
= Qnil
;
4829 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4830 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4831 Vold_style_backquotes
= Qnil
;
4832 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4834 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4835 doc
: /* Non-nil means `load' prefers the newest version of a file.
4836 This applies when a filename suffix is not explicitly specified and
4837 `load' is trying various possible suffixes (see `load-suffixes' and
4838 `load-file-rep-suffixes'). Normally, it stops at the first file
4839 that exists unless you explicitly specify one or the other. If this
4840 option is non-nil, it checks all suffixes and uses whichever file is
4842 Note that if you customize this, obviously it will not affect files
4843 that are loaded before your customizations are read! */);
4844 load_prefer_newer
= 0;
4846 /* Vsource_directory was initialized in init_lread. */
4848 DEFSYM (Qcurrent_load_list
, "current-load-list");
4849 DEFSYM (Qstandard_input
, "standard-input");
4850 DEFSYM (Qread_char
, "read-char");
4851 DEFSYM (Qget_file_char
, "get-file-char");
4852 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4853 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4855 DEFSYM (Qbackquote
, "`");
4856 DEFSYM (Qcomma
, ",");
4857 DEFSYM (Qcomma_at
, ",@");
4858 DEFSYM (Qcomma_dot
, ",.");
4860 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4861 DEFSYM (Qascii_character
, "ascii-character");
4862 DEFSYM (Qfunction
, "function");
4863 DEFSYM (Qload
, "load");
4864 DEFSYM (Qload_file_name
, "load-file-name");
4865 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4866 DEFSYM (Qfile_truename
, "file-truename");
4867 DEFSYM (Qdir_ok
, "dir-ok");
4868 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4870 staticpro (&read_objects
);
4871 read_objects
= Qnil
;
4872 staticpro (&seen_list
);
4875 Vloads_in_progress
= Qnil
;
4876 staticpro (&Vloads_in_progress
);
4878 DEFSYM (Qhash_table
, "hash-table");
4879 DEFSYM (Qdata
, "data");
4880 DEFSYM (Qtest
, "test");
4881 DEFSYM (Qsize
, "size");
4882 DEFSYM (Qweakness
, "weakness");
4883 DEFSYM (Qrehash_size
, "rehash-size");
4884 DEFSYM (Qrehash_threshold
, "rehash-threshold");