1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2014 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
28 #include <limits.h> /* For CHAR_BIT. */
29 #include <stat-time.h>
31 #include "intervals.h"
32 #include "character.h"
40 #include "termhooks.h"
41 #include "blockinput.h"
55 #endif /* HAVE_SETLOCALE */
60 #define file_offset off_t
61 #define file_tell ftello
63 #define file_offset long
64 #define file_tell ftell
67 /* Hash table read constants. */
68 static Lisp_Object Qhash_table
, Qdata
;
69 static Lisp_Object Qtest
, Qsize
;
70 static Lisp_Object Qweakness
;
71 static Lisp_Object Qrehash_size
;
72 static Lisp_Object Qrehash_threshold
;
74 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
75 Lisp_Object Qstandard_input
;
76 Lisp_Object Qvariable_documentation
;
77 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
78 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
79 static Lisp_Object Qinhibit_file_name_operation
;
80 static Lisp_Object Qeval_buffer_list
;
81 Lisp_Object Qlexical_binding
;
82 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
84 /* Used instead of Qget_file_char while loading *.elc files compiled
85 by Emacs 21 or older. */
86 static Lisp_Object Qget_emacs_mule_file_char
;
88 static Lisp_Object Qload_force_doc_strings
;
90 static Lisp_Object Qload_in_progress
;
92 /* The association list of objects read with the #n=object form.
93 Each member of the list has the form (n . object), and is used to
94 look up the object for the corresponding #n# construct.
95 It must be set to nil before all top-level calls to read0. */
96 static Lisp_Object read_objects
;
98 /* File for get_file_char to read from. Use by load. */
99 static FILE *instream
;
101 /* For use within read-from-string (this reader is non-reentrant!!) */
102 static ptrdiff_t read_from_string_index
;
103 static ptrdiff_t read_from_string_index_byte
;
104 static ptrdiff_t read_from_string_limit
;
106 /* Number of characters read in the current call to Fread or
107 Fread_from_string. */
108 static EMACS_INT readchar_count
;
110 /* This contains the last string skipped with #@. */
111 static char *saved_doc_string
;
112 /* Length of buffer allocated in saved_doc_string. */
113 static ptrdiff_t saved_doc_string_size
;
114 /* Length of actual data in saved_doc_string. */
115 static ptrdiff_t saved_doc_string_length
;
116 /* This is the file position that string came from. */
117 static file_offset saved_doc_string_position
;
119 /* This contains the previous string skipped with #@.
120 We copy it from saved_doc_string when a new string
121 is put in saved_doc_string. */
122 static char *prev_saved_doc_string
;
123 /* Length of buffer allocated in prev_saved_doc_string. */
124 static ptrdiff_t prev_saved_doc_string_size
;
125 /* Length of actual data in prev_saved_doc_string. */
126 static ptrdiff_t prev_saved_doc_string_length
;
127 /* This is the file position that string came from. */
128 static file_offset prev_saved_doc_string_position
;
130 /* True means inside a new-style backquote
131 with no surrounding parentheses.
132 Fread initializes this to false, so we need not specbind it
133 or worry about what happens to it when there is an error. */
134 static bool new_backquote_flag
;
135 static Lisp_Object Qold_style_backquotes
;
137 /* A list of file names for files being loaded in Fload. Used to
138 check for recursive loads. */
140 static Lisp_Object Vloads_in_progress
;
142 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
145 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
146 Lisp_Object
, Lisp_Object
,
147 Lisp_Object
, Lisp_Object
);
149 /* Functions that read one byte from the current source READCHARFUN
150 or unreads one byte. If the integer argument C is -1, it returns
151 one read byte, or -1 when there's no more byte in the source. If C
152 is 0 or positive, it unreads C, and the return value is not
155 static int readbyte_for_lambda (int, Lisp_Object
);
156 static int readbyte_from_file (int, Lisp_Object
);
157 static int readbyte_from_string (int, Lisp_Object
);
159 /* Handle unreading and rereading of characters.
160 Write READCHAR to read a character,
161 UNREAD(c) to unread c to be read again.
163 These macros correctly read/unread multibyte characters. */
165 #define READCHAR readchar (readcharfun, NULL)
166 #define UNREAD(c) unreadchar (readcharfun, c)
168 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
169 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
171 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
172 Qlambda, or a cons, we use this to keep an unread character because
173 a file stream can't handle multibyte-char unreading. The value -1
174 means that there's no unread character. */
175 static int unread_char
;
178 readchar (Lisp_Object readcharfun
, bool *multibyte
)
182 int (*readbyte
) (int, Lisp_Object
);
183 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
185 bool emacs_mule_encoding
= 0;
192 if (BUFFERP (readcharfun
))
194 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
196 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
198 if (! BUFFER_LIVE_P (inbuffer
))
201 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
204 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
206 /* Fetch the character code from the buffer. */
207 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
208 BUF_INC_POS (inbuffer
, pt_byte
);
215 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
216 if (! ASCII_CHAR_P (c
))
217 c
= BYTE8_TO_CHAR (c
);
220 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
224 if (MARKERP (readcharfun
))
226 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
228 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
230 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
233 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
235 /* Fetch the character code from the buffer. */
236 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
237 BUF_INC_POS (inbuffer
, bytepos
);
244 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
245 if (! ASCII_CHAR_P (c
))
246 c
= BYTE8_TO_CHAR (c
);
250 XMARKER (readcharfun
)->bytepos
= bytepos
;
251 XMARKER (readcharfun
)->charpos
++;
256 if (EQ (readcharfun
, Qlambda
))
258 readbyte
= readbyte_for_lambda
;
262 if (EQ (readcharfun
, Qget_file_char
))
264 readbyte
= readbyte_from_file
;
268 if (STRINGP (readcharfun
))
270 if (read_from_string_index
>= read_from_string_limit
)
272 else if (STRING_MULTIBYTE (readcharfun
))
276 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
277 read_from_string_index
,
278 read_from_string_index_byte
);
282 c
= SREF (readcharfun
, read_from_string_index_byte
);
283 read_from_string_index
++;
284 read_from_string_index_byte
++;
289 if (CONSP (readcharfun
))
291 /* This is the case that read_vector is reading from a unibyte
292 string that contains a byte sequence previously skipped
293 because of #@NUMBER. The car part of readcharfun is that
294 string, and the cdr part is a value of readcharfun given to
296 readbyte
= readbyte_from_string
;
297 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
298 emacs_mule_encoding
= 1;
302 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
304 readbyte
= readbyte_from_file
;
305 emacs_mule_encoding
= 1;
309 tem
= call0 (readcharfun
);
316 if (unread_char
>= 0)
322 c
= (*readbyte
) (-1, readcharfun
);
327 if (ASCII_CHAR_P (c
))
329 if (emacs_mule_encoding
)
330 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
333 len
= BYTES_BY_CHAR_HEAD (c
);
336 c
= (*readbyte
) (-1, readcharfun
);
337 if (c
< 0 || ! TRAILING_CODE_P (c
))
340 (*readbyte
) (buf
[i
], readcharfun
);
341 return BYTE8_TO_CHAR (buf
[0]);
345 return STRING_CHAR (buf
);
348 #define FROM_FILE_P(readcharfun) \
349 (EQ (readcharfun, Qget_file_char) \
350 || EQ (readcharfun, Qget_emacs_mule_file_char))
353 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
355 if (FROM_FILE_P (readcharfun
))
357 block_input (); /* FIXME: Not sure if it's needed. */
358 fseek (instream
, n
, SEEK_CUR
);
362 { /* We're not reading directly from a file. In that case, it's difficult
363 to reliably count bytes, since these are usually meant for the file's
364 encoding, whereas we're now typically in the internal encoding.
365 But luckily, skip_dyn_bytes is used to skip over a single
366 dynamic-docstring (or dynamic byte-code) which is always quoted such
367 that \037 is the final char. */
371 } while (c
>= 0 && c
!= '\037');
376 skip_dyn_eof (Lisp_Object readcharfun
)
378 if (FROM_FILE_P (readcharfun
))
380 block_input (); /* FIXME: Not sure if it's needed. */
381 fseek (instream
, 0, SEEK_END
);
385 while (READCHAR
>= 0);
388 /* Unread the character C in the way appropriate for the stream READCHARFUN.
389 If the stream is a user function, call it with the char as argument. */
392 unreadchar (Lisp_Object readcharfun
, int c
)
396 /* Don't back up the pointer if we're unreading the end-of-input mark,
397 since readchar didn't advance it when we read it. */
399 else if (BUFFERP (readcharfun
))
401 struct buffer
*b
= XBUFFER (readcharfun
);
402 ptrdiff_t charpos
= BUF_PT (b
);
403 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
405 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
406 BUF_DEC_POS (b
, bytepos
);
410 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
412 else if (MARKERP (readcharfun
))
414 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
415 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
417 XMARKER (readcharfun
)->charpos
--;
418 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
419 BUF_DEC_POS (b
, bytepos
);
423 XMARKER (readcharfun
)->bytepos
= bytepos
;
425 else if (STRINGP (readcharfun
))
427 read_from_string_index
--;
428 read_from_string_index_byte
429 = string_char_to_byte (readcharfun
, read_from_string_index
);
431 else if (CONSP (readcharfun
))
435 else if (EQ (readcharfun
, Qlambda
))
439 else if (FROM_FILE_P (readcharfun
))
444 call1 (readcharfun
, make_number (c
));
448 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
450 return read_bytecode_char (c
>= 0);
455 readbyte_from_file (int c
, Lisp_Object readcharfun
)
460 ungetc (c
, instream
);
468 /* Interrupted reads have been observed while reading over the network. */
469 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
480 return (c
== EOF
? -1 : c
);
484 readbyte_from_string (int c
, Lisp_Object readcharfun
)
486 Lisp_Object string
= XCAR (readcharfun
);
490 read_from_string_index
--;
491 read_from_string_index_byte
492 = string_char_to_byte (string
, read_from_string_index
);
495 if (read_from_string_index
>= read_from_string_limit
)
498 FETCH_STRING_CHAR_ADVANCE (c
, string
,
499 read_from_string_index
,
500 read_from_string_index_byte
);
505 /* Read one non-ASCII character from INSTREAM. The character is
506 encoded in `emacs-mule' and the first byte is already read in
510 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
512 /* Emacs-mule coding uses at most 4-byte for one character. */
513 unsigned char buf
[4];
514 int len
= emacs_mule_bytes
[c
];
515 struct charset
*charset
;
520 /* C is not a valid leading-code of `emacs-mule'. */
521 return BYTE8_TO_CHAR (c
);
527 c
= (*readbyte
) (-1, readcharfun
);
531 (*readbyte
) (buf
[i
], readcharfun
);
532 return BYTE8_TO_CHAR (buf
[0]);
539 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
540 code
= buf
[1] & 0x7F;
544 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
545 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
547 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
548 code
= buf
[2] & 0x7F;
552 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
553 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
558 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
559 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
561 c
= DECODE_CHAR (charset
, code
);
563 Fsignal (Qinvalid_read_syntax
,
564 list1 (build_string ("invalid multibyte form")));
569 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
571 static Lisp_Object
read0 (Lisp_Object
);
572 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
574 static Lisp_Object
read_list (bool, Lisp_Object
);
575 static Lisp_Object
read_vector (Lisp_Object
, bool);
577 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
579 static void substitute_object_in_subtree (Lisp_Object
,
581 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
584 /* Get a character from the tty. */
586 /* Read input events until we get one that's acceptable for our purposes.
588 If NO_SWITCH_FRAME, switch-frame events are stashed
589 until we get a character we like, and then stuffed into
592 If ASCII_REQUIRED, check function key events to see
593 if the unmodified version of the symbol has a Qascii_character
594 property, and use that character, if present.
596 If ERROR_NONASCII, signal an error if the input we
597 get isn't an ASCII character with modifiers. If it's false but
598 ASCII_REQUIRED is true, just re-read until we get an ASCII
601 If INPUT_METHOD, invoke the current input method
602 if the character warrants that.
604 If SECONDS is a number, wait that many seconds for input, and
605 return Qnil if no input arrives within that time. */
608 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
609 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
611 Lisp_Object val
, delayed_switch_frame
;
612 struct timespec end_time
;
614 #ifdef HAVE_WINDOW_SYSTEM
615 if (display_hourglass_p
)
619 delayed_switch_frame
= Qnil
;
621 /* Compute timeout. */
622 if (NUMBERP (seconds
))
624 double duration
= extract_float (seconds
);
625 struct timespec wait_time
= dtotimespec (duration
);
626 end_time
= timespec_add (current_timespec (), wait_time
);
629 /* Read until we get an acceptable event. */
632 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
633 NUMBERP (seconds
) ? &end_time
: NULL
);
634 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
639 /* `switch-frame' events are put off until after the next ASCII
640 character. This is better than signaling an error just because
641 the last characters were typed to a separate minibuffer frame,
642 for example. Eventually, some code which can deal with
643 switch-frame events will read it and process it. */
645 && EVENT_HAS_PARAMETERS (val
)
646 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
648 delayed_switch_frame
= val
;
652 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
654 /* Convert certain symbols to their ASCII equivalents. */
657 Lisp_Object tem
, tem1
;
658 tem
= Fget (val
, Qevent_symbol_element_mask
);
661 tem1
= Fget (Fcar (tem
), Qascii_character
);
662 /* Merge this symbol's modifier bits
663 with the ASCII equivalent of its basic code. */
665 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
669 /* If we don't have a character now, deal with it appropriately. */
674 Vunread_command_events
= list1 (val
);
675 error ("Non-character input-event");
682 if (! NILP (delayed_switch_frame
))
683 unread_switch_frame
= delayed_switch_frame
;
687 #ifdef HAVE_WINDOW_SYSTEM
688 if (display_hourglass_p
)
697 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
698 doc
: /* Read a character from the command input (keyboard or macro).
699 It is returned as a number.
700 If the character has modifiers, they are resolved and reflected to the
701 character code if possible (e.g. C-SPC -> 0).
703 If the user generates an event which is not a character (i.e. a mouse
704 click or function key event), `read-char' signals an error. As an
705 exception, switch-frame events are put off until non-character events
707 If you want to read non-character events, or ignore them, call
708 `read-event' or `read-char-exclusive' instead.
710 If the optional argument PROMPT is non-nil, display that as a prompt.
711 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
712 input method is turned on in the current buffer, that input method
713 is used for reading a character.
714 If the optional argument SECONDS is non-nil, it should be a number
715 specifying the maximum number of seconds to wait for input. If no
716 input arrives in that time, return nil. SECONDS may be a
717 floating-point value. */)
718 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
723 message_with_string ("%s", prompt
, 0);
724 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
726 return (NILP (val
) ? Qnil
727 : make_number (char_resolve_modifier_mask (XINT (val
))));
730 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
731 doc
: /* Read an event object from the input stream.
732 If the optional argument PROMPT is non-nil, display that as a prompt.
733 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
734 input method is turned on in the current buffer, that input method
735 is used for reading a character.
736 If the optional argument SECONDS is non-nil, it should be a number
737 specifying the maximum number of seconds to wait for input. If no
738 input arrives in that time, return nil. SECONDS may be a
739 floating-point value. */)
740 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
743 message_with_string ("%s", prompt
, 0);
744 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
747 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
748 doc
: /* Read a character from the command input (keyboard or macro).
749 It is returned as a number. Non-character events are ignored.
750 If the character has modifiers, they are resolved and reflected to the
751 character code if possible (e.g. C-SPC -> 0).
753 If the optional argument PROMPT is non-nil, display that as a prompt.
754 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
755 input method is turned on in the current buffer, that input method
756 is used for reading a character.
757 If the optional argument SECONDS is non-nil, it should be a number
758 specifying the maximum number of seconds to wait for input. If no
759 input arrives in that time, return nil. SECONDS may be a
760 floating-point value. */)
761 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
766 message_with_string ("%s", prompt
, 0);
768 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
770 return (NILP (val
) ? Qnil
771 : make_number (char_resolve_modifier_mask (XINT (val
))));
774 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
775 doc
: /* Don't use this yourself. */)
778 register Lisp_Object val
;
780 XSETINT (val
, getc (instream
));
788 /* Return true if the lisp code read using READCHARFUN defines a non-nil
789 `lexical-binding' file variable. After returning, the stream is
790 positioned following the first line, if it is a comment or #! line,
791 otherwise nothing is read. */
794 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
807 while (ch
!= '\n' && ch
!= EOF
)
809 if (ch
== '\n') ch
= READCHAR
;
810 /* It is OK to leave the position after a #! line, since
811 that is what read1 does. */
815 /* The first line isn't a comment, just give up. */
821 /* Look for an appropriate file-variable in the first line. */
825 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
826 } beg_end_state
= NOMINAL
;
827 bool in_file_vars
= 0;
829 #define UPDATE_BEG_END_STATE(ch) \
830 if (beg_end_state == NOMINAL) \
831 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
832 else if (beg_end_state == AFTER_FIRST_DASH) \
833 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
834 else if (beg_end_state == AFTER_ASTERIX) \
837 in_file_vars = !in_file_vars; \
838 beg_end_state = NOMINAL; \
841 /* Skip until we get to the file vars, if any. */
845 UPDATE_BEG_END_STATE (ch
);
847 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
851 char var
[100], val
[100];
856 /* Read a variable name. */
857 while (ch
== ' ' || ch
== '\t')
861 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
863 if (i
< sizeof var
- 1)
865 UPDATE_BEG_END_STATE (ch
);
869 /* Stop scanning if no colon was found before end marker. */
870 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
873 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
879 /* Read a variable value. */
882 while (ch
== ' ' || ch
== '\t')
886 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
888 if (i
< sizeof val
- 1)
890 UPDATE_BEG_END_STATE (ch
);
894 /* The value was terminated by an end-marker, which remove. */
896 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
900 if (strcmp (var
, "lexical-binding") == 0)
903 rv
= (strcmp (val
, "nil") != 0);
909 while (ch
!= '\n' && ch
!= EOF
)
916 /* Value is a version number of byte compiled code if the file
917 associated with file descriptor FD is a compiled Lisp file that's
918 safe to load. Only files compiled with Emacs are safe to load.
919 Files compiled with XEmacs can lead to a crash in Fbyte_code
920 because of an incompatible change in the byte compiler. */
923 safe_to_load_version (int fd
)
929 /* Read the first few bytes from the file, and look for a line
930 specifying the byte compiler version used. */
931 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
934 /* Skip to the next newline, skipping over the initial `ELC'
935 with NUL bytes following it, but note the version. */
936 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
941 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
942 buf
+ i
, nbytes
- i
) < 0)
946 lseek (fd
, 0, SEEK_SET
);
951 /* Callback for record_unwind_protect. Restore the old load list OLD,
952 after loading a file successfully. */
955 record_load_unwind (Lisp_Object old
)
957 Vloads_in_progress
= old
;
960 /* This handler function is used via internal_condition_case_1. */
963 load_error_handler (Lisp_Object data
)
969 load_warn_old_style_backquotes (Lisp_Object file
)
971 if (!NILP (Vold_style_backquotes
))
974 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
980 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
981 doc
: /* Return the suffixes that `load' should try if a suffix is \
983 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
986 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
987 while (CONSP (suffixes
))
989 Lisp_Object exts
= Vload_file_rep_suffixes
;
990 suffix
= XCAR (suffixes
);
991 suffixes
= XCDR (suffixes
);
996 lst
= Fcons (concat2 (suffix
, ext
), lst
);
999 return Fnreverse (lst
);
1002 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1003 doc
: /* Execute a file of Lisp code named FILE.
1004 First try FILE with `.elc' appended, then try with `.el',
1005 then try FILE unmodified (the exact suffixes in the exact order are
1006 determined by `load-suffixes'). Environment variable references in
1007 FILE are replaced with their values by calling `substitute-in-file-name'.
1008 This function searches the directories in `load-path'.
1010 If optional second arg NOERROR is non-nil,
1011 report no error if FILE doesn't exist.
1012 Print messages at start and end of loading unless
1013 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1015 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1016 suffixes `.elc' or `.el' to the specified name FILE.
1017 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1018 the suffix `.elc' or `.el'; don't accept just FILE unless
1019 it ends in one of those suffixes or includes a directory name.
1021 If NOSUFFIX is nil, then if a file could not be found, try looking for
1022 a different representation of the file by adding non-empty suffixes to
1023 its name, before trying another file. Emacs uses this feature to find
1024 compressed versions of files when Auto Compression mode is enabled.
1025 If NOSUFFIX is non-nil, disable this feature.
1027 The suffixes that this function tries out, when NOSUFFIX is nil, are
1028 given by the return value of `get-load-suffixes' and the values listed
1029 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1030 return value of `get-load-suffixes' is used, i.e. the file name is
1031 required to have a non-empty suffix.
1033 When searching suffixes, this function normally stops at the first
1034 one that exists. If the option `load-prefer-newer' is non-nil,
1035 however, it tries all suffixes, and uses whichever file is the newest.
1037 Loading a file records its definitions, and its `provide' and
1038 `require' calls, in an element of `load-history' whose
1039 car is the file name loaded. See `load-history'.
1041 While the file is in the process of being loaded, the variable
1042 `load-in-progress' is non-nil and the variable `load-file-name'
1043 is bound to the file's name.
1045 Return t if the file exists and loads successfully. */)
1046 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1047 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1052 ptrdiff_t count
= SPECPDL_INDEX ();
1053 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1054 Lisp_Object found
, efound
, hist_file_name
;
1055 /* True means we printed the ".el is newer" message. */
1057 /* True means we are loading a compiled file. */
1059 Lisp_Object handler
;
1061 const char *fmode
= "r";
1068 CHECK_STRING (file
);
1070 /* If file name is magic, call the handler. */
1071 /* This shouldn't be necessary any more now that `openp' handles it right.
1072 handler = Ffind_file_name_handler (file, Qload);
1073 if (!NILP (handler))
1074 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1076 /* Do this after the handler to avoid
1077 the need to gcpro noerror, nomessage and nosuffix.
1078 (Below here, we care only whether they are nil or not.)
1079 The presence of this call is the result of a historical accident:
1080 it used to be in every file-operation and when it got removed
1081 everywhere, it accidentally stayed here. Since then, enough people
1082 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1083 that it seemed risky to remove. */
1084 if (! NILP (noerror
))
1086 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1087 Qt
, load_error_handler
);
1092 file
= Fsubstitute_in_file_name (file
);
1094 /* Avoid weird lossage with null string as arg,
1095 since it would try to load a directory as a Lisp file. */
1096 if (SCHARS (file
) == 0)
1103 Lisp_Object suffixes
;
1105 GCPRO2 (file
, found
);
1107 if (! NILP (must_suffix
))
1109 /* Don't insist on adding a suffix if FILE already ends with one. */
1110 ptrdiff_t size
= SBYTES (file
);
1112 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1115 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1117 /* Don't insist on adding a suffix
1118 if the argument includes a directory name. */
1119 else if (! NILP (Ffile_name_directory (file
)))
1123 if (!NILP (nosuffix
))
1127 suffixes
= Fget_load_suffixes ();
1128 if (NILP (must_suffix
))
1132 arg
[1] = Vload_file_rep_suffixes
;
1133 suffixes
= Fappend (2, arg
);
1137 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1144 report_file_error ("Cannot open load file", file
);
1148 /* Tell startup.el whether or not we found the user's init file. */
1149 if (EQ (Qt
, Vuser_init_file
))
1150 Vuser_init_file
= found
;
1152 /* If FD is -2, that means openp found a magic file. */
1155 if (NILP (Fequal (found
, file
)))
1156 /* If FOUND is a different file name from FILE,
1157 find its handler even if we have already inhibited
1158 the `load' operation on FILE. */
1159 handler
= Ffind_file_name_handler (found
, Qt
);
1161 handler
= Ffind_file_name_handler (found
, Qload
);
1162 if (! NILP (handler
))
1163 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1165 /* Tramp has to deal with semi-broken packages that prepend
1166 drive letters to remote files. For that reason, Tramp
1167 catches file operations that test for file existence, which
1168 makes openp think X:/foo.elc files are remote. However,
1169 Tramp does not catch `load' operations for such files, so we
1170 end up with a nil as the `load' handler above. If we would
1171 continue with fd = -2, we will behave wrongly, and in
1172 particular try reading a .elc file in the "rt" mode instead
1173 of "rb". See bug #9311 for the results. To work around
1174 this, we try to open the file locally, and go with that if it
1176 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1184 /* Pacify older GCC with --enable-gcc-warnings. */
1185 IF_LINT (fd_index
= 0);
1189 fd_index
= SPECPDL_INDEX ();
1190 record_unwind_protect_int (close_file_unwind
, fd
);
1193 /* Check if we're stuck in a recursive load cycle.
1195 2000-09-21: It's not possible to just check for the file loaded
1196 being a member of Vloads_in_progress. This fails because of the
1197 way the byte compiler currently works; `provide's are not
1198 evaluated, see font-lock.el/jit-lock.el as an example. This
1199 leads to a certain amount of ``normal'' recursion.
1201 Also, just loading a file recursively is not always an error in
1202 the general case; the second load may do something different. */
1206 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1207 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1208 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1209 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1210 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1213 /* All loads are by default dynamic, unless the file itself specifies
1214 otherwise using a file-variable in the first line. This is bound here
1215 so that it takes effect whether or not we use
1216 Vload_source_file_function. */
1217 specbind (Qlexical_binding
, Qnil
);
1219 /* Get the name for load-history. */
1220 hist_file_name
= (! NILP (Vpurify_flag
)
1221 ? concat2 (Ffile_name_directory (file
),
1222 Ffile_name_nondirectory (found
))
1227 /* Check for the presence of old-style quotes and warn about them. */
1228 specbind (Qold_style_backquotes
, Qnil
);
1229 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1231 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1232 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1233 /* Load .elc files directly, but not when they are
1234 remote and have no handler! */
1241 GCPRO3 (file
, found
, hist_file_name
);
1244 && ! (version
= safe_to_load_version (fd
)))
1247 if (!load_dangerous_libraries
)
1248 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1249 else if (!NILP (nomessage
) && !force_load_messages
)
1250 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1255 efound
= ENCODE_FILE (found
);
1261 /* openp already checked for newness, no point doing it again.
1262 FIXME would be nice to get a message when openp
1263 ignores suffix order due to load_prefer_newer. */
1264 if (!load_prefer_newer
)
1266 result
= stat (SSDATA (efound
), &s1
);
1269 SSET (efound
, SBYTES (efound
) - 1, 0);
1270 result
= stat (SSDATA (efound
), &s2
);
1271 SSET (efound
, SBYTES (efound
) - 1, 'c');
1275 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1277 /* Make the progress messages mention that source is newer. */
1280 /* If we won't print another message, mention this anyway. */
1281 if (!NILP (nomessage
) && !force_load_messages
)
1283 Lisp_Object msg_file
;
1284 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1285 message_with_string ("Source file `%s' newer than byte-compiled file",
1289 } /* !load_prefer_newer */
1295 /* We are loading a source file (*.el). */
1296 if (!NILP (Vload_source_file_function
))
1303 clear_unwind_protect (fd_index
);
1305 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1306 NILP (noerror
) ? Qnil
: Qt
,
1307 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1308 return unbind_to (count
, val
);
1312 GCPRO3 (file
, found
, hist_file_name
);
1316 /* We somehow got here with fd == -2, meaning the file is deemed
1317 to be remote. Don't even try to reopen the file locally;
1318 just force a failure. */
1326 clear_unwind_protect (fd_index
);
1327 efound
= ENCODE_FILE (found
);
1328 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1330 stream
= fdopen (fd
, fmode
);
1334 report_file_error ("Opening stdio stream", file
);
1335 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1337 if (! NILP (Vpurify_flag
))
1338 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1340 if (NILP (nomessage
) || force_load_messages
)
1343 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1346 message_with_string ("Loading %s (source)...", file
, 1);
1348 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1350 else /* The typical case; compiled file newer than source file. */
1351 message_with_string ("Loading %s...", file
, 1);
1354 specbind (Qload_file_name
, found
);
1355 specbind (Qinhibit_file_name_operation
, Qnil
);
1356 specbind (Qload_in_progress
, Qt
);
1359 if (lisp_file_lexically_bound_p (Qget_file_char
))
1360 Fset (Qlexical_binding
, Qt
);
1362 if (! version
|| version
>= 22)
1363 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1364 0, Qnil
, Qnil
, Qnil
, Qnil
);
1367 /* We can't handle a file which was compiled with
1368 byte-compile-dynamic by older version of Emacs. */
1369 specbind (Qload_force_doc_strings
, Qt
);
1370 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1371 0, Qnil
, Qnil
, Qnil
, Qnil
);
1373 unbind_to (count
, Qnil
);
1375 /* Run any eval-after-load forms for this file. */
1376 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1377 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1381 xfree (saved_doc_string
);
1382 saved_doc_string
= 0;
1383 saved_doc_string_size
= 0;
1385 xfree (prev_saved_doc_string
);
1386 prev_saved_doc_string
= 0;
1387 prev_saved_doc_string_size
= 0;
1389 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1392 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1395 message_with_string ("Loading %s (source)...done", file
, 1);
1397 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1399 else /* The typical case; compiled file newer than source file. */
1400 message_with_string ("Loading %s...done", file
, 1);
1407 complete_filename_p (Lisp_Object pathname
)
1409 const unsigned char *s
= SDATA (pathname
);
1410 return (IS_DIRECTORY_SEP (s
[0])
1411 || (SCHARS (pathname
) > 2
1412 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1415 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1416 doc
: /* Search for FILENAME through PATH.
1417 Returns the file's name in absolute form, or nil if not found.
1418 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1419 file name when searching.
1420 If non-nil, PREDICATE is used instead of `file-readable-p'.
1421 PREDICATE can also be an integer to pass to the faccessat(2) function,
1422 in which case file-name-handlers are ignored.
1423 This function will normally skip directories, so if you want it to find
1424 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1425 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1428 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1429 if (NILP (predicate
) && fd
>= 0)
1434 static Lisp_Object Qdir_ok
;
1436 /* Search for a file whose name is STR, looking in directories
1437 in the Lisp list PATH, and trying suffixes from SUFFIX.
1438 On success, return a file descriptor (or 1 or -2 as described below).
1439 On failure, return -1 and set errno.
1441 SUFFIXES is a list of strings containing possible suffixes.
1442 The empty suffix is automatically added if the list is empty.
1444 PREDICATE non-nil means don't open the files,
1445 just look for one that satisfies the predicate. In this case,
1446 return 1 on success. The predicate can be a lisp function or
1447 an integer to pass to `access' (in which case file-name-handlers
1450 If STOREPTR is nonzero, it points to a slot where the name of
1451 the file actually found should be stored as a Lisp string.
1452 nil is stored there on failure.
1454 If the file we find is remote, return -2
1455 but store the found remote file name in *STOREPTR.
1457 If NEWER is true, try all SUFFIXes and return the result for the
1458 newest file that exists. Does not apply to remote files,
1459 or if PREDICATE is specified. */
1462 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1463 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1465 ptrdiff_t fn_size
= 100;
1469 ptrdiff_t want_length
;
1470 Lisp_Object filename
;
1471 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
, gcpro7
;
1472 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1473 ptrdiff_t max_suffix_len
= 0;
1474 int last_errno
= ENOENT
;
1477 /* The last-modified time of the newest matching file found.
1478 Initialize it to something less than all valid timestamps. */
1479 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1483 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1485 CHECK_STRING_CAR (tail
);
1486 max_suffix_len
= max (max_suffix_len
,
1487 SBYTES (XCAR (tail
)));
1490 string
= filename
= encoded_fn
= save_string
= Qnil
;
1491 GCPRO7 (str
, string
, save_string
, filename
, path
, suffixes
, encoded_fn
);
1496 absolute
= complete_filename_p (str
);
1498 for (; CONSP (path
); path
= XCDR (path
))
1500 filename
= Fexpand_file_name (str
, XCAR (path
));
1501 if (!complete_filename_p (filename
))
1502 /* If there are non-absolute elts in PATH (eg "."). */
1503 /* Of course, this could conceivably lose if luser sets
1504 default-directory to be something non-absolute... */
1506 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1507 if (!complete_filename_p (filename
))
1508 /* Give up on this path element! */
1512 /* Calculate maximum length of any filename made from
1513 this path element/specified file name and any possible suffix. */
1514 want_length
= max_suffix_len
+ SBYTES (filename
);
1515 if (fn_size
<= want_length
)
1516 fn
= alloca (fn_size
= 100 + want_length
);
1518 /* Loop over suffixes. */
1519 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1520 CONSP (tail
); tail
= XCDR (tail
))
1522 Lisp_Object suffix
= XCAR (tail
);
1523 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1524 Lisp_Object handler
;
1526 /* Concatenate path element/specified name with the suffix.
1527 If the directory starts with /:, remove that. */
1528 int prefixlen
= ((SCHARS (filename
) > 2
1529 && SREF (filename
, 0) == '/'
1530 && SREF (filename
, 1) == ':')
1532 fnlen
= SBYTES (filename
) - prefixlen
;
1533 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1534 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1536 /* Check that the file exists and is not a directory. */
1537 /* We used to only check for handlers on non-absolute file names:
1541 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1542 It's not clear why that was the case and it breaks things like
1543 (load "/bar.el") where the file is actually "/bar.el.gz". */
1544 /* make_string has its own ideas on when to return a unibyte
1545 string and when a multibyte string, but we know better.
1546 We must have a unibyte string when dumping, since
1547 file-name encoding is shaky at best at that time, and in
1548 particular default-file-name-coding-system is reset
1549 several times during loadup. We therefore don't want to
1550 encode the file before passing it to file I/O library
1552 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1553 string
= make_unibyte_string (fn
, fnlen
);
1555 string
= make_string (fn
, fnlen
);
1556 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1557 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1560 if (NILP (predicate
))
1561 exists
= !NILP (Ffile_readable_p (string
));
1564 Lisp_Object tmp
= call1 (predicate
, string
);
1567 else if (EQ (tmp
, Qdir_ok
)
1568 || NILP (Ffile_directory_p (string
)))
1573 last_errno
= EISDIR
;
1579 /* We succeeded; return this descriptor and filename. */
1592 encoded_fn
= ENCODE_FILE (string
);
1593 pfn
= SSDATA (encoded_fn
);
1595 /* Check that we can access or open it. */
1596 if (NATNUMP (predicate
))
1599 if (INT_MAX
< XFASTINT (predicate
))
1600 last_errno
= EINVAL
;
1601 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1605 if (file_directory_p (pfn
))
1606 last_errno
= EISDIR
;
1613 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1616 if (errno
!= ENOENT
)
1621 int err
= (fstat (fd
, &st
) != 0 ? errno
1622 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1634 if (newer
&& !NATNUMP (predicate
))
1636 struct timespec mtime
= get_stat_mtime (&st
);
1638 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1643 emacs_close (save_fd
);
1646 save_string
= string
;
1651 /* We succeeded; return this descriptor and filename. */
1659 /* No more suffixes. Return the newest. */
1660 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1663 *storeptr
= save_string
;
1679 /* Merge the list we've accumulated of globals from the current input source
1680 into the load_history variable. The details depend on whether
1681 the source has an associated file name or not.
1683 FILENAME is the file name that we are loading from.
1685 ENTIRE is true if loading that entire file, false if evaluating
1689 build_load_history (Lisp_Object filename
, bool entire
)
1691 Lisp_Object tail
, prev
, newelt
;
1692 Lisp_Object tem
, tem2
;
1695 tail
= Vload_history
;
1698 while (CONSP (tail
))
1702 /* Find the feature's previous assoc list... */
1703 if (!NILP (Fequal (filename
, Fcar (tem
))))
1707 /* If we're loading the entire file, remove old data. */
1711 Vload_history
= XCDR (tail
);
1713 Fsetcdr (prev
, XCDR (tail
));
1716 /* Otherwise, cons on new symbols that are not already members. */
1719 tem2
= Vcurrent_load_list
;
1721 while (CONSP (tem2
))
1723 newelt
= XCAR (tem2
);
1725 if (NILP (Fmember (newelt
, tem
)))
1726 Fsetcar (tail
, Fcons (XCAR (tem
),
1727 Fcons (newelt
, XCDR (tem
))));
1740 /* If we're loading an entire file, cons the new assoc onto the
1741 front of load-history, the most-recently-loaded position. Also
1742 do this if we didn't find an existing member for the file. */
1743 if (entire
|| !foundit
)
1744 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1749 readevalloop_1 (int old
)
1751 load_convert_to_unibyte
= old
;
1754 /* Signal an `end-of-file' error, if possible with file name
1757 static _Noreturn
void
1758 end_of_file_error (void)
1760 if (STRINGP (Vload_file_name
))
1761 xsignal1 (Qend_of_file
, Vload_file_name
);
1763 xsignal0 (Qend_of_file
);
1767 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1769 /* If we macroexpand the toplevel form non-recursively and it ends
1770 up being a `progn' (or if it was a progn to start), treat each
1771 form in the progn as a top-level form. This way, if one form in
1772 the progn defines a macro, that macro is in effect when we expand
1773 the remaining forms. See similar code in bytecomp.el. */
1774 val
= call2 (macroexpand
, val
, Qnil
);
1775 if (EQ (CAR_SAFE (val
), Qprogn
))
1777 Lisp_Object subforms
= XCDR (val
);
1779 for (; CONSP (subforms
); subforms
= XCDR (subforms
))
1780 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1784 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1789 /* UNIBYTE specifies how to set load_convert_to_unibyte
1790 for this invocation.
1791 READFUN, if non-nil, is used instead of `read'.
1793 START, END specify region to read in current buffer (from eval-region).
1794 If the input is not from a buffer, they must be nil. */
1797 readevalloop (Lisp_Object readcharfun
,
1799 Lisp_Object sourcename
,
1801 Lisp_Object unibyte
, Lisp_Object readfun
,
1802 Lisp_Object start
, Lisp_Object end
)
1805 register Lisp_Object val
;
1806 ptrdiff_t count
= SPECPDL_INDEX ();
1807 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1808 struct buffer
*b
= 0;
1809 bool continue_reading_p
;
1810 Lisp_Object lex_bound
;
1811 /* True if reading an entire buffer. */
1812 bool whole_buffer
= 0;
1813 /* True on the first time around. */
1814 bool first_sexp
= 1;
1815 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1817 if (NILP (Ffboundp (macroexpand
))
1818 /* Don't macroexpand in .elc files, since it should have been done
1819 already. We actually don't know whether we're in a .elc file or not,
1820 so we use circumstantial evidence: .el files normally go through
1821 Vload_source_file_function -> load-with-code-conversion
1823 || EQ (readcharfun
, Qget_file_char
)
1824 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1827 if (MARKERP (readcharfun
))
1830 start
= readcharfun
;
1833 if (BUFFERP (readcharfun
))
1834 b
= XBUFFER (readcharfun
);
1835 else if (MARKERP (readcharfun
))
1836 b
= XMARKER (readcharfun
)->buffer
;
1838 /* We assume START is nil when input is not from a buffer. */
1839 if (! NILP (start
) && !b
)
1842 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1843 specbind (Qcurrent_load_list
, Qnil
);
1844 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1845 load_convert_to_unibyte
= !NILP (unibyte
);
1847 /* If lexical binding is active (either because it was specified in
1848 the file's header, or via a buffer-local variable), create an empty
1849 lexical environment, otherwise, turn off lexical binding. */
1850 lex_bound
= find_symbol_value (Qlexical_binding
);
1851 specbind (Qinternal_interpreter_environment
,
1852 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1853 ? Qnil
: list1 (Qt
)));
1855 GCPRO4 (sourcename
, readfun
, start
, end
);
1857 /* Try to ensure sourcename is a truename, except whilst preloading. */
1858 if (NILP (Vpurify_flag
)
1859 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1860 && !NILP (Ffboundp (Qfile_truename
)))
1861 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1863 LOADHIST_ATTACH (sourcename
);
1865 continue_reading_p
= 1;
1866 while (continue_reading_p
)
1868 ptrdiff_t count1
= SPECPDL_INDEX ();
1870 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1871 error ("Reading from killed buffer");
1875 /* Switch to the buffer we are reading from. */
1876 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1877 set_buffer_internal (b
);
1879 /* Save point in it. */
1880 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1881 /* Save ZV in it. */
1882 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1883 /* Those get unbound after we read one expression. */
1885 /* Set point and ZV around stuff to be read. */
1888 Fnarrow_to_region (make_number (BEGV
), end
);
1890 /* Just for cleanliness, convert END to a marker
1891 if it is an integer. */
1893 end
= Fpoint_max_marker ();
1896 /* On the first cycle, we can easily test here
1897 whether we are reading the whole buffer. */
1898 if (b
&& first_sexp
)
1899 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1906 while ((c
= READCHAR
) != '\n' && c
!= -1);
1911 unbind_to (count1
, Qnil
);
1915 /* Ignore whitespace here, so we can detect eof. */
1916 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1917 || c
== 0xa0) /* NBSP */
1920 if (!NILP (Vpurify_flag
) && c
== '(')
1922 val
= read_list (0, readcharfun
);
1927 read_objects
= Qnil
;
1928 if (!NILP (readfun
))
1930 val
= call1 (readfun
, readcharfun
);
1932 /* If READCHARFUN has set point to ZV, we should
1933 stop reading, even if the form read sets point
1934 to a different value when evaluated. */
1935 if (BUFFERP (readcharfun
))
1937 struct buffer
*buf
= XBUFFER (readcharfun
);
1938 if (BUF_PT (buf
) == BUF_ZV (buf
))
1939 continue_reading_p
= 0;
1942 else if (! NILP (Vload_read_function
))
1943 val
= call1 (Vload_read_function
, readcharfun
);
1945 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1948 if (!NILP (start
) && continue_reading_p
)
1949 start
= Fpoint_marker ();
1951 /* Restore saved point and BEGV. */
1952 unbind_to (count1
, Qnil
);
1954 /* Now eval what we just read. */
1955 if (!NILP (macroexpand
))
1956 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1958 val
= eval_sub (val
);
1962 Vvalues
= Fcons (val
, Vvalues
);
1963 if (EQ (Vstandard_output
, Qt
))
1972 build_load_history (sourcename
,
1973 stream
|| whole_buffer
);
1977 unbind_to (count
, Qnil
);
1980 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1981 doc
: /* Execute the current buffer as Lisp code.
1982 When called from a Lisp program (i.e., not interactively), this
1983 function accepts up to five optional arguments:
1984 BUFFER is the buffer to evaluate (nil means use current buffer).
1985 PRINTFLAG controls printing of output:
1986 A value of nil means discard it; anything else is stream for print.
1987 FILENAME specifies the file name to use for `load-history'.
1988 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1990 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1991 functions should work normally even if PRINTFLAG is nil.
1993 This function preserves the position of point. */)
1994 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1996 ptrdiff_t count
= SPECPDL_INDEX ();
1997 Lisp_Object tem
, buf
;
2000 buf
= Fcurrent_buffer ();
2002 buf
= Fget_buffer (buffer
);
2004 error ("No such buffer");
2006 if (NILP (printflag
) && NILP (do_allow_print
))
2011 if (NILP (filename
))
2012 filename
= BVAR (XBUFFER (buf
), filename
);
2014 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
2015 specbind (Qstandard_output
, tem
);
2016 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
2017 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2018 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
2019 readevalloop (buf
, 0, filename
,
2020 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
2021 unbind_to (count
, Qnil
);
2026 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2027 doc
: /* Execute the region as Lisp code.
2028 When called from programs, expects two arguments,
2029 giving starting and ending indices in the current buffer
2030 of the text to be executed.
2031 Programs can pass third argument PRINTFLAG which controls output:
2032 A value of nil means discard it; anything else is stream for printing it.
2033 Also the fourth argument READ-FUNCTION, if non-nil, is used
2034 instead of `read' to read each expression. It gets one argument
2035 which is the input stream for reading characters.
2037 This function does not move point. */)
2038 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2040 /* FIXME: Do the eval-sexp-add-defvars dance! */
2041 ptrdiff_t count
= SPECPDL_INDEX ();
2042 Lisp_Object tem
, cbuf
;
2044 cbuf
= Fcurrent_buffer ();
2046 if (NILP (printflag
))
2050 specbind (Qstandard_output
, tem
);
2051 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2053 /* `readevalloop' calls functions which check the type of start and end. */
2054 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2055 !NILP (printflag
), Qnil
, read_function
,
2058 return unbind_to (count
, Qnil
);
2062 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2063 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2064 If STREAM is nil, use the value of `standard-input' (which see).
2065 STREAM or the value of `standard-input' may be:
2066 a buffer (read from point and advance it)
2067 a marker (read from where it points and advance it)
2068 a function (call it with no arguments for each character,
2069 call it with a char as argument to push a char back)
2070 a string (takes text from string, starting at the beginning)
2071 t (read text line using minibuffer and use it, or read from
2072 standard input in batch mode). */)
2073 (Lisp_Object stream
)
2076 stream
= Vstandard_input
;
2077 if (EQ (stream
, Qt
))
2078 stream
= Qread_char
;
2079 if (EQ (stream
, Qread_char
))
2080 /* FIXME: ?! When is this used !? */
2081 return call1 (intern ("read-minibuffer"),
2082 build_string ("Lisp expression: "));
2084 return read_internal_start (stream
, Qnil
, Qnil
);
2087 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2088 doc
: /* Read one Lisp expression which is represented as text by STRING.
2089 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2090 FINAL-STRING-INDEX is an integer giving the position of the next
2091 remaining character in STRING.
2092 START and END optionally delimit a substring of STRING from which to read;
2093 they default to 0 and (length STRING) respectively. */)
2094 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2097 CHECK_STRING (string
);
2098 /* `read_internal_start' sets `read_from_string_index'. */
2099 ret
= read_internal_start (string
, start
, end
);
2100 return Fcons (ret
, make_number (read_from_string_index
));
2103 /* Function to set up the global context we need in toplevel read
2106 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2107 /* `start', `end' only used when stream is a string. */
2112 new_backquote_flag
= 0;
2113 read_objects
= Qnil
;
2114 if (EQ (Vread_with_symbol_positions
, Qt
)
2115 || EQ (Vread_with_symbol_positions
, stream
))
2116 Vread_symbol_positions_list
= Qnil
;
2118 if (STRINGP (stream
)
2119 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2121 ptrdiff_t startval
, endval
;
2124 if (STRINGP (stream
))
2127 string
= XCAR (stream
);
2130 endval
= SCHARS (string
);
2134 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2135 args_out_of_range (string
, end
);
2136 endval
= XINT (end
);
2143 CHECK_NUMBER (start
);
2144 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2145 args_out_of_range (string
, start
);
2146 startval
= XINT (start
);
2148 read_from_string_index
= startval
;
2149 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2150 read_from_string_limit
= endval
;
2153 retval
= read0 (stream
);
2154 if (EQ (Vread_with_symbol_positions
, Qt
)
2155 || EQ (Vread_with_symbol_positions
, stream
))
2156 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2161 /* Signal Qinvalid_read_syntax error.
2162 S is error string of length N (if > 0) */
2164 static _Noreturn
void
2165 invalid_syntax (const char *s
)
2167 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2171 /* Use this for recursive reads, in contexts where internal tokens
2175 read0 (Lisp_Object readcharfun
)
2177 register Lisp_Object val
;
2180 val
= read1 (readcharfun
, &c
, 0);
2184 xsignal1 (Qinvalid_read_syntax
,
2185 Fmake_string (make_number (1), make_number (c
)));
2188 static ptrdiff_t read_buffer_size
;
2189 static char *read_buffer
;
2191 /* Read a \-escape sequence, assuming we already read the `\'.
2192 If the escape sequence forces unibyte, return eight-bit char. */
2195 read_escape (Lisp_Object readcharfun
, bool stringp
)
2198 /* \u allows up to four hex digits, \U up to eight. Default to the
2199 behavior for \u, and change this value in the case that \U is seen. */
2200 int unicode_hex_count
= 4;
2205 end_of_file_error ();
2235 error ("Invalid escape character syntax");
2238 c
= read_escape (readcharfun
, 0);
2239 return c
| meta_modifier
;
2244 error ("Invalid escape character syntax");
2247 c
= read_escape (readcharfun
, 0);
2248 return c
| shift_modifier
;
2253 error ("Invalid escape character syntax");
2256 c
= read_escape (readcharfun
, 0);
2257 return c
| hyper_modifier
;
2262 error ("Invalid escape character syntax");
2265 c
= read_escape (readcharfun
, 0);
2266 return c
| alt_modifier
;
2270 if (stringp
|| c
!= '-')
2277 c
= read_escape (readcharfun
, 0);
2278 return c
| super_modifier
;
2283 error ("Invalid escape character syntax");
2287 c
= read_escape (readcharfun
, 0);
2288 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2289 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2290 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2291 return c
| ctrl_modifier
;
2292 /* ASCII control chars are made from letters (both cases),
2293 as well as the non-letters within 0100...0137. */
2294 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2295 return (c
& (037 | ~0177));
2296 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2297 return (c
& (037 | ~0177));
2299 return c
| ctrl_modifier
;
2309 /* An octal escape, as in ANSI C. */
2311 register int i
= c
- '0';
2312 register int count
= 0;
2315 if ((c
= READCHAR
) >= '0' && c
<= '7')
2327 if (i
>= 0x80 && i
< 0x100)
2328 i
= BYTE8_TO_CHAR (i
);
2333 /* A hex escape, as in ANSI C. */
2340 if (c
>= '0' && c
<= '9')
2345 else if ((c
>= 'a' && c
<= 'f')
2346 || (c
>= 'A' && c
<= 'F'))
2349 if (c
>= 'a' && c
<= 'f')
2359 /* Allow hex escapes as large as ?\xfffffff, because some
2360 packages use them to denote characters with modifiers. */
2361 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2362 error ("Hex character out of range: \\x%x...", i
);
2366 if (count
< 3 && i
>= 0x80)
2367 return BYTE8_TO_CHAR (i
);
2372 /* Post-Unicode-2.0: Up to eight hex chars. */
2373 unicode_hex_count
= 8;
2376 /* A Unicode escape. We only permit them in strings and characters,
2377 not arbitrarily in the source code, as in some other languages. */
2382 while (++count
<= unicode_hex_count
)
2385 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2387 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2388 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2389 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2391 error ("Non-hex digit used for Unicode escape");
2394 error ("Non-Unicode character: 0x%x", i
);
2403 /* Return the digit that CHARACTER stands for in the given BASE.
2404 Return -1 if CHARACTER is out of range for BASE,
2405 and -2 if CHARACTER is not valid for any supported BASE. */
2407 digit_to_number (int character
, int base
)
2411 if ('0' <= character
&& character
<= '9')
2412 digit
= character
- '0';
2413 else if ('a' <= character
&& character
<= 'z')
2414 digit
= character
- 'a' + 10;
2415 else if ('A' <= character
&& character
<= 'Z')
2416 digit
= character
- 'A' + 10;
2420 return digit
< base
? digit
: -1;
2423 /* Read an integer in radix RADIX using READCHARFUN to read
2424 characters. RADIX must be in the interval [2..36]; if it isn't, a
2425 read error is signaled . Value is the integer read. Signals an
2426 error if encountering invalid read syntax or if RADIX is out of
2430 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2432 /* Room for sign, leading 0, other digits, trailing null byte.
2433 Also, room for invalid syntax diagnostic. */
2434 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2435 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2437 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2439 if (radix
< 2 || radix
> 36)
2447 if (c
== '-' || c
== '+')
2458 /* Ignore redundant leading zeros, so the buffer doesn't
2459 fill up with them. */
2465 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2472 if (p
< buf
+ sizeof buf
- 1)
2486 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2487 invalid_syntax (buf
);
2490 return string_to_number (buf
, radix
, 0);
2494 /* If the next token is ')' or ']' or '.', we store that character
2495 in *PCH and the return value is not interesting. Else, we store
2496 zero in *PCH and we read and return one lisp object.
2498 FIRST_IN_LIST is true if this is the first element of a list. */
2501 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2504 bool uninterned_symbol
= 0;
2511 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2513 end_of_file_error ();
2518 return read_list (0, readcharfun
);
2521 return read_vector (readcharfun
, 0);
2537 /* Accept extended format for hashtables (extensible to
2539 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2540 Lisp_Object tmp
= read_list (0, readcharfun
);
2541 Lisp_Object head
= CAR_SAFE (tmp
);
2542 Lisp_Object data
= Qnil
;
2543 Lisp_Object val
= Qnil
;
2544 /* The size is 2 * number of allowed keywords to
2546 Lisp_Object params
[10];
2548 Lisp_Object key
= Qnil
;
2549 int param_count
= 0;
2551 if (!EQ (head
, Qhash_table
))
2552 error ("Invalid extended read marker at head of #s list "
2553 "(only hash-table allowed)");
2555 tmp
= CDR_SAFE (tmp
);
2557 /* This is repetitive but fast and simple. */
2558 params
[param_count
] = QCsize
;
2559 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2560 if (!NILP (params
[param_count
+ 1]))
2563 params
[param_count
] = QCtest
;
2564 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2565 if (!NILP (params
[param_count
+ 1]))
2568 params
[param_count
] = QCweakness
;
2569 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2570 if (!NILP (params
[param_count
+ 1]))
2573 params
[param_count
] = QCrehash_size
;
2574 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2575 if (!NILP (params
[param_count
+ 1]))
2578 params
[param_count
] = QCrehash_threshold
;
2579 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2580 if (!NILP (params
[param_count
+ 1]))
2583 /* This is the hashtable data. */
2584 data
= Fplist_get (tmp
, Qdata
);
2586 /* Now use params to make a new hashtable and fill it. */
2587 ht
= Fmake_hash_table (param_count
, params
);
2589 while (CONSP (data
))
2594 error ("Odd number of elements in hashtable data");
2597 Fputhash (key
, val
, ht
);
2603 invalid_syntax ("#");
2611 tmp
= read_vector (readcharfun
, 0);
2612 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2613 error ("Invalid size char-table");
2614 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2626 tmp
= read_vector (readcharfun
, 0);
2629 error ("Invalid size char-table");
2630 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2631 error ("Invalid depth in char-table");
2632 depth
= XINT (AREF (tmp
, 0));
2633 if (chartab_size
[depth
] != size
- 2)
2634 error ("Invalid size char-table");
2635 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2638 invalid_syntax ("#^" "^");
2640 invalid_syntax ("#^");
2645 length
= read1 (readcharfun
, pch
, first_in_list
);
2649 Lisp_Object tmp
, val
;
2650 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2651 unsigned char *data
;
2654 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2655 if (STRING_MULTIBYTE (tmp
)
2656 || (size_in_chars
!= SCHARS (tmp
)
2657 /* We used to print 1 char too many
2658 when the number of bits was a multiple of 8.
2659 Accept such input in case it came from an old
2661 && ! (XFASTINT (length
)
2662 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2663 invalid_syntax ("#&...");
2665 val
= make_uninit_bool_vector (XFASTINT (length
));
2666 data
= bool_vector_uchar_data (val
);
2667 memcpy (data
, SDATA (tmp
), size_in_chars
);
2668 /* Clear the extraneous bits in the last byte. */
2669 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2670 data
[size_in_chars
- 1]
2671 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2674 invalid_syntax ("#&...");
2678 /* Accept compiled functions at read-time so that we don't have to
2679 build them using function calls. */
2681 struct Lisp_Vector
*vec
;
2682 tmp
= read_vector (readcharfun
, 1);
2683 vec
= XVECTOR (tmp
);
2684 if (vec
->header
.size
== 0)
2685 invalid_syntax ("Empty byte-code object");
2686 make_byte_code (vec
);
2692 struct gcpro gcpro1
;
2695 /* Read the string itself. */
2696 tmp
= read1 (readcharfun
, &ch
, 0);
2697 if (ch
!= 0 || !STRINGP (tmp
))
2698 invalid_syntax ("#");
2700 /* Read the intervals and their properties. */
2703 Lisp_Object beg
, end
, plist
;
2705 beg
= read1 (readcharfun
, &ch
, 0);
2710 end
= read1 (readcharfun
, &ch
, 0);
2712 plist
= read1 (readcharfun
, &ch
, 0);
2714 invalid_syntax ("Invalid string property list");
2715 Fset_text_properties (beg
, end
, plist
, tmp
);
2721 /* #@NUMBER is used to skip NUMBER following bytes.
2722 That's used in .elc files to skip over doc strings
2723 and function definitions. */
2726 enum { extra
= 100 };
2727 ptrdiff_t i
, nskip
= 0, digits
= 0;
2729 /* Read a decimal integer. */
2730 while ((c
= READCHAR
) >= 0
2731 && c
>= '0' && c
<= '9')
2733 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2738 if (digits
== 2 && nskip
== 0)
2739 { /* We've just seen #@00, which means "skip to end". */
2740 skip_dyn_eof (readcharfun
);
2745 /* We can't use UNREAD here, because in the code below we side-step
2746 READCHAR. Instead, assume the first char after #@NNN occupies
2747 a single byte, which is the case normally since it's just
2753 if (load_force_doc_strings
2754 && (FROM_FILE_P (readcharfun
)))
2756 /* If we are supposed to force doc strings into core right now,
2757 record the last string that we skipped,
2758 and record where in the file it comes from. */
2760 /* But first exchange saved_doc_string
2761 with prev_saved_doc_string, so we save two strings. */
2763 char *temp
= saved_doc_string
;
2764 ptrdiff_t temp_size
= saved_doc_string_size
;
2765 file_offset temp_pos
= saved_doc_string_position
;
2766 ptrdiff_t temp_len
= saved_doc_string_length
;
2768 saved_doc_string
= prev_saved_doc_string
;
2769 saved_doc_string_size
= prev_saved_doc_string_size
;
2770 saved_doc_string_position
= prev_saved_doc_string_position
;
2771 saved_doc_string_length
= prev_saved_doc_string_length
;
2773 prev_saved_doc_string
= temp
;
2774 prev_saved_doc_string_size
= temp_size
;
2775 prev_saved_doc_string_position
= temp_pos
;
2776 prev_saved_doc_string_length
= temp_len
;
2779 if (saved_doc_string_size
== 0)
2781 saved_doc_string
= xmalloc_atomic (nskip
+ extra
);
2782 saved_doc_string_size
= nskip
+ extra
;
2784 if (nskip
> saved_doc_string_size
)
2786 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2787 saved_doc_string_size
= nskip
+ extra
;
2790 saved_doc_string_position
= file_tell (instream
);
2792 /* Copy that many characters into saved_doc_string. */
2794 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2795 saved_doc_string
[i
] = c
= getc (instream
);
2798 saved_doc_string_length
= i
;
2801 /* Skip that many bytes. */
2802 skip_dyn_bytes (readcharfun
, nskip
);
2808 /* #! appears at the beginning of an executable file.
2809 Skip the first line. */
2810 while (c
!= '\n' && c
>= 0)
2815 return Vload_file_name
;
2817 return list2 (Qfunction
, read0 (readcharfun
));
2818 /* #:foo is the uninterned symbol named foo. */
2821 uninterned_symbol
= 1;
2824 && c
!= 0xa0 /* NBSP */
2826 || strchr ("\"';()[]#`,", c
) == NULL
)))
2828 /* No symbol character follows, this is the empty
2831 return Fmake_symbol (empty_unibyte_string
);
2835 /* ## is the empty symbol. */
2837 return Fintern (empty_unibyte_string
, Qnil
);
2838 /* Reader forms that can reuse previously read objects. */
2839 if (c
>= '0' && c
<= '9')
2844 /* Read a non-negative integer. */
2845 while (c
>= '0' && c
<= '9')
2847 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2848 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2849 n
= MOST_POSITIVE_FIXNUM
+ 1;
2851 n
= n
* 10 + c
- '0';
2855 if (n
<= MOST_POSITIVE_FIXNUM
)
2857 if (c
== 'r' || c
== 'R')
2858 return read_integer (readcharfun
, n
);
2860 if (! NILP (Vread_circle
))
2862 /* #n=object returns object, but associates it with
2866 /* Make a placeholder for #n# to use temporarily. */
2867 Lisp_Object placeholder
;
2870 placeholder
= Fcons (Qnil
, Qnil
);
2871 cell
= Fcons (make_number (n
), placeholder
);
2872 read_objects
= Fcons (cell
, read_objects
);
2874 /* Read the object itself. */
2875 tem
= read0 (readcharfun
);
2877 /* Now put it everywhere the placeholder was... */
2878 substitute_object_in_subtree (tem
, placeholder
);
2880 /* ...and #n# will use the real value from now on. */
2881 Fsetcdr (cell
, tem
);
2886 /* #n# returns a previously read object. */
2889 tem
= Fassq (make_number (n
), read_objects
);
2895 /* Fall through to error message. */
2897 else if (c
== 'x' || c
== 'X')
2898 return read_integer (readcharfun
, 16);
2899 else if (c
== 'o' || c
== 'O')
2900 return read_integer (readcharfun
, 8);
2901 else if (c
== 'b' || c
== 'B')
2902 return read_integer (readcharfun
, 2);
2905 invalid_syntax ("#");
2908 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2912 return list2 (Qquote
, read0 (readcharfun
));
2916 int next_char
= READCHAR
;
2918 /* Transition from old-style to new-style:
2919 If we see "(`" it used to mean old-style, which usually works
2920 fine because ` should almost never appear in such a position
2921 for new-style. But occasionally we need "(`" to mean new
2922 style, so we try to distinguish the two by the fact that we
2923 can either write "( `foo" or "(` foo", where the first
2924 intends to use new-style whereas the second intends to use
2925 old-style. For Emacs-25, we should completely remove this
2926 first_in_list exception (old-style can still be obtained via
2928 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2930 Vold_style_backquotes
= Qt
;
2936 bool saved_new_backquote_flag
= new_backquote_flag
;
2938 new_backquote_flag
= 1;
2939 value
= read0 (readcharfun
);
2940 new_backquote_flag
= saved_new_backquote_flag
;
2942 return list2 (Qbackquote
, value
);
2947 int next_char
= READCHAR
;
2949 /* Transition from old-style to new-style:
2950 It used to be impossible to have a new-style , other than within
2951 a new-style `. This is sufficient when ` and , are used in the
2952 normal way, but ` and , can also appear in args to macros that
2953 will not interpret them in the usual way, in which case , may be
2954 used without any ` anywhere near.
2955 So we now use the same heuristic as for backquote: old-style
2956 unquotes are only recognized when first on a list, and when
2957 followed by a space.
2958 Because it's more difficult to peek 2 chars ahead, a new-style
2959 ,@ can still not be used outside of a `, unless it's in the middle
2961 if (new_backquote_flag
2963 || (next_char
!= ' ' && next_char
!= '@'))
2965 Lisp_Object comma_type
= Qnil
;
2970 comma_type
= Qcomma_at
;
2972 comma_type
= Qcomma_dot
;
2975 if (ch
>= 0) UNREAD (ch
);
2976 comma_type
= Qcomma
;
2979 value
= read0 (readcharfun
);
2980 return list2 (comma_type
, value
);
2984 Vold_style_backquotes
= Qt
;
2996 end_of_file_error ();
2998 /* Accept `single space' syntax like (list ? x) where the
2999 whitespace character is SPC or TAB.
3000 Other literal whitespace like NL, CR, and FF are not accepted,
3001 as there are well-established escape sequences for these. */
3002 if (c
== ' ' || c
== '\t')
3003 return make_number (c
);
3006 c
= read_escape (readcharfun
, 0);
3007 modifiers
= c
& CHAR_MODIFIER_MASK
;
3008 c
&= ~CHAR_MODIFIER_MASK
;
3009 if (CHAR_BYTE8_P (c
))
3010 c
= CHAR_TO_BYTE8 (c
);
3013 next_char
= READCHAR
;
3014 ok
= (next_char
<= 040
3015 || (next_char
< 0200
3016 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3019 return make_number (c
);
3021 invalid_syntax ("?");
3026 char *p
= read_buffer
;
3027 char *end
= read_buffer
+ read_buffer_size
;
3029 /* True if we saw an escape sequence specifying
3030 a multibyte character. */
3031 bool force_multibyte
= 0;
3032 /* True if we saw an escape sequence specifying
3033 a single-byte character. */
3034 bool force_singlebyte
= 0;
3036 ptrdiff_t nchars
= 0;
3038 while ((ch
= READCHAR
) >= 0
3041 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3043 ptrdiff_t offset
= p
- read_buffer
;
3044 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3045 memory_full (SIZE_MAX
);
3046 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3047 read_buffer_size
*= 2;
3048 p
= read_buffer
+ offset
;
3049 end
= read_buffer
+ read_buffer_size
;
3056 ch
= read_escape (readcharfun
, 1);
3058 /* CH is -1 if \ newline has just been seen. */
3061 if (p
== read_buffer
)
3066 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3067 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3069 if (CHAR_BYTE8_P (ch
))
3070 force_singlebyte
= 1;
3071 else if (! ASCII_CHAR_P (ch
))
3072 force_multibyte
= 1;
3073 else /* I.e. ASCII_CHAR_P (ch). */
3075 /* Allow `\C- ' and `\C-?'. */
3076 if (modifiers
== CHAR_CTL
)
3079 ch
= 0, modifiers
= 0;
3081 ch
= 127, modifiers
= 0;
3083 if (modifiers
& CHAR_SHIFT
)
3085 /* Shift modifier is valid only with [A-Za-z]. */
3086 if (ch
>= 'A' && ch
<= 'Z')
3087 modifiers
&= ~CHAR_SHIFT
;
3088 else if (ch
>= 'a' && ch
<= 'z')
3089 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3092 if (modifiers
& CHAR_META
)
3094 /* Move the meta bit to the right place for a
3096 modifiers
&= ~CHAR_META
;
3097 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3098 force_singlebyte
= 1;
3102 /* Any modifiers remaining are invalid. */
3104 error ("Invalid modifier in string");
3105 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3109 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3110 if (CHAR_BYTE8_P (ch
))
3111 force_singlebyte
= 1;
3112 else if (! ASCII_CHAR_P (ch
))
3113 force_multibyte
= 1;
3119 end_of_file_error ();
3121 /* If purifying, and string starts with \ newline,
3122 return zero instead. This is for doc strings
3123 that we are really going to find in etc/DOC.nn.nn. */
3124 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3125 return make_number (0);
3127 if (! force_multibyte
&& force_singlebyte
)
3129 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3130 forms. Convert it to unibyte. */
3131 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3133 p
= read_buffer
+ nchars
;
3136 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3138 || (p
- read_buffer
!= nchars
)));
3143 int next_char
= READCHAR
;
3146 if (next_char
<= 040
3147 || (next_char
< 0200
3148 && strchr ("\"';([#?`,", next_char
) != NULL
))
3154 /* Otherwise, we fall through! Note that the atom-reading loop
3155 below will now loop at least once, assuring that we will not
3156 try to UNREAD two characters in a row. */
3160 if (c
<= 040) goto retry
;
3161 if (c
== 0xa0) /* NBSP */
3166 char *p
= read_buffer
;
3168 EMACS_INT start_position
= readchar_count
- 1;
3171 char *end
= read_buffer
+ read_buffer_size
;
3175 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3177 ptrdiff_t offset
= p
- read_buffer
;
3178 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3179 memory_full (SIZE_MAX
);
3180 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3181 read_buffer_size
*= 2;
3182 p
= read_buffer
+ offset
;
3183 end
= read_buffer
+ read_buffer_size
;
3190 end_of_file_error ();
3195 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3201 && c
!= 0xa0 /* NBSP */
3203 || strchr ("\"';()[]#`,", c
) == NULL
));
3207 ptrdiff_t offset
= p
- read_buffer
;
3208 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3209 memory_full (SIZE_MAX
);
3210 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3211 read_buffer_size
*= 2;
3212 p
= read_buffer
+ offset
;
3213 end
= read_buffer
+ read_buffer_size
;
3219 if (!quoted
&& !uninterned_symbol
)
3221 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3222 if (! NILP (result
))
3226 Lisp_Object name
, result
;
3227 ptrdiff_t nbytes
= p
- read_buffer
;
3230 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3234 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3235 ? make_pure_string
: make_specified_string
)
3236 (read_buffer
, nchars
, nbytes
, multibyte
));
3237 result
= (uninterned_symbol
? Fmake_symbol (name
)
3238 : Fintern (name
, Qnil
));
3240 if (EQ (Vread_with_symbol_positions
, Qt
)
3241 || EQ (Vread_with_symbol_positions
, readcharfun
))
3242 Vread_symbol_positions_list
3243 = Fcons (Fcons (result
, make_number (start_position
)),
3244 Vread_symbol_positions_list
);
3252 /* List of nodes we've seen during substitute_object_in_subtree. */
3253 static Lisp_Object seen_list
;
3256 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3258 Lisp_Object check_object
;
3260 /* We haven't seen any objects when we start. */
3263 /* Make all the substitutions. */
3265 = substitute_object_recurse (object
, placeholder
, object
);
3267 /* Clear seen_list because we're done with it. */
3270 /* The returned object here is expected to always eq the
3272 if (!EQ (check_object
, object
))
3273 error ("Unexpected mutation error in reader");
3276 /* Feval doesn't get called from here, so no gc protection is needed. */
3277 #define SUBSTITUTE(get_val, set_val) \
3279 Lisp_Object old_value = get_val; \
3280 Lisp_Object true_value \
3281 = substitute_object_recurse (object, placeholder, \
3284 if (!EQ (old_value, true_value)) \
3291 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3293 /* If we find the placeholder, return the target object. */
3294 if (EQ (placeholder
, subtree
))
3297 /* If we've been to this node before, don't explore it again. */
3298 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3301 /* If this node can be the entry point to a cycle, remember that
3302 we've seen it. It can only be such an entry point if it was made
3303 by #n=, which means that we can find it as a value in
3305 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3306 seen_list
= Fcons (subtree
, seen_list
);
3308 /* Recurse according to subtree's type.
3309 Every branch must return a Lisp_Object. */
3310 switch (XTYPE (subtree
))
3312 case Lisp_Vectorlike
:
3314 ptrdiff_t i
, length
= 0;
3315 if (BOOL_VECTOR_P (subtree
))
3316 return subtree
; /* No sub-objects anyway. */
3317 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3318 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3319 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3320 else if (VECTORP (subtree
))
3321 length
= ASIZE (subtree
);
3323 /* An unknown pseudovector may contain non-Lisp fields, so we
3324 can't just blindly traverse all its fields. We used to call
3325 `Flength' which signaled `sequencep', so I just preserved this
3327 wrong_type_argument (Qsequencep
, subtree
);
3329 for (i
= 0; i
< length
; i
++)
3330 SUBSTITUTE (AREF (subtree
, i
),
3331 ASET (subtree
, i
, true_value
));
3337 SUBSTITUTE (XCAR (subtree
),
3338 XSETCAR (subtree
, true_value
));
3339 SUBSTITUTE (XCDR (subtree
),
3340 XSETCDR (subtree
, true_value
));
3346 /* Check for text properties in each interval.
3347 substitute_in_interval contains part of the logic. */
3349 INTERVAL root_interval
= string_intervals (subtree
);
3350 Lisp_Object arg
= Fcons (object
, placeholder
);
3352 traverse_intervals_noorder (root_interval
,
3353 &substitute_in_interval
, arg
);
3358 /* Other types don't recurse any further. */
3364 /* Helper function for substitute_object_recurse. */
3366 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3368 Lisp_Object object
= Fcar (arg
);
3369 Lisp_Object placeholder
= Fcdr (arg
);
3371 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3381 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3382 integer syntax and fits in a fixnum, else return the nearest float if CP has
3383 either floating point or integer syntax and BASE is 10, else return nil. If
3384 IGNORE_TRAILING, consider just the longest prefix of CP that has
3385 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3386 number has integer syntax but does not fit. */
3389 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3392 char const *cp
= string
;
3394 bool float_syntax
= 0;
3397 /* Compute NaN and infinities using a variable, to cope with compilers that
3398 think they are smarter than we are. */
3401 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3402 IEEE floating point hosts, and works around a formerly-common bug where
3403 atof ("-0.0") drops the sign. */
3404 bool negative
= *cp
== '-';
3406 bool signedp
= negative
|| *cp
== '+';
3411 leading_digit
= digit_to_number (*cp
, base
);
3412 if (leading_digit
>= 0)
3417 while (digit_to_number (*cp
, base
) >= 0);
3427 if ('0' <= *cp
&& *cp
<= '9')
3432 while ('0' <= *cp
&& *cp
<= '9');
3434 if (*cp
== 'e' || *cp
== 'E')
3436 char const *ecp
= cp
;
3438 if (*cp
== '+' || *cp
== '-')
3440 if ('0' <= *cp
&& *cp
<= '9')
3445 while ('0' <= *cp
&& *cp
<= '9');
3447 else if (cp
[-1] == '+'
3448 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3454 else if (cp
[-1] == '+'
3455 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3459 value
= zero
/ zero
;
3461 /* If that made a "negative" NaN, negate it. */
3464 union { double d
; char c
[sizeof (double)]; }
3465 u_data
, u_minus_zero
;
3467 u_minus_zero
.d
= -0.0;
3468 for (i
= 0; i
< sizeof (double); i
++)
3469 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3475 /* Now VALUE is a positive NaN. */
3481 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3482 || state
== (LEAD_INT
|E_EXP
));
3485 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3486 any prefix that matches. Otherwise, the entire string must match. */
3487 if (! (ignore_trailing
3488 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3489 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3492 /* If the number uses integer and not float syntax, and is in C-language
3493 range, use its value, preferably as a fixnum. */
3494 if (leading_digit
>= 0 && ! float_syntax
)
3498 /* Fast special case for single-digit integers. This also avoids a
3499 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3500 case some versions of strtoumax accept numbers like "0x1" that Emacs
3502 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3503 return make_number (negative
? -leading_digit
: leading_digit
);
3506 n
= strtoumax (string
+ signedp
, NULL
, base
);
3507 if (errno
== ERANGE
)
3509 /* Unfortunately there's no simple and accurate way to convert
3510 non-base-10 numbers that are out of C-language range. */
3512 xsignal1 (Qoverflow_error
, build_string (string
));
3514 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3516 EMACS_INT signed_n
= n
;
3517 return make_number (negative
? -signed_n
: signed_n
);
3523 /* Either the number uses float syntax, or it does not fit into a fixnum.
3524 Convert it from string to floating point, unless the value is already
3525 known because it is an infinity, a NAN, or its absolute value fits in
3528 value
= atof (string
+ signedp
);
3530 return make_float (negative
? -value
: value
);
3535 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3539 Lisp_Object tem
, item
, vector
;
3542 tem
= read_list (1, readcharfun
);
3543 len
= Flength (tem
);
3544 vector
= Fmake_vector (len
, Qnil
);
3546 size
= ASIZE (vector
);
3547 ptr
= XVECTOR (vector
)->contents
;
3548 for (i
= 0; i
< size
; i
++)
3551 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3552 bytecode object, the docstring containing the bytecode and
3553 constants values must be treated as unibyte and passed to
3554 Fread, to get the actual bytecode string and constants vector. */
3555 if (bytecodeflag
&& load_force_doc_strings
)
3557 if (i
== COMPILED_BYTECODE
)
3559 if (!STRINGP (item
))
3560 error ("Invalid byte code");
3562 /* Delay handling the bytecode slot until we know whether
3563 it is lazily-loaded (we can tell by whether the
3564 constants slot is nil). */
3565 ASET (vector
, COMPILED_CONSTANTS
, item
);
3568 else if (i
== COMPILED_CONSTANTS
)
3570 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3574 /* Coerce string to unibyte (like string-as-unibyte,
3575 but without generating extra garbage and
3576 guaranteeing no change in the contents). */
3577 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3578 STRING_SET_UNIBYTE (bytestr
);
3580 item
= Fread (Fcons (bytestr
, readcharfun
));
3582 error ("Invalid byte code");
3584 bytestr
= XCAR (item
);
3588 /* Now handle the bytecode slot. */
3589 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3591 else if (i
== COMPILED_DOC_STRING
3593 && ! STRING_MULTIBYTE (item
))
3595 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3596 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3598 item
= Fstring_as_multibyte (item
);
3601 ASET (vector
, i
, item
);
3607 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3610 read_list (bool flag
, Lisp_Object readcharfun
)
3612 Lisp_Object val
, tail
;
3613 Lisp_Object elt
, tem
;
3614 struct gcpro gcpro1
, gcpro2
;
3615 /* 0 is the normal case.
3616 1 means this list is a doc reference; replace it with the number 0.
3617 2 means this list is a doc reference; replace it with the doc string. */
3618 int doc_reference
= 0;
3620 /* Initialize this to 1 if we are reading a list. */
3621 bool first_in_list
= flag
<= 0;
3630 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3635 /* While building, if the list starts with #$, treat it specially. */
3636 if (EQ (elt
, Vload_file_name
)
3638 && !NILP (Vpurify_flag
))
3640 if (NILP (Vdoc_file_name
))
3641 /* We have not yet called Snarf-documentation, so assume
3642 this file is described in the DOC file
3643 and Snarf-documentation will fill in the right value later.
3644 For now, replace the whole list with 0. */
3647 /* We have already called Snarf-documentation, so make a relative
3648 file name for this file, so it can be found properly
3649 in the installed Lisp directory.
3650 We don't use Fexpand_file_name because that would make
3651 the directory absolute now. */
3652 elt
= concat2 (build_string ("../lisp/"),
3653 Ffile_name_nondirectory (elt
));
3655 else if (EQ (elt
, Vload_file_name
)
3657 && load_force_doc_strings
)
3666 invalid_syntax (") or . in a vector");
3674 XSETCDR (tail
, read0 (readcharfun
));
3676 val
= read0 (readcharfun
);
3677 read1 (readcharfun
, &ch
, 0);
3681 if (doc_reference
== 1)
3682 return make_number (0);
3683 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3686 file_offset saved_position
;
3687 /* Get a doc string from the file we are loading.
3688 If it's in saved_doc_string, get it from there.
3690 Here, we don't know if the string is a
3691 bytecode string or a doc string. As a
3692 bytecode string must be unibyte, we always
3693 return a unibyte string. If it is actually a
3694 doc string, caller must make it
3697 /* Position is negative for user variables. */
3698 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3699 if (pos
>= saved_doc_string_position
3700 && pos
< (saved_doc_string_position
3701 + saved_doc_string_length
))
3703 saved
= saved_doc_string
;
3704 saved_position
= saved_doc_string_position
;
3706 /* Look in prev_saved_doc_string the same way. */
3707 else if (pos
>= prev_saved_doc_string_position
3708 && pos
< (prev_saved_doc_string_position
3709 + prev_saved_doc_string_length
))
3711 saved
= prev_saved_doc_string
;
3712 saved_position
= prev_saved_doc_string_position
;
3716 ptrdiff_t start
= pos
- saved_position
;
3719 /* Process quoting with ^A,
3720 and find the end of the string,
3721 which is marked with ^_ (037). */
3722 for (from
= start
, to
= start
;
3723 saved
[from
] != 037;)
3725 int c
= saved
[from
++];
3729 saved
[to
++] = (c
== 1 ? c
3738 return make_unibyte_string (saved
+ start
,
3742 return get_doc_string (val
, 1, 0);
3747 invalid_syntax (". in wrong context");
3749 invalid_syntax ("] in a list");
3753 XSETCDR (tail
, tem
);
3760 static Lisp_Object initial_obarray
;
3762 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3764 static size_t oblookup_last_bucket_number
;
3766 /* Get an error if OBARRAY is not an obarray.
3767 If it is one, return it. */
3770 check_obarray (Lisp_Object obarray
)
3772 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3774 /* If Vobarray is now invalid, force it to be valid. */
3775 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3776 wrong_type_argument (Qvectorp
, obarray
);
3781 /* Intern the C string STR: return a symbol with that name,
3782 interned in the current obarray. */
3785 intern_1 (const char *str
, ptrdiff_t len
)
3787 Lisp_Object obarray
= check_obarray (Vobarray
);
3788 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3790 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3794 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3796 Lisp_Object obarray
= check_obarray (Vobarray
);
3797 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3802 if (NILP (Vpurify_flag
))
3803 /* Creating a non-pure string from a string literal not
3804 implemented yet. We could just use make_string here and live
3805 with the extra copy. */
3808 return Fintern (make_pure_c_string (str
, len
), obarray
);
3811 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3812 doc
: /* Return the canonical symbol whose name is STRING.
3813 If there is none, one is created by this function and returned.
3814 A second optional argument specifies the obarray to use;
3815 it defaults to the value of `obarray'. */)
3816 (Lisp_Object string
, Lisp_Object obarray
)
3818 register Lisp_Object tem
, sym
, *ptr
;
3820 if (NILP (obarray
)) obarray
= Vobarray
;
3821 obarray
= check_obarray (obarray
);
3823 CHECK_STRING (string
);
3825 tem
= oblookup (obarray
, SSDATA (string
),
3828 if (!INTEGERP (tem
))
3831 if (!NILP (Vpurify_flag
))
3832 string
= Fpurecopy (string
);
3833 sym
= Fmake_symbol (string
);
3835 if (EQ (obarray
, initial_obarray
))
3836 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3838 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3840 if ((SREF (string
, 0) == ':')
3841 && EQ (obarray
, initial_obarray
))
3843 XSYMBOL (sym
)->constant
= 1;
3844 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3845 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3848 ptr
= aref_addr (obarray
, XINT (tem
));
3850 set_symbol_next (sym
, XSYMBOL (*ptr
));
3852 set_symbol_next (sym
, NULL
);
3857 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3858 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3859 NAME may be a string or a symbol. If it is a symbol, that exact
3860 symbol is searched for.
3861 A second optional argument specifies the obarray to use;
3862 it defaults to the value of `obarray'. */)
3863 (Lisp_Object name
, Lisp_Object obarray
)
3865 register Lisp_Object tem
, string
;
3867 if (NILP (obarray
)) obarray
= Vobarray
;
3868 obarray
= check_obarray (obarray
);
3870 if (!SYMBOLP (name
))
3872 CHECK_STRING (name
);
3876 string
= SYMBOL_NAME (name
);
3878 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3879 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3885 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3886 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3887 The value is t if a symbol was found and deleted, nil otherwise.
3888 NAME may be a string or a symbol. If it is a symbol, that symbol
3889 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3890 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3891 usage: (unintern NAME OBARRAY) */)
3892 (Lisp_Object name
, Lisp_Object obarray
)
3894 register Lisp_Object string
, tem
;
3897 if (NILP (obarray
)) obarray
= Vobarray
;
3898 obarray
= check_obarray (obarray
);
3901 string
= SYMBOL_NAME (name
);
3904 CHECK_STRING (name
);
3908 tem
= oblookup (obarray
, SSDATA (string
),
3913 /* If arg was a symbol, don't delete anything but that symbol itself. */
3914 if (SYMBOLP (name
) && !EQ (name
, tem
))
3917 /* There are plenty of other symbols which will screw up the Emacs
3918 session if we unintern them, as well as even more ways to use
3919 `setq' or `fset' or whatnot to make the Emacs session
3920 unusable. Let's not go down this silly road. --Stef */
3921 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3922 error ("Attempt to unintern t or nil"); */
3924 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3926 hash
= oblookup_last_bucket_number
;
3928 if (EQ (AREF (obarray
, hash
), tem
))
3930 if (XSYMBOL (tem
)->next
)
3933 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3934 ASET (obarray
, hash
, sym
);
3937 ASET (obarray
, hash
, make_number (0));
3941 Lisp_Object tail
, following
;
3943 for (tail
= AREF (obarray
, hash
);
3944 XSYMBOL (tail
)->next
;
3947 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3948 if (EQ (following
, tem
))
3950 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3959 /* Return the symbol in OBARRAY whose names matches the string
3960 of SIZE characters (SIZE_BYTE bytes) at PTR.
3961 If there is no such symbol, return the integer bucket number of
3962 where the symbol would be if it were present.
3964 Also store the bucket number in oblookup_last_bucket_number. */
3967 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3971 register Lisp_Object tail
;
3972 Lisp_Object bucket
, tem
;
3974 obarray
= check_obarray (obarray
);
3975 obsize
= ASIZE (obarray
);
3976 hash
= hash_string (ptr
, size_byte
) % obsize
;
3977 bucket
= AREF (obarray
, hash
);
3978 oblookup_last_bucket_number
= hash
;
3979 if (EQ (bucket
, make_number (0)))
3981 else if (!SYMBOLP (bucket
))
3982 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3984 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3986 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3987 && SCHARS (SYMBOL_NAME (tail
)) == size
3988 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3990 else if (XSYMBOL (tail
)->next
== 0)
3993 XSETINT (tem
, hash
);
3998 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
4001 register Lisp_Object tail
;
4002 CHECK_VECTOR (obarray
);
4003 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
4005 tail
= AREF (obarray
, i
);
4010 if (XSYMBOL (tail
)->next
== 0)
4012 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4018 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4020 call1 (function
, sym
);
4023 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4024 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4025 OBARRAY defaults to the value of `obarray'. */)
4026 (Lisp_Object function
, Lisp_Object obarray
)
4028 if (NILP (obarray
)) obarray
= Vobarray
;
4029 obarray
= check_obarray (obarray
);
4031 map_obarray (obarray
, mapatoms_1
, function
);
4035 #define OBARRAY_SIZE 1511
4040 Lisp_Object oblength
;
4041 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4043 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4045 Vobarray
= Fmake_vector (oblength
, make_number (0));
4046 initial_obarray
= Vobarray
;
4047 staticpro (&initial_obarray
);
4049 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
4050 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
4051 NILP (Vpurify_flag) check in intern_c_string. */
4052 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
4053 Qnil
= intern_c_string ("nil");
4055 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
4056 so those two need to be fixed manually. */
4057 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
4058 set_symbol_function (Qunbound
, Qnil
);
4059 set_symbol_plist (Qunbound
, Qnil
);
4060 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4061 XSYMBOL (Qnil
)->constant
= 1;
4062 XSYMBOL (Qnil
)->declared_special
= 1;
4063 set_symbol_plist (Qnil
, Qnil
);
4064 set_symbol_function (Qnil
, Qnil
);
4066 Qt
= intern_c_string ("t");
4067 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4068 XSYMBOL (Qnil
)->declared_special
= 1;
4069 XSYMBOL (Qt
)->constant
= 1;
4071 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4074 DEFSYM (Qvariable_documentation
, "variable-documentation");
4076 read_buffer
= xmalloc_atomic (size
);
4077 read_buffer_size
= size
;
4081 defsubr (struct Lisp_Subr
*sname
)
4083 Lisp_Object sym
, tem
;
4084 sym
= intern_c_string (sname
->symbol_name
);
4085 SCM_NEWSMOB (sname
->header
.self
, lisp_vectorlike_tag
, sname
);
4086 XSETPVECTYPE (sname
, PVEC_SUBR
);
4087 XSETSUBR (tem
, sname
);
4088 set_symbol_function (sym
, tem
);
4091 /* Define an "integer variable"; a symbol whose value is forwarded to a
4092 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4093 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4095 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4096 const char *namestring
, EMACS_INT
*address
)
4099 sym
= intern_c_string (namestring
);
4100 i_fwd
->type
= Lisp_Fwd_Int
;
4101 i_fwd
->intvar
= address
;
4102 XSYMBOL (sym
)->declared_special
= 1;
4103 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4104 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4107 /* Similar but define a variable whose value is t if address contains 1,
4108 nil if address contains 0. */
4110 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4111 const char *namestring
, bool *address
)
4114 sym
= intern_c_string (namestring
);
4115 b_fwd
->type
= Lisp_Fwd_Bool
;
4116 b_fwd
->boolvar
= address
;
4117 XSYMBOL (sym
)->declared_special
= 1;
4118 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4119 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4120 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4123 /* Similar but define a variable whose value is the Lisp Object stored
4124 at address. Two versions: with and without gc-marking of the C
4125 variable. The nopro version is used when that variable will be
4126 gc-marked for some other reason, since marking the same slot twice
4127 can cause trouble with strings. */
4129 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4130 const char *namestring
, Lisp_Object
*address
)
4133 sym
= intern_c_string (namestring
);
4134 o_fwd
->type
= Lisp_Fwd_Obj
;
4135 o_fwd
->objvar
= address
;
4136 XSYMBOL (sym
)->declared_special
= 1;
4137 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4138 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4142 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4143 const char *namestring
, Lisp_Object
*address
)
4145 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4146 staticpro (address
);
4149 /* Similar but define a variable whose value is the Lisp Object stored
4150 at a particular offset in the current kboard object. */
4153 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4154 const char *namestring
, int offset
)
4157 sym
= intern_c_string (namestring
);
4158 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4159 ko_fwd
->offset
= offset
;
4160 XSYMBOL (sym
)->declared_special
= 1;
4161 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4162 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4165 /* Check that the elements of lpath exist. */
4168 load_path_check (Lisp_Object lpath
)
4170 Lisp_Object path_tail
;
4172 /* The only elements that might not exist are those from
4173 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4175 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4177 Lisp_Object dirfile
;
4178 dirfile
= Fcar (path_tail
);
4179 if (STRINGP (dirfile
))
4181 dirfile
= Fdirectory_file_name (dirfile
);
4182 if (! file_accessible_directory_p (SSDATA (dirfile
)))
4183 dir_warning ("Lisp directory", XCAR (path_tail
));
4188 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4189 This does not include the standard site-lisp directories
4190 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4191 but it does (unless no_site_lisp is set) include site-lisp
4192 directories in the source/build directories if those exist and we
4193 are running uninstalled.
4195 Uses the following logic:
4196 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4197 The remainder is what happens when dumping works:
4198 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4199 Otherwise use PATH_LOADSEARCH.
4201 If !initialized, then just return PATH_DUMPLOADSEARCH.
4203 If Vinstallation_directory is not nil (ie, running uninstalled):
4204 If installation-dir/lisp exists and not already a member,
4205 we must be running uninstalled. Reset the load-path
4206 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4207 refers to the eventual installation directories. Since we
4208 are not yet installed, we should not use them, even if they exist.)
4209 If installation-dir/lisp does not exist, just add
4210 PATH_DUMPLOADSEARCH at the end instead.
4211 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4212 and not already a member) at the front.
4213 If installation-dir != source-dir (ie running an uninstalled,
4214 out-of-tree build) AND install-dir/src/Makefile exists BUT
4215 install-dir/src/Makefile.in does NOT exist (this is a sanity
4216 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4219 load_path_default (void)
4221 Lisp_Object lpath
= Qnil
;
4226 const char *loadpath
= ns_load_path ();
4229 normal
= PATH_LOADSEARCH
;
4231 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4233 lpath
= decode_env_path (0, normal
, 0);
4236 #else /* !CANNOT_DUMP */
4238 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4243 const char *loadpath
= ns_load_path ();
4244 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4246 lpath
= decode_env_path (0, normal
, 0);
4248 if (!NILP (Vinstallation_directory
))
4250 Lisp_Object tem
, tem1
;
4252 /* Add to the path the lisp subdir of the installation
4253 dir, if it is accessible. Note: in out-of-tree builds,
4254 this directory is empty save for Makefile. */
4255 tem
= Fexpand_file_name (build_string ("lisp"),
4256 Vinstallation_directory
);
4257 tem1
= Ffile_accessible_directory_p (tem
);
4260 if (NILP (Fmember (tem
, lpath
)))
4262 /* We are running uninstalled. The default load-path
4263 points to the eventual installed lisp directories.
4264 We should not use those now, even if they exist,
4265 so start over from a clean slate. */
4266 lpath
= list1 (tem
);
4270 /* That dir doesn't exist, so add the build-time
4271 Lisp dirs instead. */
4273 Lisp_Object dump_path
=
4274 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4275 lpath
= nconc2 (lpath
, dump_path
);
4278 /* Add site-lisp under the installation dir, if it exists. */
4281 tem
= Fexpand_file_name (build_string ("site-lisp"),
4282 Vinstallation_directory
);
4283 tem1
= Ffile_accessible_directory_p (tem
);
4286 if (NILP (Fmember (tem
, lpath
)))
4287 lpath
= Fcons (tem
, lpath
);
4291 /* If Emacs was not built in the source directory,
4292 and it is run from where it was built, add to load-path
4293 the lisp and site-lisp dirs under that directory. */
4295 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4299 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4300 Vinstallation_directory
);
4301 tem1
= Ffile_exists_p (tem
);
4303 /* Don't be fooled if they moved the entire source tree
4304 AFTER dumping Emacs. If the build directory is indeed
4305 different from the source dir, src/Makefile.in and
4306 src/Makefile will not be found together. */
4307 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4308 Vinstallation_directory
);
4309 tem2
= Ffile_exists_p (tem
);
4310 if (!NILP (tem1
) && NILP (tem2
))
4312 tem
= Fexpand_file_name (build_string ("lisp"),
4315 if (NILP (Fmember (tem
, lpath
)))
4316 lpath
= Fcons (tem
, lpath
);
4320 tem
= Fexpand_file_name (build_string ("site-lisp"),
4322 tem1
= Ffile_accessible_directory_p (tem
);
4325 if (NILP (Fmember (tem
, lpath
)))
4326 lpath
= Fcons (tem
, lpath
);
4330 } /* Vinstallation_directory != Vsource_directory */
4332 } /* if Vinstallation_directory */
4334 else /* !initialized */
4336 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4337 source directory. We used to add ../lisp (ie the lisp dir in
4338 the build directory) at the front here, but that should not
4339 be necessary, since in out of tree builds lisp/ is empty, save
4341 lpath
= decode_env_path (0, normal
, 0);
4343 #endif /* !CANNOT_DUMP */
4351 /* First, set Vload_path. */
4353 /* Ignore EMACSLOADPATH when dumping. */
4355 bool use_loadpath
= true;
4357 bool use_loadpath
= NILP (Vpurify_flag
);
4360 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4362 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4364 /* Check (non-nil) user-supplied elements. */
4365 load_path_check (Vload_path
);
4367 /* If no nils in the environment variable, use as-is.
4368 Otherwise, replace any nils with the default. */
4369 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4371 Lisp_Object elem
, elpath
= Vload_path
;
4372 Lisp_Object default_lpath
= load_path_default ();
4374 /* Check defaults, before adding site-lisp. */
4375 load_path_check (default_lpath
);
4377 /* Add the site-lisp directories to the front of the default. */
4380 Lisp_Object sitelisp
;
4381 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4382 if (! NILP (sitelisp
))
4383 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4388 /* Replace nils from EMACSLOADPATH by default. */
4389 while (CONSP (elpath
))
4392 elem
= XCAR (elpath
);
4393 elpath
= XCDR (elpath
);
4394 arg
[0] = Vload_path
;
4395 arg
[1] = NILP (elem
) ? default_lpath
: Fcons (elem
, Qnil
);
4396 Vload_path
= Fappend (2, arg
);
4398 } /* Fmemq (Qnil, Vload_path) */
4402 Vload_path
= load_path_default ();
4404 /* Check before adding site-lisp directories.
4405 The install should have created them, but they are not
4406 required, so no need to warn if they are absent.
4407 Or we might be running before installation. */
4408 load_path_check (Vload_path
);
4410 /* Add the site-lisp directories at the front. */
4411 if (initialized
&& !no_site_lisp
)
4413 Lisp_Object sitelisp
;
4414 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4415 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4421 load_in_progress
= 0;
4422 Vload_file_name
= Qnil
;
4423 Vstandard_input
= Qt
;
4424 Vloads_in_progress
= Qnil
;
4427 /* Print a warning that directory intended for use USE and with name
4428 DIRNAME cannot be accessed. On entry, errno should correspond to
4429 the access failure. Print the warning on stderr and put it in
4433 dir_warning (char const *use
, Lisp_Object dirname
)
4435 static char const format
[] = "Warning: %s `%s': %s\n";
4436 int access_errno
= errno
;
4437 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4439 /* Don't log the warning before we've initialized!! */
4442 char const *diagnostic
= emacs_strerror (access_errno
);
4444 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4445 + strlen (use
) + SBYTES (dirname
)
4446 + strlen (diagnostic
));
4447 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4449 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4455 syms_of_lread (void)
4459 DEFVAR_LISP ("obarray", Vobarray
,
4460 doc
: /* Symbol table for use by `intern' and `read'.
4461 It is a vector whose length ought to be prime for best results.
4462 The vector's contents don't make sense if examined from Lisp programs;
4463 to find all the symbols in an obarray, use `mapatoms'. */);
4465 DEFVAR_LISP ("values", Vvalues
,
4466 doc
: /* List of values of all expressions which were read, evaluated and printed.
4467 Order is reverse chronological. */);
4468 XSYMBOL (intern ("values"))->declared_special
= 0;
4470 DEFVAR_LISP ("standard-input", Vstandard_input
,
4471 doc
: /* Stream for read to get input from.
4472 See documentation of `read' for possible values. */);
4473 Vstandard_input
= Qt
;
4475 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4476 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4478 If this variable is a buffer, then only forms read from that buffer
4479 will be added to `read-symbol-positions-list'.
4480 If this variable is t, then all read forms will be added.
4481 The effect of all other values other than nil are not currently
4482 defined, although they may be in the future.
4484 The positions are relative to the last call to `read' or
4485 `read-from-string'. It is probably a bad idea to set this variable at
4486 the toplevel; bind it instead. */);
4487 Vread_with_symbol_positions
= Qnil
;
4489 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4490 doc
: /* A list mapping read symbols to their positions.
4491 This variable is modified during calls to `read' or
4492 `read-from-string', but only when `read-with-symbol-positions' is
4495 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4496 CHAR-POSITION is an integer giving the offset of that occurrence of the
4497 symbol from the position where `read' or `read-from-string' started.
4499 Note that a symbol will appear multiple times in this list, if it was
4500 read multiple times. The list is in the same order as the symbols
4502 Vread_symbol_positions_list
= Qnil
;
4504 DEFVAR_LISP ("read-circle", Vread_circle
,
4505 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4508 DEFVAR_LISP ("load-path", Vload_path
,
4509 doc
: /* List of directories to search for files to load.
4510 Each element is a string (directory name) or nil (meaning `default-directory').
4511 Initialized during startup as described in Info node `(elisp)Library Search'. */);
4513 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4514 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4515 This list should not include the empty string.
4516 `load' and related functions try to append these suffixes, in order,
4517 to the specified file name if a Lisp suffix is allowed or required. */);
4518 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4519 build_pure_c_string (".el"));
4520 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4521 doc
: /* List of suffixes that indicate representations of \
4523 This list should normally start with the empty string.
4525 Enabling Auto Compression mode appends the suffixes in
4526 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4527 mode removes them again. `load' and related functions use this list to
4528 determine whether they should look for compressed versions of a file
4529 and, if so, which suffixes they should try to append to the file name
4530 in order to do so. However, if you want to customize which suffixes
4531 the loading functions recognize as compression suffixes, you should
4532 customize `jka-compr-load-suffixes' rather than the present variable. */);
4533 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4535 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4536 doc
: /* Non-nil if inside of `load'. */);
4537 DEFSYM (Qload_in_progress
, "load-in-progress");
4539 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4540 doc
: /* An alist of functions to be evalled when particular files are loaded.
4541 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4543 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4544 a symbol \(a feature name).
4546 When `load' is run and the file-name argument matches an element's
4547 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4548 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4550 An error in FORMS does not undo the load, but does prevent execution of
4551 the rest of the FORMS. */);
4552 Vafter_load_alist
= Qnil
;
4554 DEFVAR_LISP ("load-history", Vload_history
,
4555 doc
: /* Alist mapping loaded file names to symbols and features.
4556 Each alist element should be a list (FILE-NAME ENTRIES...), where
4557 FILE-NAME is the name of a file that has been loaded into Emacs.
4558 The file name is absolute and true (i.e. it doesn't contain symlinks).
4559 As an exception, one of the alist elements may have FILE-NAME nil,
4560 for symbols and features not associated with any file.
4562 The remaining ENTRIES in the alist element describe the functions and
4563 variables defined in that file, the features provided, and the
4564 features required. Each entry has the form `(provide . FEATURE)',
4565 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4566 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4567 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4568 autoload before this file redefined it as a function. In addition,
4569 entries may also be single symbols, which means that SYMBOL was
4570 defined by `defvar' or `defconst'.
4572 During preloading, the file name recorded is relative to the main Lisp
4573 directory. These file names are converted to absolute at startup. */);
4574 Vload_history
= Qnil
;
4576 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4577 doc
: /* Full name of file being loaded by `load'. */);
4578 Vload_file_name
= Qnil
;
4580 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4581 doc
: /* File name, including directory, of user's initialization file.
4582 If the file loaded had extension `.elc', and the corresponding source file
4583 exists, this variable contains the name of source file, suitable for use
4584 by functions like `custom-save-all' which edit the init file.
4585 While Emacs loads and evaluates the init file, value is the real name
4586 of the file, regardless of whether or not it has the `.elc' extension. */);
4587 Vuser_init_file
= Qnil
;
4589 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4590 doc
: /* Used for internal purposes by `load'. */);
4591 Vcurrent_load_list
= Qnil
;
4593 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4594 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4595 The default is nil, which means use the function `read'. */);
4596 Vload_read_function
= Qnil
;
4598 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4599 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4600 The value should be a function for doing code conversion before
4601 reading a source file. It can also be nil, in which case loading is
4602 done without any code conversion.
4604 If the value is a function, it is called with four arguments,
4605 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4606 the file to load, FILE is the non-absolute name (for messages etc.),
4607 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4608 `load'. The function should return t if the file was loaded. */);
4609 Vload_source_file_function
= Qnil
;
4611 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4612 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4613 This is useful when the file being loaded is a temporary copy. */);
4614 load_force_doc_strings
= 0;
4616 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4617 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4618 This is normally bound by `load' and `eval-buffer' to control `read',
4619 and is not meant for users to change. */);
4620 load_convert_to_unibyte
= 0;
4622 DEFVAR_LISP ("source-directory", Vsource_directory
,
4623 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4624 You cannot count on them to still be there! */);
4626 = Fexpand_file_name (build_string ("../"),
4627 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4629 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4630 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4631 Vpreloaded_file_list
= Qnil
;
4633 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4634 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4635 Vbyte_boolean_vars
= Qnil
;
4637 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4638 doc
: /* Non-nil means load dangerous compiled Lisp files.
4639 Some versions of XEmacs use different byte codes than Emacs. These
4640 incompatible byte codes can make Emacs crash when it tries to execute
4642 load_dangerous_libraries
= 0;
4644 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4645 doc
: /* Non-nil means force printing messages when loading Lisp files.
4646 This overrides the value of the NOMESSAGE argument to `load'. */);
4647 force_load_messages
= 0;
4649 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4650 doc
: /* Regular expression matching safe to load compiled Lisp files.
4651 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4652 from the file, and matches them against this regular expression.
4653 When the regular expression matches, the file is considered to be safe
4654 to load. See also `load-dangerous-libraries'. */);
4655 Vbytecomp_version_regexp
4656 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4658 DEFSYM (Qlexical_binding
, "lexical-binding");
4659 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4660 doc
: /* Whether to use lexical binding when evaluating code.
4661 Non-nil means that the code in the current buffer should be evaluated
4662 with lexical binding.
4663 This variable is automatically set from the file variables of an
4664 interpreted Lisp file read using `load'. Unlike other file local
4665 variables, this must be set in the first line of a file. */);
4666 Vlexical_binding
= Qnil
;
4667 Fmake_variable_buffer_local (Qlexical_binding
);
4669 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4670 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4671 Veval_buffer_list
= Qnil
;
4673 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4674 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4675 Vold_style_backquotes
= Qnil
;
4676 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4678 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4679 doc
: /* Non-nil means `load' prefers the newest version of a file.
4680 This applies when a filename suffix is not explicitly specified and
4681 `load' is trying various possible suffixes (see `load-suffixes' and
4682 `load-file-rep-suffixes'). Normally, it stops at the first file
4683 that exists unless you explicitly specify one or the other. If this
4684 option is non-nil, it checks all suffixes and uses whichever file is
4686 Note that if you customize this, obviously it will not affect files
4687 that are loaded before your customizations are read! */);
4688 load_prefer_newer
= 0;
4690 /* Vsource_directory was initialized in init_lread. */
4692 DEFSYM (Qcurrent_load_list
, "current-load-list");
4693 DEFSYM (Qstandard_input
, "standard-input");
4694 DEFSYM (Qread_char
, "read-char");
4695 DEFSYM (Qget_file_char
, "get-file-char");
4696 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4697 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4699 DEFSYM (Qbackquote
, "`");
4700 DEFSYM (Qcomma
, ",");
4701 DEFSYM (Qcomma_at
, ",@");
4702 DEFSYM (Qcomma_dot
, ",.");
4704 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4705 DEFSYM (Qascii_character
, "ascii-character");
4706 DEFSYM (Qfunction
, "function");
4707 DEFSYM (Qload
, "load");
4708 DEFSYM (Qload_file_name
, "load-file-name");
4709 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4710 DEFSYM (Qfile_truename
, "file-truename");
4711 DEFSYM (Qdir_ok
, "dir-ok");
4712 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4714 staticpro (&read_objects
);
4715 read_objects
= Qnil
;
4716 staticpro (&seen_list
);
4719 Vloads_in_progress
= Qnil
;
4720 staticpro (&Vloads_in_progress
);
4722 DEFSYM (Qhash_table
, "hash-table");
4723 DEFSYM (Qdata
, "data");
4724 DEFSYM (Qtest
, "test");
4725 DEFSYM (Qsize
, "size");
4726 DEFSYM (Qweakness
, "weakness");
4727 DEFSYM (Qrehash_size
, "rehash-size");
4728 DEFSYM (Qrehash_threshold
, "rehash-threshold");