1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2012 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
27 #include <limits.h> /* For CHAR_BIT. */
28 #include <stat-time.h>
30 #include "intervals.h"
31 #include "character.h"
39 #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 /* True means READCHAR should read bytes one by one (not character)
99 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
100 This is set by read1 temporarily while handling #@NUMBER. */
101 static bool load_each_byte
;
103 /* List of descriptors now open for Fload. */
104 static Lisp_Object load_descriptor_list
;
106 /* File for get_file_char to read from. Use by load. */
107 static FILE *instream
;
109 /* For use within read-from-string (this reader is non-reentrant!!) */
110 static ptrdiff_t read_from_string_index
;
111 static ptrdiff_t read_from_string_index_byte
;
112 static ptrdiff_t read_from_string_limit
;
114 /* Number of characters read in the current call to Fread or
115 Fread_from_string. */
116 static EMACS_INT readchar_count
;
118 /* This contains the last string skipped with #@. */
119 static char *saved_doc_string
;
120 /* Length of buffer allocated in saved_doc_string. */
121 static ptrdiff_t saved_doc_string_size
;
122 /* Length of actual data in saved_doc_string. */
123 static ptrdiff_t saved_doc_string_length
;
124 /* This is the file position that string came from. */
125 static file_offset saved_doc_string_position
;
127 /* This contains the previous string skipped with #@.
128 We copy it from saved_doc_string when a new string
129 is put in saved_doc_string. */
130 static char *prev_saved_doc_string
;
131 /* Length of buffer allocated in prev_saved_doc_string. */
132 static ptrdiff_t prev_saved_doc_string_size
;
133 /* Length of actual data in prev_saved_doc_string. */
134 static ptrdiff_t prev_saved_doc_string_length
;
135 /* This is the file position that string came from. */
136 static file_offset prev_saved_doc_string_position
;
138 /* True means inside a new-style backquote
139 with no surrounding parentheses.
140 Fread initializes this to false, so we need not specbind it
141 or worry about what happens to it when there is an error. */
142 static bool new_backquote_flag
;
143 static Lisp_Object Qold_style_backquotes
;
145 /* A list of file names for files being loaded in Fload. Used to
146 check for recursive loads. */
148 static Lisp_Object Vloads_in_progress
;
150 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
153 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
154 Lisp_Object
, Lisp_Object
,
155 Lisp_Object
, Lisp_Object
);
156 static Lisp_Object
load_unwind (Lisp_Object
);
157 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
159 /* Functions that read one byte from the current source READCHARFUN
160 or unreads one byte. If the integer argument C is -1, it returns
161 one read byte, or -1 when there's no more byte in the source. If C
162 is 0 or positive, it unreads C, and the return value is not
165 static int readbyte_for_lambda (int, Lisp_Object
);
166 static int readbyte_from_file (int, Lisp_Object
);
167 static int readbyte_from_string (int, Lisp_Object
);
169 /* Handle unreading and rereading of characters.
170 Write READCHAR to read a character,
171 UNREAD(c) to unread c to be read again.
173 These macros correctly read/unread multibyte characters. */
175 #define READCHAR readchar (readcharfun, NULL)
176 #define UNREAD(c) unreadchar (readcharfun, c)
178 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
179 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
181 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
182 Qlambda, or a cons, we use this to keep an unread character because
183 a file stream can't handle multibyte-char unreading. The value -1
184 means that there's no unread character. */
185 static int unread_char
;
188 readchar (Lisp_Object readcharfun
, bool *multibyte
)
192 int (*readbyte
) (int, Lisp_Object
);
193 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
195 bool emacs_mule_encoding
= 0;
202 if (BUFFERP (readcharfun
))
204 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
206 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
208 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
211 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
213 /* Fetch the character code from the buffer. */
214 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
215 BUF_INC_POS (inbuffer
, pt_byte
);
222 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
223 if (! ASCII_BYTE_P (c
))
224 c
= BYTE8_TO_CHAR (c
);
227 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
231 if (MARKERP (readcharfun
))
233 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
235 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
237 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
240 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
242 /* Fetch the character code from the buffer. */
243 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
244 BUF_INC_POS (inbuffer
, bytepos
);
251 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
252 if (! ASCII_BYTE_P (c
))
253 c
= BYTE8_TO_CHAR (c
);
257 XMARKER (readcharfun
)->bytepos
= bytepos
;
258 XMARKER (readcharfun
)->charpos
++;
263 if (EQ (readcharfun
, Qlambda
))
265 readbyte
= readbyte_for_lambda
;
269 if (EQ (readcharfun
, Qget_file_char
))
271 readbyte
= readbyte_from_file
;
275 if (STRINGP (readcharfun
))
277 if (read_from_string_index
>= read_from_string_limit
)
279 else if (STRING_MULTIBYTE (readcharfun
))
283 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
284 read_from_string_index
,
285 read_from_string_index_byte
);
289 c
= SREF (readcharfun
, read_from_string_index_byte
);
290 read_from_string_index
++;
291 read_from_string_index_byte
++;
296 if (CONSP (readcharfun
))
298 /* This is the case that read_vector is reading from a unibyte
299 string that contains a byte sequence previously skipped
300 because of #@NUMBER. The car part of readcharfun is that
301 string, and the cdr part is a value of readcharfun given to
303 readbyte
= readbyte_from_string
;
304 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
305 emacs_mule_encoding
= 1;
309 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
311 readbyte
= readbyte_from_file
;
312 emacs_mule_encoding
= 1;
316 tem
= call0 (readcharfun
);
323 if (unread_char
>= 0)
329 c
= (*readbyte
) (-1, readcharfun
);
330 if (c
< 0 || load_each_byte
)
334 if (ASCII_BYTE_P (c
))
336 if (emacs_mule_encoding
)
337 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
340 len
= BYTES_BY_CHAR_HEAD (c
);
343 c
= (*readbyte
) (-1, readcharfun
);
344 if (c
< 0 || ! TRAILING_CODE_P (c
))
347 (*readbyte
) (buf
[i
], readcharfun
);
348 return BYTE8_TO_CHAR (buf
[0]);
352 return STRING_CHAR (buf
);
355 /* Unread the character C in the way appropriate for the stream READCHARFUN.
356 If the stream is a user function, call it with the char as argument. */
359 unreadchar (Lisp_Object readcharfun
, int c
)
363 /* Don't back up the pointer if we're unreading the end-of-input mark,
364 since readchar didn't advance it when we read it. */
366 else if (BUFFERP (readcharfun
))
368 struct buffer
*b
= XBUFFER (readcharfun
);
369 ptrdiff_t charpos
= BUF_PT (b
);
370 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
372 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
373 BUF_DEC_POS (b
, bytepos
);
377 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
379 else if (MARKERP (readcharfun
))
381 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
382 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
384 XMARKER (readcharfun
)->charpos
--;
385 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
386 BUF_DEC_POS (b
, bytepos
);
390 XMARKER (readcharfun
)->bytepos
= bytepos
;
392 else if (STRINGP (readcharfun
))
394 read_from_string_index
--;
395 read_from_string_index_byte
396 = string_char_to_byte (readcharfun
, read_from_string_index
);
398 else if (CONSP (readcharfun
))
402 else if (EQ (readcharfun
, Qlambda
))
406 else if (EQ (readcharfun
, Qget_file_char
)
407 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
412 ungetc (c
, instream
);
419 call1 (readcharfun
, make_number (c
));
423 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
425 return read_bytecode_char (c
>= 0);
430 readbyte_from_file (int c
, Lisp_Object readcharfun
)
435 ungetc (c
, instream
);
444 /* Interrupted reads have been observed while reading over the network. */
445 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
457 return (c
== EOF
? -1 : c
);
461 readbyte_from_string (int c
, Lisp_Object readcharfun
)
463 Lisp_Object string
= XCAR (readcharfun
);
467 read_from_string_index
--;
468 read_from_string_index_byte
469 = string_char_to_byte (string
, read_from_string_index
);
472 if (read_from_string_index
>= read_from_string_limit
)
475 FETCH_STRING_CHAR_ADVANCE (c
, string
,
476 read_from_string_index
,
477 read_from_string_index_byte
);
482 /* Read one non-ASCII character from INSTREAM. The character is
483 encoded in `emacs-mule' and the first byte is already read in
487 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
489 /* Emacs-mule coding uses at most 4-byte for one character. */
490 unsigned char buf
[4];
491 int len
= emacs_mule_bytes
[c
];
492 struct charset
*charset
;
497 /* C is not a valid leading-code of `emacs-mule'. */
498 return BYTE8_TO_CHAR (c
);
504 c
= (*readbyte
) (-1, readcharfun
);
508 (*readbyte
) (buf
[i
], readcharfun
);
509 return BYTE8_TO_CHAR (buf
[0]);
516 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
517 code
= buf
[1] & 0x7F;
521 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
522 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
524 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
525 code
= buf
[2] & 0x7F;
529 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
530 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
535 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
536 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
538 c
= DECODE_CHAR (charset
, code
);
540 Fsignal (Qinvalid_read_syntax
,
541 Fcons (build_string ("invalid multibyte form"), Qnil
));
546 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
548 static Lisp_Object
read0 (Lisp_Object
);
549 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
551 static Lisp_Object
read_list (bool, Lisp_Object
);
552 static Lisp_Object
read_vector (Lisp_Object
, bool);
554 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
556 static void substitute_object_in_subtree (Lisp_Object
,
558 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
561 /* Get a character from the tty. */
563 /* Read input events until we get one that's acceptable for our purposes.
565 If NO_SWITCH_FRAME, switch-frame events are stashed
566 until we get a character we like, and then stuffed into
569 If ASCII_REQUIRED, check function key events to see
570 if the unmodified version of the symbol has a Qascii_character
571 property, and use that character, if present.
573 If ERROR_NONASCII, signal an error if the input we
574 get isn't an ASCII character with modifiers. If it's false but
575 ASCII_REQUIRED is true, just re-read until we get an ASCII
578 If INPUT_METHOD, invoke the current input method
579 if the character warrants that.
581 If SECONDS is a number, wait that many seconds for input, and
582 return Qnil if no input arrives within that time. */
585 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
586 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
588 Lisp_Object val
, delayed_switch_frame
;
591 #ifdef HAVE_WINDOW_SYSTEM
592 if (display_hourglass_p
)
596 delayed_switch_frame
= Qnil
;
598 /* Compute timeout. */
599 if (NUMBERP (seconds
))
601 double duration
= extract_float (seconds
);
602 EMACS_TIME wait_time
= EMACS_TIME_FROM_DOUBLE (duration
);
603 end_time
= add_emacs_time (current_emacs_time (), wait_time
);
606 /* Read until we get an acceptable event. */
609 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
610 NUMBERP (seconds
) ? &end_time
: NULL
);
611 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
616 /* switch-frame events are put off until after the next ASCII
617 character. This is better than signaling an error just because
618 the last characters were typed to a separate minibuffer frame,
619 for example. Eventually, some code which can deal with
620 switch-frame events will read it and process it. */
622 && EVENT_HAS_PARAMETERS (val
)
623 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
625 delayed_switch_frame
= val
;
629 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
631 /* Convert certain symbols to their ASCII equivalents. */
634 Lisp_Object tem
, tem1
;
635 tem
= Fget (val
, Qevent_symbol_element_mask
);
638 tem1
= Fget (Fcar (tem
), Qascii_character
);
639 /* Merge this symbol's modifier bits
640 with the ASCII equivalent of its basic code. */
642 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
646 /* If we don't have a character now, deal with it appropriately. */
651 Vunread_command_events
= Fcons (val
, Qnil
);
652 error ("Non-character input-event");
659 if (! NILP (delayed_switch_frame
))
660 unread_switch_frame
= delayed_switch_frame
;
664 #ifdef HAVE_WINDOW_SYSTEM
665 if (display_hourglass_p
)
674 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
675 doc
: /* Read a character from the command input (keyboard or macro).
676 It is returned as a number.
677 If the character has modifiers, they are resolved and reflected to the
678 character code if possible (e.g. C-SPC -> 0).
680 If the user generates an event which is not a character (i.e. a mouse
681 click or function key event), `read-char' signals an error. As an
682 exception, switch-frame events are put off until non-character events
684 If you want to read non-character events, or ignore them, call
685 `read-event' or `read-char-exclusive' instead.
687 If the optional argument PROMPT is non-nil, display that as a prompt.
688 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
689 input method is turned on in the current buffer, that input method
690 is used for reading a character.
691 If the optional argument SECONDS is non-nil, it should be a number
692 specifying the maximum number of seconds to wait for input. If no
693 input arrives in that time, return nil. SECONDS may be a
694 floating-point value. */)
695 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
700 message_with_string ("%s", prompt
, 0);
701 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
703 return (NILP (val
) ? Qnil
704 : make_number (char_resolve_modifier_mask (XINT (val
))));
707 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
708 doc
: /* Read an event object from the input stream.
709 If the optional argument PROMPT is non-nil, display that as a prompt.
710 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
711 input method is turned on in the current buffer, that input method
712 is used for reading a character.
713 If the optional argument SECONDS is non-nil, it should be a number
714 specifying the maximum number of seconds to wait for input. If no
715 input arrives in that time, return nil. SECONDS may be a
716 floating-point value. */)
717 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
720 message_with_string ("%s", prompt
, 0);
721 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
724 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
725 doc
: /* Read a character from the command input (keyboard or macro).
726 It is returned as a number. Non-character events are ignored.
727 If the character has modifiers, they are resolved and reflected to the
728 character code if possible (e.g. C-SPC -> 0).
730 If the optional argument PROMPT is non-nil, display that as a prompt.
731 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
732 input method is turned on in the current buffer, that input method
733 is used for reading a character.
734 If the optional argument SECONDS is non-nil, it should be a number
735 specifying the maximum number of seconds to wait for input. If no
736 input arrives in that time, return nil. SECONDS may be a
737 floating-point value. */)
738 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
743 message_with_string ("%s", prompt
, 0);
745 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
747 return (NILP (val
) ? Qnil
748 : make_number (char_resolve_modifier_mask (XINT (val
))));
751 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
752 doc
: /* Don't use this yourself. */)
755 register Lisp_Object val
;
757 XSETINT (val
, getc (instream
));
765 /* Return true if the lisp code read using READCHARFUN defines a non-nil
766 `lexical-binding' file variable. After returning, the stream is
767 positioned following the first line, if it is a comment or #! line,
768 otherwise nothing is read. */
771 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
784 while (ch
!= '\n' && ch
!= EOF
)
786 if (ch
== '\n') ch
= READCHAR
;
787 /* It is OK to leave the position after a #! line, since
788 that is what read1 does. */
792 /* The first line isn't a comment, just give up. */
798 /* Look for an appropriate file-variable in the first line. */
802 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
803 } beg_end_state
= NOMINAL
;
804 bool in_file_vars
= 0;
806 #define UPDATE_BEG_END_STATE(ch) \
807 if (beg_end_state == NOMINAL) \
808 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
809 else if (beg_end_state == AFTER_FIRST_DASH) \
810 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
811 else if (beg_end_state == AFTER_ASTERIX) \
814 in_file_vars = !in_file_vars; \
815 beg_end_state = NOMINAL; \
818 /* Skip until we get to the file vars, if any. */
822 UPDATE_BEG_END_STATE (ch
);
824 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
828 char var
[100], val
[100];
833 /* Read a variable name. */
834 while (ch
== ' ' || ch
== '\t')
838 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
840 if (i
< sizeof var
- 1)
842 UPDATE_BEG_END_STATE (ch
);
846 /* Stop scanning if no colon was found before end marker. */
847 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
850 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
856 /* Read a variable value. */
859 while (ch
== ' ' || ch
== '\t')
863 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
865 if (i
< sizeof val
- 1)
867 UPDATE_BEG_END_STATE (ch
);
871 /* The value was terminated by an end-marker, which remove. */
873 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
877 if (strcmp (var
, "lexical-binding") == 0)
880 rv
= (strcmp (val
, "nil") != 0);
886 while (ch
!= '\n' && ch
!= EOF
)
893 /* Value is a version number of byte compiled code if the file
894 associated with file descriptor FD is a compiled Lisp file that's
895 safe to load. Only files compiled with Emacs are safe to load.
896 Files compiled with XEmacs can lead to a crash in Fbyte_code
897 because of an incompatible change in the byte compiler. */
900 safe_to_load_version (int fd
)
906 /* Read the first few bytes from the file, and look for a line
907 specifying the byte compiler version used. */
908 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
911 /* Skip to the next newline, skipping over the initial `ELC'
912 with NUL bytes following it, but note the version. */
913 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
918 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
919 buf
+ i
, nbytes
- i
) < 0)
923 lseek (fd
, 0, SEEK_SET
);
928 /* Callback for record_unwind_protect. Restore the old load list OLD,
929 after loading a file successfully. */
932 record_load_unwind (Lisp_Object old
)
934 return Vloads_in_progress
= old
;
937 /* This handler function is used via internal_condition_case_1. */
940 load_error_handler (Lisp_Object data
)
946 load_warn_old_style_backquotes (Lisp_Object file
)
948 if (!NILP (Vold_style_backquotes
))
951 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
958 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
959 doc
: /* Return the suffixes that `load' should try if a suffix is \
961 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
964 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
965 while (CONSP (suffixes
))
967 Lisp_Object exts
= Vload_file_rep_suffixes
;
968 suffix
= XCAR (suffixes
);
969 suffixes
= XCDR (suffixes
);
974 lst
= Fcons (concat2 (suffix
, ext
), lst
);
977 return Fnreverse (lst
);
980 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
981 doc
: /* Execute a file of Lisp code named FILE.
982 First try FILE with `.elc' appended, then try with `.el',
983 then try FILE unmodified (the exact suffixes in the exact order are
984 determined by `load-suffixes'). Environment variable references in
985 FILE are replaced with their values by calling `substitute-in-file-name'.
986 This function searches the directories in `load-path'.
988 If optional second arg NOERROR is non-nil,
989 report no error if FILE doesn't exist.
990 Print messages at start and end of loading unless
991 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
993 If optional fourth arg NOSUFFIX is non-nil, don't try adding
994 suffixes `.elc' or `.el' to the specified name FILE.
995 If optional fifth arg MUST-SUFFIX is non-nil, insist on
996 the suffix `.elc' or `.el'; don't accept just FILE unless
997 it ends in one of those suffixes or includes a directory name.
999 If NOSUFFIX is nil, then if a file could not be found, try looking for
1000 a different representation of the file by adding non-empty suffixes to
1001 its name, before trying another file. Emacs uses this feature to find
1002 compressed versions of files when Auto Compression mode is enabled.
1003 If NOSUFFIX is non-nil, disable this feature.
1005 The suffixes that this function tries out, when NOSUFFIX is nil, are
1006 given by the return value of `get-load-suffixes' and the values listed
1007 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1008 return value of `get-load-suffixes' is used, i.e. the file name is
1009 required to have a non-empty suffix.
1011 Loading a file records its definitions, and its `provide' and
1012 `require' calls, in an element of `load-history' whose
1013 car is the file name loaded. See `load-history'.
1015 While the file is in the process of being loaded, the variable
1016 `load-in-progress' is non-nil and the variable `load-file-name'
1017 is bound to the file's name.
1019 Return t if the file exists and loads successfully. */)
1020 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1022 register FILE *stream
;
1023 register int fd
= -1;
1024 ptrdiff_t count
= SPECPDL_INDEX ();
1025 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1026 Lisp_Object found
, efound
, hist_file_name
;
1027 /* True means we printed the ".el is newer" message. */
1029 /* True means we are loading a compiled file. */
1031 Lisp_Object handler
;
1033 const char *fmode
= "r";
1041 CHECK_STRING (file
);
1043 /* If file name is magic, call the handler. */
1044 /* This shouldn't be necessary any more now that `openp' handles it right.
1045 handler = Ffind_file_name_handler (file, Qload);
1046 if (!NILP (handler))
1047 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1049 /* Do this after the handler to avoid
1050 the need to gcpro noerror, nomessage and nosuffix.
1051 (Below here, we care only whether they are nil or not.)
1052 The presence of this call is the result of a historical accident:
1053 it used to be in every file-operation and when it got removed
1054 everywhere, it accidentally stayed here. Since then, enough people
1055 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1056 that it seemed risky to remove. */
1057 if (! NILP (noerror
))
1059 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1060 Qt
, load_error_handler
);
1065 file
= Fsubstitute_in_file_name (file
);
1068 /* Avoid weird lossage with null string as arg,
1069 since it would try to load a directory as a Lisp file. */
1070 if (SBYTES (file
) > 0)
1072 ptrdiff_t size
= SBYTES (file
);
1075 GCPRO2 (file
, found
);
1077 if (! NILP (must_suffix
))
1079 /* Don't insist on adding a suffix if FILE already ends with one. */
1081 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1084 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1086 /* Don't insist on adding a suffix
1087 if the argument includes a directory name. */
1088 else if (! NILP (Ffile_name_directory (file
)))
1092 fd
= openp (Vload_path
, file
,
1093 (!NILP (nosuffix
) ? Qnil
1094 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1095 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1096 tmp
[1] = Vload_file_rep_suffixes
,
1105 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1109 /* Tell startup.el whether or not we found the user's init file. */
1110 if (EQ (Qt
, Vuser_init_file
))
1111 Vuser_init_file
= found
;
1113 /* If FD is -2, that means openp found a magic file. */
1116 if (NILP (Fequal (found
, file
)))
1117 /* If FOUND is a different file name from FILE,
1118 find its handler even if we have already inhibited
1119 the `load' operation on FILE. */
1120 handler
= Ffind_file_name_handler (found
, Qt
);
1122 handler
= Ffind_file_name_handler (found
, Qload
);
1123 if (! NILP (handler
))
1124 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1126 /* Tramp has to deal with semi-broken packages that prepend
1127 drive letters to remote files. For that reason, Tramp
1128 catches file operations that test for file existence, which
1129 makes openp think X:/foo.elc files are remote. However,
1130 Tramp does not catch `load' operations for such files, so we
1131 end up with a nil as the `load' handler above. If we would
1132 continue with fd = -2, we will behave wrongly, and in
1133 particular try reading a .elc file in the "rt" mode instead
1134 of "rb". See bug #9311 for the results. To work around
1135 this, we try to open the file locally, and go with that if it
1137 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1143 /* Check if we're stuck in a recursive load cycle.
1145 2000-09-21: It's not possible to just check for the file loaded
1146 being a member of Vloads_in_progress. This fails because of the
1147 way the byte compiler currently works; `provide's are not
1148 evaluated, see font-lock.el/jit-lock.el as an example. This
1149 leads to a certain amount of ``normal'' recursion.
1151 Also, just loading a file recursively is not always an error in
1152 the general case; the second load may do something different. */
1156 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1157 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1161 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1163 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1164 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1167 /* All loads are by default dynamic, unless the file itself specifies
1168 otherwise using a file-variable in the first line. This is bound here
1169 so that it takes effect whether or not we use
1170 Vload_source_file_function. */
1171 specbind (Qlexical_binding
, Qnil
);
1173 /* Get the name for load-history. */
1174 hist_file_name
= (! NILP (Vpurify_flag
)
1175 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1176 tmp
[1] = Ffile_name_nondirectory (found
),
1182 /* Check for the presence of old-style quotes and warn about them. */
1183 specbind (Qold_style_backquotes
, Qnil
);
1184 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1186 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1187 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1188 /* Load .elc files directly, but not when they are
1189 remote and have no handler! */
1196 GCPRO3 (file
, found
, hist_file_name
);
1199 && ! (version
= safe_to_load_version (fd
)))
1202 if (!load_dangerous_libraries
)
1206 error ("File `%s' was not compiled in Emacs",
1209 else if (!NILP (nomessage
) && !force_load_messages
)
1210 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1215 efound
= ENCODE_FILE (found
);
1220 result
= stat (SSDATA (efound
), &s1
);
1223 SSET (efound
, SBYTES (efound
) - 1, 0);
1224 result
= stat (SSDATA (efound
), &s2
);
1225 SSET (efound
, SBYTES (efound
) - 1, 'c');
1229 && EMACS_TIME_LT (get_stat_mtime (&s1
), get_stat_mtime (&s2
)))
1231 /* Make the progress messages mention that source is newer. */
1234 /* If we won't print another message, mention this anyway. */
1235 if (!NILP (nomessage
) && !force_load_messages
)
1237 Lisp_Object msg_file
;
1238 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1239 message_with_string ("Source file `%s' newer than byte-compiled file",
1248 /* We are loading a source file (*.el). */
1249 if (!NILP (Vload_source_file_function
))
1255 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1256 NILP (noerror
) ? Qnil
: Qt
,
1257 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1258 return unbind_to (count
, val
);
1262 GCPRO3 (file
, found
, hist_file_name
);
1265 efound
= ENCODE_FILE (found
);
1266 /* If we somehow got here with fd == -2, meaning the file is deemed
1267 to be remote, don't even try to reopen the file locally; just
1268 force a failure instead. */
1272 stream
= fopen (SSDATA (efound
), fmode
);
1276 #else /* not WINDOWSNT */
1277 stream
= fdopen (fd
, fmode
);
1278 #endif /* not WINDOWSNT */
1282 error ("Failure to create stdio stream for %s", SDATA (file
));
1285 if (! NILP (Vpurify_flag
))
1286 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1288 if (NILP (nomessage
) || force_load_messages
)
1291 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1294 message_with_string ("Loading %s (source)...", file
, 1);
1296 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1298 else /* The typical case; compiled file newer than source file. */
1299 message_with_string ("Loading %s...", file
, 1);
1302 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1303 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1304 specbind (Qload_file_name
, found
);
1305 specbind (Qinhibit_file_name_operation
, Qnil
);
1306 load_descriptor_list
1307 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1308 specbind (Qload_in_progress
, Qt
);
1311 if (lisp_file_lexically_bound_p (Qget_file_char
))
1312 Fset (Qlexical_binding
, Qt
);
1314 if (! version
|| version
>= 22)
1315 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1316 0, Qnil
, Qnil
, Qnil
, Qnil
);
1319 /* We can't handle a file which was compiled with
1320 byte-compile-dynamic by older version of Emacs. */
1321 specbind (Qload_force_doc_strings
, Qt
);
1322 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1323 0, Qnil
, Qnil
, Qnil
, Qnil
);
1325 unbind_to (count
, Qnil
);
1327 /* Run any eval-after-load forms for this file. */
1328 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1329 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1333 xfree (saved_doc_string
);
1334 saved_doc_string
= 0;
1335 saved_doc_string_size
= 0;
1337 xfree (prev_saved_doc_string
);
1338 prev_saved_doc_string
= 0;
1339 prev_saved_doc_string_size
= 0;
1341 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1344 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1347 message_with_string ("Loading %s (source)...done", file
, 1);
1349 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1351 else /* The typical case; compiled file newer than source file. */
1352 message_with_string ("Loading %s...done", file
, 1);
1359 load_unwind (Lisp_Object arg
) /* Used as unwind-protect function in load. */
1361 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1372 load_descriptor_unwind (Lisp_Object oldlist
)
1374 load_descriptor_list
= oldlist
;
1378 /* Close all descriptors in use for Floads.
1379 This is used when starting a subprocess. */
1382 close_load_descs (void)
1386 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1387 emacs_close (XFASTINT (XCAR (tail
)));
1392 complete_filename_p (Lisp_Object pathname
)
1394 const unsigned char *s
= SDATA (pathname
);
1395 return (IS_DIRECTORY_SEP (s
[0])
1396 || (SCHARS (pathname
) > 2
1397 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1400 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1401 doc
: /* Search for FILENAME through PATH.
1402 Returns the file's name in absolute form, or nil if not found.
1403 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1404 file name when searching.
1405 If non-nil, PREDICATE is used instead of `file-readable-p'.
1406 PREDICATE can also be an integer to pass to the faccessat(2) function,
1407 in which case file-name-handlers are ignored.
1408 This function will normally skip directories, so if you want it to find
1409 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1410 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1413 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1414 if (NILP (predicate
) && fd
> 0)
1419 static Lisp_Object Qdir_ok
;
1421 /* Search for a file whose name is STR, looking in directories
1422 in the Lisp list PATH, and trying suffixes from SUFFIX.
1423 On success, returns a file descriptor. On failure, returns -1.
1425 SUFFIXES is a list of strings containing possible suffixes.
1426 The empty suffix is automatically added if the list is empty.
1428 PREDICATE non-nil means don't open the files,
1429 just look for one that satisfies the predicate. In this case,
1430 returns 1 on success. The predicate can be a lisp function or
1431 an integer to pass to `access' (in which case file-name-handlers
1434 If STOREPTR is nonzero, it points to a slot where the name of
1435 the file actually found should be stored as a Lisp string.
1436 nil is stored there on failure.
1438 If the file we find is remote, return -2
1439 but store the found remote file name in *STOREPTR. */
1442 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1444 ptrdiff_t fn_size
= 100;
1448 ptrdiff_t want_length
;
1449 Lisp_Object filename
;
1450 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1451 Lisp_Object string
, tail
, encoded_fn
;
1452 ptrdiff_t max_suffix_len
= 0;
1456 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1458 CHECK_STRING_CAR (tail
);
1459 max_suffix_len
= max (max_suffix_len
,
1460 SBYTES (XCAR (tail
)));
1463 string
= filename
= encoded_fn
= Qnil
;
1464 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1469 if (complete_filename_p (str
))
1472 for (; CONSP (path
); path
= XCDR (path
))
1474 filename
= Fexpand_file_name (str
, XCAR (path
));
1475 if (!complete_filename_p (filename
))
1476 /* If there are non-absolute elts in PATH (eg "."). */
1477 /* Of course, this could conceivably lose if luser sets
1478 default-directory to be something non-absolute... */
1480 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1481 if (!complete_filename_p (filename
))
1482 /* Give up on this path element! */
1486 /* Calculate maximum length of any filename made from
1487 this path element/specified file name and any possible suffix. */
1488 want_length
= max_suffix_len
+ SBYTES (filename
);
1489 if (fn_size
<= want_length
)
1490 fn
= alloca (fn_size
= 100 + want_length
);
1492 /* Loop over suffixes. */
1493 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1494 CONSP (tail
); tail
= XCDR (tail
))
1496 ptrdiff_t fnlen
, lsuffix
= SBYTES (XCAR (tail
));
1497 Lisp_Object handler
;
1499 /* Concatenate path element/specified name with the suffix.
1500 If the directory starts with /:, remove that. */
1501 int prefixlen
= ((SCHARS (filename
) > 2
1502 && SREF (filename
, 0) == '/'
1503 && SREF (filename
, 1) == ':')
1505 fnlen
= SBYTES (filename
) - prefixlen
;
1506 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1507 memcpy (fn
+ fnlen
, SDATA (XCAR (tail
)), lsuffix
+ 1);
1509 /* Check that the file exists and is not a directory. */
1510 /* We used to only check for handlers on non-absolute file names:
1514 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1515 It's not clear why that was the case and it breaks things like
1516 (load "/bar.el") where the file is actually "/bar.el.gz". */
1517 string
= make_string (fn
, fnlen
);
1518 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1519 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1522 if (NILP (predicate
))
1523 exists
= !NILP (Ffile_readable_p (string
));
1526 Lisp_Object tmp
= call1 (predicate
, string
);
1527 exists
= !NILP (tmp
)
1528 && (EQ (tmp
, Qdir_ok
)
1529 || NILP (Ffile_directory_p (string
)));
1534 /* We succeeded; return this descriptor and filename. */
1546 encoded_fn
= ENCODE_FILE (string
);
1547 pfn
= SSDATA (encoded_fn
);
1549 /* Check that we can access or open it. */
1550 if (NATNUMP (predicate
))
1551 fd
= (((XFASTINT (predicate
) & ~INT_MAX
) == 0
1552 && (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1555 && ! file_directory_p (pfn
))
1560 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1562 && (fstat (fd
, &st
) != 0 || S_ISDIR (st
.st_mode
)))
1571 /* We succeeded; return this descriptor and filename. */
1588 /* Merge the list we've accumulated of globals from the current input source
1589 into the load_history variable. The details depend on whether
1590 the source has an associated file name or not.
1592 FILENAME is the file name that we are loading from.
1594 ENTIRE is true if loading that entire file, false if evaluating
1598 build_load_history (Lisp_Object filename
, bool entire
)
1600 Lisp_Object tail
, prev
, newelt
;
1601 Lisp_Object tem
, tem2
;
1604 tail
= Vload_history
;
1607 while (CONSP (tail
))
1611 /* Find the feature's previous assoc list... */
1612 if (!NILP (Fequal (filename
, Fcar (tem
))))
1616 /* If we're loading the entire file, remove old data. */
1620 Vload_history
= XCDR (tail
);
1622 Fsetcdr (prev
, XCDR (tail
));
1625 /* Otherwise, cons on new symbols that are not already members. */
1628 tem2
= Vcurrent_load_list
;
1630 while (CONSP (tem2
))
1632 newelt
= XCAR (tem2
);
1634 if (NILP (Fmember (newelt
, tem
)))
1635 Fsetcar (tail
, Fcons (XCAR (tem
),
1636 Fcons (newelt
, XCDR (tem
))));
1649 /* If we're loading an entire file, cons the new assoc onto the
1650 front of load-history, the most-recently-loaded position. Also
1651 do this if we didn't find an existing member for the file. */
1652 if (entire
|| !foundit
)
1653 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1658 readevalloop_1 (Lisp_Object old
)
1660 load_convert_to_unibyte
= ! NILP (old
);
1664 /* Signal an `end-of-file' error, if possible with file name
1667 static _Noreturn
void
1668 end_of_file_error (void)
1670 if (STRINGP (Vload_file_name
))
1671 xsignal1 (Qend_of_file
, Vload_file_name
);
1673 xsignal0 (Qend_of_file
);
1676 /* UNIBYTE specifies how to set load_convert_to_unibyte
1677 for this invocation.
1678 READFUN, if non-nil, is used instead of `read'.
1680 START, END specify region to read in current buffer (from eval-region).
1681 If the input is not from a buffer, they must be nil. */
1684 readevalloop (Lisp_Object readcharfun
,
1686 Lisp_Object sourcename
,
1688 Lisp_Object unibyte
, Lisp_Object readfun
,
1689 Lisp_Object start
, Lisp_Object end
)
1692 register Lisp_Object val
;
1693 ptrdiff_t count
= SPECPDL_INDEX ();
1694 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1695 struct buffer
*b
= 0;
1696 bool continue_reading_p
;
1697 Lisp_Object lex_bound
;
1698 /* True if reading an entire buffer. */
1699 bool whole_buffer
= 0;
1700 /* True on the first time around. */
1701 bool first_sexp
= 1;
1702 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1704 if (NILP (Ffboundp (macroexpand
))
1705 /* Don't macroexpand in .elc files, since it should have been done
1706 already. We actually don't know whether we're in a .elc file or not,
1707 so we use circumstantial evidence: .el files normally go through
1708 Vload_source_file_function -> load-with-code-conversion
1710 || EQ (readcharfun
, Qget_file_char
)
1711 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1714 if (MARKERP (readcharfun
))
1717 start
= readcharfun
;
1720 if (BUFFERP (readcharfun
))
1721 b
= XBUFFER (readcharfun
);
1722 else if (MARKERP (readcharfun
))
1723 b
= XMARKER (readcharfun
)->buffer
;
1725 /* We assume START is nil when input is not from a buffer. */
1726 if (! NILP (start
) && !b
)
1729 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1730 specbind (Qcurrent_load_list
, Qnil
);
1731 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1732 load_convert_to_unibyte
= !NILP (unibyte
);
1734 /* If lexical binding is active (either because it was specified in
1735 the file's header, or via a buffer-local variable), create an empty
1736 lexical environment, otherwise, turn off lexical binding. */
1737 lex_bound
= find_symbol_value (Qlexical_binding
);
1738 specbind (Qinternal_interpreter_environment
,
1739 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1740 ? Qnil
: Fcons (Qt
, Qnil
));
1742 GCPRO4 (sourcename
, readfun
, start
, end
);
1744 /* Try to ensure sourcename is a truename, except whilst preloading. */
1745 if (NILP (Vpurify_flag
)
1746 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1747 && !NILP (Ffboundp (Qfile_truename
)))
1748 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1750 LOADHIST_ATTACH (sourcename
);
1752 continue_reading_p
= 1;
1753 while (continue_reading_p
)
1755 ptrdiff_t count1
= SPECPDL_INDEX ();
1757 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1758 error ("Reading from killed buffer");
1762 /* Switch to the buffer we are reading from. */
1763 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1764 set_buffer_internal (b
);
1766 /* Save point in it. */
1767 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1768 /* Save ZV in it. */
1769 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1770 /* Those get unbound after we read one expression. */
1772 /* Set point and ZV around stuff to be read. */
1775 Fnarrow_to_region (make_number (BEGV
), end
);
1777 /* Just for cleanliness, convert END to a marker
1778 if it is an integer. */
1780 end
= Fpoint_max_marker ();
1783 /* On the first cycle, we can easily test here
1784 whether we are reading the whole buffer. */
1785 if (b
&& first_sexp
)
1786 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1793 while ((c
= READCHAR
) != '\n' && c
!= -1);
1798 unbind_to (count1
, Qnil
);
1802 /* Ignore whitespace here, so we can detect eof. */
1803 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1804 || c
== 0xa0) /* NBSP */
1807 if (!NILP (Vpurify_flag
) && c
== '(')
1809 val
= read_list (0, readcharfun
);
1814 read_objects
= Qnil
;
1815 if (!NILP (readfun
))
1817 val
= call1 (readfun
, readcharfun
);
1819 /* If READCHARFUN has set point to ZV, we should
1820 stop reading, even if the form read sets point
1821 to a different value when evaluated. */
1822 if (BUFFERP (readcharfun
))
1824 struct buffer
*buf
= XBUFFER (readcharfun
);
1825 if (BUF_PT (buf
) == BUF_ZV (buf
))
1826 continue_reading_p
= 0;
1829 else if (! NILP (Vload_read_function
))
1830 val
= call1 (Vload_read_function
, readcharfun
);
1832 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1835 if (!NILP (start
) && continue_reading_p
)
1836 start
= Fpoint_marker ();
1838 /* Restore saved point and BEGV. */
1839 unbind_to (count1
, Qnil
);
1841 /* Now eval what we just read. */
1842 if (!NILP (macroexpand
))
1843 val
= call1 (macroexpand
, val
);
1844 val
= eval_sub (val
);
1848 Vvalues
= Fcons (val
, Vvalues
);
1849 if (EQ (Vstandard_output
, Qt
))
1858 build_load_history (sourcename
,
1859 stream
|| whole_buffer
);
1863 unbind_to (count
, Qnil
);
1866 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1867 doc
: /* Execute the current buffer as Lisp code.
1868 When called from a Lisp program (i.e., not interactively), this
1869 function accepts up to five optional arguments:
1870 BUFFER is the buffer to evaluate (nil means use current buffer).
1871 PRINTFLAG controls printing of output:
1872 A value of nil means discard it; anything else is stream for print.
1873 FILENAME specifies the file name to use for `load-history'.
1874 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1876 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1877 functions should work normally even if PRINTFLAG is nil.
1879 This function preserves the position of point. */)
1880 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1882 ptrdiff_t count
= SPECPDL_INDEX ();
1883 Lisp_Object tem
, buf
;
1886 buf
= Fcurrent_buffer ();
1888 buf
= Fget_buffer (buffer
);
1890 error ("No such buffer");
1892 if (NILP (printflag
) && NILP (do_allow_print
))
1897 if (NILP (filename
))
1898 filename
= BVAR (XBUFFER (buf
), filename
);
1900 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1901 specbind (Qstandard_output
, tem
);
1902 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1903 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1904 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1905 readevalloop (buf
, 0, filename
,
1906 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1907 unbind_to (count
, Qnil
);
1912 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1913 doc
: /* Execute the region as Lisp code.
1914 When called from programs, expects two arguments,
1915 giving starting and ending indices in the current buffer
1916 of the text to be executed.
1917 Programs can pass third argument PRINTFLAG which controls output:
1918 A value of nil means discard it; anything else is stream for printing it.
1919 Also the fourth argument READ-FUNCTION, if non-nil, is used
1920 instead of `read' to read each expression. It gets one argument
1921 which is the input stream for reading characters.
1923 This function does not move point. */)
1924 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1926 /* FIXME: Do the eval-sexp-add-defvars dance! */
1927 ptrdiff_t count
= SPECPDL_INDEX ();
1928 Lisp_Object tem
, cbuf
;
1930 cbuf
= Fcurrent_buffer ();
1932 if (NILP (printflag
))
1936 specbind (Qstandard_output
, tem
);
1937 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1939 /* `readevalloop' calls functions which check the type of start and end. */
1940 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1941 !NILP (printflag
), Qnil
, read_function
,
1944 return unbind_to (count
, Qnil
);
1948 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1949 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1950 If STREAM is nil, use the value of `standard-input' (which see).
1951 STREAM or the value of `standard-input' may be:
1952 a buffer (read from point and advance it)
1953 a marker (read from where it points and advance it)
1954 a function (call it with no arguments for each character,
1955 call it with a char as argument to push a char back)
1956 a string (takes text from string, starting at the beginning)
1957 t (read text line using minibuffer and use it, or read from
1958 standard input in batch mode). */)
1959 (Lisp_Object stream
)
1962 stream
= Vstandard_input
;
1963 if (EQ (stream
, Qt
))
1964 stream
= Qread_char
;
1965 if (EQ (stream
, Qread_char
))
1966 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1968 return read_internal_start (stream
, Qnil
, Qnil
);
1971 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1972 doc
: /* Read one Lisp expression which is represented as text by STRING.
1973 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1974 FINAL-STRING-INDEX is an integer giving the position of the next
1975 remaining character in STRING.
1976 START and END optionally delimit a substring of STRING from which to read;
1977 they default to 0 and (length STRING) respectively. */)
1978 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1981 CHECK_STRING (string
);
1982 /* `read_internal_start' sets `read_from_string_index'. */
1983 ret
= read_internal_start (string
, start
, end
);
1984 return Fcons (ret
, make_number (read_from_string_index
));
1987 /* Function to set up the global context we need in toplevel read
1990 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1991 /* `start', `end' only used when stream is a string. */
1996 new_backquote_flag
= 0;
1997 read_objects
= Qnil
;
1998 if (EQ (Vread_with_symbol_positions
, Qt
)
1999 || EQ (Vread_with_symbol_positions
, stream
))
2000 Vread_symbol_positions_list
= Qnil
;
2002 if (STRINGP (stream
)
2003 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2005 ptrdiff_t startval
, endval
;
2008 if (STRINGP (stream
))
2011 string
= XCAR (stream
);
2014 endval
= SCHARS (string
);
2018 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2019 args_out_of_range (string
, end
);
2020 endval
= XINT (end
);
2027 CHECK_NUMBER (start
);
2028 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2029 args_out_of_range (string
, start
);
2030 startval
= XINT (start
);
2032 read_from_string_index
= startval
;
2033 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2034 read_from_string_limit
= endval
;
2037 retval
= read0 (stream
);
2038 if (EQ (Vread_with_symbol_positions
, Qt
)
2039 || EQ (Vread_with_symbol_positions
, stream
))
2040 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2045 /* Signal Qinvalid_read_syntax error.
2046 S is error string of length N (if > 0) */
2048 static _Noreturn
void
2049 invalid_syntax (const char *s
)
2051 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2055 /* Use this for recursive reads, in contexts where internal tokens
2059 read0 (Lisp_Object readcharfun
)
2061 register Lisp_Object val
;
2064 val
= read1 (readcharfun
, &c
, 0);
2068 xsignal1 (Qinvalid_read_syntax
,
2069 Fmake_string (make_number (1), make_number (c
)));
2072 static ptrdiff_t read_buffer_size
;
2073 static char *read_buffer
;
2075 /* Read a \-escape sequence, assuming we already read the `\'.
2076 If the escape sequence forces unibyte, return eight-bit char. */
2079 read_escape (Lisp_Object readcharfun
, bool stringp
)
2082 /* \u allows up to four hex digits, \U up to eight. Default to the
2083 behavior for \u, and change this value in the case that \U is seen. */
2084 int unicode_hex_count
= 4;
2089 end_of_file_error ();
2119 error ("Invalid escape character syntax");
2122 c
= read_escape (readcharfun
, 0);
2123 return c
| meta_modifier
;
2128 error ("Invalid escape character syntax");
2131 c
= read_escape (readcharfun
, 0);
2132 return c
| shift_modifier
;
2137 error ("Invalid escape character syntax");
2140 c
= read_escape (readcharfun
, 0);
2141 return c
| hyper_modifier
;
2146 error ("Invalid escape character syntax");
2149 c
= read_escape (readcharfun
, 0);
2150 return c
| alt_modifier
;
2154 if (stringp
|| c
!= '-')
2161 c
= read_escape (readcharfun
, 0);
2162 return c
| super_modifier
;
2167 error ("Invalid escape character syntax");
2171 c
= read_escape (readcharfun
, 0);
2172 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2173 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2174 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2175 return c
| ctrl_modifier
;
2176 /* ASCII control chars are made from letters (both cases),
2177 as well as the non-letters within 0100...0137. */
2178 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2179 return (c
& (037 | ~0177));
2180 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2181 return (c
& (037 | ~0177));
2183 return c
| ctrl_modifier
;
2193 /* An octal escape, as in ANSI C. */
2195 register int i
= c
- '0';
2196 register int count
= 0;
2199 if ((c
= READCHAR
) >= '0' && c
<= '7')
2211 if (i
>= 0x80 && i
< 0x100)
2212 i
= BYTE8_TO_CHAR (i
);
2217 /* A hex escape, as in ANSI C. */
2224 if (c
>= '0' && c
<= '9')
2229 else if ((c
>= 'a' && c
<= 'f')
2230 || (c
>= 'A' && c
<= 'F'))
2233 if (c
>= 'a' && c
<= 'f')
2243 /* Allow hex escapes as large as ?\xfffffff, because some
2244 packages use them to denote characters with modifiers. */
2245 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2246 error ("Hex character out of range: \\x%x...", i
);
2250 if (count
< 3 && i
>= 0x80)
2251 return BYTE8_TO_CHAR (i
);
2256 /* Post-Unicode-2.0: Up to eight hex chars. */
2257 unicode_hex_count
= 8;
2260 /* A Unicode escape. We only permit them in strings and characters,
2261 not arbitrarily in the source code, as in some other languages. */
2266 while (++count
<= unicode_hex_count
)
2269 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2271 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2272 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2273 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2275 error ("Non-hex digit used for Unicode escape");
2278 error ("Non-Unicode character: 0x%x", i
);
2287 /* Return the digit that CHARACTER stands for in the given BASE.
2288 Return -1 if CHARACTER is out of range for BASE,
2289 and -2 if CHARACTER is not valid for any supported BASE. */
2291 digit_to_number (int character
, int base
)
2295 if ('0' <= character
&& character
<= '9')
2296 digit
= character
- '0';
2297 else if ('a' <= character
&& character
<= 'z')
2298 digit
= character
- 'a' + 10;
2299 else if ('A' <= character
&& character
<= 'Z')
2300 digit
= character
- 'A' + 10;
2304 return digit
< base
? digit
: -1;
2307 /* Read an integer in radix RADIX using READCHARFUN to read
2308 characters. RADIX must be in the interval [2..36]; if it isn't, a
2309 read error is signaled . Value is the integer read. Signals an
2310 error if encountering invalid read syntax or if RADIX is out of
2314 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2316 /* Room for sign, leading 0, other digits, trailing null byte.
2317 Also, room for invalid syntax diagnostic. */
2318 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2319 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2321 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2323 if (radix
< 2 || radix
> 36)
2331 if (c
== '-' || c
== '+')
2342 /* Ignore redundant leading zeros, so the buffer doesn't
2343 fill up with them. */
2349 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2356 if (p
< buf
+ sizeof buf
- 1)
2370 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2371 invalid_syntax (buf
);
2374 return string_to_number (buf
, radix
, 0);
2378 /* If the next token is ')' or ']' or '.', we store that character
2379 in *PCH and the return value is not interesting. Else, we store
2380 zero in *PCH and we read and return one lisp object.
2382 FIRST_IN_LIST is true if this is the first element of a list. */
2385 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2388 bool uninterned_symbol
= 0;
2396 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2398 end_of_file_error ();
2403 return read_list (0, readcharfun
);
2406 return read_vector (readcharfun
, 0);
2422 /* Accept extended format for hashtables (extensible to
2424 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2425 Lisp_Object tmp
= read_list (0, readcharfun
);
2426 Lisp_Object head
= CAR_SAFE (tmp
);
2427 Lisp_Object data
= Qnil
;
2428 Lisp_Object val
= Qnil
;
2429 /* The size is 2 * number of allowed keywords to
2431 Lisp_Object params
[10];
2433 Lisp_Object key
= Qnil
;
2434 int param_count
= 0;
2436 if (!EQ (head
, Qhash_table
))
2437 error ("Invalid extended read marker at head of #s list "
2438 "(only hash-table allowed)");
2440 tmp
= CDR_SAFE (tmp
);
2442 /* This is repetitive but fast and simple. */
2443 params
[param_count
] = QCsize
;
2444 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2445 if (!NILP (params
[param_count
+ 1]))
2448 params
[param_count
] = QCtest
;
2449 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2450 if (!NILP (params
[param_count
+ 1]))
2453 params
[param_count
] = QCweakness
;
2454 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2455 if (!NILP (params
[param_count
+ 1]))
2458 params
[param_count
] = QCrehash_size
;
2459 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2460 if (!NILP (params
[param_count
+ 1]))
2463 params
[param_count
] = QCrehash_threshold
;
2464 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2465 if (!NILP (params
[param_count
+ 1]))
2468 /* This is the hashtable data. */
2469 data
= Fplist_get (tmp
, Qdata
);
2471 /* Now use params to make a new hashtable and fill it. */
2472 ht
= Fmake_hash_table (param_count
, params
);
2474 while (CONSP (data
))
2479 error ("Odd number of elements in hashtable data");
2482 Fputhash (key
, val
, ht
);
2488 invalid_syntax ("#");
2496 tmp
= read_vector (readcharfun
, 0);
2497 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2498 error ("Invalid size char-table");
2499 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2511 tmp
= read_vector (readcharfun
, 0);
2514 error ("Invalid size char-table");
2515 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2516 error ("Invalid depth in char-table");
2517 depth
= XINT (AREF (tmp
, 0));
2518 if (chartab_size
[depth
] != size
- 2)
2519 error ("Invalid size char-table");
2520 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2523 invalid_syntax ("#^^");
2525 invalid_syntax ("#^");
2530 length
= read1 (readcharfun
, pch
, first_in_list
);
2534 Lisp_Object tmp
, val
;
2535 EMACS_INT size_in_chars
2536 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2537 / BOOL_VECTOR_BITS_PER_CHAR
);
2540 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2541 if (STRING_MULTIBYTE (tmp
)
2542 || (size_in_chars
!= SCHARS (tmp
)
2543 /* We used to print 1 char too many
2544 when the number of bits was a multiple of 8.
2545 Accept such input in case it came from an old
2547 && ! (XFASTINT (length
)
2548 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2549 invalid_syntax ("#&...");
2551 val
= Fmake_bool_vector (length
, Qnil
);
2552 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2553 /* Clear the extraneous bits in the last byte. */
2554 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2555 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2556 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2559 invalid_syntax ("#&...");
2563 /* Accept compiled functions at read-time so that we don't have to
2564 build them using function calls. */
2566 tmp
= read_vector (readcharfun
, 1);
2567 make_byte_code (XVECTOR (tmp
));
2573 struct gcpro gcpro1
;
2576 /* Read the string itself. */
2577 tmp
= read1 (readcharfun
, &ch
, 0);
2578 if (ch
!= 0 || !STRINGP (tmp
))
2579 invalid_syntax ("#");
2581 /* Read the intervals and their properties. */
2584 Lisp_Object beg
, end
, plist
;
2586 beg
= read1 (readcharfun
, &ch
, 0);
2591 end
= read1 (readcharfun
, &ch
, 0);
2593 plist
= read1 (readcharfun
, &ch
, 0);
2595 invalid_syntax ("Invalid string property list");
2596 Fset_text_properties (beg
, end
, plist
, tmp
);
2602 /* #@NUMBER is used to skip NUMBER following characters.
2603 That's used in .elc files to skip over doc strings
2604 and function definitions. */
2607 enum { extra
= 100 };
2608 ptrdiff_t i
, nskip
= 0;
2611 /* Read a decimal integer. */
2612 while ((c
= READCHAR
) >= 0
2613 && c
>= '0' && c
<= '9')
2615 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2622 if (load_force_doc_strings
2623 && (EQ (readcharfun
, Qget_file_char
)
2624 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2626 /* If we are supposed to force doc strings into core right now,
2627 record the last string that we skipped,
2628 and record where in the file it comes from. */
2630 /* But first exchange saved_doc_string
2631 with prev_saved_doc_string, so we save two strings. */
2633 char *temp
= saved_doc_string
;
2634 ptrdiff_t temp_size
= saved_doc_string_size
;
2635 file_offset temp_pos
= saved_doc_string_position
;
2636 ptrdiff_t temp_len
= saved_doc_string_length
;
2638 saved_doc_string
= prev_saved_doc_string
;
2639 saved_doc_string_size
= prev_saved_doc_string_size
;
2640 saved_doc_string_position
= prev_saved_doc_string_position
;
2641 saved_doc_string_length
= prev_saved_doc_string_length
;
2643 prev_saved_doc_string
= temp
;
2644 prev_saved_doc_string_size
= temp_size
;
2645 prev_saved_doc_string_position
= temp_pos
;
2646 prev_saved_doc_string_length
= temp_len
;
2649 if (saved_doc_string_size
== 0)
2651 saved_doc_string
= xmalloc (nskip
+ extra
);
2652 saved_doc_string_size
= nskip
+ extra
;
2654 if (nskip
> saved_doc_string_size
)
2656 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2657 saved_doc_string_size
= nskip
+ extra
;
2660 saved_doc_string_position
= file_tell (instream
);
2662 /* Copy that many characters into saved_doc_string. */
2663 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2664 saved_doc_string
[i
] = c
= READCHAR
;
2666 saved_doc_string_length
= i
;
2670 /* Skip that many characters. */
2671 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2680 /* #! appears at the beginning of an executable file.
2681 Skip the first line. */
2682 while (c
!= '\n' && c
>= 0)
2687 return Vload_file_name
;
2689 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2690 /* #:foo is the uninterned symbol named foo. */
2693 uninterned_symbol
= 1;
2696 && c
!= 0xa0 /* NBSP */
2698 || strchr ("\"';()[]#`,", c
) == NULL
)))
2700 /* No symbol character follows, this is the empty
2703 return Fmake_symbol (empty_unibyte_string
);
2707 /* ## is the empty symbol. */
2709 return Fintern (empty_unibyte_string
, Qnil
);
2710 /* Reader forms that can reuse previously read objects. */
2711 if (c
>= '0' && c
<= '9')
2716 /* Read a non-negative integer. */
2717 while (c
>= '0' && c
<= '9')
2719 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2720 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2721 n
= MOST_POSITIVE_FIXNUM
+ 1;
2723 n
= n
* 10 + c
- '0';
2727 if (n
<= MOST_POSITIVE_FIXNUM
)
2729 if (c
== 'r' || c
== 'R')
2730 return read_integer (readcharfun
, n
);
2732 if (! NILP (Vread_circle
))
2734 /* #n=object returns object, but associates it with
2738 /* Make a placeholder for #n# to use temporarily. */
2739 Lisp_Object placeholder
;
2742 placeholder
= Fcons (Qnil
, Qnil
);
2743 cell
= Fcons (make_number (n
), placeholder
);
2744 read_objects
= Fcons (cell
, read_objects
);
2746 /* Read the object itself. */
2747 tem
= read0 (readcharfun
);
2749 /* Now put it everywhere the placeholder was... */
2750 substitute_object_in_subtree (tem
, placeholder
);
2752 /* ...and #n# will use the real value from now on. */
2753 Fsetcdr (cell
, tem
);
2758 /* #n# returns a previously read object. */
2761 tem
= Fassq (make_number (n
), read_objects
);
2767 /* Fall through to error message. */
2769 else if (c
== 'x' || c
== 'X')
2770 return read_integer (readcharfun
, 16);
2771 else if (c
== 'o' || c
== 'O')
2772 return read_integer (readcharfun
, 8);
2773 else if (c
== 'b' || c
== 'B')
2774 return read_integer (readcharfun
, 2);
2777 invalid_syntax ("#");
2780 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2785 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2790 int next_char
= READCHAR
;
2792 /* Transition from old-style to new-style:
2793 If we see "(`" it used to mean old-style, which usually works
2794 fine because ` should almost never appear in such a position
2795 for new-style. But occasionally we need "(`" to mean new
2796 style, so we try to distinguish the two by the fact that we
2797 can either write "( `foo" or "(` foo", where the first
2798 intends to use new-style whereas the second intends to use
2799 old-style. For Emacs-25, we should completely remove this
2800 first_in_list exception (old-style can still be obtained via
2802 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2804 Vold_style_backquotes
= Qt
;
2810 bool saved_new_backquote_flag
= new_backquote_flag
;
2812 new_backquote_flag
= 1;
2813 value
= read0 (readcharfun
);
2814 new_backquote_flag
= saved_new_backquote_flag
;
2816 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2821 int next_char
= READCHAR
;
2823 /* Transition from old-style to new-style:
2824 It used to be impossible to have a new-style , other than within
2825 a new-style `. This is sufficient when ` and , are used in the
2826 normal way, but ` and , can also appear in args to macros that
2827 will not interpret them in the usual way, in which case , may be
2828 used without any ` anywhere near.
2829 So we now use the same heuristic as for backquote: old-style
2830 unquotes are only recognized when first on a list, and when
2831 followed by a space.
2832 Because it's more difficult to peek 2 chars ahead, a new-style
2833 ,@ can still not be used outside of a `, unless it's in the middle
2835 if (new_backquote_flag
2837 || (next_char
!= ' ' && next_char
!= '@'))
2839 Lisp_Object comma_type
= Qnil
;
2844 comma_type
= Qcomma_at
;
2846 comma_type
= Qcomma_dot
;
2849 if (ch
>= 0) UNREAD (ch
);
2850 comma_type
= Qcomma
;
2853 value
= read0 (readcharfun
);
2854 return Fcons (comma_type
, Fcons (value
, Qnil
));
2858 Vold_style_backquotes
= Qt
;
2870 end_of_file_error ();
2872 /* Accept `single space' syntax like (list ? x) where the
2873 whitespace character is SPC or TAB.
2874 Other literal whitespace like NL, CR, and FF are not accepted,
2875 as there are well-established escape sequences for these. */
2876 if (c
== ' ' || c
== '\t')
2877 return make_number (c
);
2880 c
= read_escape (readcharfun
, 0);
2881 modifiers
= c
& CHAR_MODIFIER_MASK
;
2882 c
&= ~CHAR_MODIFIER_MASK
;
2883 if (CHAR_BYTE8_P (c
))
2884 c
= CHAR_TO_BYTE8 (c
);
2887 next_char
= READCHAR
;
2888 ok
= (next_char
<= 040
2889 || (next_char
< 0200
2890 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2893 return make_number (c
);
2895 invalid_syntax ("?");
2900 char *p
= read_buffer
;
2901 char *end
= read_buffer
+ read_buffer_size
;
2903 /* True if we saw an escape sequence specifying
2904 a multibyte character. */
2905 bool force_multibyte
= 0;
2906 /* True if we saw an escape sequence specifying
2907 a single-byte character. */
2908 bool force_singlebyte
= 0;
2910 ptrdiff_t nchars
= 0;
2912 while ((ch
= READCHAR
) >= 0
2915 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2917 ptrdiff_t offset
= p
- read_buffer
;
2918 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2919 memory_full (SIZE_MAX
);
2920 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
2921 read_buffer_size
*= 2;
2922 p
= read_buffer
+ offset
;
2923 end
= read_buffer
+ read_buffer_size
;
2930 ch
= read_escape (readcharfun
, 1);
2932 /* CH is -1 if \ newline has just been seen. */
2935 if (p
== read_buffer
)
2940 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2941 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2943 if (CHAR_BYTE8_P (ch
))
2944 force_singlebyte
= 1;
2945 else if (! ASCII_CHAR_P (ch
))
2946 force_multibyte
= 1;
2947 else /* I.e. ASCII_CHAR_P (ch). */
2949 /* Allow `\C- ' and `\C-?'. */
2950 if (modifiers
== CHAR_CTL
)
2953 ch
= 0, modifiers
= 0;
2955 ch
= 127, modifiers
= 0;
2957 if (modifiers
& CHAR_SHIFT
)
2959 /* Shift modifier is valid only with [A-Za-z]. */
2960 if (ch
>= 'A' && ch
<= 'Z')
2961 modifiers
&= ~CHAR_SHIFT
;
2962 else if (ch
>= 'a' && ch
<= 'z')
2963 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2966 if (modifiers
& CHAR_META
)
2968 /* Move the meta bit to the right place for a
2970 modifiers
&= ~CHAR_META
;
2971 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2972 force_singlebyte
= 1;
2976 /* Any modifiers remaining are invalid. */
2978 error ("Invalid modifier in string");
2979 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2983 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2984 if (CHAR_BYTE8_P (ch
))
2985 force_singlebyte
= 1;
2986 else if (! ASCII_CHAR_P (ch
))
2987 force_multibyte
= 1;
2993 end_of_file_error ();
2995 /* If purifying, and string starts with \ newline,
2996 return zero instead. This is for doc strings
2997 that we are really going to find in etc/DOC.nn.nn. */
2998 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2999 return make_number (0);
3001 if (! force_multibyte
&& force_singlebyte
)
3003 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3004 forms. Convert it to unibyte. */
3005 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3007 p
= read_buffer
+ nchars
;
3010 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3012 || (p
- read_buffer
!= nchars
)));
3017 int next_char
= READCHAR
;
3020 if (next_char
<= 040
3021 || (next_char
< 0200
3022 && strchr ("\"';([#?`,", next_char
) != NULL
))
3028 /* Otherwise, we fall through! Note that the atom-reading loop
3029 below will now loop at least once, assuring that we will not
3030 try to UNREAD two characters in a row. */
3034 if (c
<= 040) goto retry
;
3035 if (c
== 0xa0) /* NBSP */
3040 char *p
= read_buffer
;
3042 EMACS_INT start_position
= readchar_count
- 1;
3045 char *end
= read_buffer
+ read_buffer_size
;
3049 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3051 ptrdiff_t offset
= p
- read_buffer
;
3052 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3053 memory_full (SIZE_MAX
);
3054 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3055 read_buffer_size
*= 2;
3056 p
= read_buffer
+ offset
;
3057 end
= read_buffer
+ read_buffer_size
;
3064 end_of_file_error ();
3069 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3075 && c
!= 0xa0 /* NBSP */
3077 || strchr ("\"';()[]#`,", c
) == NULL
));
3081 ptrdiff_t offset
= p
- read_buffer
;
3082 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3083 memory_full (SIZE_MAX
);
3084 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3085 read_buffer_size
*= 2;
3086 p
= read_buffer
+ offset
;
3087 end
= read_buffer
+ read_buffer_size
;
3093 if (!quoted
&& !uninterned_symbol
)
3095 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3096 if (! NILP (result
))
3100 Lisp_Object name
, result
;
3101 ptrdiff_t nbytes
= p
- read_buffer
;
3104 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3108 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3109 ? make_pure_string
: make_specified_string
)
3110 (read_buffer
, nchars
, nbytes
, multibyte
));
3111 result
= (uninterned_symbol
? Fmake_symbol (name
)
3112 : Fintern (name
, Qnil
));
3114 if (EQ (Vread_with_symbol_positions
, Qt
)
3115 || EQ (Vread_with_symbol_positions
, readcharfun
))
3116 Vread_symbol_positions_list
3117 = Fcons (Fcons (result
, make_number (start_position
)),
3118 Vread_symbol_positions_list
);
3126 /* List of nodes we've seen during substitute_object_in_subtree. */
3127 static Lisp_Object seen_list
;
3130 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3132 Lisp_Object check_object
;
3134 /* We haven't seen any objects when we start. */
3137 /* Make all the substitutions. */
3139 = substitute_object_recurse (object
, placeholder
, object
);
3141 /* Clear seen_list because we're done with it. */
3144 /* The returned object here is expected to always eq the
3146 if (!EQ (check_object
, object
))
3147 error ("Unexpected mutation error in reader");
3150 /* Feval doesn't get called from here, so no gc protection is needed. */
3151 #define SUBSTITUTE(get_val, set_val) \
3153 Lisp_Object old_value = get_val; \
3154 Lisp_Object true_value \
3155 = substitute_object_recurse (object, placeholder, \
3158 if (!EQ (old_value, true_value)) \
3165 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3167 /* If we find the placeholder, return the target object. */
3168 if (EQ (placeholder
, subtree
))
3171 /* If we've been to this node before, don't explore it again. */
3172 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3175 /* If this node can be the entry point to a cycle, remember that
3176 we've seen it. It can only be such an entry point if it was made
3177 by #n=, which means that we can find it as a value in
3179 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3180 seen_list
= Fcons (subtree
, seen_list
);
3182 /* Recurse according to subtree's type.
3183 Every branch must return a Lisp_Object. */
3184 switch (XTYPE (subtree
))
3186 case Lisp_Vectorlike
:
3188 ptrdiff_t i
, length
= 0;
3189 if (BOOL_VECTOR_P (subtree
))
3190 return subtree
; /* No sub-objects anyway. */
3191 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3192 || COMPILEDP (subtree
))
3193 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3194 else if (VECTORP (subtree
))
3195 length
= ASIZE (subtree
);
3197 /* An unknown pseudovector may contain non-Lisp fields, so we
3198 can't just blindly traverse all its fields. We used to call
3199 `Flength' which signaled `sequencep', so I just preserved this
3201 wrong_type_argument (Qsequencep
, subtree
);
3203 for (i
= 0; i
< length
; i
++)
3204 SUBSTITUTE (AREF (subtree
, i
),
3205 ASET (subtree
, i
, true_value
));
3211 SUBSTITUTE (XCAR (subtree
),
3212 XSETCAR (subtree
, true_value
));
3213 SUBSTITUTE (XCDR (subtree
),
3214 XSETCDR (subtree
, true_value
));
3220 /* Check for text properties in each interval.
3221 substitute_in_interval contains part of the logic. */
3223 INTERVAL root_interval
= string_intervals (subtree
);
3224 Lisp_Object arg
= Fcons (object
, placeholder
);
3226 traverse_intervals_noorder (root_interval
,
3227 &substitute_in_interval
, arg
);
3232 /* Other types don't recurse any further. */
3238 /* Helper function for substitute_object_recurse. */
3240 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3242 Lisp_Object object
= Fcar (arg
);
3243 Lisp_Object placeholder
= Fcdr (arg
);
3245 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3255 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3256 integer syntax and fits in a fixnum, else return the nearest float if CP has
3257 either floating point or integer syntax and BASE is 10, else return nil. If
3258 IGNORE_TRAILING, consider just the longest prefix of CP that has
3259 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3260 number has integer syntax but does not fit. */
3263 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3266 char const *cp
= string
;
3268 bool float_syntax
= 0;
3271 /* Compute NaN and infinities using a variable, to cope with compilers that
3272 think they are smarter than we are. */
3275 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3276 IEEE floating point hosts, and works around a formerly-common bug where
3277 atof ("-0.0") drops the sign. */
3278 bool negative
= *cp
== '-';
3280 bool signedp
= negative
|| *cp
== '+';
3285 leading_digit
= digit_to_number (*cp
, base
);
3286 if (0 <= leading_digit
)
3291 while (0 <= digit_to_number (*cp
, base
));
3301 if ('0' <= *cp
&& *cp
<= '9')
3306 while ('0' <= *cp
&& *cp
<= '9');
3308 if (*cp
== 'e' || *cp
== 'E')
3310 char const *ecp
= cp
;
3312 if (*cp
== '+' || *cp
== '-')
3314 if ('0' <= *cp
&& *cp
<= '9')
3319 while ('0' <= *cp
&& *cp
<= '9');
3321 else if (cp
[-1] == '+'
3322 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3328 else if (cp
[-1] == '+'
3329 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3333 value
= zero
/ zero
;
3335 /* If that made a "negative" NaN, negate it. */
3338 union { double d
; char c
[sizeof (double)]; }
3339 u_data
, u_minus_zero
;
3341 u_minus_zero
.d
= -0.0;
3342 for (i
= 0; i
< sizeof (double); i
++)
3343 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3349 /* Now VALUE is a positive NaN. */
3355 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3356 || state
== (LEAD_INT
|E_EXP
));
3359 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3360 any prefix that matches. Otherwise, the entire string must match. */
3361 if (! (ignore_trailing
3362 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3363 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3366 /* If the number uses integer and not float syntax, and is in C-language
3367 range, use its value, preferably as a fixnum. */
3368 if (0 <= leading_digit
&& ! float_syntax
)
3372 /* Fast special case for single-digit integers. This also avoids a
3373 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3374 case some versions of strtoumax accept numbers like "0x1" that Emacs
3376 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3377 return make_number (negative
? -leading_digit
: leading_digit
);
3380 n
= strtoumax (string
+ signedp
, NULL
, base
);
3381 if (errno
== ERANGE
)
3383 /* Unfortunately there's no simple and accurate way to convert
3384 non-base-10 numbers that are out of C-language range. */
3386 xsignal1 (Qoverflow_error
, build_string (string
));
3388 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3390 EMACS_INT signed_n
= n
;
3391 return make_number (negative
? -signed_n
: signed_n
);
3397 /* Either the number uses float syntax, or it does not fit into a fixnum.
3398 Convert it from string to floating point, unless the value is already
3399 known because it is an infinity, a NAN, or its absolute value fits in
3402 value
= atof (string
+ signedp
);
3404 return make_float (negative
? -value
: value
);
3409 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3413 Lisp_Object tem
, item
, vector
;
3414 struct Lisp_Cons
*otem
;
3417 tem
= read_list (1, readcharfun
);
3418 len
= Flength (tem
);
3419 vector
= Fmake_vector (len
, Qnil
);
3421 size
= ASIZE (vector
);
3422 ptr
= XVECTOR (vector
)->contents
;
3423 for (i
= 0; i
< size
; i
++)
3426 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3427 bytecode object, the docstring containing the bytecode and
3428 constants values must be treated as unibyte and passed to
3429 Fread, to get the actual bytecode string and constants vector. */
3430 if (bytecodeflag
&& load_force_doc_strings
)
3432 if (i
== COMPILED_BYTECODE
)
3434 if (!STRINGP (item
))
3435 error ("Invalid byte code");
3437 /* Delay handling the bytecode slot until we know whether
3438 it is lazily-loaded (we can tell by whether the
3439 constants slot is nil). */
3440 ASET (vector
, COMPILED_CONSTANTS
, item
);
3443 else if (i
== COMPILED_CONSTANTS
)
3445 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3449 /* Coerce string to unibyte (like string-as-unibyte,
3450 but without generating extra garbage and
3451 guaranteeing no change in the contents). */
3452 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3453 STRING_SET_UNIBYTE (bytestr
);
3455 item
= Fread (Fcons (bytestr
, readcharfun
));
3457 error ("Invalid byte code");
3459 otem
= XCONS (item
);
3460 bytestr
= XCAR (item
);
3465 /* Now handle the bytecode slot. */
3466 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3468 else if (i
== COMPILED_DOC_STRING
3470 && ! STRING_MULTIBYTE (item
))
3472 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3473 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3475 item
= Fstring_as_multibyte (item
);
3478 ASET (vector
, i
, item
);
3486 /* FLAG means check for ] to terminate rather than ) and . */
3489 read_list (bool flag
, Lisp_Object readcharfun
)
3491 Lisp_Object val
, tail
;
3492 Lisp_Object elt
, tem
;
3493 struct gcpro gcpro1
, gcpro2
;
3494 /* 0 is the normal case.
3495 1 means this list is a doc reference; replace it with the number 0.
3496 2 means this list is a doc reference; replace it with the doc string. */
3497 int doc_reference
= 0;
3499 /* Initialize this to 1 if we are reading a list. */
3500 bool first_in_list
= flag
<= 0;
3509 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3514 /* While building, if the list starts with #$, treat it specially. */
3515 if (EQ (elt
, Vload_file_name
)
3517 && !NILP (Vpurify_flag
))
3519 if (NILP (Vdoc_file_name
))
3520 /* We have not yet called Snarf-documentation, so assume
3521 this file is described in the DOC-MM.NN file
3522 and Snarf-documentation will fill in the right value later.
3523 For now, replace the whole list with 0. */
3526 /* We have already called Snarf-documentation, so make a relative
3527 file name for this file, so it can be found properly
3528 in the installed Lisp directory.
3529 We don't use Fexpand_file_name because that would make
3530 the directory absolute now. */
3531 elt
= concat2 (build_string ("../lisp/"),
3532 Ffile_name_nondirectory (elt
));
3534 else if (EQ (elt
, Vload_file_name
)
3536 && load_force_doc_strings
)
3545 invalid_syntax (") or . in a vector");
3553 XSETCDR (tail
, read0 (readcharfun
));
3555 val
= read0 (readcharfun
);
3556 read1 (readcharfun
, &ch
, 0);
3560 if (doc_reference
== 1)
3561 return make_number (0);
3562 if (doc_reference
== 2)
3564 /* Get a doc string from the file we are loading.
3565 If it's in saved_doc_string, get it from there.
3567 Here, we don't know if the string is a
3568 bytecode string or a doc string. As a
3569 bytecode string must be unibyte, we always
3570 return a unibyte string. If it is actually a
3571 doc string, caller must make it
3574 EMACS_INT pos
= XINT (XCDR (val
));
3575 /* Position is negative for user variables. */
3576 if (pos
< 0) pos
= -pos
;
3577 if (pos
>= saved_doc_string_position
3578 && pos
< (saved_doc_string_position
3579 + saved_doc_string_length
))
3581 ptrdiff_t start
= pos
- saved_doc_string_position
;
3584 /* Process quoting with ^A,
3585 and find the end of the string,
3586 which is marked with ^_ (037). */
3587 for (from
= start
, to
= start
;
3588 saved_doc_string
[from
] != 037;)
3590 int c
= saved_doc_string
[from
++];
3593 c
= saved_doc_string
[from
++];
3595 saved_doc_string
[to
++] = c
;
3597 saved_doc_string
[to
++] = 0;
3599 saved_doc_string
[to
++] = 037;
3602 saved_doc_string
[to
++] = c
;
3605 return make_unibyte_string (saved_doc_string
+ start
,
3608 /* Look in prev_saved_doc_string the same way. */
3609 else if (pos
>= prev_saved_doc_string_position
3610 && pos
< (prev_saved_doc_string_position
3611 + prev_saved_doc_string_length
))
3614 pos
- prev_saved_doc_string_position
;
3617 /* Process quoting with ^A,
3618 and find the end of the string,
3619 which is marked with ^_ (037). */
3620 for (from
= start
, to
= start
;
3621 prev_saved_doc_string
[from
] != 037;)
3623 int c
= prev_saved_doc_string
[from
++];
3626 c
= prev_saved_doc_string
[from
++];
3628 prev_saved_doc_string
[to
++] = c
;
3630 prev_saved_doc_string
[to
++] = 0;
3632 prev_saved_doc_string
[to
++] = 037;
3635 prev_saved_doc_string
[to
++] = c
;
3638 return make_unibyte_string (prev_saved_doc_string
3643 return get_doc_string (val
, 1, 0);
3648 invalid_syntax (". in wrong context");
3650 invalid_syntax ("] in a list");
3652 tem
= Fcons (elt
, Qnil
);
3654 XSETCDR (tail
, tem
);
3661 static Lisp_Object initial_obarray
;
3663 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3665 static size_t oblookup_last_bucket_number
;
3667 /* Get an error if OBARRAY is not an obarray.
3668 If it is one, return it. */
3671 check_obarray (Lisp_Object obarray
)
3673 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3675 /* If Vobarray is now invalid, force it to be valid. */
3676 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3677 wrong_type_argument (Qvectorp
, obarray
);
3682 /* Intern the C string STR: return a symbol with that name,
3683 interned in the current obarray. */
3686 intern_1 (const char *str
, ptrdiff_t len
)
3688 Lisp_Object obarray
= check_obarray (Vobarray
);
3689 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3691 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3695 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3697 Lisp_Object obarray
= check_obarray (Vobarray
);
3698 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3703 if (NILP (Vpurify_flag
))
3704 /* Creating a non-pure string from a string literal not
3705 implemented yet. We could just use make_string here and live
3706 with the extra copy. */
3709 return Fintern (make_pure_c_string (str
, len
), obarray
);
3712 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3713 doc
: /* Return the canonical symbol whose name is STRING.
3714 If there is none, one is created by this function and returned.
3715 A second optional argument specifies the obarray to use;
3716 it defaults to the value of `obarray'. */)
3717 (Lisp_Object string
, Lisp_Object obarray
)
3719 register Lisp_Object tem
, sym
, *ptr
;
3721 if (NILP (obarray
)) obarray
= Vobarray
;
3722 obarray
= check_obarray (obarray
);
3724 CHECK_STRING (string
);
3726 tem
= oblookup (obarray
, SSDATA (string
),
3729 if (!INTEGERP (tem
))
3732 if (!NILP (Vpurify_flag
))
3733 string
= Fpurecopy (string
);
3734 sym
= Fmake_symbol (string
);
3736 if (EQ (obarray
, initial_obarray
))
3737 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3739 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3741 if ((SREF (string
, 0) == ':')
3742 && EQ (obarray
, initial_obarray
))
3744 XSYMBOL (sym
)->constant
= 1;
3745 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3746 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3749 ptr
= aref_addr (obarray
, XINT(tem
));
3751 set_symbol_next (sym
, XSYMBOL (*ptr
));
3753 set_symbol_next (sym
, NULL
);
3758 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3759 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3760 NAME may be a string or a symbol. If it is a symbol, that exact
3761 symbol is searched for.
3762 A second optional argument specifies the obarray to use;
3763 it defaults to the value of `obarray'. */)
3764 (Lisp_Object name
, Lisp_Object obarray
)
3766 register Lisp_Object tem
, string
;
3768 if (NILP (obarray
)) obarray
= Vobarray
;
3769 obarray
= check_obarray (obarray
);
3771 if (!SYMBOLP (name
))
3773 CHECK_STRING (name
);
3777 string
= SYMBOL_NAME (name
);
3779 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3780 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3786 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3787 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3788 The value is t if a symbol was found and deleted, nil otherwise.
3789 NAME may be a string or a symbol. If it is a symbol, that symbol
3790 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3791 OBARRAY defaults to the value of the variable `obarray'. */)
3792 (Lisp_Object name
, Lisp_Object obarray
)
3794 register Lisp_Object string
, tem
;
3797 if (NILP (obarray
)) obarray
= Vobarray
;
3798 obarray
= check_obarray (obarray
);
3801 string
= SYMBOL_NAME (name
);
3804 CHECK_STRING (name
);
3808 tem
= oblookup (obarray
, SSDATA (string
),
3813 /* If arg was a symbol, don't delete anything but that symbol itself. */
3814 if (SYMBOLP (name
) && !EQ (name
, tem
))
3817 /* There are plenty of other symbols which will screw up the Emacs
3818 session if we unintern them, as well as even more ways to use
3819 `setq' or `fset' or whatnot to make the Emacs session
3820 unusable. Let's not go down this silly road. --Stef */
3821 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3822 error ("Attempt to unintern t or nil"); */
3824 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3826 hash
= oblookup_last_bucket_number
;
3828 if (EQ (AREF (obarray
, hash
), tem
))
3830 if (XSYMBOL (tem
)->next
)
3833 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3834 ASET (obarray
, hash
, sym
);
3837 ASET (obarray
, hash
, make_number (0));
3841 Lisp_Object tail
, following
;
3843 for (tail
= AREF (obarray
, hash
);
3844 XSYMBOL (tail
)->next
;
3847 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3848 if (EQ (following
, tem
))
3850 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3859 /* Return the symbol in OBARRAY whose names matches the string
3860 of SIZE characters (SIZE_BYTE bytes) at PTR.
3861 If there is no such symbol in OBARRAY, return nil.
3863 Also store the bucket number in oblookup_last_bucket_number. */
3866 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3870 register Lisp_Object tail
;
3871 Lisp_Object bucket
, tem
;
3873 obarray
= check_obarray (obarray
);
3874 obsize
= ASIZE (obarray
);
3876 /* This is sometimes needed in the middle of GC. */
3877 obsize
&= ~ARRAY_MARK_FLAG
;
3878 hash
= hash_string (ptr
, size_byte
) % obsize
;
3879 bucket
= AREF (obarray
, hash
);
3880 oblookup_last_bucket_number
= hash
;
3881 if (EQ (bucket
, make_number (0)))
3883 else if (!SYMBOLP (bucket
))
3884 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3886 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3888 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3889 && SCHARS (SYMBOL_NAME (tail
)) == size
3890 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3892 else if (XSYMBOL (tail
)->next
== 0)
3895 XSETINT (tem
, hash
);
3900 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3903 register Lisp_Object tail
;
3904 CHECK_VECTOR (obarray
);
3905 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3907 tail
= AREF (obarray
, i
);
3912 if (XSYMBOL (tail
)->next
== 0)
3914 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3920 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3922 call1 (function
, sym
);
3925 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3926 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3927 OBARRAY defaults to the value of `obarray'. */)
3928 (Lisp_Object function
, Lisp_Object obarray
)
3930 if (NILP (obarray
)) obarray
= Vobarray
;
3931 obarray
= check_obarray (obarray
);
3933 map_obarray (obarray
, mapatoms_1
, function
);
3937 #define OBARRAY_SIZE 1511
3942 Lisp_Object oblength
;
3943 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3945 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3947 Vobarray
= Fmake_vector (oblength
, make_number (0));
3948 initial_obarray
= Vobarray
;
3949 staticpro (&initial_obarray
);
3951 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
3952 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3953 NILP (Vpurify_flag) check in intern_c_string. */
3954 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3955 Qnil
= intern_c_string ("nil");
3957 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3958 so those two need to be fixed manually. */
3959 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3960 set_symbol_function (Qunbound
, Qunbound
);
3961 set_symbol_plist (Qunbound
, Qnil
);
3962 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3963 XSYMBOL (Qnil
)->constant
= 1;
3964 XSYMBOL (Qnil
)->declared_special
= 1;
3965 set_symbol_plist (Qnil
, Qnil
);
3967 Qt
= intern_c_string ("t");
3968 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3969 XSYMBOL (Qnil
)->declared_special
= 1;
3970 XSYMBOL (Qt
)->constant
= 1;
3972 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3975 DEFSYM (Qvariable_documentation
, "variable-documentation");
3977 read_buffer
= xmalloc (size
);
3978 read_buffer_size
= size
;
3982 defsubr (struct Lisp_Subr
*sname
)
3984 Lisp_Object sym
, tem
;
3985 sym
= intern_c_string (sname
->symbol_name
);
3986 XSETPVECTYPE (sname
, PVEC_SUBR
);
3987 XSETSUBR (tem
, sname
);
3988 set_symbol_function (sym
, tem
);
3991 #ifdef NOTDEF /* Use fset in subr.el now! */
3993 defalias (struct Lisp_Subr
*sname
, char *string
)
3996 sym
= intern (string
);
3997 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4001 /* Define an "integer variable"; a symbol whose value is forwarded to a
4002 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4003 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4005 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4006 const char *namestring
, EMACS_INT
*address
)
4009 sym
= intern_c_string (namestring
);
4010 i_fwd
->type
= Lisp_Fwd_Int
;
4011 i_fwd
->intvar
= address
;
4012 XSYMBOL (sym
)->declared_special
= 1;
4013 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4014 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4017 /* Similar but define a variable whose value is t if address contains 1,
4018 nil if address contains 0. */
4020 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4021 const char *namestring
, bool *address
)
4024 sym
= intern_c_string (namestring
);
4025 b_fwd
->type
= Lisp_Fwd_Bool
;
4026 b_fwd
->boolvar
= address
;
4027 XSYMBOL (sym
)->declared_special
= 1;
4028 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4029 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4030 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4033 /* Similar but define a variable whose value is the Lisp Object stored
4034 at address. Two versions: with and without gc-marking of the C
4035 variable. The nopro version is used when that variable will be
4036 gc-marked for some other reason, since marking the same slot twice
4037 can cause trouble with strings. */
4039 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4040 const char *namestring
, Lisp_Object
*address
)
4043 sym
= intern_c_string (namestring
);
4044 o_fwd
->type
= Lisp_Fwd_Obj
;
4045 o_fwd
->objvar
= address
;
4046 XSYMBOL (sym
)->declared_special
= 1;
4047 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4048 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4052 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4053 const char *namestring
, Lisp_Object
*address
)
4055 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4056 staticpro (address
);
4059 /* Similar but define a variable whose value is the Lisp Object stored
4060 at a particular offset in the current kboard object. */
4063 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4064 const char *namestring
, int offset
)
4067 sym
= intern_c_string (namestring
);
4068 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4069 ko_fwd
->offset
= offset
;
4070 XSYMBOL (sym
)->declared_special
= 1;
4071 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4072 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4075 /* Check that the elements of Vload_path exist. */
4078 load_path_check (void)
4080 Lisp_Object path_tail
;
4082 /* The only elements that might not exist are those from
4083 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4085 for (path_tail
= Vload_path
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4087 Lisp_Object dirfile
;
4088 dirfile
= Fcar (path_tail
);
4089 if (STRINGP (dirfile
))
4091 dirfile
= Fdirectory_file_name (dirfile
);
4092 if (! file_accessible_directory_p (SSDATA (dirfile
)))
4093 dir_warning ("Lisp directory", XCAR (path_tail
));
4098 /* Record the value of load-path used at the start of dumping
4099 so we can see if the site changed it later during dumping. */
4100 static Lisp_Object dump_path
;
4102 /* Compute the default Vload_path, with the following logic:
4104 use EMACSLOADPATH env-var if set; otherwise use PATH_LOADSEARCH,
4105 prepending PATH_SITELOADSEARCH unless --no-site-lisp.
4106 The remainder is what happens when dumping works:
4107 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4108 Otherwise use EMACSLOADPATH if set, else PATH_LOADSEARCH.
4110 If !initialized, then just set both Vload_path and dump_path.
4111 If initialized, then if Vload_path != dump_path, do nothing.
4112 (Presumably the load-path has already been changed by something.
4113 This can only be from a site-load file during dumping,
4114 or because EMACSLOADPATH is set.)
4115 If Vinstallation_directory is not nil (ie, running uninstalled):
4116 If installation-dir/lisp exists and not already a member,
4117 we must be running uninstalled. Reset the load-path
4118 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4119 refers to the eventual installation directories. Since we
4120 are not yet installed, we should not use them, even if they exist.)
4121 If installation-dir/lisp does not exist, just add dump_path at the
4123 Add installation-dir/leim (if exists and not already a member) at the front.
4124 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4125 and not already a member) at the front.
4126 If installation-dir != source-dir (ie running an uninstalled,
4127 out-of-tree build) AND install-dir/src/Makefile exists BUT
4128 install-dir/src/Makefile.in does NOT exist (this is a sanity
4129 check), then repeat the above steps for source-dir/lisp,
4131 Finally, add the site-lisp directories at the front (if !no_site_lisp).
4141 const char *loadpath
= ns_load_path ();
4144 normal
= PATH_LOADSEARCH
;
4146 Vload_path
= decode_env_path ("EMACSLOADPATH", loadpath
? loadpath
: normal
);
4148 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4153 /* FIXME CANNOT_DUMP platforms should get source-dir/lisp etc added
4154 to their load-path too, AFAICS. I don't think we can tell the
4155 difference between initialized and !initialized in this case,
4156 so we'll have to do it unconditionally when Vinstallation_directory
4158 if (!no_site_lisp
&& !egetenv ("EMACSLOADPATH"))
4160 Lisp_Object sitelisp
;
4161 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4162 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4164 #else /* !CANNOT_DUMP */
4165 if (NILP (Vpurify_flag
))
4167 normal
= PATH_LOADSEARCH
;
4168 /* If the EMACSLOADPATH environment variable is set, use its value.
4169 This doesn't apply if we're dumping. */
4170 if (egetenv ("EMACSLOADPATH"))
4171 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4174 normal
= PATH_DUMPLOADSEARCH
;
4176 /* In a dumped Emacs, we normally reset the value of Vload_path using
4177 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4178 the source directory, instead of the path of the installed elisp
4179 libraries. However, if it appears that Vload_path has already been
4180 changed from the default that was saved before dumping, don't
4181 change it further. Changes can only be due to EMACSLOADPATH, or
4182 site-lisp files that were processed during dumping. */
4185 if (NILP (Fequal (dump_path
, Vload_path
)))
4187 /* Do not make any changes, just check the elements exist. */
4188 /* Note: --no-site-lisp is ignored.
4189 I don't know what to do about this. */
4195 const char *loadpath
= ns_load_path ();
4196 Vload_path
= decode_env_path (0, loadpath
? loadpath
: normal
);
4198 Vload_path
= decode_env_path (0, normal
);
4200 if (!NILP (Vinstallation_directory
))
4202 Lisp_Object tem
, tem1
;
4204 /* Add to the path the lisp subdir of the installation
4205 dir, if it is accessible. Note: in out-of-tree builds,
4206 this directory is empty save for Makefile. */
4207 tem
= Fexpand_file_name (build_string ("lisp"),
4208 Vinstallation_directory
);
4209 tem1
= Ffile_accessible_directory_p (tem
);
4212 if (NILP (Fmember (tem
, Vload_path
)))
4214 /* We are running uninstalled. The default load-path
4215 points to the eventual installed lisp, leim
4216 directories. We should not use those now, even
4217 if they exist, so start over from a clean slate. */
4218 Vload_path
= Fcons (tem
, Qnil
);
4222 /* That dir doesn't exist, so add the build-time
4223 Lisp dirs instead. */
4224 Vload_path
= nconc2 (Vload_path
, dump_path
);
4226 /* Add leim under the installation dir, if it is accessible. */
4227 tem
= Fexpand_file_name (build_string ("leim"),
4228 Vinstallation_directory
);
4229 tem1
= Ffile_accessible_directory_p (tem
);
4232 if (NILP (Fmember (tem
, Vload_path
)))
4233 Vload_path
= Fcons (tem
, Vload_path
);
4236 /* Add site-lisp under the installation dir, if it exists. */
4239 tem
= Fexpand_file_name (build_string ("site-lisp"),
4240 Vinstallation_directory
);
4241 tem1
= Ffile_accessible_directory_p (tem
);
4244 if (NILP (Fmember (tem
, Vload_path
)))
4245 Vload_path
= Fcons (tem
, Vload_path
);
4249 /* If Emacs was not built in the source directory,
4250 and it is run from where it was built, add to load-path
4251 the lisp, leim and site-lisp dirs under that directory. */
4253 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4257 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4258 Vinstallation_directory
);
4259 tem1
= Ffile_exists_p (tem
);
4261 /* Don't be fooled if they moved the entire source tree
4262 AFTER dumping Emacs. If the build directory is indeed
4263 different from the source dir, src/Makefile.in and
4264 src/Makefile will not be found together. */
4265 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4266 Vinstallation_directory
);
4267 tem2
= Ffile_exists_p (tem
);
4268 if (!NILP (tem1
) && NILP (tem2
))
4270 tem
= Fexpand_file_name (build_string ("lisp"),
4273 if (NILP (Fmember (tem
, Vload_path
)))
4274 Vload_path
= Fcons (tem
, Vload_path
);
4276 tem
= Fexpand_file_name (build_string ("leim"),
4279 if (NILP (Fmember (tem
, Vload_path
)))
4280 Vload_path
= Fcons (tem
, Vload_path
);
4284 tem
= Fexpand_file_name (build_string ("site-lisp"),
4286 tem1
= Ffile_accessible_directory_p (tem
);
4289 if (NILP (Fmember (tem
, Vload_path
)))
4290 Vload_path
= Fcons (tem
, Vload_path
);
4294 } /* Vinstallation_directory != Vsource_directory */
4296 } /* if Vinstallation_directory */
4298 /* Check before adding the site-lisp directories.
4299 The install should have created them, but they are not
4300 required, so no need to warn if they are absent.
4301 Or we might be running before installation. */
4304 /* Add the site-lisp directories at the front. */
4307 Lisp_Object sitelisp
;
4308 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4309 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4311 } /* if dump_path == Vload_path */
4313 else /* !initialized */
4315 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4316 source directory. We used to add ../lisp (ie the lisp dir in
4317 the build directory) at the front here, but that caused trouble
4318 because it was copied from dump_path into Vload_path, above,
4319 when Vinstallation_directory was non-nil. It should not be
4320 necessary, since in out of tree builds lisp/ is empty, save
4322 Vload_path
= decode_env_path (0, normal
);
4323 dump_path
= Vload_path
;
4324 /* No point calling load_path_check; load-path only contains essential
4325 elements from the source directory at this point. They cannot
4326 be missing unless something went extremely (and improbably)
4327 wrong, in which case the build will fail in obvious ways. */
4329 #endif /* !CANNOT_DUMP */
4333 load_in_progress
= 0;
4334 Vload_file_name
= Qnil
;
4336 load_descriptor_list
= Qnil
;
4338 Vstandard_input
= Qt
;
4339 Vloads_in_progress
= Qnil
;
4342 /* Print a warning that directory intended for use USE and with name
4343 DIRNAME cannot be accessed. On entry, errno should correspond to
4344 the access failure. Print the warning on stderr and put it in
4348 dir_warning (char const *use
, Lisp_Object dirname
)
4350 static char const format
[] = "Warning: %s `%s': %s\n";
4351 int access_errno
= errno
;
4352 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4354 /* Don't log the warning before we've initialized!! */
4357 char const *diagnostic
= emacs_strerror (access_errno
);
4359 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4360 + strlen (use
) + SBYTES (dirname
)
4361 + strlen (diagnostic
));
4362 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4364 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4370 syms_of_lread (void)
4373 defsubr (&Sread_from_string
);
4375 defsubr (&Sintern_soft
);
4376 defsubr (&Sunintern
);
4377 defsubr (&Sget_load_suffixes
);
4379 defsubr (&Seval_buffer
);
4380 defsubr (&Seval_region
);
4381 defsubr (&Sread_char
);
4382 defsubr (&Sread_char_exclusive
);
4383 defsubr (&Sread_event
);
4384 defsubr (&Sget_file_char
);
4385 defsubr (&Smapatoms
);
4386 defsubr (&Slocate_file_internal
);
4388 DEFVAR_LISP ("obarray", Vobarray
,
4389 doc
: /* Symbol table for use by `intern' and `read'.
4390 It is a vector whose length ought to be prime for best results.
4391 The vector's contents don't make sense if examined from Lisp programs;
4392 to find all the symbols in an obarray, use `mapatoms'. */);
4394 DEFVAR_LISP ("values", Vvalues
,
4395 doc
: /* List of values of all expressions which were read, evaluated and printed.
4396 Order is reverse chronological. */);
4397 XSYMBOL (intern ("values"))->declared_special
= 0;
4399 DEFVAR_LISP ("standard-input", Vstandard_input
,
4400 doc
: /* Stream for read to get input from.
4401 See documentation of `read' for possible values. */);
4402 Vstandard_input
= Qt
;
4404 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4405 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4407 If this variable is a buffer, then only forms read from that buffer
4408 will be added to `read-symbol-positions-list'.
4409 If this variable is t, then all read forms will be added.
4410 The effect of all other values other than nil are not currently
4411 defined, although they may be in the future.
4413 The positions are relative to the last call to `read' or
4414 `read-from-string'. It is probably a bad idea to set this variable at
4415 the toplevel; bind it instead. */);
4416 Vread_with_symbol_positions
= Qnil
;
4418 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4419 doc
: /* A list mapping read symbols to their positions.
4420 This variable is modified during calls to `read' or
4421 `read-from-string', but only when `read-with-symbol-positions' is
4424 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4425 CHAR-POSITION is an integer giving the offset of that occurrence of the
4426 symbol from the position where `read' or `read-from-string' started.
4428 Note that a symbol will appear multiple times in this list, if it was
4429 read multiple times. The list is in the same order as the symbols
4431 Vread_symbol_positions_list
= Qnil
;
4433 DEFVAR_LISP ("read-circle", Vread_circle
,
4434 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4437 DEFVAR_LISP ("load-path", Vload_path
,
4438 doc
: /* List of directories to search for files to load.
4439 Each element is a string (directory name) or nil (try default directory).
4440 Initialized based on EMACSLOADPATH environment variable, if any,
4441 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4443 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4444 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4445 This list should not include the empty string.
4446 `load' and related functions try to append these suffixes, in order,
4447 to the specified file name if a Lisp suffix is allowed or required. */);
4448 Vload_suffixes
= Fcons (build_pure_c_string (".elc"),
4449 Fcons (build_pure_c_string (".el"), Qnil
));
4450 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4451 doc
: /* List of suffixes that indicate representations of \
4453 This list should normally start with the empty string.
4455 Enabling Auto Compression mode appends the suffixes in
4456 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4457 mode removes them again. `load' and related functions use this list to
4458 determine whether they should look for compressed versions of a file
4459 and, if so, which suffixes they should try to append to the file name
4460 in order to do so. However, if you want to customize which suffixes
4461 the loading functions recognize as compression suffixes, you should
4462 customize `jka-compr-load-suffixes' rather than the present variable. */);
4463 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4465 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4466 doc
: /* Non-nil if inside of `load'. */);
4467 DEFSYM (Qload_in_progress
, "load-in-progress");
4469 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4470 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4471 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4473 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4474 a symbol \(a feature name).
4476 When `load' is run and the file-name argument matches an element's
4477 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4478 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4480 An error in FORMS does not undo the load, but does prevent execution of
4481 the rest of the FORMS. */);
4482 Vafter_load_alist
= Qnil
;
4484 DEFVAR_LISP ("load-history", Vload_history
,
4485 doc
: /* Alist mapping loaded file names to symbols and features.
4486 Each alist element should be a list (FILE-NAME ENTRIES...), where
4487 FILE-NAME is the name of a file that has been loaded into Emacs.
4488 The file name is absolute and true (i.e. it doesn't contain symlinks).
4489 As an exception, one of the alist elements may have FILE-NAME nil,
4490 for symbols and features not associated with any file.
4492 The remaining ENTRIES in the alist element describe the functions and
4493 variables defined in that file, the features provided, and the
4494 features required. Each entry has the form `(provide . FEATURE)',
4495 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4496 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4497 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4498 autoload before this file redefined it as a function. In addition,
4499 entries may also be single symbols, which means that SYMBOL was
4500 defined by `defvar' or `defconst'.
4502 During preloading, the file name recorded is relative to the main Lisp
4503 directory. These file names are converted to absolute at startup. */);
4504 Vload_history
= Qnil
;
4506 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4507 doc
: /* Full name of file being loaded by `load'. */);
4508 Vload_file_name
= Qnil
;
4510 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4511 doc
: /* File name, including directory, of user's initialization file.
4512 If the file loaded had extension `.elc', and the corresponding source file
4513 exists, this variable contains the name of source file, suitable for use
4514 by functions like `custom-save-all' which edit the init file.
4515 While Emacs loads and evaluates the init file, value is the real name
4516 of the file, regardless of whether or not it has the `.elc' extension. */);
4517 Vuser_init_file
= Qnil
;
4519 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4520 doc
: /* Used for internal purposes by `load'. */);
4521 Vcurrent_load_list
= Qnil
;
4523 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4524 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4525 The default is nil, which means use the function `read'. */);
4526 Vload_read_function
= Qnil
;
4528 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4529 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4530 This function is for doing code conversion before reading the source file.
4531 If nil, loading is done without any code conversion.
4532 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4533 FULLNAME is the full name of FILE.
4534 See `load' for the meaning of the remaining arguments. */);
4535 Vload_source_file_function
= Qnil
;
4537 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4538 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4539 This is useful when the file being loaded is a temporary copy. */);
4540 load_force_doc_strings
= 0;
4542 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4543 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4544 This is normally bound by `load' and `eval-buffer' to control `read',
4545 and is not meant for users to change. */);
4546 load_convert_to_unibyte
= 0;
4548 DEFVAR_LISP ("source-directory", Vsource_directory
,
4549 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4550 You cannot count on them to still be there! */);
4552 = Fexpand_file_name (build_string ("../"),
4553 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4555 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4556 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4557 Vpreloaded_file_list
= Qnil
;
4559 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4560 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4561 Vbyte_boolean_vars
= Qnil
;
4563 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4564 doc
: /* Non-nil means load dangerous compiled Lisp files.
4565 Some versions of XEmacs use different byte codes than Emacs. These
4566 incompatible byte codes can make Emacs crash when it tries to execute
4568 load_dangerous_libraries
= 0;
4570 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4571 doc
: /* Non-nil means force printing messages when loading Lisp files.
4572 This overrides the value of the NOMESSAGE argument to `load'. */);
4573 force_load_messages
= 0;
4575 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4576 doc
: /* Regular expression matching safe to load compiled Lisp files.
4577 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4578 from the file, and matches them against this regular expression.
4579 When the regular expression matches, the file is considered to be safe
4580 to load. See also `load-dangerous-libraries'. */);
4581 Vbytecomp_version_regexp
4582 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4584 DEFSYM (Qlexical_binding
, "lexical-binding");
4585 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4586 doc
: /* Whether to use lexical binding when evaluating code.
4587 Non-nil means that the code in the current buffer should be evaluated
4588 with lexical binding.
4589 This variable is automatically set from the file variables of an
4590 interpreted Lisp file read using `load'. Unlike other file local
4591 variables, this must be set in the first line of a file. */);
4592 Vlexical_binding
= Qnil
;
4593 Fmake_variable_buffer_local (Qlexical_binding
);
4595 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4596 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4597 Veval_buffer_list
= Qnil
;
4599 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4600 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4601 Vold_style_backquotes
= Qnil
;
4602 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4604 /* Vsource_directory was initialized in init_lread. */
4606 load_descriptor_list
= Qnil
;
4607 staticpro (&load_descriptor_list
);
4609 DEFSYM (Qcurrent_load_list
, "current-load-list");
4610 DEFSYM (Qstandard_input
, "standard-input");
4611 DEFSYM (Qread_char
, "read-char");
4612 DEFSYM (Qget_file_char
, "get-file-char");
4613 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4614 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4616 DEFSYM (Qbackquote
, "`");
4617 DEFSYM (Qcomma
, ",");
4618 DEFSYM (Qcomma_at
, ",@");
4619 DEFSYM (Qcomma_dot
, ",.");
4621 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4622 DEFSYM (Qascii_character
, "ascii-character");
4623 DEFSYM (Qfunction
, "function");
4624 DEFSYM (Qload
, "load");
4625 DEFSYM (Qload_file_name
, "load-file-name");
4626 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4627 DEFSYM (Qfile_truename
, "file-truename");
4628 DEFSYM (Qdir_ok
, "dir-ok");
4629 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4631 staticpro (&dump_path
);
4633 staticpro (&read_objects
);
4634 read_objects
= Qnil
;
4635 staticpro (&seen_list
);
4638 Vloads_in_progress
= Qnil
;
4639 staticpro (&Vloads_in_progress
);
4641 DEFSYM (Qhash_table
, "hash-table");
4642 DEFSYM (Qdata
, "data");
4643 DEFSYM (Qtest
, "test");
4644 DEFSYM (Qsize
, "size");
4645 DEFSYM (Qweakness
, "weakness");
4646 DEFSYM (Qrehash_size
, "rehash-size");
4647 DEFSYM (Qrehash_threshold
, "rehash-threshold");