1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2013 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
28 #include <limits.h> /* For CHAR_BIT. */
29 #include <stat-time.h>
31 #include "intervals.h"
32 #include "character.h"
40 #include "termhooks.h"
41 #include "blockinput.h"
55 #endif /* HAVE_SETLOCALE */
60 #define file_offset off_t
61 #define file_tell ftello
63 #define file_offset long
64 #define file_tell ftell
67 /* Hash table read constants. */
68 static Lisp_Object Qhash_table
, Qdata
;
69 static Lisp_Object Qtest
, Qsize
;
70 static Lisp_Object Qweakness
;
71 static Lisp_Object Qrehash_size
;
72 static Lisp_Object Qrehash_threshold
;
74 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
75 Lisp_Object Qstandard_input
;
76 Lisp_Object Qvariable_documentation
;
77 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
78 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
79 static Lisp_Object Qinhibit_file_name_operation
;
80 static Lisp_Object Qeval_buffer_list
;
81 Lisp_Object Qlexical_binding
;
82 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
84 /* Used instead of Qget_file_char while loading *.elc files compiled
85 by Emacs 21 or older. */
86 static Lisp_Object Qget_emacs_mule_file_char
;
88 static Lisp_Object Qload_force_doc_strings
;
90 static Lisp_Object Qload_in_progress
;
92 /* The association list of objects read with the #n=object form.
93 Each member of the list has the form (n . object), and is used to
94 look up the object for the corresponding #n# construct.
95 It must be set to nil before all top-level calls to read0. */
96 static Lisp_Object read_objects
;
98 /* File for get_file_char to read from. Use by load. */
99 static FILE *instream
;
101 /* For use within read-from-string (this reader is non-reentrant!!) */
102 static ptrdiff_t read_from_string_index
;
103 static ptrdiff_t read_from_string_index_byte
;
104 static ptrdiff_t read_from_string_limit
;
106 /* Number of characters read in the current call to Fread or
107 Fread_from_string. */
108 static EMACS_INT readchar_count
;
110 /* This contains the last string skipped with #@. */
111 static char *saved_doc_string
;
112 /* Length of buffer allocated in saved_doc_string. */
113 static ptrdiff_t saved_doc_string_size
;
114 /* Length of actual data in saved_doc_string. */
115 static ptrdiff_t saved_doc_string_length
;
116 /* This is the file position that string came from. */
117 static file_offset saved_doc_string_position
;
119 /* This contains the previous string skipped with #@.
120 We copy it from saved_doc_string when a new string
121 is put in saved_doc_string. */
122 static char *prev_saved_doc_string
;
123 /* Length of buffer allocated in prev_saved_doc_string. */
124 static ptrdiff_t prev_saved_doc_string_size
;
125 /* Length of actual data in prev_saved_doc_string. */
126 static ptrdiff_t prev_saved_doc_string_length
;
127 /* This is the file position that string came from. */
128 static file_offset prev_saved_doc_string_position
;
130 /* True means inside a new-style backquote
131 with no surrounding parentheses.
132 Fread initializes this to false, so we need not specbind it
133 or worry about what happens to it when there is an error. */
134 static bool new_backquote_flag
;
135 static Lisp_Object Qold_style_backquotes
;
137 /* A list of file names for files being loaded in Fload. Used to
138 check for recursive loads. */
140 static Lisp_Object Vloads_in_progress
;
142 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
145 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
146 Lisp_Object
, Lisp_Object
,
147 Lisp_Object
, Lisp_Object
);
149 /* Functions that read one byte from the current source READCHARFUN
150 or unreads one byte. If the integer argument C is -1, it returns
151 one read byte, or -1 when there's no more byte in the source. If C
152 is 0 or positive, it unreads C, and the return value is not
155 static int readbyte_for_lambda (int, Lisp_Object
);
156 static int readbyte_from_file (int, Lisp_Object
);
157 static int readbyte_from_string (int, Lisp_Object
);
159 /* Handle unreading and rereading of characters.
160 Write READCHAR to read a character,
161 UNREAD(c) to unread c to be read again.
163 These macros correctly read/unread multibyte characters. */
165 #define READCHAR readchar (readcharfun, NULL)
166 #define UNREAD(c) unreadchar (readcharfun, c)
168 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
169 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
171 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
172 Qlambda, or a cons, we use this to keep an unread character because
173 a file stream can't handle multibyte-char unreading. The value -1
174 means that there's no unread character. */
175 static int unread_char
;
178 readchar (Lisp_Object readcharfun
, bool *multibyte
)
182 int (*readbyte
) (int, Lisp_Object
);
183 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
185 bool emacs_mule_encoding
= 0;
192 if (BUFFERP (readcharfun
))
194 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
196 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
198 if (! BUFFER_LIVE_P (inbuffer
))
201 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
204 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
206 /* Fetch the character code from the buffer. */
207 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
208 BUF_INC_POS (inbuffer
, pt_byte
);
215 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
216 if (! ASCII_BYTE_P (c
))
217 c
= BYTE8_TO_CHAR (c
);
220 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
224 if (MARKERP (readcharfun
))
226 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
228 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
230 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
233 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
235 /* Fetch the character code from the buffer. */
236 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
237 BUF_INC_POS (inbuffer
, bytepos
);
244 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
245 if (! ASCII_BYTE_P (c
))
246 c
= BYTE8_TO_CHAR (c
);
250 XMARKER (readcharfun
)->bytepos
= bytepos
;
251 XMARKER (readcharfun
)->charpos
++;
256 if (EQ (readcharfun
, Qlambda
))
258 readbyte
= readbyte_for_lambda
;
262 if (EQ (readcharfun
, Qget_file_char
))
264 readbyte
= readbyte_from_file
;
268 if (STRINGP (readcharfun
))
270 if (read_from_string_index
>= read_from_string_limit
)
272 else if (STRING_MULTIBYTE (readcharfun
))
276 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
277 read_from_string_index
,
278 read_from_string_index_byte
);
282 c
= SREF (readcharfun
, read_from_string_index_byte
);
283 read_from_string_index
++;
284 read_from_string_index_byte
++;
289 if (CONSP (readcharfun
))
291 /* This is the case that read_vector is reading from a unibyte
292 string that contains a byte sequence previously skipped
293 because of #@NUMBER. The car part of readcharfun is that
294 string, and the cdr part is a value of readcharfun given to
296 readbyte
= readbyte_from_string
;
297 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
298 emacs_mule_encoding
= 1;
302 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
304 readbyte
= readbyte_from_file
;
305 emacs_mule_encoding
= 1;
309 tem
= call0 (readcharfun
);
316 if (unread_char
>= 0)
322 c
= (*readbyte
) (-1, readcharfun
);
327 if (ASCII_BYTE_P (c
))
329 if (emacs_mule_encoding
)
330 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
333 len
= BYTES_BY_CHAR_HEAD (c
);
336 c
= (*readbyte
) (-1, readcharfun
);
337 if (c
< 0 || ! TRAILING_CODE_P (c
))
340 (*readbyte
) (buf
[i
], readcharfun
);
341 return BYTE8_TO_CHAR (buf
[0]);
345 return STRING_CHAR (buf
);
348 #define FROM_FILE_P(readcharfun) \
349 (EQ (readcharfun, Qget_file_char) \
350 || EQ (readcharfun, Qget_emacs_mule_file_char))
353 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
355 if (FROM_FILE_P (readcharfun
))
357 block_input (); /* FIXME: Not sure if it's needed. */
358 fseek (instream
, n
, SEEK_CUR
);
362 { /* We're not reading directly from a file. In that case, it's difficult
363 to reliably count bytes, since these are usually meant for the file's
364 encoding, whereas we're now typically in the internal encoding.
365 But luckily, skip_dyn_bytes is used to skip over a single
366 dynamic-docstring (or dynamic byte-code) which is always quoted such
367 that \037 is the final char. */
371 } while (c
>= 0 && c
!= '\037');
376 skip_dyn_eof (Lisp_Object readcharfun
)
378 if (FROM_FILE_P (readcharfun
))
380 block_input (); /* FIXME: Not sure if it's needed. */
381 fseek (instream
, 0, SEEK_END
);
385 while (READCHAR
>= 0);
388 /* Unread the character C in the way appropriate for the stream READCHARFUN.
389 If the stream is a user function, call it with the char as argument. */
392 unreadchar (Lisp_Object readcharfun
, int c
)
396 /* Don't back up the pointer if we're unreading the end-of-input mark,
397 since readchar didn't advance it when we read it. */
399 else if (BUFFERP (readcharfun
))
401 struct buffer
*b
= XBUFFER (readcharfun
);
402 ptrdiff_t charpos
= BUF_PT (b
);
403 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
405 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
406 BUF_DEC_POS (b
, bytepos
);
410 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
412 else if (MARKERP (readcharfun
))
414 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
415 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
417 XMARKER (readcharfun
)->charpos
--;
418 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
419 BUF_DEC_POS (b
, bytepos
);
423 XMARKER (readcharfun
)->bytepos
= bytepos
;
425 else if (STRINGP (readcharfun
))
427 read_from_string_index
--;
428 read_from_string_index_byte
429 = string_char_to_byte (readcharfun
, read_from_string_index
);
431 else if (CONSP (readcharfun
))
435 else if (EQ (readcharfun
, Qlambda
))
439 else if (FROM_FILE_P (readcharfun
))
444 call1 (readcharfun
, make_number (c
));
448 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
450 return read_bytecode_char (c
>= 0);
455 readbyte_from_file (int c
, Lisp_Object readcharfun
)
460 ungetc (c
, instream
);
468 /* Interrupted reads have been observed while reading over the network. */
469 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
480 return (c
== EOF
? -1 : c
);
484 readbyte_from_string (int c
, Lisp_Object readcharfun
)
486 Lisp_Object string
= XCAR (readcharfun
);
490 read_from_string_index
--;
491 read_from_string_index_byte
492 = string_char_to_byte (string
, read_from_string_index
);
495 if (read_from_string_index
>= read_from_string_limit
)
498 FETCH_STRING_CHAR_ADVANCE (c
, string
,
499 read_from_string_index
,
500 read_from_string_index_byte
);
505 /* Read one non-ASCII character from INSTREAM. The character is
506 encoded in `emacs-mule' and the first byte is already read in
510 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
512 /* Emacs-mule coding uses at most 4-byte for one character. */
513 unsigned char buf
[4];
514 int len
= emacs_mule_bytes
[c
];
515 struct charset
*charset
;
520 /* C is not a valid leading-code of `emacs-mule'. */
521 return BYTE8_TO_CHAR (c
);
527 c
= (*readbyte
) (-1, readcharfun
);
531 (*readbyte
) (buf
[i
], readcharfun
);
532 return BYTE8_TO_CHAR (buf
[0]);
539 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
540 code
= buf
[1] & 0x7F;
544 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
545 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
547 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
548 code
= buf
[2] & 0x7F;
552 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
553 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
558 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
559 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
561 c
= DECODE_CHAR (charset
, code
);
563 Fsignal (Qinvalid_read_syntax
,
564 list1 (build_string ("invalid multibyte form")));
569 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
571 static Lisp_Object
read0 (Lisp_Object
);
572 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
574 static Lisp_Object
read_list (bool, Lisp_Object
);
575 static Lisp_Object
read_vector (Lisp_Object
, bool);
577 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
579 static void substitute_object_in_subtree (Lisp_Object
,
581 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
584 /* Get a character from the tty. */
586 /* Read input events until we get one that's acceptable for our purposes.
588 If NO_SWITCH_FRAME, switch-frame events are stashed
589 until we get a character we like, and then stuffed into
592 If ASCII_REQUIRED, check function key events to see
593 if the unmodified version of the symbol has a Qascii_character
594 property, and use that character, if present.
596 If ERROR_NONASCII, signal an error if the input we
597 get isn't an ASCII character with modifiers. If it's false but
598 ASCII_REQUIRED is true, just re-read until we get an ASCII
601 If INPUT_METHOD, invoke the current input method
602 if the character warrants that.
604 If SECONDS is a number, wait that many seconds for input, and
605 return Qnil if no input arrives within that time. */
608 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
609 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
611 Lisp_Object val
, delayed_switch_frame
;
612 struct timespec end_time
;
614 #ifdef HAVE_WINDOW_SYSTEM
615 if (display_hourglass_p
)
619 delayed_switch_frame
= Qnil
;
621 /* Compute timeout. */
622 if (NUMBERP (seconds
))
624 double duration
= extract_float (seconds
);
625 struct timespec wait_time
= dtotimespec (duration
);
626 end_time
= timespec_add (current_timespec (), wait_time
);
629 /* Read until we get an acceptable event. */
632 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
633 NUMBERP (seconds
) ? &end_time
: NULL
);
634 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
639 /* `switch-frame' events are put off until after the next ASCII
640 character. This is better than signaling an error just because
641 the last characters were typed to a separate minibuffer frame,
642 for example. Eventually, some code which can deal with
643 switch-frame events will read it and process it. */
645 && EVENT_HAS_PARAMETERS (val
)
646 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
648 delayed_switch_frame
= val
;
652 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
654 /* Convert certain symbols to their ASCII equivalents. */
657 Lisp_Object tem
, tem1
;
658 tem
= Fget (val
, Qevent_symbol_element_mask
);
661 tem1
= Fget (Fcar (tem
), Qascii_character
);
662 /* Merge this symbol's modifier bits
663 with the ASCII equivalent of its basic code. */
665 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
669 /* If we don't have a character now, deal with it appropriately. */
674 Vunread_command_events
= list1 (val
);
675 error ("Non-character input-event");
682 if (! NILP (delayed_switch_frame
))
683 unread_switch_frame
= delayed_switch_frame
;
687 #ifdef HAVE_WINDOW_SYSTEM
688 if (display_hourglass_p
)
697 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
698 doc
: /* Read a character from the command input (keyboard or macro).
699 It is returned as a number.
700 If the character has modifiers, they are resolved and reflected to the
701 character code if possible (e.g. C-SPC -> 0).
703 If the user generates an event which is not a character (i.e. a mouse
704 click or function key event), `read-char' signals an error. As an
705 exception, switch-frame events are put off until non-character events
707 If you want to read non-character events, or ignore them, call
708 `read-event' or `read-char-exclusive' instead.
710 If the optional argument PROMPT is non-nil, display that as a prompt.
711 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
712 input method is turned on in the current buffer, that input method
713 is used for reading a character.
714 If the optional argument SECONDS is non-nil, it should be a number
715 specifying the maximum number of seconds to wait for input. If no
716 input arrives in that time, return nil. SECONDS may be a
717 floating-point value. */)
718 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
723 message_with_string ("%s", prompt
, 0);
724 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
726 return (NILP (val
) ? Qnil
727 : make_number (char_resolve_modifier_mask (XINT (val
))));
730 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
731 doc
: /* Read an event object from the input stream.
732 If the optional argument PROMPT is non-nil, display that as a prompt.
733 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
734 input method is turned on in the current buffer, that input method
735 is used for reading a character.
736 If the optional argument SECONDS is non-nil, it should be a number
737 specifying the maximum number of seconds to wait for input. If no
738 input arrives in that time, return nil. SECONDS may be a
739 floating-point value. */)
740 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
743 message_with_string ("%s", prompt
, 0);
744 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
747 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
748 doc
: /* Read a character from the command input (keyboard or macro).
749 It is returned as a number. Non-character events are ignored.
750 If the character has modifiers, they are resolved and reflected to the
751 character code if possible (e.g. C-SPC -> 0).
753 If the optional argument PROMPT is non-nil, display that as a prompt.
754 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
755 input method is turned on in the current buffer, that input method
756 is used for reading a character.
757 If the optional argument SECONDS is non-nil, it should be a number
758 specifying the maximum number of seconds to wait for input. If no
759 input arrives in that time, return nil. SECONDS may be a
760 floating-point value. */)
761 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
766 message_with_string ("%s", prompt
, 0);
768 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
770 return (NILP (val
) ? Qnil
771 : make_number (char_resolve_modifier_mask (XINT (val
))));
774 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
775 doc
: /* Don't use this yourself. */)
778 register Lisp_Object val
;
780 XSETINT (val
, getc (instream
));
788 /* Return true if the lisp code read using READCHARFUN defines a non-nil
789 `lexical-binding' file variable. After returning, the stream is
790 positioned following the first line, if it is a comment or #! line,
791 otherwise nothing is read. */
794 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
807 while (ch
!= '\n' && ch
!= EOF
)
809 if (ch
== '\n') ch
= READCHAR
;
810 /* It is OK to leave the position after a #! line, since
811 that is what read1 does. */
815 /* The first line isn't a comment, just give up. */
821 /* Look for an appropriate file-variable in the first line. */
825 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
826 } beg_end_state
= NOMINAL
;
827 bool in_file_vars
= 0;
829 #define UPDATE_BEG_END_STATE(ch) \
830 if (beg_end_state == NOMINAL) \
831 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
832 else if (beg_end_state == AFTER_FIRST_DASH) \
833 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
834 else if (beg_end_state == AFTER_ASTERIX) \
837 in_file_vars = !in_file_vars; \
838 beg_end_state = NOMINAL; \
841 /* Skip until we get to the file vars, if any. */
845 UPDATE_BEG_END_STATE (ch
);
847 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
851 char var
[100], val
[100];
856 /* Read a variable name. */
857 while (ch
== ' ' || ch
== '\t')
861 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
863 if (i
< sizeof var
- 1)
865 UPDATE_BEG_END_STATE (ch
);
869 /* Stop scanning if no colon was found before end marker. */
870 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
873 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
879 /* Read a variable value. */
882 while (ch
== ' ' || ch
== '\t')
886 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
888 if (i
< sizeof val
- 1)
890 UPDATE_BEG_END_STATE (ch
);
894 /* The value was terminated by an end-marker, which remove. */
896 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
900 if (strcmp (var
, "lexical-binding") == 0)
903 rv
= (strcmp (val
, "nil") != 0);
909 while (ch
!= '\n' && ch
!= EOF
)
916 /* Value is a version number of byte compiled code if the file
917 associated with file descriptor FD is a compiled Lisp file that's
918 safe to load. Only files compiled with Emacs are safe to load.
919 Files compiled with XEmacs can lead to a crash in Fbyte_code
920 because of an incompatible change in the byte compiler. */
923 safe_to_load_version (int fd
)
929 /* Read the first few bytes from the file, and look for a line
930 specifying the byte compiler version used. */
931 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
934 /* Skip to the next newline, skipping over the initial `ELC'
935 with NUL bytes following it, but note the version. */
936 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
941 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
942 buf
+ i
, nbytes
- i
) < 0)
946 lseek (fd
, 0, SEEK_SET
);
951 /* Callback for record_unwind_protect. Restore the old load list OLD,
952 after loading a file successfully. */
955 record_load_unwind (Lisp_Object old
)
957 Vloads_in_progress
= old
;
960 /* This handler function is used via internal_condition_case_1. */
963 load_error_handler (Lisp_Object data
)
969 load_warn_old_style_backquotes (Lisp_Object file
)
971 if (!NILP (Vold_style_backquotes
))
974 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
980 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
981 doc
: /* Return the suffixes that `load' should try if a suffix is \
983 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
986 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
987 while (CONSP (suffixes
))
989 Lisp_Object exts
= Vload_file_rep_suffixes
;
990 suffix
= XCAR (suffixes
);
991 suffixes
= XCDR (suffixes
);
996 lst
= Fcons (concat2 (suffix
, ext
), lst
);
999 return Fnreverse (lst
);
1002 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1003 doc
: /* Execute a file of Lisp code named FILE.
1004 First try FILE with `.elc' appended, then try with `.el',
1005 then try FILE unmodified (the exact suffixes in the exact order are
1006 determined by `load-suffixes'). Environment variable references in
1007 FILE are replaced with their values by calling `substitute-in-file-name'.
1008 This function searches the directories in `load-path'.
1010 If optional second arg NOERROR is non-nil,
1011 report no error if FILE doesn't exist.
1012 Print messages at start and end of loading unless
1013 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1015 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1016 suffixes `.elc' or `.el' to the specified name FILE.
1017 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1018 the suffix `.elc' or `.el'; don't accept just FILE unless
1019 it ends in one of those suffixes or includes a directory name.
1021 If NOSUFFIX is nil, then if a file could not be found, try looking for
1022 a different representation of the file by adding non-empty suffixes to
1023 its name, before trying another file. Emacs uses this feature to find
1024 compressed versions of files when Auto Compression mode is enabled.
1025 If NOSUFFIX is non-nil, disable this feature.
1027 The suffixes that this function tries out, when NOSUFFIX is nil, are
1028 given by the return value of `get-load-suffixes' and the values listed
1029 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1030 return value of `get-load-suffixes' is used, i.e. the file name is
1031 required to have a non-empty suffix.
1033 Loading a file records its definitions, and its `provide' and
1034 `require' calls, in an element of `load-history' whose
1035 car is the file name loaded. See `load-history'.
1037 While the file is in the process of being loaded, the variable
1038 `load-in-progress' is non-nil and the variable `load-file-name'
1039 is bound to the file's name.
1041 Return t if the file exists and loads successfully. */)
1042 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1043 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1048 ptrdiff_t count
= SPECPDL_INDEX ();
1049 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1050 Lisp_Object found
, efound
, hist_file_name
;
1051 /* True means we printed the ".el is newer" message. */
1053 /* True means we are loading a compiled file. */
1055 Lisp_Object handler
;
1057 const char *fmode
= "r";
1064 CHECK_STRING (file
);
1066 /* If file name is magic, call the handler. */
1067 /* This shouldn't be necessary any more now that `openp' handles it right.
1068 handler = Ffind_file_name_handler (file, Qload);
1069 if (!NILP (handler))
1070 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1072 /* Do this after the handler to avoid
1073 the need to gcpro noerror, nomessage and nosuffix.
1074 (Below here, we care only whether they are nil or not.)
1075 The presence of this call is the result of a historical accident:
1076 it used to be in every file-operation and when it got removed
1077 everywhere, it accidentally stayed here. Since then, enough people
1078 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1079 that it seemed risky to remove. */
1080 if (! NILP (noerror
))
1082 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1083 Qt
, load_error_handler
);
1088 file
= Fsubstitute_in_file_name (file
);
1090 /* Avoid weird lossage with null string as arg,
1091 since it would try to load a directory as a Lisp file. */
1092 if (SCHARS (file
) == 0)
1099 Lisp_Object suffixes
;
1101 GCPRO2 (file
, found
);
1103 if (! NILP (must_suffix
))
1105 /* Don't insist on adding a suffix if FILE already ends with one. */
1106 ptrdiff_t size
= SBYTES (file
);
1108 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1111 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1113 /* Don't insist on adding a suffix
1114 if the argument includes a directory name. */
1115 else if (! NILP (Ffile_name_directory (file
)))
1119 if (!NILP (nosuffix
))
1123 suffixes
= Fget_load_suffixes ();
1124 if (NILP (must_suffix
))
1128 arg
[1] = Vload_file_rep_suffixes
;
1129 suffixes
= Fappend (2, arg
);
1133 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
);
1140 report_file_error ("Cannot open load file", file
);
1144 /* Tell startup.el whether or not we found the user's init file. */
1145 if (EQ (Qt
, Vuser_init_file
))
1146 Vuser_init_file
= found
;
1148 /* If FD is -2, that means openp found a magic file. */
1151 if (NILP (Fequal (found
, file
)))
1152 /* If FOUND is a different file name from FILE,
1153 find its handler even if we have already inhibited
1154 the `load' operation on FILE. */
1155 handler
= Ffind_file_name_handler (found
, Qt
);
1157 handler
= Ffind_file_name_handler (found
, Qload
);
1158 if (! NILP (handler
))
1159 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1161 /* Tramp has to deal with semi-broken packages that prepend
1162 drive letters to remote files. For that reason, Tramp
1163 catches file operations that test for file existence, which
1164 makes openp think X:/foo.elc files are remote. However,
1165 Tramp does not catch `load' operations for such files, so we
1166 end up with a nil as the `load' handler above. If we would
1167 continue with fd = -2, we will behave wrongly, and in
1168 particular try reading a .elc file in the "rt" mode instead
1169 of "rb". See bug #9311 for the results. To work around
1170 this, we try to open the file locally, and go with that if it
1172 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1180 /* Pacify older GCC with --enable-gcc-warnings. */
1181 IF_LINT (fd_index
= 0);
1185 fd_index
= SPECPDL_INDEX ();
1186 record_unwind_protect_int (close_file_unwind
, fd
);
1189 /* Check if we're stuck in a recursive load cycle.
1191 2000-09-21: It's not possible to just check for the file loaded
1192 being a member of Vloads_in_progress. This fails because of the
1193 way the byte compiler currently works; `provide's are not
1194 evaluated, see font-lock.el/jit-lock.el as an example. This
1195 leads to a certain amount of ``normal'' recursion.
1197 Also, just loading a file recursively is not always an error in
1198 the general case; the second load may do something different. */
1202 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1203 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1204 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1205 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1206 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1209 /* All loads are by default dynamic, unless the file itself specifies
1210 otherwise using a file-variable in the first line. This is bound here
1211 so that it takes effect whether or not we use
1212 Vload_source_file_function. */
1213 specbind (Qlexical_binding
, Qnil
);
1215 /* Get the name for load-history. */
1216 hist_file_name
= (! NILP (Vpurify_flag
)
1217 ? concat2 (Ffile_name_directory (file
),
1218 Ffile_name_nondirectory (found
))
1223 /* Check for the presence of old-style quotes and warn about them. */
1224 specbind (Qold_style_backquotes
, Qnil
);
1225 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1227 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1228 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1229 /* Load .elc files directly, but not when they are
1230 remote and have no handler! */
1237 GCPRO3 (file
, found
, hist_file_name
);
1240 && ! (version
= safe_to_load_version (fd
)))
1243 if (!load_dangerous_libraries
)
1244 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1245 else if (!NILP (nomessage
) && !force_load_messages
)
1246 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1251 efound
= ENCODE_FILE (found
);
1256 result
= stat (SSDATA (efound
), &s1
);
1259 SSET (efound
, SBYTES (efound
) - 1, 0);
1260 result
= stat (SSDATA (efound
), &s2
);
1261 SSET (efound
, SBYTES (efound
) - 1, 'c');
1265 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1267 /* Make the progress messages mention that source is newer. */
1270 /* If we won't print another message, mention this anyway. */
1271 if (!NILP (nomessage
) && !force_load_messages
)
1273 Lisp_Object msg_file
;
1274 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1275 message_with_string ("Source file `%s' newer than byte-compiled file",
1284 /* We are loading a source file (*.el). */
1285 if (!NILP (Vload_source_file_function
))
1292 clear_unwind_protect (fd_index
);
1294 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1295 NILP (noerror
) ? Qnil
: Qt
,
1296 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1297 return unbind_to (count
, val
);
1301 GCPRO3 (file
, found
, hist_file_name
);
1305 /* We somehow got here with fd == -2, meaning the file is deemed
1306 to be remote. Don't even try to reopen the file locally;
1307 just force a failure. */
1315 clear_unwind_protect (fd_index
);
1316 efound
= ENCODE_FILE (found
);
1317 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1319 stream
= fdopen (fd
, fmode
);
1323 report_file_error ("Opening stdio stream", file
);
1324 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1326 if (! NILP (Vpurify_flag
))
1327 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1329 if (NILP (nomessage
) || force_load_messages
)
1332 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1335 message_with_string ("Loading %s (source)...", file
, 1);
1337 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1339 else /* The typical case; compiled file newer than source file. */
1340 message_with_string ("Loading %s...", file
, 1);
1343 specbind (Qload_file_name
, found
);
1344 specbind (Qinhibit_file_name_operation
, Qnil
);
1345 specbind (Qload_in_progress
, Qt
);
1348 if (lisp_file_lexically_bound_p (Qget_file_char
))
1349 Fset (Qlexical_binding
, Qt
);
1351 if (! version
|| version
>= 22)
1352 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1353 0, Qnil
, Qnil
, Qnil
, Qnil
);
1356 /* We can't handle a file which was compiled with
1357 byte-compile-dynamic by older version of Emacs. */
1358 specbind (Qload_force_doc_strings
, Qt
);
1359 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1360 0, Qnil
, Qnil
, Qnil
, Qnil
);
1362 unbind_to (count
, Qnil
);
1364 /* Run any eval-after-load forms for this file. */
1365 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1366 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1370 xfree (saved_doc_string
);
1371 saved_doc_string
= 0;
1372 saved_doc_string_size
= 0;
1374 xfree (prev_saved_doc_string
);
1375 prev_saved_doc_string
= 0;
1376 prev_saved_doc_string_size
= 0;
1378 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1381 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1384 message_with_string ("Loading %s (source)...done", file
, 1);
1386 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1388 else /* The typical case; compiled file newer than source file. */
1389 message_with_string ("Loading %s...done", file
, 1);
1396 complete_filename_p (Lisp_Object pathname
)
1398 const unsigned char *s
= SDATA (pathname
);
1399 return (IS_DIRECTORY_SEP (s
[0])
1400 || (SCHARS (pathname
) > 2
1401 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1404 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1405 doc
: /* Search for FILENAME through PATH.
1406 Returns the file's name in absolute form, or nil if not found.
1407 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1408 file name when searching.
1409 If non-nil, PREDICATE is used instead of `file-readable-p'.
1410 PREDICATE can also be an integer to pass to the faccessat(2) function,
1411 in which case file-name-handlers are ignored.
1412 This function will normally skip directories, so if you want it to find
1413 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1414 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1417 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1418 if (NILP (predicate
) && fd
>= 0)
1423 static Lisp_Object Qdir_ok
;
1425 /* Search for a file whose name is STR, looking in directories
1426 in the Lisp list PATH, and trying suffixes from SUFFIX.
1427 On success, return a file descriptor (or 1 or -2 as described below).
1428 On failure, return -1 and set errno.
1430 SUFFIXES is a list of strings containing possible suffixes.
1431 The empty suffix is automatically added if the list is empty.
1433 PREDICATE non-nil means don't open the files,
1434 just look for one that satisfies the predicate. In this case,
1435 return 1 on success. The predicate can be a lisp function or
1436 an integer to pass to `access' (in which case file-name-handlers
1439 If STOREPTR is nonzero, it points to a slot where the name of
1440 the file actually found should be stored as a Lisp string.
1441 nil is stored there on failure.
1443 If the file we find is remote, return -2
1444 but store the found remote file name in *STOREPTR. */
1447 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1448 Lisp_Object
*storeptr
, Lisp_Object predicate
)
1450 ptrdiff_t fn_size
= 100;
1454 ptrdiff_t want_length
;
1455 Lisp_Object filename
;
1456 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1457 Lisp_Object string
, tail
, encoded_fn
;
1458 ptrdiff_t max_suffix_len
= 0;
1459 int last_errno
= ENOENT
;
1463 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1465 CHECK_STRING_CAR (tail
);
1466 max_suffix_len
= max (max_suffix_len
,
1467 SBYTES (XCAR (tail
)));
1470 string
= filename
= encoded_fn
= Qnil
;
1471 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1476 if (complete_filename_p (str
))
1479 for (; CONSP (path
); path
= XCDR (path
))
1481 filename
= Fexpand_file_name (str
, XCAR (path
));
1482 if (!complete_filename_p (filename
))
1483 /* If there are non-absolute elts in PATH (eg "."). */
1484 /* Of course, this could conceivably lose if luser sets
1485 default-directory to be something non-absolute... */
1487 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1488 if (!complete_filename_p (filename
))
1489 /* Give up on this path element! */
1493 /* Calculate maximum length of any filename made from
1494 this path element/specified file name and any possible suffix. */
1495 want_length
= max_suffix_len
+ SBYTES (filename
);
1496 if (fn_size
<= want_length
)
1497 fn
= alloca (fn_size
= 100 + want_length
);
1499 /* Loop over suffixes. */
1500 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1501 CONSP (tail
); tail
= XCDR (tail
))
1503 Lisp_Object suffix
= XCAR (tail
);
1504 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1505 Lisp_Object handler
;
1507 /* Concatenate path element/specified name with the suffix.
1508 If the directory starts with /:, remove that. */
1509 int prefixlen
= ((SCHARS (filename
) > 2
1510 && SREF (filename
, 0) == '/'
1511 && SREF (filename
, 1) == ':')
1513 fnlen
= SBYTES (filename
) - prefixlen
;
1514 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1515 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1517 /* Check that the file exists and is not a directory. */
1518 /* We used to only check for handlers on non-absolute file names:
1522 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1523 It's not clear why that was the case and it breaks things like
1524 (load "/bar.el") where the file is actually "/bar.el.gz". */
1525 /* make_string has its own ideas on when to return a unibyte
1526 string and when a multibyte string, but we know better.
1527 We must have a unibyte string when dumping, since
1528 file-name encoding is shaky at best at that time, and in
1529 particular default-file-name-coding-system is reset
1530 several times during loadup. We therefore don't want to
1531 encode the file before passing it to file I/O library
1533 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1534 string
= make_unibyte_string (fn
, fnlen
);
1536 string
= make_string (fn
, fnlen
);
1537 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1538 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1541 if (NILP (predicate
))
1542 exists
= !NILP (Ffile_readable_p (string
));
1545 Lisp_Object tmp
= call1 (predicate
, string
);
1548 else if (EQ (tmp
, Qdir_ok
)
1549 || NILP (Ffile_directory_p (string
)))
1554 last_errno
= EISDIR
;
1560 /* We succeeded; return this descriptor and filename. */
1572 encoded_fn
= ENCODE_FILE (string
);
1573 pfn
= SSDATA (encoded_fn
);
1575 /* Check that we can access or open it. */
1576 if (NATNUMP (predicate
))
1579 if (INT_MAX
< XFASTINT (predicate
))
1580 last_errno
= EINVAL
;
1581 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1585 if (file_directory_p (pfn
))
1586 last_errno
= EISDIR
;
1593 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1596 if (errno
!= ENOENT
)
1602 int err
= (fstat (fd
, &st
) != 0 ? errno
1603 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1615 /* We succeeded; return this descriptor and filename. */
1633 /* Merge the list we've accumulated of globals from the current input source
1634 into the load_history variable. The details depend on whether
1635 the source has an associated file name or not.
1637 FILENAME is the file name that we are loading from.
1639 ENTIRE is true if loading that entire file, false if evaluating
1643 build_load_history (Lisp_Object filename
, bool entire
)
1645 Lisp_Object tail
, prev
, newelt
;
1646 Lisp_Object tem
, tem2
;
1649 tail
= Vload_history
;
1652 while (CONSP (tail
))
1656 /* Find the feature's previous assoc list... */
1657 if (!NILP (Fequal (filename
, Fcar (tem
))))
1661 /* If we're loading the entire file, remove old data. */
1665 Vload_history
= XCDR (tail
);
1667 Fsetcdr (prev
, XCDR (tail
));
1670 /* Otherwise, cons on new symbols that are not already members. */
1673 tem2
= Vcurrent_load_list
;
1675 while (CONSP (tem2
))
1677 newelt
= XCAR (tem2
);
1679 if (NILP (Fmember (newelt
, tem
)))
1680 Fsetcar (tail
, Fcons (XCAR (tem
),
1681 Fcons (newelt
, XCDR (tem
))));
1694 /* If we're loading an entire file, cons the new assoc onto the
1695 front of load-history, the most-recently-loaded position. Also
1696 do this if we didn't find an existing member for the file. */
1697 if (entire
|| !foundit
)
1698 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1703 readevalloop_1 (int old
)
1705 load_convert_to_unibyte
= old
;
1708 /* Signal an `end-of-file' error, if possible with file name
1711 static _Noreturn
void
1712 end_of_file_error (void)
1714 if (STRINGP (Vload_file_name
))
1715 xsignal1 (Qend_of_file
, Vload_file_name
);
1717 xsignal0 (Qend_of_file
);
1720 /* UNIBYTE specifies how to set load_convert_to_unibyte
1721 for this invocation.
1722 READFUN, if non-nil, is used instead of `read'.
1724 START, END specify region to read in current buffer (from eval-region).
1725 If the input is not from a buffer, they must be nil. */
1728 readevalloop (Lisp_Object readcharfun
,
1730 Lisp_Object sourcename
,
1732 Lisp_Object unibyte
, Lisp_Object readfun
,
1733 Lisp_Object start
, Lisp_Object end
)
1736 register Lisp_Object val
;
1737 ptrdiff_t count
= SPECPDL_INDEX ();
1738 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1739 struct buffer
*b
= 0;
1740 bool continue_reading_p
;
1741 Lisp_Object lex_bound
;
1742 /* True if reading an entire buffer. */
1743 bool whole_buffer
= 0;
1744 /* True on the first time around. */
1745 bool first_sexp
= 1;
1746 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1748 if (NILP (Ffboundp (macroexpand
))
1749 /* Don't macroexpand in .elc files, since it should have been done
1750 already. We actually don't know whether we're in a .elc file or not,
1751 so we use circumstantial evidence: .el files normally go through
1752 Vload_source_file_function -> load-with-code-conversion
1754 || EQ (readcharfun
, Qget_file_char
)
1755 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1758 if (MARKERP (readcharfun
))
1761 start
= readcharfun
;
1764 if (BUFFERP (readcharfun
))
1765 b
= XBUFFER (readcharfun
);
1766 else if (MARKERP (readcharfun
))
1767 b
= XMARKER (readcharfun
)->buffer
;
1769 /* We assume START is nil when input is not from a buffer. */
1770 if (! NILP (start
) && !b
)
1773 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1774 specbind (Qcurrent_load_list
, Qnil
);
1775 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1776 load_convert_to_unibyte
= !NILP (unibyte
);
1778 /* If lexical binding is active (either because it was specified in
1779 the file's header, or via a buffer-local variable), create an empty
1780 lexical environment, otherwise, turn off lexical binding. */
1781 lex_bound
= find_symbol_value (Qlexical_binding
);
1782 specbind (Qinternal_interpreter_environment
,
1783 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1784 ? Qnil
: list1 (Qt
)));
1786 GCPRO4 (sourcename
, readfun
, start
, end
);
1788 /* Try to ensure sourcename is a truename, except whilst preloading. */
1789 if (NILP (Vpurify_flag
)
1790 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1791 && !NILP (Ffboundp (Qfile_truename
)))
1792 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1794 LOADHIST_ATTACH (sourcename
);
1796 continue_reading_p
= 1;
1797 while (continue_reading_p
)
1799 ptrdiff_t count1
= SPECPDL_INDEX ();
1801 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1802 error ("Reading from killed buffer");
1806 /* Switch to the buffer we are reading from. */
1807 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1808 set_buffer_internal (b
);
1810 /* Save point in it. */
1811 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1812 /* Save ZV in it. */
1813 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1814 /* Those get unbound after we read one expression. */
1816 /* Set point and ZV around stuff to be read. */
1819 Fnarrow_to_region (make_number (BEGV
), end
);
1821 /* Just for cleanliness, convert END to a marker
1822 if it is an integer. */
1824 end
= Fpoint_max_marker ();
1827 /* On the first cycle, we can easily test here
1828 whether we are reading the whole buffer. */
1829 if (b
&& first_sexp
)
1830 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1837 while ((c
= READCHAR
) != '\n' && c
!= -1);
1842 unbind_to (count1
, Qnil
);
1846 /* Ignore whitespace here, so we can detect eof. */
1847 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1848 || c
== 0xa0) /* NBSP */
1851 if (!NILP (Vpurify_flag
) && c
== '(')
1853 val
= read_list (0, readcharfun
);
1858 read_objects
= Qnil
;
1859 if (!NILP (readfun
))
1861 val
= call1 (readfun
, readcharfun
);
1863 /* If READCHARFUN has set point to ZV, we should
1864 stop reading, even if the form read sets point
1865 to a different value when evaluated. */
1866 if (BUFFERP (readcharfun
))
1868 struct buffer
*buf
= XBUFFER (readcharfun
);
1869 if (BUF_PT (buf
) == BUF_ZV (buf
))
1870 continue_reading_p
= 0;
1873 else if (! NILP (Vload_read_function
))
1874 val
= call1 (Vload_read_function
, readcharfun
);
1876 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1879 if (!NILP (start
) && continue_reading_p
)
1880 start
= Fpoint_marker ();
1882 /* Restore saved point and BEGV. */
1883 unbind_to (count1
, Qnil
);
1885 /* Now eval what we just read. */
1886 if (!NILP (macroexpand
))
1887 val
= call1 (macroexpand
, val
);
1888 val
= eval_sub (val
);
1892 Vvalues
= Fcons (val
, Vvalues
);
1893 if (EQ (Vstandard_output
, Qt
))
1902 build_load_history (sourcename
,
1903 stream
|| whole_buffer
);
1907 unbind_to (count
, Qnil
);
1910 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1911 doc
: /* Execute the current buffer as Lisp code.
1912 When called from a Lisp program (i.e., not interactively), this
1913 function accepts up to five optional arguments:
1914 BUFFER is the buffer to evaluate (nil means use current buffer).
1915 PRINTFLAG controls printing of output:
1916 A value of nil means discard it; anything else is stream for print.
1917 FILENAME specifies the file name to use for `load-history'.
1918 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1920 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1921 functions should work normally even if PRINTFLAG is nil.
1923 This function preserves the position of point. */)
1924 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1926 ptrdiff_t count
= SPECPDL_INDEX ();
1927 Lisp_Object tem
, buf
;
1930 buf
= Fcurrent_buffer ();
1932 buf
= Fget_buffer (buffer
);
1934 error ("No such buffer");
1936 if (NILP (printflag
) && NILP (do_allow_print
))
1941 if (NILP (filename
))
1942 filename
= BVAR (XBUFFER (buf
), filename
);
1944 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1945 specbind (Qstandard_output
, tem
);
1946 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1947 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1948 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1949 readevalloop (buf
, 0, filename
,
1950 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1951 unbind_to (count
, Qnil
);
1956 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1957 doc
: /* Execute the region as Lisp code.
1958 When called from programs, expects two arguments,
1959 giving starting and ending indices in the current buffer
1960 of the text to be executed.
1961 Programs can pass third argument PRINTFLAG which controls output:
1962 A value of nil means discard it; anything else is stream for printing it.
1963 Also the fourth argument READ-FUNCTION, if non-nil, is used
1964 instead of `read' to read each expression. It gets one argument
1965 which is the input stream for reading characters.
1967 This function does not move point. */)
1968 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1970 /* FIXME: Do the eval-sexp-add-defvars dance! */
1971 ptrdiff_t count
= SPECPDL_INDEX ();
1972 Lisp_Object tem
, cbuf
;
1974 cbuf
= Fcurrent_buffer ();
1976 if (NILP (printflag
))
1980 specbind (Qstandard_output
, tem
);
1981 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1983 /* `readevalloop' calls functions which check the type of start and end. */
1984 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1985 !NILP (printflag
), Qnil
, read_function
,
1988 return unbind_to (count
, Qnil
);
1992 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1993 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1994 If STREAM is nil, use the value of `standard-input' (which see).
1995 STREAM or the value of `standard-input' may be:
1996 a buffer (read from point and advance it)
1997 a marker (read from where it points and advance it)
1998 a function (call it with no arguments for each character,
1999 call it with a char as argument to push a char back)
2000 a string (takes text from string, starting at the beginning)
2001 t (read text line using minibuffer and use it, or read from
2002 standard input in batch mode). */)
2003 (Lisp_Object stream
)
2006 stream
= Vstandard_input
;
2007 if (EQ (stream
, Qt
))
2008 stream
= Qread_char
;
2009 if (EQ (stream
, Qread_char
))
2010 /* FIXME: ¿¡ When is this used !? */
2011 return call1 (intern ("read-minibuffer"),
2012 build_string ("Lisp expression: "));
2014 return read_internal_start (stream
, Qnil
, Qnil
);
2017 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2018 doc
: /* Read one Lisp expression which is represented as text by STRING.
2019 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2020 FINAL-STRING-INDEX is an integer giving the position of the next
2021 remaining character in STRING.
2022 START and END optionally delimit a substring of STRING from which to read;
2023 they default to 0 and (length STRING) respectively. */)
2024 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2027 CHECK_STRING (string
);
2028 /* `read_internal_start' sets `read_from_string_index'. */
2029 ret
= read_internal_start (string
, start
, end
);
2030 return Fcons (ret
, make_number (read_from_string_index
));
2033 /* Function to set up the global context we need in toplevel read
2036 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2037 /* `start', `end' only used when stream is a string. */
2042 new_backquote_flag
= 0;
2043 read_objects
= Qnil
;
2044 if (EQ (Vread_with_symbol_positions
, Qt
)
2045 || EQ (Vread_with_symbol_positions
, stream
))
2046 Vread_symbol_positions_list
= Qnil
;
2048 if (STRINGP (stream
)
2049 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2051 ptrdiff_t startval
, endval
;
2054 if (STRINGP (stream
))
2057 string
= XCAR (stream
);
2060 endval
= SCHARS (string
);
2064 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2065 args_out_of_range (string
, end
);
2066 endval
= XINT (end
);
2073 CHECK_NUMBER (start
);
2074 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2075 args_out_of_range (string
, start
);
2076 startval
= XINT (start
);
2078 read_from_string_index
= startval
;
2079 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2080 read_from_string_limit
= endval
;
2083 retval
= read0 (stream
);
2084 if (EQ (Vread_with_symbol_positions
, Qt
)
2085 || EQ (Vread_with_symbol_positions
, stream
))
2086 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2091 /* Signal Qinvalid_read_syntax error.
2092 S is error string of length N (if > 0) */
2094 static _Noreturn
void
2095 invalid_syntax (const char *s
)
2097 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2101 /* Use this for recursive reads, in contexts where internal tokens
2105 read0 (Lisp_Object readcharfun
)
2107 register Lisp_Object val
;
2110 val
= read1 (readcharfun
, &c
, 0);
2114 xsignal1 (Qinvalid_read_syntax
,
2115 Fmake_string (make_number (1), make_number (c
)));
2118 static ptrdiff_t read_buffer_size
;
2119 static char *read_buffer
;
2121 /* Read a \-escape sequence, assuming we already read the `\'.
2122 If the escape sequence forces unibyte, return eight-bit char. */
2125 read_escape (Lisp_Object readcharfun
, bool stringp
)
2128 /* \u allows up to four hex digits, \U up to eight. Default to the
2129 behavior for \u, and change this value in the case that \U is seen. */
2130 int unicode_hex_count
= 4;
2135 end_of_file_error ();
2165 error ("Invalid escape character syntax");
2168 c
= read_escape (readcharfun
, 0);
2169 return c
| meta_modifier
;
2174 error ("Invalid escape character syntax");
2177 c
= read_escape (readcharfun
, 0);
2178 return c
| shift_modifier
;
2183 error ("Invalid escape character syntax");
2186 c
= read_escape (readcharfun
, 0);
2187 return c
| hyper_modifier
;
2192 error ("Invalid escape character syntax");
2195 c
= read_escape (readcharfun
, 0);
2196 return c
| alt_modifier
;
2200 if (stringp
|| c
!= '-')
2207 c
= read_escape (readcharfun
, 0);
2208 return c
| super_modifier
;
2213 error ("Invalid escape character syntax");
2217 c
= read_escape (readcharfun
, 0);
2218 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2219 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2220 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2221 return c
| ctrl_modifier
;
2222 /* ASCII control chars are made from letters (both cases),
2223 as well as the non-letters within 0100...0137. */
2224 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2225 return (c
& (037 | ~0177));
2226 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2227 return (c
& (037 | ~0177));
2229 return c
| ctrl_modifier
;
2239 /* An octal escape, as in ANSI C. */
2241 register int i
= c
- '0';
2242 register int count
= 0;
2245 if ((c
= READCHAR
) >= '0' && c
<= '7')
2257 if (i
>= 0x80 && i
< 0x100)
2258 i
= BYTE8_TO_CHAR (i
);
2263 /* A hex escape, as in ANSI C. */
2270 if (c
>= '0' && c
<= '9')
2275 else if ((c
>= 'a' && c
<= 'f')
2276 || (c
>= 'A' && c
<= 'F'))
2279 if (c
>= 'a' && c
<= 'f')
2289 /* Allow hex escapes as large as ?\xfffffff, because some
2290 packages use them to denote characters with modifiers. */
2291 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2292 error ("Hex character out of range: \\x%x...", i
);
2296 if (count
< 3 && i
>= 0x80)
2297 return BYTE8_TO_CHAR (i
);
2302 /* Post-Unicode-2.0: Up to eight hex chars. */
2303 unicode_hex_count
= 8;
2306 /* A Unicode escape. We only permit them in strings and characters,
2307 not arbitrarily in the source code, as in some other languages. */
2312 while (++count
<= unicode_hex_count
)
2315 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2317 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2318 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2319 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2321 error ("Non-hex digit used for Unicode escape");
2324 error ("Non-Unicode character: 0x%x", i
);
2333 /* Return the digit that CHARACTER stands for in the given BASE.
2334 Return -1 if CHARACTER is out of range for BASE,
2335 and -2 if CHARACTER is not valid for any supported BASE. */
2337 digit_to_number (int character
, int base
)
2341 if ('0' <= character
&& character
<= '9')
2342 digit
= character
- '0';
2343 else if ('a' <= character
&& character
<= 'z')
2344 digit
= character
- 'a' + 10;
2345 else if ('A' <= character
&& character
<= 'Z')
2346 digit
= character
- 'A' + 10;
2350 return digit
< base
? digit
: -1;
2353 /* Read an integer in radix RADIX using READCHARFUN to read
2354 characters. RADIX must be in the interval [2..36]; if it isn't, a
2355 read error is signaled . Value is the integer read. Signals an
2356 error if encountering invalid read syntax or if RADIX is out of
2360 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2362 /* Room for sign, leading 0, other digits, trailing null byte.
2363 Also, room for invalid syntax diagnostic. */
2364 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2365 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2367 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2369 if (radix
< 2 || radix
> 36)
2377 if (c
== '-' || c
== '+')
2388 /* Ignore redundant leading zeros, so the buffer doesn't
2389 fill up with them. */
2395 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2402 if (p
< buf
+ sizeof buf
- 1)
2416 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2417 invalid_syntax (buf
);
2420 return string_to_number (buf
, radix
, 0);
2424 /* If the next token is ')' or ']' or '.', we store that character
2425 in *PCH and the return value is not interesting. Else, we store
2426 zero in *PCH and we read and return one lisp object.
2428 FIRST_IN_LIST is true if this is the first element of a list. */
2431 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2434 bool uninterned_symbol
= 0;
2441 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2443 end_of_file_error ();
2448 return read_list (0, readcharfun
);
2451 return read_vector (readcharfun
, 0);
2467 /* Accept extended format for hashtables (extensible to
2469 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2470 Lisp_Object tmp
= read_list (0, readcharfun
);
2471 Lisp_Object head
= CAR_SAFE (tmp
);
2472 Lisp_Object data
= Qnil
;
2473 Lisp_Object val
= Qnil
;
2474 /* The size is 2 * number of allowed keywords to
2476 Lisp_Object params
[10];
2478 Lisp_Object key
= Qnil
;
2479 int param_count
= 0;
2481 if (!EQ (head
, Qhash_table
))
2482 error ("Invalid extended read marker at head of #s list "
2483 "(only hash-table allowed)");
2485 tmp
= CDR_SAFE (tmp
);
2487 /* This is repetitive but fast and simple. */
2488 params
[param_count
] = QCsize
;
2489 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2490 if (!NILP (params
[param_count
+ 1]))
2493 params
[param_count
] = QCtest
;
2494 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2495 if (!NILP (params
[param_count
+ 1]))
2498 params
[param_count
] = QCweakness
;
2499 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2500 if (!NILP (params
[param_count
+ 1]))
2503 params
[param_count
] = QCrehash_size
;
2504 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2505 if (!NILP (params
[param_count
+ 1]))
2508 params
[param_count
] = QCrehash_threshold
;
2509 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2510 if (!NILP (params
[param_count
+ 1]))
2513 /* This is the hashtable data. */
2514 data
= Fplist_get (tmp
, Qdata
);
2516 /* Now use params to make a new hashtable and fill it. */
2517 ht
= Fmake_hash_table (param_count
, params
);
2519 while (CONSP (data
))
2524 error ("Odd number of elements in hashtable data");
2527 Fputhash (key
, val
, ht
);
2533 invalid_syntax ("#");
2541 tmp
= read_vector (readcharfun
, 0);
2542 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2543 error ("Invalid size char-table");
2544 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2556 tmp
= read_vector (readcharfun
, 0);
2559 error ("Invalid size char-table");
2560 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2561 error ("Invalid depth in char-table");
2562 depth
= XINT (AREF (tmp
, 0));
2563 if (chartab_size
[depth
] != size
- 2)
2564 error ("Invalid size char-table");
2565 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2568 invalid_syntax ("#^^");
2570 invalid_syntax ("#^");
2575 length
= read1 (readcharfun
, pch
, first_in_list
);
2579 Lisp_Object tmp
, val
;
2580 EMACS_INT size_in_chars
2581 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2582 / BOOL_VECTOR_BITS_PER_CHAR
);
2583 unsigned char *data
;
2586 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2587 if (STRING_MULTIBYTE (tmp
)
2588 || (size_in_chars
!= SCHARS (tmp
)
2589 /* We used to print 1 char too many
2590 when the number of bits was a multiple of 8.
2591 Accept such input in case it came from an old
2593 && ! (XFASTINT (length
)
2594 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2595 invalid_syntax ("#&...");
2597 val
= Fmake_bool_vector (length
, Qnil
);
2598 data
= bool_vector_uchar_data (val
);
2599 memcpy (data
, SDATA (tmp
), size_in_chars
);
2600 /* Clear the extraneous bits in the last byte. */
2601 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2602 data
[size_in_chars
- 1]
2603 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2606 invalid_syntax ("#&...");
2610 /* Accept compiled functions at read-time so that we don't have to
2611 build them using function calls. */
2613 tmp
= read_vector (readcharfun
, 1);
2614 struct Lisp_Vector
* vec
= XVECTOR (tmp
);
2615 if (vec
->header
.size
==0)
2616 invalid_syntax ("Empty byte-code object");
2617 make_byte_code (vec
);
2623 struct gcpro gcpro1
;
2626 /* Read the string itself. */
2627 tmp
= read1 (readcharfun
, &ch
, 0);
2628 if (ch
!= 0 || !STRINGP (tmp
))
2629 invalid_syntax ("#");
2631 /* Read the intervals and their properties. */
2634 Lisp_Object beg
, end
, plist
;
2636 beg
= read1 (readcharfun
, &ch
, 0);
2641 end
= read1 (readcharfun
, &ch
, 0);
2643 plist
= read1 (readcharfun
, &ch
, 0);
2645 invalid_syntax ("Invalid string property list");
2646 Fset_text_properties (beg
, end
, plist
, tmp
);
2652 /* #@NUMBER is used to skip NUMBER following bytes.
2653 That's used in .elc files to skip over doc strings
2654 and function definitions. */
2657 enum { extra
= 100 };
2658 ptrdiff_t i
, nskip
= 0, digits
= 0;
2660 /* Read a decimal integer. */
2661 while ((c
= READCHAR
) >= 0
2662 && c
>= '0' && c
<= '9')
2664 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2669 if (digits
== 2 && nskip
== 0)
2670 { /* We've just seen #@00, which means "skip to end". */
2671 skip_dyn_eof (readcharfun
);
2676 /* We can't use UNREAD here, because in the code below we side-step
2677 READCHAR. Instead, assume the first char after #@NNN occupies
2678 a single byte, which is the case normally since it's just
2684 if (load_force_doc_strings
2685 && (FROM_FILE_P (readcharfun
)))
2687 /* If we are supposed to force doc strings into core right now,
2688 record the last string that we skipped,
2689 and record where in the file it comes from. */
2691 /* But first exchange saved_doc_string
2692 with prev_saved_doc_string, so we save two strings. */
2694 char *temp
= saved_doc_string
;
2695 ptrdiff_t temp_size
= saved_doc_string_size
;
2696 file_offset temp_pos
= saved_doc_string_position
;
2697 ptrdiff_t temp_len
= saved_doc_string_length
;
2699 saved_doc_string
= prev_saved_doc_string
;
2700 saved_doc_string_size
= prev_saved_doc_string_size
;
2701 saved_doc_string_position
= prev_saved_doc_string_position
;
2702 saved_doc_string_length
= prev_saved_doc_string_length
;
2704 prev_saved_doc_string
= temp
;
2705 prev_saved_doc_string_size
= temp_size
;
2706 prev_saved_doc_string_position
= temp_pos
;
2707 prev_saved_doc_string_length
= temp_len
;
2710 if (saved_doc_string_size
== 0)
2712 saved_doc_string
= xmalloc (nskip
+ extra
);
2713 saved_doc_string_size
= nskip
+ extra
;
2715 if (nskip
> saved_doc_string_size
)
2717 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2718 saved_doc_string_size
= nskip
+ extra
;
2721 saved_doc_string_position
= file_tell (instream
);
2723 /* Copy that many characters into saved_doc_string. */
2725 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2726 saved_doc_string
[i
] = c
= getc (instream
);
2729 saved_doc_string_length
= i
;
2732 /* Skip that many bytes. */
2733 skip_dyn_bytes (readcharfun
, nskip
);
2739 /* #! appears at the beginning of an executable file.
2740 Skip the first line. */
2741 while (c
!= '\n' && c
>= 0)
2746 return Vload_file_name
;
2748 return list2 (Qfunction
, read0 (readcharfun
));
2749 /* #:foo is the uninterned symbol named foo. */
2752 uninterned_symbol
= 1;
2755 && c
!= 0xa0 /* NBSP */
2757 || strchr ("\"';()[]#`,", c
) == NULL
)))
2759 /* No symbol character follows, this is the empty
2762 return Fmake_symbol (empty_unibyte_string
);
2766 /* ## is the empty symbol. */
2768 return Fintern (empty_unibyte_string
, Qnil
);
2769 /* Reader forms that can reuse previously read objects. */
2770 if (c
>= '0' && c
<= '9')
2775 /* Read a non-negative integer. */
2776 while (c
>= '0' && c
<= '9')
2778 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2779 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2780 n
= MOST_POSITIVE_FIXNUM
+ 1;
2782 n
= n
* 10 + c
- '0';
2786 if (n
<= MOST_POSITIVE_FIXNUM
)
2788 if (c
== 'r' || c
== 'R')
2789 return read_integer (readcharfun
, n
);
2791 if (! NILP (Vread_circle
))
2793 /* #n=object returns object, but associates it with
2797 /* Make a placeholder for #n# to use temporarily. */
2798 Lisp_Object placeholder
;
2801 placeholder
= Fcons (Qnil
, Qnil
);
2802 cell
= Fcons (make_number (n
), placeholder
);
2803 read_objects
= Fcons (cell
, read_objects
);
2805 /* Read the object itself. */
2806 tem
= read0 (readcharfun
);
2808 /* Now put it everywhere the placeholder was... */
2809 substitute_object_in_subtree (tem
, placeholder
);
2811 /* ...and #n# will use the real value from now on. */
2812 Fsetcdr (cell
, tem
);
2817 /* #n# returns a previously read object. */
2820 tem
= Fassq (make_number (n
), read_objects
);
2826 /* Fall through to error message. */
2828 else if (c
== 'x' || c
== 'X')
2829 return read_integer (readcharfun
, 16);
2830 else if (c
== 'o' || c
== 'O')
2831 return read_integer (readcharfun
, 8);
2832 else if (c
== 'b' || c
== 'B')
2833 return read_integer (readcharfun
, 2);
2836 invalid_syntax ("#");
2839 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2843 return list2 (Qquote
, read0 (readcharfun
));
2847 int next_char
= READCHAR
;
2849 /* Transition from old-style to new-style:
2850 If we see "(`" it used to mean old-style, which usually works
2851 fine because ` should almost never appear in such a position
2852 for new-style. But occasionally we need "(`" to mean new
2853 style, so we try to distinguish the two by the fact that we
2854 can either write "( `foo" or "(` foo", where the first
2855 intends to use new-style whereas the second intends to use
2856 old-style. For Emacs-25, we should completely remove this
2857 first_in_list exception (old-style can still be obtained via
2859 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2861 Vold_style_backquotes
= Qt
;
2867 bool saved_new_backquote_flag
= new_backquote_flag
;
2869 new_backquote_flag
= 1;
2870 value
= read0 (readcharfun
);
2871 new_backquote_flag
= saved_new_backquote_flag
;
2873 return list2 (Qbackquote
, value
);
2878 int next_char
= READCHAR
;
2880 /* Transition from old-style to new-style:
2881 It used to be impossible to have a new-style , other than within
2882 a new-style `. This is sufficient when ` and , are used in the
2883 normal way, but ` and , can also appear in args to macros that
2884 will not interpret them in the usual way, in which case , may be
2885 used without any ` anywhere near.
2886 So we now use the same heuristic as for backquote: old-style
2887 unquotes are only recognized when first on a list, and when
2888 followed by a space.
2889 Because it's more difficult to peek 2 chars ahead, a new-style
2890 ,@ can still not be used outside of a `, unless it's in the middle
2892 if (new_backquote_flag
2894 || (next_char
!= ' ' && next_char
!= '@'))
2896 Lisp_Object comma_type
= Qnil
;
2901 comma_type
= Qcomma_at
;
2903 comma_type
= Qcomma_dot
;
2906 if (ch
>= 0) UNREAD (ch
);
2907 comma_type
= Qcomma
;
2910 value
= read0 (readcharfun
);
2911 return list2 (comma_type
, value
);
2915 Vold_style_backquotes
= Qt
;
2927 end_of_file_error ();
2929 /* Accept `single space' syntax like (list ? x) where the
2930 whitespace character is SPC or TAB.
2931 Other literal whitespace like NL, CR, and FF are not accepted,
2932 as there are well-established escape sequences for these. */
2933 if (c
== ' ' || c
== '\t')
2934 return make_number (c
);
2937 c
= read_escape (readcharfun
, 0);
2938 modifiers
= c
& CHAR_MODIFIER_MASK
;
2939 c
&= ~CHAR_MODIFIER_MASK
;
2940 if (CHAR_BYTE8_P (c
))
2941 c
= CHAR_TO_BYTE8 (c
);
2944 next_char
= READCHAR
;
2945 ok
= (next_char
<= 040
2946 || (next_char
< 0200
2947 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2950 return make_number (c
);
2952 invalid_syntax ("?");
2957 char *p
= read_buffer
;
2958 char *end
= read_buffer
+ read_buffer_size
;
2960 /* True if we saw an escape sequence specifying
2961 a multibyte character. */
2962 bool force_multibyte
= 0;
2963 /* True if we saw an escape sequence specifying
2964 a single-byte character. */
2965 bool force_singlebyte
= 0;
2967 ptrdiff_t nchars
= 0;
2969 while ((ch
= READCHAR
) >= 0
2972 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2974 ptrdiff_t offset
= p
- read_buffer
;
2975 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2976 memory_full (SIZE_MAX
);
2977 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
2978 read_buffer_size
*= 2;
2979 p
= read_buffer
+ offset
;
2980 end
= read_buffer
+ read_buffer_size
;
2987 ch
= read_escape (readcharfun
, 1);
2989 /* CH is -1 if \ newline has just been seen. */
2992 if (p
== read_buffer
)
2997 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2998 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3000 if (CHAR_BYTE8_P (ch
))
3001 force_singlebyte
= 1;
3002 else if (! ASCII_CHAR_P (ch
))
3003 force_multibyte
= 1;
3004 else /* I.e. ASCII_CHAR_P (ch). */
3006 /* Allow `\C- ' and `\C-?'. */
3007 if (modifiers
== CHAR_CTL
)
3010 ch
= 0, modifiers
= 0;
3012 ch
= 127, modifiers
= 0;
3014 if (modifiers
& CHAR_SHIFT
)
3016 /* Shift modifier is valid only with [A-Za-z]. */
3017 if (ch
>= 'A' && ch
<= 'Z')
3018 modifiers
&= ~CHAR_SHIFT
;
3019 else if (ch
>= 'a' && ch
<= 'z')
3020 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3023 if (modifiers
& CHAR_META
)
3025 /* Move the meta bit to the right place for a
3027 modifiers
&= ~CHAR_META
;
3028 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3029 force_singlebyte
= 1;
3033 /* Any modifiers remaining are invalid. */
3035 error ("Invalid modifier in string");
3036 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3040 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3041 if (CHAR_BYTE8_P (ch
))
3042 force_singlebyte
= 1;
3043 else if (! ASCII_CHAR_P (ch
))
3044 force_multibyte
= 1;
3050 end_of_file_error ();
3052 /* If purifying, and string starts with \ newline,
3053 return zero instead. This is for doc strings
3054 that we are really going to find in etc/DOC.nn.nn. */
3055 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3056 return make_number (0);
3058 if (! force_multibyte
&& force_singlebyte
)
3060 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3061 forms. Convert it to unibyte. */
3062 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3064 p
= read_buffer
+ nchars
;
3067 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3069 || (p
- read_buffer
!= nchars
)));
3074 int next_char
= READCHAR
;
3077 if (next_char
<= 040
3078 || (next_char
< 0200
3079 && strchr ("\"';([#?`,", next_char
) != NULL
))
3085 /* Otherwise, we fall through! Note that the atom-reading loop
3086 below will now loop at least once, assuring that we will not
3087 try to UNREAD two characters in a row. */
3091 if (c
<= 040) goto retry
;
3092 if (c
== 0xa0) /* NBSP */
3097 char *p
= read_buffer
;
3099 EMACS_INT start_position
= readchar_count
- 1;
3102 char *end
= read_buffer
+ read_buffer_size
;
3106 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3108 ptrdiff_t offset
= p
- read_buffer
;
3109 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3110 memory_full (SIZE_MAX
);
3111 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3112 read_buffer_size
*= 2;
3113 p
= read_buffer
+ offset
;
3114 end
= read_buffer
+ read_buffer_size
;
3121 end_of_file_error ();
3126 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3132 && c
!= 0xa0 /* NBSP */
3134 || strchr ("\"';()[]#`,", c
) == NULL
));
3138 ptrdiff_t offset
= p
- read_buffer
;
3139 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3140 memory_full (SIZE_MAX
);
3141 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3142 read_buffer_size
*= 2;
3143 p
= read_buffer
+ offset
;
3144 end
= read_buffer
+ read_buffer_size
;
3150 if (!quoted
&& !uninterned_symbol
)
3152 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3153 if (! NILP (result
))
3157 Lisp_Object name
, result
;
3158 ptrdiff_t nbytes
= p
- read_buffer
;
3161 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3165 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3166 ? make_pure_string
: make_specified_string
)
3167 (read_buffer
, nchars
, nbytes
, multibyte
));
3168 result
= (uninterned_symbol
? Fmake_symbol (name
)
3169 : Fintern (name
, Qnil
));
3171 if (EQ (Vread_with_symbol_positions
, Qt
)
3172 || EQ (Vread_with_symbol_positions
, readcharfun
))
3173 Vread_symbol_positions_list
3174 = Fcons (Fcons (result
, make_number (start_position
)),
3175 Vread_symbol_positions_list
);
3183 /* List of nodes we've seen during substitute_object_in_subtree. */
3184 static Lisp_Object seen_list
;
3187 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3189 Lisp_Object check_object
;
3191 /* We haven't seen any objects when we start. */
3194 /* Make all the substitutions. */
3196 = substitute_object_recurse (object
, placeholder
, object
);
3198 /* Clear seen_list because we're done with it. */
3201 /* The returned object here is expected to always eq the
3203 if (!EQ (check_object
, object
))
3204 error ("Unexpected mutation error in reader");
3207 /* Feval doesn't get called from here, so no gc protection is needed. */
3208 #define SUBSTITUTE(get_val, set_val) \
3210 Lisp_Object old_value = get_val; \
3211 Lisp_Object true_value \
3212 = substitute_object_recurse (object, placeholder, \
3215 if (!EQ (old_value, true_value)) \
3222 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3224 /* If we find the placeholder, return the target object. */
3225 if (EQ (placeholder
, subtree
))
3228 /* If we've been to this node before, don't explore it again. */
3229 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3232 /* If this node can be the entry point to a cycle, remember that
3233 we've seen it. It can only be such an entry point if it was made
3234 by #n=, which means that we can find it as a value in
3236 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3237 seen_list
= Fcons (subtree
, seen_list
);
3239 /* Recurse according to subtree's type.
3240 Every branch must return a Lisp_Object. */
3241 switch (XTYPE (subtree
))
3243 case Lisp_Vectorlike
:
3245 ptrdiff_t i
, length
= 0;
3246 if (BOOL_VECTOR_P (subtree
))
3247 return subtree
; /* No sub-objects anyway. */
3248 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3249 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3250 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3251 else if (VECTORP (subtree
))
3252 length
= ASIZE (subtree
);
3254 /* An unknown pseudovector may contain non-Lisp fields, so we
3255 can't just blindly traverse all its fields. We used to call
3256 `Flength' which signaled `sequencep', so I just preserved this
3258 wrong_type_argument (Qsequencep
, subtree
);
3260 for (i
= 0; i
< length
; i
++)
3261 SUBSTITUTE (AREF (subtree
, i
),
3262 ASET (subtree
, i
, true_value
));
3268 SUBSTITUTE (XCAR (subtree
),
3269 XSETCAR (subtree
, true_value
));
3270 SUBSTITUTE (XCDR (subtree
),
3271 XSETCDR (subtree
, true_value
));
3277 /* Check for text properties in each interval.
3278 substitute_in_interval contains part of the logic. */
3280 INTERVAL root_interval
= string_intervals (subtree
);
3281 Lisp_Object arg
= Fcons (object
, placeholder
);
3283 traverse_intervals_noorder (root_interval
,
3284 &substitute_in_interval
, arg
);
3289 /* Other types don't recurse any further. */
3295 /* Helper function for substitute_object_recurse. */
3297 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3299 Lisp_Object object
= Fcar (arg
);
3300 Lisp_Object placeholder
= Fcdr (arg
);
3302 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3312 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3313 integer syntax and fits in a fixnum, else return the nearest float if CP has
3314 either floating point or integer syntax and BASE is 10, else return nil. If
3315 IGNORE_TRAILING, consider just the longest prefix of CP that has
3316 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3317 number has integer syntax but does not fit. */
3320 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3323 char const *cp
= string
;
3325 bool float_syntax
= 0;
3328 /* Compute NaN and infinities using a variable, to cope with compilers that
3329 think they are smarter than we are. */
3332 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3333 IEEE floating point hosts, and works around a formerly-common bug where
3334 atof ("-0.0") drops the sign. */
3335 bool negative
= *cp
== '-';
3337 bool signedp
= negative
|| *cp
== '+';
3342 leading_digit
= digit_to_number (*cp
, base
);
3343 if (leading_digit
>= 0)
3348 while (digit_to_number (*cp
, base
) >= 0);
3358 if ('0' <= *cp
&& *cp
<= '9')
3363 while ('0' <= *cp
&& *cp
<= '9');
3365 if (*cp
== 'e' || *cp
== 'E')
3367 char const *ecp
= cp
;
3369 if (*cp
== '+' || *cp
== '-')
3371 if ('0' <= *cp
&& *cp
<= '9')
3376 while ('0' <= *cp
&& *cp
<= '9');
3378 else if (cp
[-1] == '+'
3379 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3385 else if (cp
[-1] == '+'
3386 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3390 value
= zero
/ zero
;
3392 /* If that made a "negative" NaN, negate it. */
3395 union { double d
; char c
[sizeof (double)]; }
3396 u_data
, u_minus_zero
;
3398 u_minus_zero
.d
= -0.0;
3399 for (i
= 0; i
< sizeof (double); i
++)
3400 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3406 /* Now VALUE is a positive NaN. */
3412 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3413 || state
== (LEAD_INT
|E_EXP
));
3416 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3417 any prefix that matches. Otherwise, the entire string must match. */
3418 if (! (ignore_trailing
3419 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3420 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3423 /* If the number uses integer and not float syntax, and is in C-language
3424 range, use its value, preferably as a fixnum. */
3425 if (leading_digit
>= 0 && ! float_syntax
)
3429 /* Fast special case for single-digit integers. This also avoids a
3430 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3431 case some versions of strtoumax accept numbers like "0x1" that Emacs
3433 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3434 return make_number (negative
? -leading_digit
: leading_digit
);
3437 n
= strtoumax (string
+ signedp
, NULL
, base
);
3438 if (errno
== ERANGE
)
3440 /* Unfortunately there's no simple and accurate way to convert
3441 non-base-10 numbers that are out of C-language range. */
3443 xsignal1 (Qoverflow_error
, build_string (string
));
3445 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3447 EMACS_INT signed_n
= n
;
3448 return make_number (negative
? -signed_n
: signed_n
);
3454 /* Either the number uses float syntax, or it does not fit into a fixnum.
3455 Convert it from string to floating point, unless the value is already
3456 known because it is an infinity, a NAN, or its absolute value fits in
3459 value
= atof (string
+ signedp
);
3461 return make_float (negative
? -value
: value
);
3466 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3470 Lisp_Object tem
, item
, vector
;
3471 struct Lisp_Cons
*otem
;
3474 tem
= read_list (1, readcharfun
);
3475 len
= Flength (tem
);
3476 vector
= Fmake_vector (len
, Qnil
);
3478 size
= ASIZE (vector
);
3479 ptr
= XVECTOR (vector
)->contents
;
3480 for (i
= 0; i
< size
; i
++)
3483 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3484 bytecode object, the docstring containing the bytecode and
3485 constants values must be treated as unibyte and passed to
3486 Fread, to get the actual bytecode string and constants vector. */
3487 if (bytecodeflag
&& load_force_doc_strings
)
3489 if (i
== COMPILED_BYTECODE
)
3491 if (!STRINGP (item
))
3492 error ("Invalid byte code");
3494 /* Delay handling the bytecode slot until we know whether
3495 it is lazily-loaded (we can tell by whether the
3496 constants slot is nil). */
3497 ASET (vector
, COMPILED_CONSTANTS
, item
);
3500 else if (i
== COMPILED_CONSTANTS
)
3502 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3506 /* Coerce string to unibyte (like string-as-unibyte,
3507 but without generating extra garbage and
3508 guaranteeing no change in the contents). */
3509 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3510 STRING_SET_UNIBYTE (bytestr
);
3512 item
= Fread (Fcons (bytestr
, readcharfun
));
3514 error ("Invalid byte code");
3516 otem
= XCONS (item
);
3517 bytestr
= XCAR (item
);
3522 /* Now handle the bytecode slot. */
3523 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3525 else if (i
== COMPILED_DOC_STRING
3527 && ! STRING_MULTIBYTE (item
))
3529 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3530 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3532 item
= Fstring_as_multibyte (item
);
3535 ASET (vector
, i
, item
);
3543 /* FLAG means check for ] to terminate rather than ) and . */
3546 read_list (bool flag
, Lisp_Object readcharfun
)
3548 Lisp_Object val
, tail
;
3549 Lisp_Object elt
, tem
;
3550 struct gcpro gcpro1
, gcpro2
;
3551 /* 0 is the normal case.
3552 1 means this list is a doc reference; replace it with the number 0.
3553 2 means this list is a doc reference; replace it with the doc string. */
3554 int doc_reference
= 0;
3556 /* Initialize this to 1 if we are reading a list. */
3557 bool first_in_list
= flag
<= 0;
3566 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3571 /* While building, if the list starts with #$, treat it specially. */
3572 if (EQ (elt
, Vload_file_name
)
3574 && !NILP (Vpurify_flag
))
3576 if (NILP (Vdoc_file_name
))
3577 /* We have not yet called Snarf-documentation, so assume
3578 this file is described in the DOC file
3579 and Snarf-documentation will fill in the right value later.
3580 For now, replace the whole list with 0. */
3583 /* We have already called Snarf-documentation, so make a relative
3584 file name for this file, so it can be found properly
3585 in the installed Lisp directory.
3586 We don't use Fexpand_file_name because that would make
3587 the directory absolute now. */
3588 elt
= concat2 (build_string ("../lisp/"),
3589 Ffile_name_nondirectory (elt
));
3591 else if (EQ (elt
, Vload_file_name
)
3593 && load_force_doc_strings
)
3602 invalid_syntax (") or . in a vector");
3610 XSETCDR (tail
, read0 (readcharfun
));
3612 val
= read0 (readcharfun
);
3613 read1 (readcharfun
, &ch
, 0);
3617 if (doc_reference
== 1)
3618 return make_number (0);
3619 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3622 file_offset saved_position
;
3623 /* Get a doc string from the file we are loading.
3624 If it's in saved_doc_string, get it from there.
3626 Here, we don't know if the string is a
3627 bytecode string or a doc string. As a
3628 bytecode string must be unibyte, we always
3629 return a unibyte string. If it is actually a
3630 doc string, caller must make it
3633 /* Position is negative for user variables. */
3634 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3635 if (pos
>= saved_doc_string_position
3636 && pos
< (saved_doc_string_position
3637 + saved_doc_string_length
))
3639 saved
= saved_doc_string
;
3640 saved_position
= saved_doc_string_position
;
3642 /* Look in prev_saved_doc_string the same way. */
3643 else if (pos
>= prev_saved_doc_string_position
3644 && pos
< (prev_saved_doc_string_position
3645 + prev_saved_doc_string_length
))
3647 saved
= prev_saved_doc_string
;
3648 saved_position
= prev_saved_doc_string_position
;
3652 ptrdiff_t start
= pos
- saved_position
;
3655 /* Process quoting with ^A,
3656 and find the end of the string,
3657 which is marked with ^_ (037). */
3658 for (from
= start
, to
= start
;
3659 saved
[from
] != 037;)
3661 int c
= saved
[from
++];
3665 saved
[to
++] = (c
== 1 ? c
3674 return make_unibyte_string (saved
+ start
,
3678 return get_doc_string (val
, 1, 0);
3683 invalid_syntax (". in wrong context");
3685 invalid_syntax ("] in a list");
3689 XSETCDR (tail
, tem
);
3696 static Lisp_Object initial_obarray
;
3698 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3700 static size_t oblookup_last_bucket_number
;
3702 /* Get an error if OBARRAY is not an obarray.
3703 If it is one, return it. */
3706 check_obarray (Lisp_Object obarray
)
3708 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3710 /* If Vobarray is now invalid, force it to be valid. */
3711 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3712 wrong_type_argument (Qvectorp
, obarray
);
3717 /* Intern the C string STR: return a symbol with that name,
3718 interned in the current obarray. */
3721 intern_1 (const char *str
, ptrdiff_t len
)
3723 Lisp_Object obarray
= check_obarray (Vobarray
);
3724 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3726 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3730 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3732 Lisp_Object obarray
= check_obarray (Vobarray
);
3733 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3738 if (NILP (Vpurify_flag
))
3739 /* Creating a non-pure string from a string literal not
3740 implemented yet. We could just use make_string here and live
3741 with the extra copy. */
3744 return Fintern (make_pure_c_string (str
, len
), obarray
);
3747 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3748 doc
: /* Return the canonical symbol whose name is STRING.
3749 If there is none, one is created by this function and returned.
3750 A second optional argument specifies the obarray to use;
3751 it defaults to the value of `obarray'. */)
3752 (Lisp_Object string
, Lisp_Object obarray
)
3754 register Lisp_Object tem
, sym
, *ptr
;
3756 if (NILP (obarray
)) obarray
= Vobarray
;
3757 obarray
= check_obarray (obarray
);
3759 CHECK_STRING (string
);
3761 tem
= oblookup (obarray
, SSDATA (string
),
3764 if (!INTEGERP (tem
))
3767 if (!NILP (Vpurify_flag
))
3768 string
= Fpurecopy (string
);
3769 sym
= Fmake_symbol (string
);
3771 if (EQ (obarray
, initial_obarray
))
3772 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3774 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3776 if ((SREF (string
, 0) == ':')
3777 && EQ (obarray
, initial_obarray
))
3779 XSYMBOL (sym
)->constant
= 1;
3780 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3781 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3784 ptr
= aref_addr (obarray
, XINT(tem
));
3786 set_symbol_next (sym
, XSYMBOL (*ptr
));
3788 set_symbol_next (sym
, NULL
);
3793 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3794 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3795 NAME may be a string or a symbol. If it is a symbol, that exact
3796 symbol is searched for.
3797 A second optional argument specifies the obarray to use;
3798 it defaults to the value of `obarray'. */)
3799 (Lisp_Object name
, Lisp_Object obarray
)
3801 register Lisp_Object tem
, string
;
3803 if (NILP (obarray
)) obarray
= Vobarray
;
3804 obarray
= check_obarray (obarray
);
3806 if (!SYMBOLP (name
))
3808 CHECK_STRING (name
);
3812 string
= SYMBOL_NAME (name
);
3814 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3815 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3821 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3822 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3823 The value is t if a symbol was found and deleted, nil otherwise.
3824 NAME may be a string or a symbol. If it is a symbol, that symbol
3825 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3826 OBARRAY defaults to the value of the variable `obarray'. */)
3827 (Lisp_Object name
, Lisp_Object obarray
)
3829 register Lisp_Object string
, tem
;
3832 if (NILP (obarray
)) obarray
= Vobarray
;
3833 obarray
= check_obarray (obarray
);
3836 string
= SYMBOL_NAME (name
);
3839 CHECK_STRING (name
);
3843 tem
= oblookup (obarray
, SSDATA (string
),
3848 /* If arg was a symbol, don't delete anything but that symbol itself. */
3849 if (SYMBOLP (name
) && !EQ (name
, tem
))
3852 /* There are plenty of other symbols which will screw up the Emacs
3853 session if we unintern them, as well as even more ways to use
3854 `setq' or `fset' or whatnot to make the Emacs session
3855 unusable. Let's not go down this silly road. --Stef */
3856 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3857 error ("Attempt to unintern t or nil"); */
3859 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3861 hash
= oblookup_last_bucket_number
;
3863 if (EQ (AREF (obarray
, hash
), tem
))
3865 if (XSYMBOL (tem
)->next
)
3868 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3869 ASET (obarray
, hash
, sym
);
3872 ASET (obarray
, hash
, make_number (0));
3876 Lisp_Object tail
, following
;
3878 for (tail
= AREF (obarray
, hash
);
3879 XSYMBOL (tail
)->next
;
3882 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3883 if (EQ (following
, tem
))
3885 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3894 /* Return the symbol in OBARRAY whose names matches the string
3895 of SIZE characters (SIZE_BYTE bytes) at PTR.
3896 If there is no such symbol in OBARRAY, return nil.
3898 Also store the bucket number in oblookup_last_bucket_number. */
3901 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3905 register Lisp_Object tail
;
3906 Lisp_Object bucket
, tem
;
3908 obarray
= check_obarray (obarray
);
3909 obsize
= ASIZE (obarray
);
3911 /* This is sometimes needed in the middle of GC. */
3912 obsize
&= ~ARRAY_MARK_FLAG
;
3913 hash
= hash_string (ptr
, size_byte
) % obsize
;
3914 bucket
= AREF (obarray
, hash
);
3915 oblookup_last_bucket_number
= hash
;
3916 if (EQ (bucket
, make_number (0)))
3918 else if (!SYMBOLP (bucket
))
3919 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3921 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3923 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3924 && SCHARS (SYMBOL_NAME (tail
)) == size
3925 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3927 else if (XSYMBOL (tail
)->next
== 0)
3930 XSETINT (tem
, hash
);
3935 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3938 register Lisp_Object tail
;
3939 CHECK_VECTOR (obarray
);
3940 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3942 tail
= AREF (obarray
, i
);
3947 if (XSYMBOL (tail
)->next
== 0)
3949 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3955 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3957 call1 (function
, sym
);
3960 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3961 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3962 OBARRAY defaults to the value of `obarray'. */)
3963 (Lisp_Object function
, Lisp_Object obarray
)
3965 if (NILP (obarray
)) obarray
= Vobarray
;
3966 obarray
= check_obarray (obarray
);
3968 map_obarray (obarray
, mapatoms_1
, function
);
3972 #define OBARRAY_SIZE 1511
3977 Lisp_Object oblength
;
3978 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3980 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3982 Vobarray
= Fmake_vector (oblength
, make_number (0));
3983 initial_obarray
= Vobarray
;
3984 staticpro (&initial_obarray
);
3986 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
3987 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3988 NILP (Vpurify_flag) check in intern_c_string. */
3989 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3990 Qnil
= intern_c_string ("nil");
3992 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3993 so those two need to be fixed manually. */
3994 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3995 set_symbol_function (Qunbound
, Qnil
);
3996 set_symbol_plist (Qunbound
, Qnil
);
3997 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3998 XSYMBOL (Qnil
)->constant
= 1;
3999 XSYMBOL (Qnil
)->declared_special
= 1;
4000 set_symbol_plist (Qnil
, Qnil
);
4001 set_symbol_function (Qnil
, Qnil
);
4003 Qt
= intern_c_string ("t");
4004 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4005 XSYMBOL (Qnil
)->declared_special
= 1;
4006 XSYMBOL (Qt
)->constant
= 1;
4008 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4011 DEFSYM (Qvariable_documentation
, "variable-documentation");
4013 read_buffer
= xmalloc (size
);
4014 read_buffer_size
= size
;
4018 defsubr (struct Lisp_Subr
*sname
)
4020 Lisp_Object sym
, tem
;
4021 sym
= intern_c_string (sname
->symbol_name
);
4022 XSETPVECTYPE (sname
, PVEC_SUBR
);
4023 XSETSUBR (tem
, sname
);
4024 set_symbol_function (sym
, tem
);
4027 #ifdef NOTDEF /* Use fset in subr.el now! */
4029 defalias (struct Lisp_Subr
*sname
, char *string
)
4032 sym
= intern (string
);
4033 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4037 /* Define an "integer variable"; a symbol whose value is forwarded to a
4038 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4039 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4041 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4042 const char *namestring
, EMACS_INT
*address
)
4045 sym
= intern_c_string (namestring
);
4046 i_fwd
->type
= Lisp_Fwd_Int
;
4047 i_fwd
->intvar
= address
;
4048 XSYMBOL (sym
)->declared_special
= 1;
4049 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4050 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4053 /* Similar but define a variable whose value is t if address contains 1,
4054 nil if address contains 0. */
4056 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4057 const char *namestring
, bool *address
)
4060 sym
= intern_c_string (namestring
);
4061 b_fwd
->type
= Lisp_Fwd_Bool
;
4062 b_fwd
->boolvar
= address
;
4063 XSYMBOL (sym
)->declared_special
= 1;
4064 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4065 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4066 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4069 /* Similar but define a variable whose value is the Lisp Object stored
4070 at address. Two versions: with and without gc-marking of the C
4071 variable. The nopro version is used when that variable will be
4072 gc-marked for some other reason, since marking the same slot twice
4073 can cause trouble with strings. */
4075 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4076 const char *namestring
, Lisp_Object
*address
)
4079 sym
= intern_c_string (namestring
);
4080 o_fwd
->type
= Lisp_Fwd_Obj
;
4081 o_fwd
->objvar
= address
;
4082 XSYMBOL (sym
)->declared_special
= 1;
4083 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4084 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4088 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4089 const char *namestring
, Lisp_Object
*address
)
4091 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4092 staticpro (address
);
4095 /* Similar but define a variable whose value is the Lisp Object stored
4096 at a particular offset in the current kboard object. */
4099 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4100 const char *namestring
, int offset
)
4103 sym
= intern_c_string (namestring
);
4104 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4105 ko_fwd
->offset
= offset
;
4106 XSYMBOL (sym
)->declared_special
= 1;
4107 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4108 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4111 /* Check that the elements of Vload_path exist. */
4114 load_path_check (void)
4116 Lisp_Object path_tail
;
4118 /* The only elements that might not exist are those from
4119 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4121 for (path_tail
= Vload_path
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4123 Lisp_Object dirfile
;
4124 dirfile
= Fcar (path_tail
);
4125 if (STRINGP (dirfile
))
4127 dirfile
= Fdirectory_file_name (dirfile
);
4128 if (! file_accessible_directory_p (SSDATA (dirfile
)))
4129 dir_warning ("Lisp directory", XCAR (path_tail
));
4134 /* Record the value of load-path used at the start of dumping
4135 so we can see if the site changed it later during dumping. */
4136 static Lisp_Object dump_path
;
4138 /* Compute the default Vload_path, with the following logic:
4140 use EMACSLOADPATH env-var if set; otherwise use PATH_LOADSEARCH,
4141 prepending PATH_SITELOADSEARCH unless --no-site-lisp.
4142 The remainder is what happens when dumping works:
4143 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4144 Otherwise use EMACSLOADPATH if set, else PATH_LOADSEARCH.
4146 If !initialized, then just set both Vload_path and dump_path.
4147 If initialized, then if Vload_path != dump_path, do nothing.
4148 (Presumably the load-path has already been changed by something.
4149 This can only be from a site-load file during dumping,
4150 or because EMACSLOADPATH is set.)
4151 If Vinstallation_directory is not nil (ie, running uninstalled):
4152 If installation-dir/lisp exists and not already a member,
4153 we must be running uninstalled. Reset the load-path
4154 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4155 refers to the eventual installation directories. Since we
4156 are not yet installed, we should not use them, even if they exist.)
4157 If installation-dir/lisp does not exist, just add dump_path at the
4159 Add installation-dir/leim (if exists and not already a member) at the front.
4160 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4161 and not already a member) at the front.
4162 If installation-dir != source-dir (ie running an uninstalled,
4163 out-of-tree build) AND install-dir/src/Makefile exists BUT
4164 install-dir/src/Makefile.in does NOT exist (this is a sanity
4165 check), then repeat the above steps for source-dir/lisp,
4167 Finally, add the site-lisp directories at the front (if !no_site_lisp).
4177 const char *loadpath
= ns_load_path ();
4180 normal
= PATH_LOADSEARCH
;
4182 Vload_path
= decode_env_path ("EMACSLOADPATH", loadpath
? loadpath
: normal
);
4184 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4189 /* FIXME CANNOT_DUMP platforms should get source-dir/lisp etc added
4190 to their load-path too, AFAICS. I don't think we can tell the
4191 difference between initialized and !initialized in this case,
4192 so we'll have to do it unconditionally when Vinstallation_directory
4194 if (!no_site_lisp
&& !egetenv ("EMACSLOADPATH"))
4196 Lisp_Object sitelisp
;
4197 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4198 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4200 #else /* !CANNOT_DUMP */
4201 if (NILP (Vpurify_flag
))
4203 normal
= PATH_LOADSEARCH
;
4204 /* If the EMACSLOADPATH environment variable is set, use its value.
4205 This doesn't apply if we're dumping. */
4206 if (egetenv ("EMACSLOADPATH"))
4207 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4210 normal
= PATH_DUMPLOADSEARCH
;
4212 /* In a dumped Emacs, we normally reset the value of Vload_path using
4213 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4214 the source directory, instead of the path of the installed elisp
4215 libraries. However, if it appears that Vload_path has already been
4216 changed from the default that was saved before dumping, don't
4217 change it further. Changes can only be due to EMACSLOADPATH, or
4218 site-lisp files that were processed during dumping. */
4221 if (NILP (Fequal (dump_path
, Vload_path
)))
4223 /* Do not make any changes, just check the elements exist. */
4224 /* Note: --no-site-lisp is ignored.
4225 I don't know what to do about this. */
4231 const char *loadpath
= ns_load_path ();
4232 Vload_path
= decode_env_path (0, loadpath
? loadpath
: normal
);
4234 Vload_path
= decode_env_path (0, normal
);
4236 if (!NILP (Vinstallation_directory
))
4238 Lisp_Object tem
, tem1
;
4240 /* Add to the path the lisp subdir of the installation
4241 dir, if it is accessible. Note: in out-of-tree builds,
4242 this directory is empty save for Makefile. */
4243 tem
= Fexpand_file_name (build_string ("lisp"),
4244 Vinstallation_directory
);
4245 tem1
= Ffile_accessible_directory_p (tem
);
4248 if (NILP (Fmember (tem
, Vload_path
)))
4250 /* We are running uninstalled. The default load-path
4251 points to the eventual installed lisp, leim
4252 directories. We should not use those now, even
4253 if they exist, so start over from a clean slate. */
4254 Vload_path
= list1 (tem
);
4258 /* That dir doesn't exist, so add the build-time
4259 Lisp dirs instead. */
4260 Vload_path
= nconc2 (Vload_path
, dump_path
);
4262 /* Add leim under the installation dir, if it is accessible. */
4263 tem
= Fexpand_file_name (build_string ("leim"),
4264 Vinstallation_directory
);
4265 tem1
= Ffile_accessible_directory_p (tem
);
4268 if (NILP (Fmember (tem
, Vload_path
)))
4269 Vload_path
= Fcons (tem
, Vload_path
);
4272 /* Add site-lisp under the installation dir, if it exists. */
4275 tem
= Fexpand_file_name (build_string ("site-lisp"),
4276 Vinstallation_directory
);
4277 tem1
= Ffile_accessible_directory_p (tem
);
4280 if (NILP (Fmember (tem
, Vload_path
)))
4281 Vload_path
= Fcons (tem
, Vload_path
);
4285 /* If Emacs was not built in the source directory,
4286 and it is run from where it was built, add to load-path
4287 the lisp, leim and site-lisp dirs under that directory. */
4289 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4293 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4294 Vinstallation_directory
);
4295 tem1
= Ffile_exists_p (tem
);
4297 /* Don't be fooled if they moved the entire source tree
4298 AFTER dumping Emacs. If the build directory is indeed
4299 different from the source dir, src/Makefile.in and
4300 src/Makefile will not be found together. */
4301 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4302 Vinstallation_directory
);
4303 tem2
= Ffile_exists_p (tem
);
4304 if (!NILP (tem1
) && NILP (tem2
))
4306 tem
= Fexpand_file_name (build_string ("lisp"),
4309 if (NILP (Fmember (tem
, Vload_path
)))
4310 Vload_path
= Fcons (tem
, Vload_path
);
4312 tem
= Fexpand_file_name (build_string ("leim"),
4315 if (NILP (Fmember (tem
, Vload_path
)))
4316 Vload_path
= Fcons (tem
, Vload_path
);
4320 tem
= Fexpand_file_name (build_string ("site-lisp"),
4322 tem1
= Ffile_accessible_directory_p (tem
);
4325 if (NILP (Fmember (tem
, Vload_path
)))
4326 Vload_path
= Fcons (tem
, Vload_path
);
4330 } /* Vinstallation_directory != Vsource_directory */
4332 } /* if Vinstallation_directory */
4334 /* Check before adding the site-lisp directories.
4335 The install should have created them, but they are not
4336 required, so no need to warn if they are absent.
4337 Or we might be running before installation. */
4340 /* Add the site-lisp directories at the front. */
4343 Lisp_Object sitelisp
;
4344 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4345 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4347 } /* if dump_path == Vload_path */
4349 else /* !initialized */
4351 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4352 source directory. We used to add ../lisp (ie the lisp dir in
4353 the build directory) at the front here, but that caused trouble
4354 because it was copied from dump_path into Vload_path, above,
4355 when Vinstallation_directory was non-nil. It should not be
4356 necessary, since in out of tree builds lisp/ is empty, save
4358 Vload_path
= decode_env_path (0, normal
);
4359 dump_path
= Vload_path
;
4360 /* No point calling load_path_check; load-path only contains essential
4361 elements from the source directory at this point. They cannot
4362 be missing unless something went extremely (and improbably)
4363 wrong, in which case the build will fail in obvious ways. */
4365 #endif /* !CANNOT_DUMP */
4369 load_in_progress
= 0;
4370 Vload_file_name
= Qnil
;
4371 Vstandard_input
= Qt
;
4372 Vloads_in_progress
= Qnil
;
4375 /* Print a warning that directory intended for use USE and with name
4376 DIRNAME cannot be accessed. On entry, errno should correspond to
4377 the access failure. Print the warning on stderr and put it in
4381 dir_warning (char const *use
, Lisp_Object dirname
)
4383 static char const format
[] = "Warning: %s `%s': %s\n";
4384 int access_errno
= errno
;
4385 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4387 /* Don't log the warning before we've initialized!! */
4390 char const *diagnostic
= emacs_strerror (access_errno
);
4392 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4393 + strlen (use
) + SBYTES (dirname
)
4394 + strlen (diagnostic
));
4395 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4397 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4403 syms_of_lread (void)
4406 defsubr (&Sread_from_string
);
4408 defsubr (&Sintern_soft
);
4409 defsubr (&Sunintern
);
4410 defsubr (&Sget_load_suffixes
);
4412 defsubr (&Seval_buffer
);
4413 defsubr (&Seval_region
);
4414 defsubr (&Sread_char
);
4415 defsubr (&Sread_char_exclusive
);
4416 defsubr (&Sread_event
);
4417 defsubr (&Sget_file_char
);
4418 defsubr (&Smapatoms
);
4419 defsubr (&Slocate_file_internal
);
4421 DEFVAR_LISP ("obarray", Vobarray
,
4422 doc
: /* Symbol table for use by `intern' and `read'.
4423 It is a vector whose length ought to be prime for best results.
4424 The vector's contents don't make sense if examined from Lisp programs;
4425 to find all the symbols in an obarray, use `mapatoms'. */);
4427 DEFVAR_LISP ("values", Vvalues
,
4428 doc
: /* List of values of all expressions which were read, evaluated and printed.
4429 Order is reverse chronological. */);
4430 XSYMBOL (intern ("values"))->declared_special
= 0;
4432 DEFVAR_LISP ("standard-input", Vstandard_input
,
4433 doc
: /* Stream for read to get input from.
4434 See documentation of `read' for possible values. */);
4435 Vstandard_input
= Qt
;
4437 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4438 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4440 If this variable is a buffer, then only forms read from that buffer
4441 will be added to `read-symbol-positions-list'.
4442 If this variable is t, then all read forms will be added.
4443 The effect of all other values other than nil are not currently
4444 defined, although they may be in the future.
4446 The positions are relative to the last call to `read' or
4447 `read-from-string'. It is probably a bad idea to set this variable at
4448 the toplevel; bind it instead. */);
4449 Vread_with_symbol_positions
= Qnil
;
4451 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4452 doc
: /* A list mapping read symbols to their positions.
4453 This variable is modified during calls to `read' or
4454 `read-from-string', but only when `read-with-symbol-positions' is
4457 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4458 CHAR-POSITION is an integer giving the offset of that occurrence of the
4459 symbol from the position where `read' or `read-from-string' started.
4461 Note that a symbol will appear multiple times in this list, if it was
4462 read multiple times. The list is in the same order as the symbols
4464 Vread_symbol_positions_list
= Qnil
;
4466 DEFVAR_LISP ("read-circle", Vread_circle
,
4467 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4470 DEFVAR_LISP ("load-path", Vload_path
,
4471 doc
: /* List of directories to search for files to load.
4472 Each element is a string (directory name) or nil (try default directory).
4473 Initialized based on EMACSLOADPATH environment variable, if any,
4474 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4476 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4477 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4478 This list should not include the empty string.
4479 `load' and related functions try to append these suffixes, in order,
4480 to the specified file name if a Lisp suffix is allowed or required. */);
4481 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4482 build_pure_c_string (".el"));
4483 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4484 doc
: /* List of suffixes that indicate representations of \
4486 This list should normally start with the empty string.
4488 Enabling Auto Compression mode appends the suffixes in
4489 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4490 mode removes them again. `load' and related functions use this list to
4491 determine whether they should look for compressed versions of a file
4492 and, if so, which suffixes they should try to append to the file name
4493 in order to do so. However, if you want to customize which suffixes
4494 the loading functions recognize as compression suffixes, you should
4495 customize `jka-compr-load-suffixes' rather than the present variable. */);
4496 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4498 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4499 doc
: /* Non-nil if inside of `load'. */);
4500 DEFSYM (Qload_in_progress
, "load-in-progress");
4502 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4503 doc
: /* An alist of functions to be evalled when particular files are loaded.
4504 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4506 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4507 a symbol \(a feature name).
4509 When `load' is run and the file-name argument matches an element's
4510 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4511 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4513 An error in FORMS does not undo the load, but does prevent execution of
4514 the rest of the FORMS. */);
4515 Vafter_load_alist
= Qnil
;
4517 DEFVAR_LISP ("load-history", Vload_history
,
4518 doc
: /* Alist mapping loaded file names to symbols and features.
4519 Each alist element should be a list (FILE-NAME ENTRIES...), where
4520 FILE-NAME is the name of a file that has been loaded into Emacs.
4521 The file name is absolute and true (i.e. it doesn't contain symlinks).
4522 As an exception, one of the alist elements may have FILE-NAME nil,
4523 for symbols and features not associated with any file.
4525 The remaining ENTRIES in the alist element describe the functions and
4526 variables defined in that file, the features provided, and the
4527 features required. Each entry has the form `(provide . FEATURE)',
4528 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4529 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4530 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4531 autoload before this file redefined it as a function. In addition,
4532 entries may also be single symbols, which means that SYMBOL was
4533 defined by `defvar' or `defconst'.
4535 During preloading, the file name recorded is relative to the main Lisp
4536 directory. These file names are converted to absolute at startup. */);
4537 Vload_history
= Qnil
;
4539 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4540 doc
: /* Full name of file being loaded by `load'. */);
4541 Vload_file_name
= Qnil
;
4543 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4544 doc
: /* File name, including directory, of user's initialization file.
4545 If the file loaded had extension `.elc', and the corresponding source file
4546 exists, this variable contains the name of source file, suitable for use
4547 by functions like `custom-save-all' which edit the init file.
4548 While Emacs loads and evaluates the init file, value is the real name
4549 of the file, regardless of whether or not it has the `.elc' extension. */);
4550 Vuser_init_file
= Qnil
;
4552 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4553 doc
: /* Used for internal purposes by `load'. */);
4554 Vcurrent_load_list
= Qnil
;
4556 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4557 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4558 The default is nil, which means use the function `read'. */);
4559 Vload_read_function
= Qnil
;
4561 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4562 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4563 The value should be a function for doing code conversion before
4564 reading a source file. It can also be nil, in which case loading is
4565 done without any code conversion.
4567 If the value is a function, it is called with four arguments,
4568 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4569 the file to load, FILE is the non-absolute name (for messages etc.),
4570 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4571 `load'. The function should return t if the file was loaded. */);
4572 Vload_source_file_function
= Qnil
;
4574 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4575 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4576 This is useful when the file being loaded is a temporary copy. */);
4577 load_force_doc_strings
= 0;
4579 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4580 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4581 This is normally bound by `load' and `eval-buffer' to control `read',
4582 and is not meant for users to change. */);
4583 load_convert_to_unibyte
= 0;
4585 DEFVAR_LISP ("source-directory", Vsource_directory
,
4586 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4587 You cannot count on them to still be there! */);
4589 = Fexpand_file_name (build_string ("../"),
4590 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4592 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4593 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4594 Vpreloaded_file_list
= Qnil
;
4596 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4597 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4598 Vbyte_boolean_vars
= Qnil
;
4600 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4601 doc
: /* Non-nil means load dangerous compiled Lisp files.
4602 Some versions of XEmacs use different byte codes than Emacs. These
4603 incompatible byte codes can make Emacs crash when it tries to execute
4605 load_dangerous_libraries
= 0;
4607 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4608 doc
: /* Non-nil means force printing messages when loading Lisp files.
4609 This overrides the value of the NOMESSAGE argument to `load'. */);
4610 force_load_messages
= 0;
4612 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4613 doc
: /* Regular expression matching safe to load compiled Lisp files.
4614 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4615 from the file, and matches them against this regular expression.
4616 When the regular expression matches, the file is considered to be safe
4617 to load. See also `load-dangerous-libraries'. */);
4618 Vbytecomp_version_regexp
4619 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4621 DEFSYM (Qlexical_binding
, "lexical-binding");
4622 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4623 doc
: /* Whether to use lexical binding when evaluating code.
4624 Non-nil means that the code in the current buffer should be evaluated
4625 with lexical binding.
4626 This variable is automatically set from the file variables of an
4627 interpreted Lisp file read using `load'. Unlike other file local
4628 variables, this must be set in the first line of a file. */);
4629 Vlexical_binding
= Qnil
;
4630 Fmake_variable_buffer_local (Qlexical_binding
);
4632 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4633 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4634 Veval_buffer_list
= Qnil
;
4636 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4637 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4638 Vold_style_backquotes
= Qnil
;
4639 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4641 /* Vsource_directory was initialized in init_lread. */
4643 DEFSYM (Qcurrent_load_list
, "current-load-list");
4644 DEFSYM (Qstandard_input
, "standard-input");
4645 DEFSYM (Qread_char
, "read-char");
4646 DEFSYM (Qget_file_char
, "get-file-char");
4647 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4648 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4650 DEFSYM (Qbackquote
, "`");
4651 DEFSYM (Qcomma
, ",");
4652 DEFSYM (Qcomma_at
, ",@");
4653 DEFSYM (Qcomma_dot
, ",.");
4655 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4656 DEFSYM (Qascii_character
, "ascii-character");
4657 DEFSYM (Qfunction
, "function");
4658 DEFSYM (Qload
, "load");
4659 DEFSYM (Qload_file_name
, "load-file-name");
4660 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4661 DEFSYM (Qfile_truename
, "file-truename");
4662 DEFSYM (Qdir_ok
, "dir-ok");
4663 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4665 staticpro (&dump_path
);
4667 staticpro (&read_objects
);
4668 read_objects
= Qnil
;
4669 staticpro (&seen_list
);
4672 Vloads_in_progress
= Qnil
;
4673 staticpro (&Vloads_in_progress
);
4675 DEFSYM (Qhash_table
, "hash-table");
4676 DEFSYM (Qdata
, "data");
4677 DEFSYM (Qtest
, "test");
4678 DEFSYM (Qsize
, "size");
4679 DEFSYM (Qweakness
, "weakness");
4680 DEFSYM (Qrehash_size
, "rehash-size");
4681 DEFSYM (Qrehash_threshold
, "rehash-threshold");