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
))
973 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
974 Fmessage (2, (Lisp_Object
[]) {format
, file
});
978 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
979 doc
: /* Return the suffixes that `load' should try if a suffix is \
981 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
984 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
985 while (CONSP (suffixes
))
987 Lisp_Object exts
= Vload_file_rep_suffixes
;
988 suffix
= XCAR (suffixes
);
989 suffixes
= XCDR (suffixes
);
994 lst
= Fcons (concat2 (suffix
, ext
), lst
);
997 return Fnreverse (lst
);
1000 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1001 doc
: /* Execute a file of Lisp code named FILE.
1002 First try FILE with `.elc' appended, then try with `.el',
1003 then try FILE unmodified (the exact suffixes in the exact order are
1004 determined by `load-suffixes'). Environment variable references in
1005 FILE are replaced with their values by calling `substitute-in-file-name'.
1006 This function searches the directories in `load-path'.
1008 If optional second arg NOERROR is non-nil,
1009 report no error if FILE doesn't exist.
1010 Print messages at start and end of loading unless
1011 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1013 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1014 suffixes `.elc' or `.el' to the specified name FILE.
1015 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1016 the suffix `.elc' or `.el'; don't accept just FILE unless
1017 it ends in one of those suffixes or includes a directory name.
1019 If NOSUFFIX is nil, then if a file could not be found, try looking for
1020 a different representation of the file by adding non-empty suffixes to
1021 its name, before trying another file. Emacs uses this feature to find
1022 compressed versions of files when Auto Compression mode is enabled.
1023 If NOSUFFIX is non-nil, disable this feature.
1025 The suffixes that this function tries out, when NOSUFFIX is nil, are
1026 given by the return value of `get-load-suffixes' and the values listed
1027 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1028 return value of `get-load-suffixes' is used, i.e. the file name is
1029 required to have a non-empty suffix.
1031 When searching suffixes, this function normally stops at the first
1032 one that exists. If the option `load-prefer-newer' is non-nil,
1033 however, it tries all suffixes, and uses whichever file is the newest.
1035 Loading a file records its definitions, and its `provide' and
1036 `require' calls, in an element of `load-history' whose
1037 car is the file name loaded. See `load-history'.
1039 While the file is in the process of being loaded, the variable
1040 `load-in-progress' is non-nil and the variable `load-file-name'
1041 is bound to the file's name.
1043 Return t if the file exists and loads successfully. */)
1044 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1045 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1050 ptrdiff_t count
= SPECPDL_INDEX ();
1051 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1052 Lisp_Object found
, efound
, hist_file_name
;
1053 /* True means we printed the ".el is newer" message. */
1055 /* True means we are loading a compiled file. */
1057 Lisp_Object handler
;
1059 const char *fmode
= "r";
1066 CHECK_STRING (file
);
1068 /* If file name is magic, call the handler. */
1069 /* This shouldn't be necessary any more now that `openp' handles it right.
1070 handler = Ffind_file_name_handler (file, Qload);
1071 if (!NILP (handler))
1072 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1074 /* Do this after the handler to avoid
1075 the need to gcpro noerror, nomessage and nosuffix.
1076 (Below here, we care only whether they are nil or not.)
1077 The presence of this call is the result of a historical accident:
1078 it used to be in every file-operation and when it got removed
1079 everywhere, it accidentally stayed here. Since then, enough people
1080 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1081 that it seemed risky to remove. */
1082 if (! NILP (noerror
))
1084 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1085 Qt
, load_error_handler
);
1090 file
= Fsubstitute_in_file_name (file
);
1092 /* Avoid weird lossage with null string as arg,
1093 since it would try to load a directory as a Lisp file. */
1094 if (SCHARS (file
) == 0)
1101 Lisp_Object suffixes
;
1103 GCPRO2 (file
, found
);
1105 if (! NILP (must_suffix
))
1107 /* Don't insist on adding a suffix if FILE already ends with one. */
1108 ptrdiff_t size
= SBYTES (file
);
1110 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1113 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1115 /* Don't insist on adding a suffix
1116 if the argument includes a directory name. */
1117 else if (! NILP (Ffile_name_directory (file
)))
1121 if (!NILP (nosuffix
))
1125 suffixes
= Fget_load_suffixes ();
1126 if (NILP (must_suffix
))
1130 arg
[1] = Vload_file_rep_suffixes
;
1131 suffixes
= Fappend (2, arg
);
1135 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1142 report_file_error ("Cannot open load file", file
);
1146 /* Tell startup.el whether or not we found the user's init file. */
1147 if (EQ (Qt
, Vuser_init_file
))
1148 Vuser_init_file
= found
;
1150 /* If FD is -2, that means openp found a magic file. */
1153 if (NILP (Fequal (found
, file
)))
1154 /* If FOUND is a different file name from FILE,
1155 find its handler even if we have already inhibited
1156 the `load' operation on FILE. */
1157 handler
= Ffind_file_name_handler (found
, Qt
);
1159 handler
= Ffind_file_name_handler (found
, Qload
);
1160 if (! NILP (handler
))
1161 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1163 /* Tramp has to deal with semi-broken packages that prepend
1164 drive letters to remote files. For that reason, Tramp
1165 catches file operations that test for file existence, which
1166 makes openp think X:/foo.elc files are remote. However,
1167 Tramp does not catch `load' operations for such files, so we
1168 end up with a nil as the `load' handler above. If we would
1169 continue with fd = -2, we will behave wrongly, and in
1170 particular try reading a .elc file in the "rt" mode instead
1171 of "rb". See bug #9311 for the results. To work around
1172 this, we try to open the file locally, and go with that if it
1174 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1182 /* Pacify older GCC with --enable-gcc-warnings. */
1183 IF_LINT (fd_index
= 0);
1187 fd_index
= SPECPDL_INDEX ();
1188 record_unwind_protect_int (close_file_unwind
, fd
);
1191 /* Check if we're stuck in a recursive load cycle.
1193 2000-09-21: It's not possible to just check for the file loaded
1194 being a member of Vloads_in_progress. This fails because of the
1195 way the byte compiler currently works; `provide's are not
1196 evaluated, see font-lock.el/jit-lock.el as an example. This
1197 leads to a certain amount of ``normal'' recursion.
1199 Also, just loading a file recursively is not always an error in
1200 the general case; the second load may do something different. */
1204 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1205 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1206 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1207 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1208 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1211 /* All loads are by default dynamic, unless the file itself specifies
1212 otherwise using a file-variable in the first line. This is bound here
1213 so that it takes effect whether or not we use
1214 Vload_source_file_function. */
1215 specbind (Qlexical_binding
, Qnil
);
1217 /* Get the name for load-history. */
1218 hist_file_name
= (! NILP (Vpurify_flag
)
1219 ? concat2 (Ffile_name_directory (file
),
1220 Ffile_name_nondirectory (found
))
1225 /* Check for the presence of old-style quotes and warn about them. */
1226 specbind (Qold_style_backquotes
, Qnil
);
1227 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1229 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1230 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1231 /* Load .elc files directly, but not when they are
1232 remote and have no handler! */
1239 GCPRO3 (file
, found
, hist_file_name
);
1242 && ! (version
= safe_to_load_version (fd
)))
1245 if (!load_dangerous_libraries
)
1246 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1247 else if (!NILP (nomessage
) && !force_load_messages
)
1248 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1253 efound
= ENCODE_FILE (found
);
1259 /* openp already checked for newness, no point doing it again.
1260 FIXME would be nice to get a message when openp
1261 ignores suffix order due to load_prefer_newer. */
1262 if (!load_prefer_newer
)
1264 result
= stat (SSDATA (efound
), &s1
);
1267 SSET (efound
, SBYTES (efound
) - 1, 0);
1268 result
= stat (SSDATA (efound
), &s2
);
1269 SSET (efound
, SBYTES (efound
) - 1, 'c');
1273 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1275 /* Make the progress messages mention that source is newer. */
1278 /* If we won't print another message, mention this anyway. */
1279 if (!NILP (nomessage
) && !force_load_messages
)
1281 Lisp_Object msg_file
;
1282 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1283 message_with_string ("Source file `%s' newer than byte-compiled file",
1287 } /* !load_prefer_newer */
1293 /* We are loading a source file (*.el). */
1294 if (!NILP (Vload_source_file_function
))
1301 clear_unwind_protect (fd_index
);
1303 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1304 NILP (noerror
) ? Qnil
: Qt
,
1305 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1306 return unbind_to (count
, val
);
1310 GCPRO3 (file
, found
, hist_file_name
);
1314 /* We somehow got here with fd == -2, meaning the file is deemed
1315 to be remote. Don't even try to reopen the file locally;
1316 just force a failure. */
1324 clear_unwind_protect (fd_index
);
1325 efound
= ENCODE_FILE (found
);
1326 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1328 stream
= fdopen (fd
, fmode
);
1332 report_file_error ("Opening stdio stream", file
);
1333 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1335 if (! NILP (Vpurify_flag
))
1336 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1338 if (NILP (nomessage
) || force_load_messages
)
1341 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1344 message_with_string ("Loading %s (source)...", file
, 1);
1346 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1348 else /* The typical case; compiled file newer than source file. */
1349 message_with_string ("Loading %s...", file
, 1);
1352 specbind (Qload_file_name
, found
);
1353 specbind (Qinhibit_file_name_operation
, Qnil
);
1354 specbind (Qload_in_progress
, Qt
);
1357 if (lisp_file_lexically_bound_p (Qget_file_char
))
1358 Fset (Qlexical_binding
, Qt
);
1360 if (! version
|| version
>= 22)
1361 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1362 0, Qnil
, Qnil
, Qnil
, Qnil
);
1365 /* We can't handle a file which was compiled with
1366 byte-compile-dynamic by older version of Emacs. */
1367 specbind (Qload_force_doc_strings
, Qt
);
1368 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1369 0, Qnil
, Qnil
, Qnil
, Qnil
);
1371 unbind_to (count
, Qnil
);
1373 /* Run any eval-after-load forms for this file. */
1374 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1375 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1379 xfree (saved_doc_string
);
1380 saved_doc_string
= 0;
1381 saved_doc_string_size
= 0;
1383 xfree (prev_saved_doc_string
);
1384 prev_saved_doc_string
= 0;
1385 prev_saved_doc_string_size
= 0;
1387 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1390 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1393 message_with_string ("Loading %s (source)...done", file
, 1);
1395 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1397 else /* The typical case; compiled file newer than source file. */
1398 message_with_string ("Loading %s...done", file
, 1);
1405 complete_filename_p (Lisp_Object pathname
)
1407 const unsigned char *s
= SDATA (pathname
);
1408 return (IS_DIRECTORY_SEP (s
[0])
1409 || (SCHARS (pathname
) > 2
1410 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1413 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1414 doc
: /* Search for FILENAME through PATH.
1415 Returns the file's name in absolute form, or nil if not found.
1416 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1417 file name when searching.
1418 If non-nil, PREDICATE is used instead of `file-readable-p'.
1419 PREDICATE can also be an integer to pass to the faccessat(2) function,
1420 in which case file-name-handlers are ignored.
1421 This function will normally skip directories, so if you want it to find
1422 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1423 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1426 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1427 if (NILP (predicate
) && fd
>= 0)
1432 static Lisp_Object Qdir_ok
;
1434 /* Search for a file whose name is STR, looking in directories
1435 in the Lisp list PATH, and trying suffixes from SUFFIX.
1436 On success, return a file descriptor (or 1 or -2 as described below).
1437 On failure, return -1 and set errno.
1439 SUFFIXES is a list of strings containing possible suffixes.
1440 The empty suffix is automatically added if the list is empty.
1442 PREDICATE non-nil means don't open the files,
1443 just look for one that satisfies the predicate. In this case,
1444 return 1 on success. The predicate can be a lisp function or
1445 an integer to pass to `access' (in which case file-name-handlers
1448 If STOREPTR is nonzero, it points to a slot where the name of
1449 the file actually found should be stored as a Lisp string.
1450 nil is stored there on failure.
1452 If the file we find is remote, return -2
1453 but store the found remote file name in *STOREPTR.
1455 If NEWER is true, try all SUFFIXes and return the result for the
1456 newest file that exists. Does not apply to remote files,
1457 or if PREDICATE is specified. */
1460 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1461 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1463 ptrdiff_t fn_size
= 100;
1467 ptrdiff_t want_length
;
1468 Lisp_Object filename
;
1469 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
, gcpro7
;
1470 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1471 ptrdiff_t max_suffix_len
= 0;
1472 int last_errno
= ENOENT
;
1476 /* The last-modified time of the newest matching file found.
1477 Initialize it to something less than all valid timestamps. */
1478 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1482 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1484 CHECK_STRING_CAR (tail
);
1485 max_suffix_len
= max (max_suffix_len
,
1486 SBYTES (XCAR (tail
)));
1489 string
= filename
= encoded_fn
= save_string
= Qnil
;
1490 GCPRO7 (str
, string
, save_string
, filename
, path
, suffixes
, encoded_fn
);
1495 absolute
= complete_filename_p (str
);
1497 for (; CONSP (path
); path
= XCDR (path
))
1499 filename
= Fexpand_file_name (str
, XCAR (path
));
1500 if (!complete_filename_p (filename
))
1501 /* If there are non-absolute elts in PATH (eg "."). */
1502 /* Of course, this could conceivably lose if luser sets
1503 default-directory to be something non-absolute... */
1505 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1506 if (!complete_filename_p (filename
))
1507 /* Give up on this path element! */
1511 /* Calculate maximum length of any filename made from
1512 this path element/specified file name and any possible suffix. */
1513 want_length
= max_suffix_len
+ SBYTES (filename
);
1514 if (fn_size
<= want_length
)
1516 fn_size
= 100 + want_length
;
1517 fn
= SAFE_ALLOCA (fn_size
);
1520 /* Loop over suffixes. */
1521 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1522 CONSP (tail
); tail
= XCDR (tail
))
1524 Lisp_Object suffix
= XCAR (tail
);
1525 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1526 Lisp_Object handler
;
1528 /* Concatenate path element/specified name with the suffix.
1529 If the directory starts with /:, remove that. */
1530 int prefixlen
= ((SCHARS (filename
) > 2
1531 && SREF (filename
, 0) == '/'
1532 && SREF (filename
, 1) == ':')
1534 fnlen
= SBYTES (filename
) - prefixlen
;
1535 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1536 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1538 /* Check that the file exists and is not a directory. */
1539 /* We used to only check for handlers on non-absolute file names:
1543 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1544 It's not clear why that was the case and it breaks things like
1545 (load "/bar.el") where the file is actually "/bar.el.gz". */
1546 /* make_string has its own ideas on when to return a unibyte
1547 string and when a multibyte string, but we know better.
1548 We must have a unibyte string when dumping, since
1549 file-name encoding is shaky at best at that time, and in
1550 particular default-file-name-coding-system is reset
1551 several times during loadup. We therefore don't want to
1552 encode the file before passing it to file I/O library
1554 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1555 string
= make_unibyte_string (fn
, fnlen
);
1557 string
= make_string (fn
, fnlen
);
1558 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1559 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1562 if (NILP (predicate
))
1563 exists
= !NILP (Ffile_readable_p (string
));
1566 Lisp_Object tmp
= call1 (predicate
, string
);
1569 else if (EQ (tmp
, Qdir_ok
)
1570 || NILP (Ffile_directory_p (string
)))
1575 last_errno
= EISDIR
;
1581 /* We succeeded; return this descriptor and filename. */
1595 encoded_fn
= ENCODE_FILE (string
);
1596 pfn
= SSDATA (encoded_fn
);
1598 /* Check that we can access or open it. */
1599 if (NATNUMP (predicate
))
1602 if (INT_MAX
< XFASTINT (predicate
))
1603 last_errno
= EINVAL
;
1604 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1608 if (file_directory_p (pfn
))
1609 last_errno
= EISDIR
;
1616 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1619 if (errno
!= ENOENT
)
1624 int err
= (fstat (fd
, &st
) != 0 ? errno
1625 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1637 if (newer
&& !NATNUMP (predicate
))
1639 struct timespec mtime
= get_stat_mtime (&st
);
1641 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1646 emacs_close (save_fd
);
1649 save_string
= string
;
1654 /* We succeeded; return this descriptor and filename. */
1663 /* No more suffixes. Return the newest. */
1664 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1667 *storeptr
= save_string
;
1685 /* Merge the list we've accumulated of globals from the current input source
1686 into the load_history variable. The details depend on whether
1687 the source has an associated file name or not.
1689 FILENAME is the file name that we are loading from.
1691 ENTIRE is true if loading that entire file, false if evaluating
1695 build_load_history (Lisp_Object filename
, bool entire
)
1697 Lisp_Object tail
, prev
, newelt
;
1698 Lisp_Object tem
, tem2
;
1701 tail
= Vload_history
;
1704 while (CONSP (tail
))
1708 /* Find the feature's previous assoc list... */
1709 if (!NILP (Fequal (filename
, Fcar (tem
))))
1713 /* If we're loading the entire file, remove old data. */
1717 Vload_history
= XCDR (tail
);
1719 Fsetcdr (prev
, XCDR (tail
));
1722 /* Otherwise, cons on new symbols that are not already members. */
1725 tem2
= Vcurrent_load_list
;
1727 while (CONSP (tem2
))
1729 newelt
= XCAR (tem2
);
1731 if (NILP (Fmember (newelt
, tem
)))
1732 Fsetcar (tail
, Fcons (XCAR (tem
),
1733 Fcons (newelt
, XCDR (tem
))));
1746 /* If we're loading an entire file, cons the new assoc onto the
1747 front of load-history, the most-recently-loaded position. Also
1748 do this if we didn't find an existing member for the file. */
1749 if (entire
|| !foundit
)
1750 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1755 readevalloop_1 (int old
)
1757 load_convert_to_unibyte
= old
;
1760 /* Signal an `end-of-file' error, if possible with file name
1763 static _Noreturn
void
1764 end_of_file_error (void)
1766 if (STRINGP (Vload_file_name
))
1767 xsignal1 (Qend_of_file
, Vload_file_name
);
1769 xsignal0 (Qend_of_file
);
1773 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1775 /* If we macroexpand the toplevel form non-recursively and it ends
1776 up being a `progn' (or if it was a progn to start), treat each
1777 form in the progn as a top-level form. This way, if one form in
1778 the progn defines a macro, that macro is in effect when we expand
1779 the remaining forms. See similar code in bytecomp.el. */
1780 val
= call2 (macroexpand
, val
, Qnil
);
1781 if (EQ (CAR_SAFE (val
), Qprogn
))
1783 struct gcpro gcpro1
;
1784 Lisp_Object subforms
= XCDR (val
);
1787 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1788 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1793 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1797 /* UNIBYTE specifies how to set load_convert_to_unibyte
1798 for this invocation.
1799 READFUN, if non-nil, is used instead of `read'.
1801 START, END specify region to read in current buffer (from eval-region).
1802 If the input is not from a buffer, they must be nil. */
1805 readevalloop (Lisp_Object readcharfun
,
1807 Lisp_Object sourcename
,
1809 Lisp_Object unibyte
, Lisp_Object readfun
,
1810 Lisp_Object start
, Lisp_Object end
)
1813 register Lisp_Object val
;
1814 ptrdiff_t count
= SPECPDL_INDEX ();
1815 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1816 struct buffer
*b
= 0;
1817 bool continue_reading_p
;
1818 Lisp_Object lex_bound
;
1819 /* True if reading an entire buffer. */
1820 bool whole_buffer
= 0;
1821 /* True on the first time around. */
1822 bool first_sexp
= 1;
1823 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1825 if (NILP (Ffboundp (macroexpand
))
1826 /* Don't macroexpand in .elc files, since it should have been done
1827 already. We actually don't know whether we're in a .elc file or not,
1828 so we use circumstantial evidence: .el files normally go through
1829 Vload_source_file_function -> load-with-code-conversion
1831 || EQ (readcharfun
, Qget_file_char
)
1832 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1835 if (MARKERP (readcharfun
))
1838 start
= readcharfun
;
1841 if (BUFFERP (readcharfun
))
1842 b
= XBUFFER (readcharfun
);
1843 else if (MARKERP (readcharfun
))
1844 b
= XMARKER (readcharfun
)->buffer
;
1846 /* We assume START is nil when input is not from a buffer. */
1847 if (! NILP (start
) && !b
)
1850 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1851 specbind (Qcurrent_load_list
, Qnil
);
1852 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1853 load_convert_to_unibyte
= !NILP (unibyte
);
1855 /* If lexical binding is active (either because it was specified in
1856 the file's header, or via a buffer-local variable), create an empty
1857 lexical environment, otherwise, turn off lexical binding. */
1858 lex_bound
= find_symbol_value (Qlexical_binding
);
1859 specbind (Qinternal_interpreter_environment
,
1860 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1861 ? Qnil
: list1 (Qt
)));
1863 GCPRO4 (sourcename
, readfun
, start
, end
);
1865 /* Try to ensure sourcename is a truename, except whilst preloading. */
1866 if (NILP (Vpurify_flag
)
1867 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1868 && !NILP (Ffboundp (Qfile_truename
)))
1869 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1871 LOADHIST_ATTACH (sourcename
);
1873 continue_reading_p
= 1;
1874 while (continue_reading_p
)
1876 ptrdiff_t count1
= SPECPDL_INDEX ();
1878 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1879 error ("Reading from killed buffer");
1883 /* Switch to the buffer we are reading from. */
1884 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1885 set_buffer_internal (b
);
1887 /* Save point in it. */
1888 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1889 /* Save ZV in it. */
1890 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1891 /* Those get unbound after we read one expression. */
1893 /* Set point and ZV around stuff to be read. */
1896 Fnarrow_to_region (make_number (BEGV
), end
);
1898 /* Just for cleanliness, convert END to a marker
1899 if it is an integer. */
1901 end
= Fpoint_max_marker ();
1904 /* On the first cycle, we can easily test here
1905 whether we are reading the whole buffer. */
1906 if (b
&& first_sexp
)
1907 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1914 while ((c
= READCHAR
) != '\n' && c
!= -1);
1919 unbind_to (count1
, Qnil
);
1923 /* Ignore whitespace here, so we can detect eof. */
1924 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1925 || c
== 0xa0) /* NBSP */
1928 if (!NILP (Vpurify_flag
) && c
== '(')
1930 val
= read_list (0, readcharfun
);
1935 read_objects
= Qnil
;
1936 if (!NILP (readfun
))
1938 val
= call1 (readfun
, readcharfun
);
1940 /* If READCHARFUN has set point to ZV, we should
1941 stop reading, even if the form read sets point
1942 to a different value when evaluated. */
1943 if (BUFFERP (readcharfun
))
1945 struct buffer
*buf
= XBUFFER (readcharfun
);
1946 if (BUF_PT (buf
) == BUF_ZV (buf
))
1947 continue_reading_p
= 0;
1950 else if (! NILP (Vload_read_function
))
1951 val
= call1 (Vload_read_function
, readcharfun
);
1953 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1956 if (!NILP (start
) && continue_reading_p
)
1957 start
= Fpoint_marker ();
1959 /* Restore saved point and BEGV. */
1960 unbind_to (count1
, Qnil
);
1962 /* Now eval what we just read. */
1963 if (!NILP (macroexpand
))
1964 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1966 val
= eval_sub (val
);
1970 Vvalues
= Fcons (val
, Vvalues
);
1971 if (EQ (Vstandard_output
, Qt
))
1980 build_load_history (sourcename
,
1981 stream
|| whole_buffer
);
1985 unbind_to (count
, Qnil
);
1988 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1989 doc
: /* Execute the current buffer as Lisp code.
1990 When called from a Lisp program (i.e., not interactively), this
1991 function accepts up to five optional arguments:
1992 BUFFER is the buffer to evaluate (nil means use current buffer).
1993 PRINTFLAG controls printing of output:
1994 A value of nil means discard it; anything else is stream for print.
1995 FILENAME specifies the file name to use for `load-history'.
1996 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1998 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1999 functions should work normally even if PRINTFLAG is nil.
2001 This function preserves the position of point. */)
2002 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
2004 ptrdiff_t count
= SPECPDL_INDEX ();
2005 Lisp_Object tem
, buf
;
2008 buf
= Fcurrent_buffer ();
2010 buf
= Fget_buffer (buffer
);
2012 error ("No such buffer");
2014 if (NILP (printflag
) && NILP (do_allow_print
))
2019 if (NILP (filename
))
2020 filename
= BVAR (XBUFFER (buf
), filename
);
2022 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
2023 specbind (Qstandard_output
, tem
);
2024 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
2025 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2026 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
2027 readevalloop (buf
, 0, filename
,
2028 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
2029 unbind_to (count
, Qnil
);
2034 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2035 doc
: /* Execute the region as Lisp code.
2036 When called from programs, expects two arguments,
2037 giving starting and ending indices in the current buffer
2038 of the text to be executed.
2039 Programs can pass third argument PRINTFLAG which controls output:
2040 A value of nil means discard it; anything else is stream for printing it.
2041 Also the fourth argument READ-FUNCTION, if non-nil, is used
2042 instead of `read' to read each expression. It gets one argument
2043 which is the input stream for reading characters.
2045 This function does not move point. */)
2046 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2048 /* FIXME: Do the eval-sexp-add-defvars dance! */
2049 ptrdiff_t count
= SPECPDL_INDEX ();
2050 Lisp_Object tem
, cbuf
;
2052 cbuf
= Fcurrent_buffer ();
2054 if (NILP (printflag
))
2058 specbind (Qstandard_output
, tem
);
2059 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2061 /* `readevalloop' calls functions which check the type of start and end. */
2062 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2063 !NILP (printflag
), Qnil
, read_function
,
2066 return unbind_to (count
, Qnil
);
2070 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2071 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2072 If STREAM is nil, use the value of `standard-input' (which see).
2073 STREAM or the value of `standard-input' may be:
2074 a buffer (read from point and advance it)
2075 a marker (read from where it points and advance it)
2076 a function (call it with no arguments for each character,
2077 call it with a char as argument to push a char back)
2078 a string (takes text from string, starting at the beginning)
2079 t (read text line using minibuffer and use it, or read from
2080 standard input in batch mode). */)
2081 (Lisp_Object stream
)
2084 stream
= Vstandard_input
;
2085 if (EQ (stream
, Qt
))
2086 stream
= Qread_char
;
2087 if (EQ (stream
, Qread_char
))
2088 /* FIXME: ?! When is this used !? */
2089 return call1 (intern ("read-minibuffer"),
2090 build_string ("Lisp expression: "));
2092 return read_internal_start (stream
, Qnil
, Qnil
);
2095 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2096 doc
: /* Read one Lisp expression which is represented as text by STRING.
2097 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2098 FINAL-STRING-INDEX is an integer giving the position of the next
2099 remaining character in STRING. START and END optionally delimit
2100 a substring of STRING from which to read; they default to 0 and
2101 (length STRING) respectively. Negative values are counted from
2102 the end of STRING. */)
2103 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2106 CHECK_STRING (string
);
2107 /* `read_internal_start' sets `read_from_string_index'. */
2108 ret
= read_internal_start (string
, start
, end
);
2109 return Fcons (ret
, make_number (read_from_string_index
));
2112 /* Function to set up the global context we need in toplevel read
2113 calls. START and END only used when STREAM is a string. */
2115 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2120 new_backquote_flag
= 0;
2121 read_objects
= Qnil
;
2122 if (EQ (Vread_with_symbol_positions
, Qt
)
2123 || EQ (Vread_with_symbol_positions
, stream
))
2124 Vread_symbol_positions_list
= Qnil
;
2126 if (STRINGP (stream
)
2127 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2129 ptrdiff_t startval
, endval
;
2132 if (STRINGP (stream
))
2135 string
= XCAR (stream
);
2137 validate_subarray (string
, start
, end
, SCHARS (string
),
2138 &startval
, &endval
);
2140 read_from_string_index
= startval
;
2141 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2142 read_from_string_limit
= endval
;
2145 retval
= read0 (stream
);
2146 if (EQ (Vread_with_symbol_positions
, Qt
)
2147 || EQ (Vread_with_symbol_positions
, stream
))
2148 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2153 /* Signal Qinvalid_read_syntax error.
2154 S is error string of length N (if > 0) */
2156 static _Noreturn
void
2157 invalid_syntax (const char *s
)
2159 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2163 /* Use this for recursive reads, in contexts where internal tokens
2167 read0 (Lisp_Object readcharfun
)
2169 register Lisp_Object val
;
2172 val
= read1 (readcharfun
, &c
, 0);
2176 xsignal1 (Qinvalid_read_syntax
,
2177 Fmake_string (make_number (1), make_number (c
)));
2180 static ptrdiff_t read_buffer_size
;
2181 static char *read_buffer
;
2183 /* Read a \-escape sequence, assuming we already read the `\'.
2184 If the escape sequence forces unibyte, return eight-bit char. */
2187 read_escape (Lisp_Object readcharfun
, bool stringp
)
2190 /* \u allows up to four hex digits, \U up to eight. Default to the
2191 behavior for \u, and change this value in the case that \U is seen. */
2192 int unicode_hex_count
= 4;
2197 end_of_file_error ();
2227 error ("Invalid escape character syntax");
2230 c
= read_escape (readcharfun
, 0);
2231 return c
| meta_modifier
;
2236 error ("Invalid escape character syntax");
2239 c
= read_escape (readcharfun
, 0);
2240 return c
| shift_modifier
;
2245 error ("Invalid escape character syntax");
2248 c
= read_escape (readcharfun
, 0);
2249 return c
| hyper_modifier
;
2254 error ("Invalid escape character syntax");
2257 c
= read_escape (readcharfun
, 0);
2258 return c
| alt_modifier
;
2262 if (stringp
|| c
!= '-')
2269 c
= read_escape (readcharfun
, 0);
2270 return c
| super_modifier
;
2275 error ("Invalid escape character syntax");
2279 c
= read_escape (readcharfun
, 0);
2280 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2281 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2282 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2283 return c
| ctrl_modifier
;
2284 /* ASCII control chars are made from letters (both cases),
2285 as well as the non-letters within 0100...0137. */
2286 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2287 return (c
& (037 | ~0177));
2288 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2289 return (c
& (037 | ~0177));
2291 return c
| ctrl_modifier
;
2301 /* An octal escape, as in ANSI C. */
2303 register int i
= c
- '0';
2304 register int count
= 0;
2307 if ((c
= READCHAR
) >= '0' && c
<= '7')
2319 if (i
>= 0x80 && i
< 0x100)
2320 i
= BYTE8_TO_CHAR (i
);
2325 /* A hex escape, as in ANSI C. */
2332 if (c
>= '0' && c
<= '9')
2337 else if ((c
>= 'a' && c
<= 'f')
2338 || (c
>= 'A' && c
<= 'F'))
2341 if (c
>= 'a' && c
<= 'f')
2351 /* Allow hex escapes as large as ?\xfffffff, because some
2352 packages use them to denote characters with modifiers. */
2353 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2354 error ("Hex character out of range: \\x%x...", i
);
2358 if (count
< 3 && i
>= 0x80)
2359 return BYTE8_TO_CHAR (i
);
2364 /* Post-Unicode-2.0: Up to eight hex chars. */
2365 unicode_hex_count
= 8;
2368 /* A Unicode escape. We only permit them in strings and characters,
2369 not arbitrarily in the source code, as in some other languages. */
2374 while (++count
<= unicode_hex_count
)
2377 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2379 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2380 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2381 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2383 error ("Non-hex digit used for Unicode escape");
2386 error ("Non-Unicode character: 0x%x", i
);
2395 /* Return the digit that CHARACTER stands for in the given BASE.
2396 Return -1 if CHARACTER is out of range for BASE,
2397 and -2 if CHARACTER is not valid for any supported BASE. */
2399 digit_to_number (int character
, int base
)
2403 if ('0' <= character
&& character
<= '9')
2404 digit
= character
- '0';
2405 else if ('a' <= character
&& character
<= 'z')
2406 digit
= character
- 'a' + 10;
2407 else if ('A' <= character
&& character
<= 'Z')
2408 digit
= character
- 'A' + 10;
2412 return digit
< base
? digit
: -1;
2415 /* Read an integer in radix RADIX using READCHARFUN to read
2416 characters. RADIX must be in the interval [2..36]; if it isn't, a
2417 read error is signaled . Value is the integer read. Signals an
2418 error if encountering invalid read syntax or if RADIX is out of
2422 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2424 /* Room for sign, leading 0, other digits, trailing null byte.
2425 Also, room for invalid syntax diagnostic. */
2426 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2427 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2429 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2431 if (radix
< 2 || radix
> 36)
2439 if (c
== '-' || c
== '+')
2450 /* Ignore redundant leading zeros, so the buffer doesn't
2451 fill up with them. */
2457 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2464 if (p
< buf
+ sizeof buf
- 1)
2478 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2479 invalid_syntax (buf
);
2482 return string_to_number (buf
, radix
, 0);
2486 /* If the next token is ')' or ']' or '.', we store that character
2487 in *PCH and the return value is not interesting. Else, we store
2488 zero in *PCH and we read and return one lisp object.
2490 FIRST_IN_LIST is true if this is the first element of a list. */
2493 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2496 bool uninterned_symbol
= 0;
2503 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2505 end_of_file_error ();
2510 return read_list (0, readcharfun
);
2513 return read_vector (readcharfun
, 0);
2529 /* Accept extended format for hashtables (extensible to
2531 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2532 Lisp_Object tmp
= read_list (0, readcharfun
);
2533 Lisp_Object head
= CAR_SAFE (tmp
);
2534 Lisp_Object data
= Qnil
;
2535 Lisp_Object val
= Qnil
;
2536 /* The size is 2 * number of allowed keywords to
2538 Lisp_Object params
[10];
2540 Lisp_Object key
= Qnil
;
2541 int param_count
= 0;
2543 if (!EQ (head
, Qhash_table
))
2544 error ("Invalid extended read marker at head of #s list "
2545 "(only hash-table allowed)");
2547 tmp
= CDR_SAFE (tmp
);
2549 /* This is repetitive but fast and simple. */
2550 params
[param_count
] = QCsize
;
2551 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2552 if (!NILP (params
[param_count
+ 1]))
2555 params
[param_count
] = QCtest
;
2556 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2557 if (!NILP (params
[param_count
+ 1]))
2560 params
[param_count
] = QCweakness
;
2561 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2562 if (!NILP (params
[param_count
+ 1]))
2565 params
[param_count
] = QCrehash_size
;
2566 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2567 if (!NILP (params
[param_count
+ 1]))
2570 params
[param_count
] = QCrehash_threshold
;
2571 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2572 if (!NILP (params
[param_count
+ 1]))
2575 /* This is the hashtable data. */
2576 data
= Fplist_get (tmp
, Qdata
);
2578 /* Now use params to make a new hashtable and fill it. */
2579 ht
= Fmake_hash_table (param_count
, params
);
2581 while (CONSP (data
))
2586 error ("Odd number of elements in hashtable data");
2589 Fputhash (key
, val
, ht
);
2595 invalid_syntax ("#");
2603 tmp
= read_vector (readcharfun
, 0);
2604 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2605 error ("Invalid size char-table");
2606 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2614 /* Sub char-table can't be read as a regular
2615 vector because of a two C integer fields. */
2616 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2617 ptrdiff_t size
= XINT (Flength (tmp
));
2618 int i
, depth
, min_char
;
2619 struct Lisp_Cons
*cell
;
2622 error ("Zero-sized sub char-table");
2624 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2625 error ("Invalid depth in sub char-table");
2626 depth
= XINT (XCAR (tmp
));
2627 if (chartab_size
[depth
] != size
- 2)
2628 error ("Invalid size in sub char-table");
2629 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2632 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2633 error ("Invalid minimum character in sub-char-table");
2634 min_char
= XINT (XCAR (tmp
));
2635 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2638 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2639 for (i
= 0; i
< size
; i
++)
2641 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2642 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2647 invalid_syntax ("#^^");
2649 invalid_syntax ("#^");
2654 length
= read1 (readcharfun
, pch
, first_in_list
);
2658 Lisp_Object tmp
, val
;
2659 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2660 unsigned char *data
;
2663 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2664 if (STRING_MULTIBYTE (tmp
)
2665 || (size_in_chars
!= SCHARS (tmp
)
2666 /* We used to print 1 char too many
2667 when the number of bits was a multiple of 8.
2668 Accept such input in case it came from an old
2670 && ! (XFASTINT (length
)
2671 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2672 invalid_syntax ("#&...");
2674 val
= make_uninit_bool_vector (XFASTINT (length
));
2675 data
= bool_vector_uchar_data (val
);
2676 memcpy (data
, SDATA (tmp
), size_in_chars
);
2677 /* Clear the extraneous bits in the last byte. */
2678 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2679 data
[size_in_chars
- 1]
2680 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2683 invalid_syntax ("#&...");
2687 /* Accept compiled functions at read-time so that we don't have to
2688 build them using function calls. */
2690 struct Lisp_Vector
*vec
;
2691 tmp
= read_vector (readcharfun
, 1);
2692 vec
= XVECTOR (tmp
);
2693 if (vec
->header
.size
== 0)
2694 invalid_syntax ("Empty byte-code object");
2695 make_byte_code (vec
);
2701 struct gcpro gcpro1
;
2704 /* Read the string itself. */
2705 tmp
= read1 (readcharfun
, &ch
, 0);
2706 if (ch
!= 0 || !STRINGP (tmp
))
2707 invalid_syntax ("#");
2709 /* Read the intervals and their properties. */
2712 Lisp_Object beg
, end
, plist
;
2714 beg
= read1 (readcharfun
, &ch
, 0);
2719 end
= read1 (readcharfun
, &ch
, 0);
2721 plist
= read1 (readcharfun
, &ch
, 0);
2723 invalid_syntax ("Invalid string property list");
2724 Fset_text_properties (beg
, end
, plist
, tmp
);
2730 /* #@NUMBER is used to skip NUMBER following bytes.
2731 That's used in .elc files to skip over doc strings
2732 and function definitions. */
2735 enum { extra
= 100 };
2736 ptrdiff_t i
, nskip
= 0, digits
= 0;
2738 /* Read a decimal integer. */
2739 while ((c
= READCHAR
) >= 0
2740 && c
>= '0' && c
<= '9')
2742 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2747 if (digits
== 2 && nskip
== 0)
2748 { /* We've just seen #@00, which means "skip to end". */
2749 skip_dyn_eof (readcharfun
);
2754 /* We can't use UNREAD here, because in the code below we side-step
2755 READCHAR. Instead, assume the first char after #@NNN occupies
2756 a single byte, which is the case normally since it's just
2762 if (load_force_doc_strings
2763 && (FROM_FILE_P (readcharfun
)))
2765 /* If we are supposed to force doc strings into core right now,
2766 record the last string that we skipped,
2767 and record where in the file it comes from. */
2769 /* But first exchange saved_doc_string
2770 with prev_saved_doc_string, so we save two strings. */
2772 char *temp
= saved_doc_string
;
2773 ptrdiff_t temp_size
= saved_doc_string_size
;
2774 file_offset temp_pos
= saved_doc_string_position
;
2775 ptrdiff_t temp_len
= saved_doc_string_length
;
2777 saved_doc_string
= prev_saved_doc_string
;
2778 saved_doc_string_size
= prev_saved_doc_string_size
;
2779 saved_doc_string_position
= prev_saved_doc_string_position
;
2780 saved_doc_string_length
= prev_saved_doc_string_length
;
2782 prev_saved_doc_string
= temp
;
2783 prev_saved_doc_string_size
= temp_size
;
2784 prev_saved_doc_string_position
= temp_pos
;
2785 prev_saved_doc_string_length
= temp_len
;
2788 if (saved_doc_string_size
== 0)
2790 saved_doc_string
= xmalloc (nskip
+ extra
);
2791 saved_doc_string_size
= nskip
+ extra
;
2793 if (nskip
> saved_doc_string_size
)
2795 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2796 saved_doc_string_size
= nskip
+ extra
;
2799 saved_doc_string_position
= file_tell (instream
);
2801 /* Copy that many characters into saved_doc_string. */
2803 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2804 saved_doc_string
[i
] = c
= getc (instream
);
2807 saved_doc_string_length
= i
;
2810 /* Skip that many bytes. */
2811 skip_dyn_bytes (readcharfun
, nskip
);
2817 /* #! appears at the beginning of an executable file.
2818 Skip the first line. */
2819 while (c
!= '\n' && c
>= 0)
2824 return Vload_file_name
;
2826 return list2 (Qfunction
, read0 (readcharfun
));
2827 /* #:foo is the uninterned symbol named foo. */
2830 uninterned_symbol
= 1;
2833 && c
!= 0xa0 /* NBSP */
2835 || strchr ("\"';()[]#`,", c
) == NULL
)))
2837 /* No symbol character follows, this is the empty
2840 return Fmake_symbol (empty_unibyte_string
);
2844 /* ## is the empty symbol. */
2846 return Fintern (empty_unibyte_string
, Qnil
);
2847 /* Reader forms that can reuse previously read objects. */
2848 if (c
>= '0' && c
<= '9')
2853 /* Read a non-negative integer. */
2854 while (c
>= '0' && c
<= '9')
2856 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2857 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2858 n
= MOST_POSITIVE_FIXNUM
+ 1;
2860 n
= n
* 10 + c
- '0';
2864 if (n
<= MOST_POSITIVE_FIXNUM
)
2866 if (c
== 'r' || c
== 'R')
2867 return read_integer (readcharfun
, n
);
2869 if (! NILP (Vread_circle
))
2871 /* #n=object returns object, but associates it with
2875 /* Make a placeholder for #n# to use temporarily. */
2876 AUTO_CONS (placeholder
, Qnil
, Qnil
);
2877 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2878 read_objects
= Fcons (cell
, read_objects
);
2880 /* Read the object itself. */
2881 tem
= read0 (readcharfun
);
2883 /* Now put it everywhere the placeholder was... */
2884 substitute_object_in_subtree (tem
, placeholder
);
2886 /* ...and #n# will use the real value from now on. */
2887 Fsetcdr (cell
, tem
);
2892 /* #n# returns a previously read object. */
2895 tem
= Fassq (make_number (n
), read_objects
);
2901 /* Fall through to error message. */
2903 else if (c
== 'x' || c
== 'X')
2904 return read_integer (readcharfun
, 16);
2905 else if (c
== 'o' || c
== 'O')
2906 return read_integer (readcharfun
, 8);
2907 else if (c
== 'b' || c
== 'B')
2908 return read_integer (readcharfun
, 2);
2911 invalid_syntax ("#");
2914 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2918 return list2 (Qquote
, read0 (readcharfun
));
2922 int next_char
= READCHAR
;
2924 /* Transition from old-style to new-style:
2925 If we see "(`" it used to mean old-style, which usually works
2926 fine because ` should almost never appear in such a position
2927 for new-style. But occasionally we need "(`" to mean new
2928 style, so we try to distinguish the two by the fact that we
2929 can either write "( `foo" or "(` foo", where the first
2930 intends to use new-style whereas the second intends to use
2931 old-style. For Emacs-25, we should completely remove this
2932 first_in_list exception (old-style can still be obtained via
2934 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2936 Vold_style_backquotes
= Qt
;
2942 bool saved_new_backquote_flag
= new_backquote_flag
;
2944 new_backquote_flag
= 1;
2945 value
= read0 (readcharfun
);
2946 new_backquote_flag
= saved_new_backquote_flag
;
2948 return list2 (Qbackquote
, value
);
2953 int next_char
= READCHAR
;
2955 /* Transition from old-style to new-style:
2956 It used to be impossible to have a new-style , other than within
2957 a new-style `. This is sufficient when ` and , are used in the
2958 normal way, but ` and , can also appear in args to macros that
2959 will not interpret them in the usual way, in which case , may be
2960 used without any ` anywhere near.
2961 So we now use the same heuristic as for backquote: old-style
2962 unquotes are only recognized when first on a list, and when
2963 followed by a space.
2964 Because it's more difficult to peek 2 chars ahead, a new-style
2965 ,@ can still not be used outside of a `, unless it's in the middle
2967 if (new_backquote_flag
2969 || (next_char
!= ' ' && next_char
!= '@'))
2971 Lisp_Object comma_type
= Qnil
;
2976 comma_type
= Qcomma_at
;
2978 comma_type
= Qcomma_dot
;
2981 if (ch
>= 0) UNREAD (ch
);
2982 comma_type
= Qcomma
;
2985 value
= read0 (readcharfun
);
2986 return list2 (comma_type
, value
);
2990 Vold_style_backquotes
= Qt
;
3002 end_of_file_error ();
3004 /* Accept `single space' syntax like (list ? x) where the
3005 whitespace character is SPC or TAB.
3006 Other literal whitespace like NL, CR, and FF are not accepted,
3007 as there are well-established escape sequences for these. */
3008 if (c
== ' ' || c
== '\t')
3009 return make_number (c
);
3012 c
= read_escape (readcharfun
, 0);
3013 modifiers
= c
& CHAR_MODIFIER_MASK
;
3014 c
&= ~CHAR_MODIFIER_MASK
;
3015 if (CHAR_BYTE8_P (c
))
3016 c
= CHAR_TO_BYTE8 (c
);
3019 next_char
= READCHAR
;
3020 ok
= (next_char
<= 040
3021 || (next_char
< 0200
3022 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3025 return make_number (c
);
3027 invalid_syntax ("?");
3032 char *p
= read_buffer
;
3033 char *end
= read_buffer
+ read_buffer_size
;
3035 /* True if we saw an escape sequence specifying
3036 a multibyte character. */
3037 bool force_multibyte
= 0;
3038 /* True if we saw an escape sequence specifying
3039 a single-byte character. */
3040 bool force_singlebyte
= 0;
3042 ptrdiff_t nchars
= 0;
3044 while ((ch
= READCHAR
) >= 0
3047 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3049 ptrdiff_t offset
= p
- read_buffer
;
3050 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3051 memory_full (SIZE_MAX
);
3052 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3053 read_buffer_size
*= 2;
3054 p
= read_buffer
+ offset
;
3055 end
= read_buffer
+ read_buffer_size
;
3062 ch
= read_escape (readcharfun
, 1);
3064 /* CH is -1 if \ newline has just been seen. */
3067 if (p
== read_buffer
)
3072 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3073 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3075 if (CHAR_BYTE8_P (ch
))
3076 force_singlebyte
= 1;
3077 else if (! ASCII_CHAR_P (ch
))
3078 force_multibyte
= 1;
3079 else /* I.e. ASCII_CHAR_P (ch). */
3081 /* Allow `\C- ' and `\C-?'. */
3082 if (modifiers
== CHAR_CTL
)
3085 ch
= 0, modifiers
= 0;
3087 ch
= 127, modifiers
= 0;
3089 if (modifiers
& CHAR_SHIFT
)
3091 /* Shift modifier is valid only with [A-Za-z]. */
3092 if (ch
>= 'A' && ch
<= 'Z')
3093 modifiers
&= ~CHAR_SHIFT
;
3094 else if (ch
>= 'a' && ch
<= 'z')
3095 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3098 if (modifiers
& CHAR_META
)
3100 /* Move the meta bit to the right place for a
3102 modifiers
&= ~CHAR_META
;
3103 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3104 force_singlebyte
= 1;
3108 /* Any modifiers remaining are invalid. */
3110 error ("Invalid modifier in string");
3111 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3115 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3116 if (CHAR_BYTE8_P (ch
))
3117 force_singlebyte
= 1;
3118 else if (! ASCII_CHAR_P (ch
))
3119 force_multibyte
= 1;
3125 end_of_file_error ();
3127 /* If purifying, and string starts with \ newline,
3128 return zero instead. This is for doc strings
3129 that we are really going to find in etc/DOC.nn.nn. */
3130 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3131 return make_number (0);
3133 if (! force_multibyte
&& force_singlebyte
)
3135 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3136 forms. Convert it to unibyte. */
3137 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3139 p
= read_buffer
+ nchars
;
3142 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3144 || (p
- read_buffer
!= nchars
)));
3149 int next_char
= READCHAR
;
3152 if (next_char
<= 040
3153 || (next_char
< 0200
3154 && strchr ("\"';([#?`,", next_char
) != NULL
))
3160 /* Otherwise, we fall through! Note that the atom-reading loop
3161 below will now loop at least once, assuring that we will not
3162 try to UNREAD two characters in a row. */
3166 if (c
<= 040) goto retry
;
3167 if (c
== 0xa0) /* NBSP */
3172 char *p
= read_buffer
;
3174 EMACS_INT start_position
= readchar_count
- 1;
3177 char *end
= read_buffer
+ read_buffer_size
;
3181 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3183 ptrdiff_t offset
= p
- read_buffer
;
3184 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3185 memory_full (SIZE_MAX
);
3186 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3187 read_buffer_size
*= 2;
3188 p
= read_buffer
+ offset
;
3189 end
= read_buffer
+ read_buffer_size
;
3196 end_of_file_error ();
3201 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3207 && c
!= 0xa0 /* NBSP */
3209 || strchr ("\"';()[]#`,", c
) == NULL
));
3213 ptrdiff_t offset
= p
- read_buffer
;
3214 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3215 memory_full (SIZE_MAX
);
3216 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3217 read_buffer_size
*= 2;
3218 p
= read_buffer
+ offset
;
3219 end
= read_buffer
+ read_buffer_size
;
3225 if (!quoted
&& !uninterned_symbol
)
3227 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3228 if (! NILP (result
))
3232 Lisp_Object name
, result
;
3233 ptrdiff_t nbytes
= p
- read_buffer
;
3236 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3240 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3241 ? make_pure_string
: make_specified_string
)
3242 (read_buffer
, nchars
, nbytes
, multibyte
));
3243 result
= (uninterned_symbol
? Fmake_symbol (name
)
3244 : Fintern (name
, Qnil
));
3246 if (EQ (Vread_with_symbol_positions
, Qt
)
3247 || EQ (Vread_with_symbol_positions
, readcharfun
))
3248 Vread_symbol_positions_list
3249 = Fcons (Fcons (result
, make_number (start_position
)),
3250 Vread_symbol_positions_list
);
3258 /* List of nodes we've seen during substitute_object_in_subtree. */
3259 static Lisp_Object seen_list
;
3262 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3264 Lisp_Object check_object
;
3266 /* We haven't seen any objects when we start. */
3269 /* Make all the substitutions. */
3271 = substitute_object_recurse (object
, placeholder
, object
);
3273 /* Clear seen_list because we're done with it. */
3276 /* The returned object here is expected to always eq the
3278 if (!EQ (check_object
, object
))
3279 error ("Unexpected mutation error in reader");
3282 /* Feval doesn't get called from here, so no gc protection is needed. */
3283 #define SUBSTITUTE(get_val, set_val) \
3285 Lisp_Object old_value = get_val; \
3286 Lisp_Object true_value \
3287 = substitute_object_recurse (object, placeholder, \
3290 if (!EQ (old_value, true_value)) \
3297 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3299 /* If we find the placeholder, return the target object. */
3300 if (EQ (placeholder
, subtree
))
3303 /* If we've been to this node before, don't explore it again. */
3304 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3307 /* If this node can be the entry point to a cycle, remember that
3308 we've seen it. It can only be such an entry point if it was made
3309 by #n=, which means that we can find it as a value in
3311 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3312 seen_list
= Fcons (subtree
, seen_list
);
3314 /* Recurse according to subtree's type.
3315 Every branch must return a Lisp_Object. */
3316 switch (XTYPE (subtree
))
3318 case Lisp_Vectorlike
:
3320 ptrdiff_t i
, length
= 0;
3321 if (BOOL_VECTOR_P (subtree
))
3322 return subtree
; /* No sub-objects anyway. */
3323 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3324 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3325 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3326 else if (VECTORP (subtree
))
3327 length
= ASIZE (subtree
);
3329 /* An unknown pseudovector may contain non-Lisp fields, so we
3330 can't just blindly traverse all its fields. We used to call
3331 `Flength' which signaled `sequencep', so I just preserved this
3333 wrong_type_argument (Qsequencep
, subtree
);
3335 for (i
= 0; i
< length
; i
++)
3336 SUBSTITUTE (AREF (subtree
, i
),
3337 ASET (subtree
, i
, true_value
));
3343 SUBSTITUTE (XCAR (subtree
),
3344 XSETCAR (subtree
, true_value
));
3345 SUBSTITUTE (XCDR (subtree
),
3346 XSETCDR (subtree
, true_value
));
3352 /* Check for text properties in each interval.
3353 substitute_in_interval contains part of the logic. */
3355 INTERVAL root_interval
= string_intervals (subtree
);
3356 AUTO_CONS (arg
, object
, placeholder
);
3358 traverse_intervals_noorder (root_interval
,
3359 &substitute_in_interval
, arg
);
3364 /* Other types don't recurse any further. */
3370 /* Helper function for substitute_object_recurse. */
3372 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3374 Lisp_Object object
= Fcar (arg
);
3375 Lisp_Object placeholder
= Fcdr (arg
);
3377 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3387 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3388 integer syntax and fits in a fixnum, else return the nearest float if CP has
3389 either floating point or integer syntax and BASE is 10, else return nil. If
3390 IGNORE_TRAILING, consider just the longest prefix of CP that has
3391 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3392 number has integer syntax but does not fit. */
3395 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3398 char const *cp
= string
;
3400 bool float_syntax
= 0;
3403 /* Compute NaN and infinities using a variable, to cope with compilers that
3404 think they are smarter than we are. */
3407 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3408 IEEE floating point hosts, and works around a formerly-common bug where
3409 atof ("-0.0") drops the sign. */
3410 bool negative
= *cp
== '-';
3412 bool signedp
= negative
|| *cp
== '+';
3417 leading_digit
= digit_to_number (*cp
, base
);
3418 if (leading_digit
>= 0)
3423 while (digit_to_number (*cp
, base
) >= 0);
3433 if ('0' <= *cp
&& *cp
<= '9')
3438 while ('0' <= *cp
&& *cp
<= '9');
3440 if (*cp
== 'e' || *cp
== 'E')
3442 char const *ecp
= cp
;
3444 if (*cp
== '+' || *cp
== '-')
3446 if ('0' <= *cp
&& *cp
<= '9')
3451 while ('0' <= *cp
&& *cp
<= '9');
3453 else if (cp
[-1] == '+'
3454 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3460 else if (cp
[-1] == '+'
3461 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3465 value
= zero
/ zero
;
3467 /* If that made a "negative" NaN, negate it. */
3470 union { double d
; char c
[sizeof (double)]; }
3471 u_data
, u_minus_zero
;
3473 u_minus_zero
.d
= -0.0;
3474 for (i
= 0; i
< sizeof (double); i
++)
3475 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3481 /* Now VALUE is a positive NaN. */
3487 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3488 || state
== (LEAD_INT
|E_EXP
));
3491 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3492 any prefix that matches. Otherwise, the entire string must match. */
3493 if (! (ignore_trailing
3494 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3495 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3498 /* If the number uses integer and not float syntax, and is in C-language
3499 range, use its value, preferably as a fixnum. */
3500 if (leading_digit
>= 0 && ! float_syntax
)
3504 /* Fast special case for single-digit integers. This also avoids a
3505 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3506 case some versions of strtoumax accept numbers like "0x1" that Emacs
3508 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3509 return make_number (negative
? -leading_digit
: leading_digit
);
3512 n
= strtoumax (string
+ signedp
, NULL
, base
);
3513 if (errno
== ERANGE
)
3515 /* Unfortunately there's no simple and accurate way to convert
3516 non-base-10 numbers that are out of C-language range. */
3518 xsignal1 (Qoverflow_error
, build_string (string
));
3520 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3522 EMACS_INT signed_n
= n
;
3523 return make_number (negative
? -signed_n
: signed_n
);
3529 /* Either the number uses float syntax, or it does not fit into a fixnum.
3530 Convert it from string to floating point, unless the value is already
3531 known because it is an infinity, a NAN, or its absolute value fits in
3534 value
= atof (string
+ signedp
);
3536 return make_float (negative
? -value
: value
);
3541 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3545 Lisp_Object tem
, item
, vector
;
3546 struct Lisp_Cons
*otem
;
3549 tem
= read_list (1, readcharfun
);
3550 len
= Flength (tem
);
3551 vector
= Fmake_vector (len
, Qnil
);
3553 size
= ASIZE (vector
);
3554 ptr
= XVECTOR (vector
)->contents
;
3555 for (i
= 0; i
< size
; i
++)
3558 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3559 bytecode object, the docstring containing the bytecode and
3560 constants values must be treated as unibyte and passed to
3561 Fread, to get the actual bytecode string and constants vector. */
3562 if (bytecodeflag
&& load_force_doc_strings
)
3564 if (i
== COMPILED_BYTECODE
)
3566 if (!STRINGP (item
))
3567 error ("Invalid byte code");
3569 /* Delay handling the bytecode slot until we know whether
3570 it is lazily-loaded (we can tell by whether the
3571 constants slot is nil). */
3572 ASET (vector
, COMPILED_CONSTANTS
, item
);
3575 else if (i
== COMPILED_CONSTANTS
)
3577 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3581 /* Coerce string to unibyte (like string-as-unibyte,
3582 but without generating extra garbage and
3583 guaranteeing no change in the contents). */
3584 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3585 STRING_SET_UNIBYTE (bytestr
);
3587 item
= Fread (Fcons (bytestr
, readcharfun
));
3589 error ("Invalid byte code");
3591 otem
= XCONS (item
);
3592 bytestr
= XCAR (item
);
3597 /* Now handle the bytecode slot. */
3598 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3600 else if (i
== COMPILED_DOC_STRING
3602 && ! STRING_MULTIBYTE (item
))
3604 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3605 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3607 item
= Fstring_as_multibyte (item
);
3610 ASET (vector
, i
, item
);
3618 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3621 read_list (bool flag
, Lisp_Object readcharfun
)
3623 Lisp_Object val
, tail
;
3624 Lisp_Object elt
, tem
;
3625 struct gcpro gcpro1
, gcpro2
;
3626 /* 0 is the normal case.
3627 1 means this list is a doc reference; replace it with the number 0.
3628 2 means this list is a doc reference; replace it with the doc string. */
3629 int doc_reference
= 0;
3631 /* Initialize this to 1 if we are reading a list. */
3632 bool first_in_list
= flag
<= 0;
3641 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3646 /* While building, if the list starts with #$, treat it specially. */
3647 if (EQ (elt
, Vload_file_name
)
3649 && !NILP (Vpurify_flag
))
3651 if (NILP (Vdoc_file_name
))
3652 /* We have not yet called Snarf-documentation, so assume
3653 this file is described in the DOC file
3654 and Snarf-documentation will fill in the right value later.
3655 For now, replace the whole list with 0. */
3658 /* We have already called Snarf-documentation, so make a relative
3659 file name for this file, so it can be found properly
3660 in the installed Lisp directory.
3661 We don't use Fexpand_file_name because that would make
3662 the directory absolute now. */
3664 AUTO_STRING (dotdotlisp
, "../lisp/");
3665 elt
= concat2 (dotdotlisp
, Ffile_name_nondirectory (elt
));
3668 else if (EQ (elt
, Vload_file_name
)
3670 && load_force_doc_strings
)
3679 invalid_syntax (") or . in a vector");
3687 XSETCDR (tail
, read0 (readcharfun
));
3689 val
= read0 (readcharfun
);
3690 read1 (readcharfun
, &ch
, 0);
3694 if (doc_reference
== 1)
3695 return make_number (0);
3696 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3699 file_offset saved_position
;
3700 /* Get a doc string from the file we are loading.
3701 If it's in saved_doc_string, get it from there.
3703 Here, we don't know if the string is a
3704 bytecode string or a doc string. As a
3705 bytecode string must be unibyte, we always
3706 return a unibyte string. If it is actually a
3707 doc string, caller must make it
3710 /* Position is negative for user variables. */
3711 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3712 if (pos
>= saved_doc_string_position
3713 && pos
< (saved_doc_string_position
3714 + saved_doc_string_length
))
3716 saved
= saved_doc_string
;
3717 saved_position
= saved_doc_string_position
;
3719 /* Look in prev_saved_doc_string the same way. */
3720 else if (pos
>= prev_saved_doc_string_position
3721 && pos
< (prev_saved_doc_string_position
3722 + prev_saved_doc_string_length
))
3724 saved
= prev_saved_doc_string
;
3725 saved_position
= prev_saved_doc_string_position
;
3729 ptrdiff_t start
= pos
- saved_position
;
3732 /* Process quoting with ^A,
3733 and find the end of the string,
3734 which is marked with ^_ (037). */
3735 for (from
= start
, to
= start
;
3736 saved
[from
] != 037;)
3738 int c
= saved
[from
++];
3742 saved
[to
++] = (c
== 1 ? c
3751 return make_unibyte_string (saved
+ start
,
3755 return get_doc_string (val
, 1, 0);
3760 invalid_syntax (". in wrong context");
3762 invalid_syntax ("] in a list");
3766 XSETCDR (tail
, tem
);
3773 static Lisp_Object initial_obarray
;
3775 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3777 static size_t oblookup_last_bucket_number
;
3779 /* Get an error if OBARRAY is not an obarray.
3780 If it is one, return it. */
3783 check_obarray (Lisp_Object obarray
)
3785 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3787 /* If Vobarray is now invalid, force it to be valid. */
3788 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3789 wrong_type_argument (Qvectorp
, obarray
);
3794 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3797 intern_driver (Lisp_Object string
, Lisp_Object obarray
, ptrdiff_t index
)
3799 Lisp_Object
*ptr
, sym
= Fmake_symbol (string
);
3801 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3802 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3805 if ((SREF (string
, 0) == ':') && EQ (obarray
, initial_obarray
))
3807 XSYMBOL (sym
)->constant
= 1;
3808 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3809 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3812 ptr
= aref_addr (obarray
, index
);
3813 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3818 /* Intern the C string STR: return a symbol with that name,
3819 interned in the current obarray. */
3822 intern_1 (const char *str
, ptrdiff_t len
)
3824 Lisp_Object obarray
= check_obarray (Vobarray
);
3825 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3827 return SYMBOLP (tem
) ? tem
: intern_driver (make_string (str
, len
),
3828 obarray
, XINT (tem
));
3832 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3834 Lisp_Object obarray
= check_obarray (Vobarray
);
3835 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3839 /* Creating a non-pure string from a string literal not implemented yet.
3840 We could just use make_string here and live with the extra copy. */
3841 eassert (!NILP (Vpurify_flag
));
3842 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, XINT (tem
));
3847 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3848 doc
: /* Return the canonical symbol whose name is STRING.
3849 If there is none, one is created by this function and returned.
3850 A second optional argument specifies the obarray to use;
3851 it defaults to the value of `obarray'. */)
3852 (Lisp_Object string
, Lisp_Object obarray
)
3856 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3857 CHECK_STRING (string
);
3859 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3861 tem
= intern_driver (NILP (Vpurify_flag
) ? string
3862 : Fpurecopy (string
), obarray
, XINT (tem
));
3866 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3867 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3868 NAME may be a string or a symbol. If it is a symbol, that exact
3869 symbol is searched for.
3870 A second optional argument specifies the obarray to use;
3871 it defaults to the value of `obarray'. */)
3872 (Lisp_Object name
, Lisp_Object obarray
)
3874 register Lisp_Object tem
, string
;
3876 if (NILP (obarray
)) obarray
= Vobarray
;
3877 obarray
= check_obarray (obarray
);
3879 if (!SYMBOLP (name
))
3881 CHECK_STRING (name
);
3885 string
= SYMBOL_NAME (name
);
3887 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3888 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3894 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3895 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3896 The value is t if a symbol was found and deleted, nil otherwise.
3897 NAME may be a string or a symbol. If it is a symbol, that symbol
3898 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3899 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3900 usage: (unintern NAME OBARRAY) */)
3901 (Lisp_Object name
, Lisp_Object obarray
)
3903 register Lisp_Object string
, tem
;
3906 if (NILP (obarray
)) obarray
= Vobarray
;
3907 obarray
= check_obarray (obarray
);
3910 string
= SYMBOL_NAME (name
);
3913 CHECK_STRING (name
);
3917 tem
= oblookup (obarray
, SSDATA (string
),
3922 /* If arg was a symbol, don't delete anything but that symbol itself. */
3923 if (SYMBOLP (name
) && !EQ (name
, tem
))
3926 /* There are plenty of other symbols which will screw up the Emacs
3927 session if we unintern them, as well as even more ways to use
3928 `setq' or `fset' or whatnot to make the Emacs session
3929 unusable. Let's not go down this silly road. --Stef */
3930 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3931 error ("Attempt to unintern t or nil"); */
3933 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3935 hash
= oblookup_last_bucket_number
;
3937 if (EQ (AREF (obarray
, hash
), tem
))
3939 if (XSYMBOL (tem
)->next
)
3942 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3943 ASET (obarray
, hash
, sym
);
3946 ASET (obarray
, hash
, make_number (0));
3950 Lisp_Object tail
, following
;
3952 for (tail
= AREF (obarray
, hash
);
3953 XSYMBOL (tail
)->next
;
3956 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3957 if (EQ (following
, tem
))
3959 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3968 /* Return the symbol in OBARRAY whose names matches the string
3969 of SIZE characters (SIZE_BYTE bytes) at PTR.
3970 If there is no such symbol, return the integer bucket number of
3971 where the symbol would be if it were present.
3973 Also store the bucket number in oblookup_last_bucket_number. */
3976 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3980 register Lisp_Object tail
;
3981 Lisp_Object bucket
, tem
;
3983 obarray
= check_obarray (obarray
);
3984 obsize
= ASIZE (obarray
);
3986 /* This is sometimes needed in the middle of GC. */
3987 obsize
&= ~ARRAY_MARK_FLAG
;
3988 hash
= hash_string (ptr
, size_byte
) % obsize
;
3989 bucket
= AREF (obarray
, hash
);
3990 oblookup_last_bucket_number
= hash
;
3991 if (EQ (bucket
, make_number (0)))
3993 else if (!SYMBOLP (bucket
))
3994 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3996 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3998 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3999 && SCHARS (SYMBOL_NAME (tail
)) == size
4000 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
4002 else if (XSYMBOL (tail
)->next
== 0)
4005 XSETINT (tem
, hash
);
4010 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
4013 register Lisp_Object tail
;
4014 CHECK_VECTOR (obarray
);
4015 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
4017 tail
= AREF (obarray
, i
);
4022 if (XSYMBOL (tail
)->next
== 0)
4024 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4030 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4032 call1 (function
, sym
);
4035 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4036 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4037 OBARRAY defaults to the value of `obarray'. */)
4038 (Lisp_Object function
, Lisp_Object obarray
)
4040 if (NILP (obarray
)) obarray
= Vobarray
;
4041 obarray
= check_obarray (obarray
);
4043 map_obarray (obarray
, mapatoms_1
, function
);
4047 #define OBARRAY_SIZE 1511
4052 Lisp_Object oblength
;
4053 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4055 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4057 Vobarray
= Fmake_vector (oblength
, make_number (0));
4058 initial_obarray
= Vobarray
;
4059 staticpro (&initial_obarray
);
4061 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
4062 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
4063 NILP (Vpurify_flag) check in intern_c_string. */
4064 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
4065 Qnil
= intern_c_string ("nil");
4067 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
4068 so those two need to be fixed manually. */
4069 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
4070 set_symbol_function (Qunbound
, Qnil
);
4071 set_symbol_plist (Qunbound
, Qnil
);
4072 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4073 XSYMBOL (Qnil
)->constant
= 1;
4074 XSYMBOL (Qnil
)->declared_special
= 1;
4075 set_symbol_plist (Qnil
, Qnil
);
4076 set_symbol_function (Qnil
, Qnil
);
4078 Qt
= intern_c_string ("t");
4079 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4080 XSYMBOL (Qnil
)->declared_special
= 1;
4081 XSYMBOL (Qt
)->constant
= 1;
4083 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4086 DEFSYM (Qvariable_documentation
, "variable-documentation");
4088 read_buffer
= xmalloc (size
);
4089 read_buffer_size
= size
;
4093 defsubr (struct Lisp_Subr
*sname
)
4095 Lisp_Object sym
, tem
;
4096 sym
= intern_c_string (sname
->symbol_name
);
4097 XSETPVECTYPE (sname
, PVEC_SUBR
);
4098 XSETSUBR (tem
, sname
);
4099 set_symbol_function (sym
, tem
);
4102 #ifdef NOTDEF /* Use fset in subr.el now! */
4104 defalias (struct Lisp_Subr
*sname
, char *string
)
4107 sym
= intern (string
);
4108 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4112 /* Define an "integer variable"; a symbol whose value is forwarded to a
4113 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4114 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4116 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4117 const char *namestring
, EMACS_INT
*address
)
4120 sym
= intern_c_string (namestring
);
4121 i_fwd
->type
= Lisp_Fwd_Int
;
4122 i_fwd
->intvar
= address
;
4123 XSYMBOL (sym
)->declared_special
= 1;
4124 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4125 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4128 /* Similar but define a variable whose value is t if address contains 1,
4129 nil if address contains 0. */
4131 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4132 const char *namestring
, bool *address
)
4135 sym
= intern_c_string (namestring
);
4136 b_fwd
->type
= Lisp_Fwd_Bool
;
4137 b_fwd
->boolvar
= address
;
4138 XSYMBOL (sym
)->declared_special
= 1;
4139 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4140 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4141 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4144 /* Similar but define a variable whose value is the Lisp Object stored
4145 at address. Two versions: with and without gc-marking of the C
4146 variable. The nopro version is used when that variable will be
4147 gc-marked for some other reason, since marking the same slot twice
4148 can cause trouble with strings. */
4150 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4151 const char *namestring
, Lisp_Object
*address
)
4154 sym
= intern_c_string (namestring
);
4155 o_fwd
->type
= Lisp_Fwd_Obj
;
4156 o_fwd
->objvar
= address
;
4157 XSYMBOL (sym
)->declared_special
= 1;
4158 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4159 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4163 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4164 const char *namestring
, Lisp_Object
*address
)
4166 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4167 staticpro (address
);
4170 /* Similar but define a variable whose value is the Lisp Object stored
4171 at a particular offset in the current kboard object. */
4174 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4175 const char *namestring
, int offset
)
4178 sym
= intern_c_string (namestring
);
4179 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4180 ko_fwd
->offset
= offset
;
4181 XSYMBOL (sym
)->declared_special
= 1;
4182 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4183 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4186 /* Check that the elements of lpath exist. */
4189 load_path_check (Lisp_Object lpath
)
4191 Lisp_Object path_tail
;
4193 /* The only elements that might not exist are those from
4194 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4196 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4198 Lisp_Object dirfile
;
4199 dirfile
= Fcar (path_tail
);
4200 if (STRINGP (dirfile
))
4202 dirfile
= Fdirectory_file_name (dirfile
);
4203 if (! file_accessible_directory_p (dirfile
))
4204 dir_warning ("Lisp directory", XCAR (path_tail
));
4209 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4210 This does not include the standard site-lisp directories
4211 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4212 but it does (unless no_site_lisp is set) include site-lisp
4213 directories in the source/build directories if those exist and we
4214 are running uninstalled.
4216 Uses the following logic:
4217 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4218 The remainder is what happens when dumping works:
4219 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4220 Otherwise use PATH_LOADSEARCH.
4222 If !initialized, then just return PATH_DUMPLOADSEARCH.
4224 If Vinstallation_directory is not nil (ie, running uninstalled):
4225 If installation-dir/lisp exists and not already a member,
4226 we must be running uninstalled. Reset the load-path
4227 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4228 refers to the eventual installation directories. Since we
4229 are not yet installed, we should not use them, even if they exist.)
4230 If installation-dir/lisp does not exist, just add
4231 PATH_DUMPLOADSEARCH at the end instead.
4232 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4233 and not already a member) at the front.
4234 If installation-dir != source-dir (ie running an uninstalled,
4235 out-of-tree build) AND install-dir/src/Makefile exists BUT
4236 install-dir/src/Makefile.in does NOT exist (this is a sanity
4237 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4240 load_path_default (void)
4242 Lisp_Object lpath
= Qnil
;
4247 const char *loadpath
= ns_load_path ();
4250 normal
= PATH_LOADSEARCH
;
4252 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4254 lpath
= decode_env_path (0, normal
, 0);
4257 #else /* !CANNOT_DUMP */
4259 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4264 const char *loadpath
= ns_load_path ();
4265 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4267 lpath
= decode_env_path (0, normal
, 0);
4269 if (!NILP (Vinstallation_directory
))
4271 Lisp_Object tem
, tem1
;
4273 /* Add to the path the lisp subdir of the installation
4274 dir, if it is accessible. Note: in out-of-tree builds,
4275 this directory is empty save for Makefile. */
4276 tem
= Fexpand_file_name (build_string ("lisp"),
4277 Vinstallation_directory
);
4278 tem1
= Ffile_accessible_directory_p (tem
);
4281 if (NILP (Fmember (tem
, lpath
)))
4283 /* We are running uninstalled. The default load-path
4284 points to the eventual installed lisp directories.
4285 We should not use those now, even if they exist,
4286 so start over from a clean slate. */
4287 lpath
= list1 (tem
);
4291 /* That dir doesn't exist, so add the build-time
4292 Lisp dirs instead. */
4294 Lisp_Object dump_path
=
4295 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4296 lpath
= nconc2 (lpath
, dump_path
);
4299 /* Add site-lisp under the installation dir, if it exists. */
4302 tem
= Fexpand_file_name (build_string ("site-lisp"),
4303 Vinstallation_directory
);
4304 tem1
= Ffile_accessible_directory_p (tem
);
4307 if (NILP (Fmember (tem
, lpath
)))
4308 lpath
= Fcons (tem
, lpath
);
4312 /* If Emacs was not built in the source directory,
4313 and it is run from where it was built, add to load-path
4314 the lisp and site-lisp dirs under that directory. */
4316 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4320 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4321 Vinstallation_directory
);
4322 tem1
= Ffile_exists_p (tem
);
4324 /* Don't be fooled if they moved the entire source tree
4325 AFTER dumping Emacs. If the build directory is indeed
4326 different from the source dir, src/Makefile.in and
4327 src/Makefile will not be found together. */
4328 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4329 Vinstallation_directory
);
4330 tem2
= Ffile_exists_p (tem
);
4331 if (!NILP (tem1
) && NILP (tem2
))
4333 tem
= Fexpand_file_name (build_string ("lisp"),
4336 if (NILP (Fmember (tem
, lpath
)))
4337 lpath
= Fcons (tem
, lpath
);
4341 tem
= Fexpand_file_name (build_string ("site-lisp"),
4343 tem1
= Ffile_accessible_directory_p (tem
);
4346 if (NILP (Fmember (tem
, lpath
)))
4347 lpath
= Fcons (tem
, lpath
);
4351 } /* Vinstallation_directory != Vsource_directory */
4353 } /* if Vinstallation_directory */
4355 else /* !initialized */
4357 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4358 source directory. We used to add ../lisp (ie the lisp dir in
4359 the build directory) at the front here, but that should not
4360 be necessary, since in out of tree builds lisp/ is empty, save
4362 lpath
= decode_env_path (0, normal
, 0);
4364 #endif /* !CANNOT_DUMP */
4372 /* First, set Vload_path. */
4374 /* Ignore EMACSLOADPATH when dumping. */
4376 bool use_loadpath
= true;
4378 bool use_loadpath
= NILP (Vpurify_flag
);
4381 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4383 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4385 /* Check (non-nil) user-supplied elements. */
4386 load_path_check (Vload_path
);
4388 /* If no nils in the environment variable, use as-is.
4389 Otherwise, replace any nils with the default. */
4390 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4392 Lisp_Object elem
, elpath
= Vload_path
;
4393 Lisp_Object default_lpath
= load_path_default ();
4395 /* Check defaults, before adding site-lisp. */
4396 load_path_check (default_lpath
);
4398 /* Add the site-lisp directories to the front of the default. */
4401 Lisp_Object sitelisp
;
4402 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4403 if (! NILP (sitelisp
))
4404 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4409 /* Replace nils from EMACSLOADPATH by default. */
4410 while (CONSP (elpath
))
4413 elem
= XCAR (elpath
);
4414 elpath
= XCDR (elpath
);
4415 arg
[0] = Vload_path
;
4416 arg
[1] = NILP (elem
) ? default_lpath
: Fcons (elem
, Qnil
);
4417 Vload_path
= Fappend (2, arg
);
4419 } /* Fmemq (Qnil, Vload_path) */
4423 Vload_path
= load_path_default ();
4425 /* Check before adding site-lisp directories.
4426 The install should have created them, but they are not
4427 required, so no need to warn if they are absent.
4428 Or we might be running before installation. */
4429 load_path_check (Vload_path
);
4431 /* Add the site-lisp directories at the front. */
4432 if (initialized
&& !no_site_lisp
)
4434 Lisp_Object sitelisp
;
4435 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4436 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4442 load_in_progress
= 0;
4443 Vload_file_name
= Qnil
;
4444 Vstandard_input
= Qt
;
4445 Vloads_in_progress
= Qnil
;
4448 /* Print a warning that directory intended for use USE and with name
4449 DIRNAME cannot be accessed. On entry, errno should correspond to
4450 the access failure. Print the warning on stderr and put it in
4454 dir_warning (char const *use
, Lisp_Object dirname
)
4456 static char const format
[] = "Warning: %s `%s': %s\n";
4457 int access_errno
= errno
;
4458 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4460 /* Don't log the warning before we've initialized!! */
4463 char const *diagnostic
= emacs_strerror (access_errno
);
4465 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4466 + strlen (use
) + SBYTES (dirname
)
4467 + strlen (diagnostic
));
4468 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4470 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4476 syms_of_lread (void)
4479 defsubr (&Sread_from_string
);
4481 defsubr (&Sintern_soft
);
4482 defsubr (&Sunintern
);
4483 defsubr (&Sget_load_suffixes
);
4485 defsubr (&Seval_buffer
);
4486 defsubr (&Seval_region
);
4487 defsubr (&Sread_char
);
4488 defsubr (&Sread_char_exclusive
);
4489 defsubr (&Sread_event
);
4490 defsubr (&Sget_file_char
);
4491 defsubr (&Smapatoms
);
4492 defsubr (&Slocate_file_internal
);
4494 DEFVAR_LISP ("obarray", Vobarray
,
4495 doc
: /* Symbol table for use by `intern' and `read'.
4496 It is a vector whose length ought to be prime for best results.
4497 The vector's contents don't make sense if examined from Lisp programs;
4498 to find all the symbols in an obarray, use `mapatoms'. */);
4500 DEFVAR_LISP ("values", Vvalues
,
4501 doc
: /* List of values of all expressions which were read, evaluated and printed.
4502 Order is reverse chronological. */);
4503 XSYMBOL (intern ("values"))->declared_special
= 0;
4505 DEFVAR_LISP ("standard-input", Vstandard_input
,
4506 doc
: /* Stream for read to get input from.
4507 See documentation of `read' for possible values. */);
4508 Vstandard_input
= Qt
;
4510 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4511 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4513 If this variable is a buffer, then only forms read from that buffer
4514 will be added to `read-symbol-positions-list'.
4515 If this variable is t, then all read forms will be added.
4516 The effect of all other values other than nil are not currently
4517 defined, although they may be in the future.
4519 The positions are relative to the last call to `read' or
4520 `read-from-string'. It is probably a bad idea to set this variable at
4521 the toplevel; bind it instead. */);
4522 Vread_with_symbol_positions
= Qnil
;
4524 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4525 doc
: /* A list mapping read symbols to their positions.
4526 This variable is modified during calls to `read' or
4527 `read-from-string', but only when `read-with-symbol-positions' is
4530 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4531 CHAR-POSITION is an integer giving the offset of that occurrence of the
4532 symbol from the position where `read' or `read-from-string' started.
4534 Note that a symbol will appear multiple times in this list, if it was
4535 read multiple times. The list is in the same order as the symbols
4537 Vread_symbol_positions_list
= Qnil
;
4539 DEFVAR_LISP ("read-circle", Vread_circle
,
4540 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4543 DEFVAR_LISP ("load-path", Vload_path
,
4544 doc
: /* List of directories to search for files to load.
4545 Each element is a string (directory name) or nil (meaning `default-directory').
4546 Initialized during startup as described in Info node `(elisp)Library Search'. */);
4548 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4549 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4550 This list should not include the empty string.
4551 `load' and related functions try to append these suffixes, in order,
4552 to the specified file name if a Lisp suffix is allowed or required. */);
4553 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4554 build_pure_c_string (".el"));
4555 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4556 doc
: /* List of suffixes that indicate representations of \
4558 This list should normally start with the empty string.
4560 Enabling Auto Compression mode appends the suffixes in
4561 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4562 mode removes them again. `load' and related functions use this list to
4563 determine whether they should look for compressed versions of a file
4564 and, if so, which suffixes they should try to append to the file name
4565 in order to do so. However, if you want to customize which suffixes
4566 the loading functions recognize as compression suffixes, you should
4567 customize `jka-compr-load-suffixes' rather than the present variable. */);
4568 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4570 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4571 doc
: /* Non-nil if inside of `load'. */);
4572 DEFSYM (Qload_in_progress
, "load-in-progress");
4574 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4575 doc
: /* An alist of functions to be evalled when particular files are loaded.
4576 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4578 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4579 a symbol \(a feature name).
4581 When `load' is run and the file-name argument matches an element's
4582 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4583 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4585 An error in FORMS does not undo the load, but does prevent execution of
4586 the rest of the FORMS. */);
4587 Vafter_load_alist
= Qnil
;
4589 DEFVAR_LISP ("load-history", Vload_history
,
4590 doc
: /* Alist mapping loaded file names to symbols and features.
4591 Each alist element should be a list (FILE-NAME ENTRIES...), where
4592 FILE-NAME is the name of a file that has been loaded into Emacs.
4593 The file name is absolute and true (i.e. it doesn't contain symlinks).
4594 As an exception, one of the alist elements may have FILE-NAME nil,
4595 for symbols and features not associated with any file.
4597 The remaining ENTRIES in the alist element describe the functions and
4598 variables defined in that file, the features provided, and the
4599 features required. Each entry has the form `(provide . FEATURE)',
4600 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4601 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4602 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4603 autoload before this file redefined it as a function. In addition,
4604 entries may also be single symbols, which means that SYMBOL was
4605 defined by `defvar' or `defconst'.
4607 During preloading, the file name recorded is relative to the main Lisp
4608 directory. These file names are converted to absolute at startup. */);
4609 Vload_history
= Qnil
;
4611 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4612 doc
: /* Full name of file being loaded by `load'. */);
4613 Vload_file_name
= Qnil
;
4615 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4616 doc
: /* File name, including directory, of user's initialization file.
4617 If the file loaded had extension `.elc', and the corresponding source file
4618 exists, this variable contains the name of source file, suitable for use
4619 by functions like `custom-save-all' which edit the init file.
4620 While Emacs loads and evaluates the init file, value is the real name
4621 of the file, regardless of whether or not it has the `.elc' extension. */);
4622 Vuser_init_file
= Qnil
;
4624 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4625 doc
: /* Used for internal purposes by `load'. */);
4626 Vcurrent_load_list
= Qnil
;
4628 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4629 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4630 The default is nil, which means use the function `read'. */);
4631 Vload_read_function
= Qnil
;
4633 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4634 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4635 The value should be a function for doing code conversion before
4636 reading a source file. It can also be nil, in which case loading is
4637 done without any code conversion.
4639 If the value is a function, it is called with four arguments,
4640 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4641 the file to load, FILE is the non-absolute name (for messages etc.),
4642 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4643 `load'. The function should return t if the file was loaded. */);
4644 Vload_source_file_function
= Qnil
;
4646 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4647 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4648 This is useful when the file being loaded is a temporary copy. */);
4649 load_force_doc_strings
= 0;
4651 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4652 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4653 This is normally bound by `load' and `eval-buffer' to control `read',
4654 and is not meant for users to change. */);
4655 load_convert_to_unibyte
= 0;
4657 DEFVAR_LISP ("source-directory", Vsource_directory
,
4658 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4659 You cannot count on them to still be there! */);
4661 = Fexpand_file_name (build_string ("../"),
4662 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4664 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4665 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4666 Vpreloaded_file_list
= Qnil
;
4668 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4669 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4670 Vbyte_boolean_vars
= Qnil
;
4672 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4673 doc
: /* Non-nil means load dangerous compiled Lisp files.
4674 Some versions of XEmacs use different byte codes than Emacs. These
4675 incompatible byte codes can make Emacs crash when it tries to execute
4677 load_dangerous_libraries
= 0;
4679 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4680 doc
: /* Non-nil means force printing messages when loading Lisp files.
4681 This overrides the value of the NOMESSAGE argument to `load'. */);
4682 force_load_messages
= 0;
4684 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4685 doc
: /* Regular expression matching safe to load compiled Lisp files.
4686 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4687 from the file, and matches them against this regular expression.
4688 When the regular expression matches, the file is considered to be safe
4689 to load. See also `load-dangerous-libraries'. */);
4690 Vbytecomp_version_regexp
4691 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4693 DEFSYM (Qlexical_binding
, "lexical-binding");
4694 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4695 doc
: /* Whether to use lexical binding when evaluating code.
4696 Non-nil means that the code in the current buffer should be evaluated
4697 with lexical binding.
4698 This variable is automatically set from the file variables of an
4699 interpreted Lisp file read using `load'. Unlike other file local
4700 variables, this must be set in the first line of a file. */);
4701 Vlexical_binding
= Qnil
;
4702 Fmake_variable_buffer_local (Qlexical_binding
);
4704 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4705 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4706 Veval_buffer_list
= Qnil
;
4708 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4709 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4710 Vold_style_backquotes
= Qnil
;
4711 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4713 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4714 doc
: /* Non-nil means `load' prefers the newest version of a file.
4715 This applies when a filename suffix is not explicitly specified and
4716 `load' is trying various possible suffixes (see `load-suffixes' and
4717 `load-file-rep-suffixes'). Normally, it stops at the first file
4718 that exists unless you explicitly specify one or the other. If this
4719 option is non-nil, it checks all suffixes and uses whichever file is
4721 Note that if you customize this, obviously it will not affect files
4722 that are loaded before your customizations are read! */);
4723 load_prefer_newer
= 0;
4725 /* Vsource_directory was initialized in init_lread. */
4727 DEFSYM (Qcurrent_load_list
, "current-load-list");
4728 DEFSYM (Qstandard_input
, "standard-input");
4729 DEFSYM (Qread_char
, "read-char");
4730 DEFSYM (Qget_file_char
, "get-file-char");
4731 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4732 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4734 DEFSYM (Qbackquote
, "`");
4735 DEFSYM (Qcomma
, ",");
4736 DEFSYM (Qcomma_at
, ",@");
4737 DEFSYM (Qcomma_dot
, ",.");
4739 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4740 DEFSYM (Qascii_character
, "ascii-character");
4741 DEFSYM (Qfunction
, "function");
4742 DEFSYM (Qload
, "load");
4743 DEFSYM (Qload_file_name
, "load-file-name");
4744 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4745 DEFSYM (Qfile_truename
, "file-truename");
4746 DEFSYM (Qdir_ok
, "dir-ok");
4747 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4749 staticpro (&read_objects
);
4750 read_objects
= Qnil
;
4751 staticpro (&seen_list
);
4754 Vloads_in_progress
= Qnil
;
4755 staticpro (&Vloads_in_progress
);
4757 DEFSYM (Qhash_table
, "hash-table");
4758 DEFSYM (Qdata
, "data");
4759 DEFSYM (Qtest
, "test");
4760 DEFSYM (Qsize
, "size");
4761 DEFSYM (Qweakness
, "weakness");
4762 DEFSYM (Qrehash_size
, "rehash-size");
4763 DEFSYM (Qrehash_threshold
, "rehash-threshold");