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