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 this function fails to find a file, it may look for different
1000 representations of that file before trying another file.
1001 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
1002 to the file name. Emacs uses this feature mainly to find compressed
1003 versions of files when Auto Compression mode is enabled.
1005 The exact suffixes that this function tries out, in the exact order,
1006 are given by the value of the variable `load-file-rep-suffixes' if
1007 NOSUFFIX is non-nil and by the return value of the function
1008 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1009 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1010 and then the former.
1012 Loading a file records its definitions, and its `provide' and
1013 `require' calls, in an element of `load-history' whose
1014 car is the file name loaded. See `load-history'.
1016 While the file is in the process of being loaded, the variable
1017 `load-in-progress' is non-nil and the variable `load-file-name'
1018 is bound to the file's name.
1020 Return t if the file exists and loads successfully. */)
1021 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1023 register FILE *stream
;
1024 register int fd
= -1;
1025 ptrdiff_t count
= SPECPDL_INDEX ();
1026 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1027 Lisp_Object found
, efound
, hist_file_name
;
1028 /* True means we printed the ".el is newer" message. */
1030 /* True means we are loading a compiled file. */
1032 Lisp_Object handler
;
1034 const char *fmode
= "r";
1042 CHECK_STRING (file
);
1044 /* If file name is magic, call the handler. */
1045 /* This shouldn't be necessary any more now that `openp' handles it right.
1046 handler = Ffind_file_name_handler (file, Qload);
1047 if (!NILP (handler))
1048 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1050 /* Do this after the handler to avoid
1051 the need to gcpro noerror, nomessage and nosuffix.
1052 (Below here, we care only whether they are nil or not.)
1053 The presence of this call is the result of a historical accident:
1054 it used to be in every file-operation and when it got removed
1055 everywhere, it accidentally stayed here. Since then, enough people
1056 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1057 that it seemed risky to remove. */
1058 if (! NILP (noerror
))
1060 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1061 Qt
, load_error_handler
);
1066 file
= Fsubstitute_in_file_name (file
);
1069 /* Avoid weird lossage with null string as arg,
1070 since it would try to load a directory as a Lisp file. */
1071 if (SBYTES (file
) > 0)
1073 ptrdiff_t size
= SBYTES (file
);
1076 GCPRO2 (file
, found
);
1078 if (! NILP (must_suffix
))
1080 /* Don't insist on adding a suffix if FILE already ends with one. */
1082 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1085 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1087 /* Don't insist on adding a suffix
1088 if the argument includes a directory name. */
1089 else if (! NILP (Ffile_name_directory (file
)))
1093 fd
= openp (Vload_path
, file
,
1094 (!NILP (nosuffix
) ? Qnil
1095 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1096 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1097 tmp
[1] = Vload_file_rep_suffixes
,
1106 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1110 /* Tell startup.el whether or not we found the user's init file. */
1111 if (EQ (Qt
, Vuser_init_file
))
1112 Vuser_init_file
= found
;
1114 /* If FD is -2, that means openp found a magic file. */
1117 if (NILP (Fequal (found
, file
)))
1118 /* If FOUND is a different file name from FILE,
1119 find its handler even if we have already inhibited
1120 the `load' operation on FILE. */
1121 handler
= Ffind_file_name_handler (found
, Qt
);
1123 handler
= Ffind_file_name_handler (found
, Qload
);
1124 if (! NILP (handler
))
1125 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1127 /* Tramp has to deal with semi-broken packages that prepend
1128 drive letters to remote files. For that reason, Tramp
1129 catches file operations that test for file existence, which
1130 makes openp think X:/foo.elc files are remote. However,
1131 Tramp does not catch `load' operations for such files, so we
1132 end up with a nil as the `load' handler above. If we would
1133 continue with fd = -2, we will behave wrongly, and in
1134 particular try reading a .elc file in the "rt" mode instead
1135 of "rb". See bug #9311 for the results. To work around
1136 this, we try to open the file locally, and go with that if it
1138 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1144 /* Check if we're stuck in a recursive load cycle.
1146 2000-09-21: It's not possible to just check for the file loaded
1147 being a member of Vloads_in_progress. This fails because of the
1148 way the byte compiler currently works; `provide's are not
1149 evaluated, see font-lock.el/jit-lock.el as an example. This
1150 leads to a certain amount of ``normal'' recursion.
1152 Also, just loading a file recursively is not always an error in
1153 the general case; the second load may do something different. */
1157 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1158 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1162 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1164 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1165 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1168 /* All loads are by default dynamic, unless the file itself specifies
1169 otherwise using a file-variable in the first line. This is bound here
1170 so that it takes effect whether or not we use
1171 Vload_source_file_function. */
1172 specbind (Qlexical_binding
, Qnil
);
1174 /* Get the name for load-history. */
1175 hist_file_name
= (! NILP (Vpurify_flag
)
1176 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1177 tmp
[1] = Ffile_name_nondirectory (found
),
1183 /* Check for the presence of old-style quotes and warn about them. */
1184 specbind (Qold_style_backquotes
, Qnil
);
1185 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1187 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1188 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1189 /* Load .elc files directly, but not when they are
1190 remote and have no handler! */
1197 GCPRO3 (file
, found
, hist_file_name
);
1200 && ! (version
= safe_to_load_version (fd
)))
1203 if (!load_dangerous_libraries
)
1207 error ("File `%s' was not compiled in Emacs",
1210 else if (!NILP (nomessage
) && !force_load_messages
)
1211 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1216 efound
= ENCODE_FILE (found
);
1221 result
= stat (SSDATA (efound
), &s1
);
1224 SSET (efound
, SBYTES (efound
) - 1, 0);
1225 result
= stat (SSDATA (efound
), &s2
);
1226 SSET (efound
, SBYTES (efound
) - 1, 'c');
1230 && EMACS_TIME_LT (get_stat_mtime (&s1
), get_stat_mtime (&s2
)))
1232 /* Make the progress messages mention that source is newer. */
1235 /* If we won't print another message, mention this anyway. */
1236 if (!NILP (nomessage
) && !force_load_messages
)
1238 Lisp_Object msg_file
;
1239 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1240 message_with_string ("Source file `%s' newer than byte-compiled file",
1249 /* We are loading a source file (*.el). */
1250 if (!NILP (Vload_source_file_function
))
1256 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1257 NILP (noerror
) ? Qnil
: Qt
,
1258 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1259 return unbind_to (count
, val
);
1263 GCPRO3 (file
, found
, hist_file_name
);
1266 efound
= ENCODE_FILE (found
);
1267 /* If we somehow got here with fd == -2, meaning the file is deemed
1268 to be remote, don't even try to reopen the file locally; just
1269 force a failure instead. */
1273 stream
= fopen (SSDATA (efound
), fmode
);
1277 #else /* not WINDOWSNT */
1278 stream
= fdopen (fd
, fmode
);
1279 #endif /* not WINDOWSNT */
1283 error ("Failure to create stdio stream for %s", SDATA (file
));
1286 if (! NILP (Vpurify_flag
))
1287 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1289 if (NILP (nomessage
) || force_load_messages
)
1292 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1295 message_with_string ("Loading %s (source)...", file
, 1);
1297 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1299 else /* The typical case; compiled file newer than source file. */
1300 message_with_string ("Loading %s...", file
, 1);
1303 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1304 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1305 specbind (Qload_file_name
, found
);
1306 specbind (Qinhibit_file_name_operation
, Qnil
);
1307 load_descriptor_list
1308 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1309 specbind (Qload_in_progress
, Qt
);
1312 if (lisp_file_lexically_bound_p (Qget_file_char
))
1313 Fset (Qlexical_binding
, Qt
);
1315 if (! version
|| version
>= 22)
1316 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1317 0, Qnil
, Qnil
, Qnil
, Qnil
);
1320 /* We can't handle a file which was compiled with
1321 byte-compile-dynamic by older version of Emacs. */
1322 specbind (Qload_force_doc_strings
, Qt
);
1323 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1324 0, Qnil
, Qnil
, Qnil
, Qnil
);
1326 unbind_to (count
, Qnil
);
1328 /* Run any eval-after-load forms for this file. */
1329 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1330 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1334 xfree (saved_doc_string
);
1335 saved_doc_string
= 0;
1336 saved_doc_string_size
= 0;
1338 xfree (prev_saved_doc_string
);
1339 prev_saved_doc_string
= 0;
1340 prev_saved_doc_string_size
= 0;
1342 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1345 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1348 message_with_string ("Loading %s (source)...done", file
, 1);
1350 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1352 else /* The typical case; compiled file newer than source file. */
1353 message_with_string ("Loading %s...done", file
, 1);
1360 load_unwind (Lisp_Object arg
) /* Used as unwind-protect function in load. */
1362 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1373 load_descriptor_unwind (Lisp_Object oldlist
)
1375 load_descriptor_list
= oldlist
;
1379 /* Close all descriptors in use for Floads.
1380 This is used when starting a subprocess. */
1383 close_load_descs (void)
1387 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1388 emacs_close (XFASTINT (XCAR (tail
)));
1393 complete_filename_p (Lisp_Object pathname
)
1395 const unsigned char *s
= SDATA (pathname
);
1396 return (IS_DIRECTORY_SEP (s
[0])
1397 || (SCHARS (pathname
) > 2
1398 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1401 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1402 doc
: /* Search for FILENAME through PATH.
1403 Returns the file's name in absolute form, or nil if not found.
1404 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1405 file name when searching.
1406 If non-nil, PREDICATE is used instead of `file-readable-p'.
1407 PREDICATE can also be an integer to pass to the access(2) function,
1408 in which case file-name-handlers are ignored.
1409 This function will normally skip directories, so if you want it to find
1410 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1411 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1414 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1415 if (NILP (predicate
) && fd
> 0)
1420 static Lisp_Object Qdir_ok
;
1422 /* Search for a file whose name is STR, looking in directories
1423 in the Lisp list PATH, and trying suffixes from SUFFIX.
1424 On success, returns a file descriptor. On failure, returns -1.
1426 SUFFIXES is a list of strings containing possible suffixes.
1427 The empty suffix is automatically added if the list is empty.
1429 PREDICATE non-nil means don't open the files,
1430 just look for one that satisfies the predicate. In this case,
1431 returns 1 on success. The predicate can be a lisp function or
1432 an integer to pass to `access' (in which case file-name-handlers
1435 If STOREPTR is nonzero, it points to a slot where the name of
1436 the file actually found should be stored as a Lisp string.
1437 nil is stored there on failure.
1439 If the file we find is remote, return -2
1440 but store the found remote file name in *STOREPTR. */
1443 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1446 ptrdiff_t fn_size
= 100;
1450 ptrdiff_t want_length
;
1451 Lisp_Object filename
;
1452 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1453 Lisp_Object string
, tail
, encoded_fn
;
1454 ptrdiff_t max_suffix_len
= 0;
1458 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1460 CHECK_STRING_CAR (tail
);
1461 max_suffix_len
= max (max_suffix_len
,
1462 SBYTES (XCAR (tail
)));
1465 string
= filename
= encoded_fn
= Qnil
;
1466 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1471 if (complete_filename_p (str
))
1474 for (; CONSP (path
); path
= XCDR (path
))
1476 filename
= Fexpand_file_name (str
, XCAR (path
));
1477 if (!complete_filename_p (filename
))
1478 /* If there are non-absolute elts in PATH (eg "."). */
1479 /* Of course, this could conceivably lose if luser sets
1480 default-directory to be something non-absolute... */
1482 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1483 if (!complete_filename_p (filename
))
1484 /* Give up on this path element! */
1488 /* Calculate maximum length of any filename made from
1489 this path element/specified file name and any possible suffix. */
1490 want_length
= max_suffix_len
+ SBYTES (filename
);
1491 if (fn_size
<= want_length
)
1492 fn
= alloca (fn_size
= 100 + want_length
);
1494 /* Loop over suffixes. */
1495 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1496 CONSP (tail
); tail
= XCDR (tail
))
1498 ptrdiff_t fnlen
, lsuffix
= SBYTES (XCAR (tail
));
1499 Lisp_Object handler
;
1502 /* Concatenate path element/specified name with the suffix.
1503 If the directory starts with /:, remove that. */
1504 int prefixlen
= ((SCHARS (filename
) > 2
1505 && SREF (filename
, 0) == '/'
1506 && SREF (filename
, 1) == ':')
1508 fnlen
= SBYTES (filename
) - prefixlen
;
1509 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1510 memcpy (fn
+ fnlen
, SDATA (XCAR (tail
)), lsuffix
+ 1);
1512 /* Check that the file exists and is not a directory. */
1513 /* We used to only check for handlers on non-absolute file names:
1517 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1518 It's not clear why that was the case and it breaks things like
1519 (load "/bar.el") where the file is actually "/bar.el.gz". */
1520 string
= make_string (fn
, fnlen
);
1521 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1522 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1524 if (NILP (predicate
))
1525 exists
= !NILP (Ffile_readable_p (string
));
1528 Lisp_Object tmp
= call1 (predicate
, string
);
1529 exists
= !NILP (tmp
)
1530 && (EQ (tmp
, Qdir_ok
)
1531 || NILP (Ffile_directory_p (string
)));
1536 /* We succeeded; return this descriptor and filename. */
1550 encoded_fn
= ENCODE_FILE (string
);
1551 pfn
= SSDATA (encoded_fn
);
1553 exists
= access (pfn
, F_OK
) == 0 && access (pfn
, D_OK
) < 0;
1555 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1559 /* Check that we can access or open it. */
1560 if (NATNUMP (predicate
))
1561 fd
= (((XFASTINT (predicate
) & ~INT_MAX
) == 0
1562 && access (pfn
, XFASTINT (predicate
)) == 0)
1565 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1569 /* We succeeded; return this descriptor and filename. */
1587 /* Merge the list we've accumulated of globals from the current input source
1588 into the load_history variable. The details depend on whether
1589 the source has an associated file name or not.
1591 FILENAME is the file name that we are loading from.
1593 ENTIRE is true if loading that entire file, false if evaluating
1597 build_load_history (Lisp_Object filename
, bool entire
)
1599 Lisp_Object tail
, prev
, newelt
;
1600 Lisp_Object tem
, tem2
;
1603 tail
= Vload_history
;
1606 while (CONSP (tail
))
1610 /* Find the feature's previous assoc list... */
1611 if (!NILP (Fequal (filename
, Fcar (tem
))))
1615 /* If we're loading the entire file, remove old data. */
1619 Vload_history
= XCDR (tail
);
1621 Fsetcdr (prev
, XCDR (tail
));
1624 /* Otherwise, cons on new symbols that are not already members. */
1627 tem2
= Vcurrent_load_list
;
1629 while (CONSP (tem2
))
1631 newelt
= XCAR (tem2
);
1633 if (NILP (Fmember (newelt
, tem
)))
1634 Fsetcar (tail
, Fcons (XCAR (tem
),
1635 Fcons (newelt
, XCDR (tem
))));
1648 /* If we're loading an entire file, cons the new assoc onto the
1649 front of load-history, the most-recently-loaded position. Also
1650 do this if we didn't find an existing member for the file. */
1651 if (entire
|| !foundit
)
1652 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1657 readevalloop_1 (Lisp_Object old
)
1659 load_convert_to_unibyte
= ! NILP (old
);
1663 /* Signal an `end-of-file' error, if possible with file name
1666 static _Noreturn
void
1667 end_of_file_error (void)
1669 if (STRINGP (Vload_file_name
))
1670 xsignal1 (Qend_of_file
, Vload_file_name
);
1672 xsignal0 (Qend_of_file
);
1675 /* UNIBYTE specifies how to set load_convert_to_unibyte
1676 for this invocation.
1677 READFUN, if non-nil, is used instead of `read'.
1679 START, END specify region to read in current buffer (from eval-region).
1680 If the input is not from a buffer, they must be nil. */
1683 readevalloop (Lisp_Object readcharfun
,
1685 Lisp_Object sourcename
,
1687 Lisp_Object unibyte
, Lisp_Object readfun
,
1688 Lisp_Object start
, Lisp_Object end
)
1691 register Lisp_Object val
;
1692 ptrdiff_t count
= SPECPDL_INDEX ();
1693 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1694 struct buffer
*b
= 0;
1695 bool continue_reading_p
;
1696 Lisp_Object lex_bound
;
1697 /* True if reading an entire buffer. */
1698 bool whole_buffer
= 0;
1699 /* True on the first time around. */
1700 bool first_sexp
= 1;
1701 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1703 if (NILP (Ffboundp (macroexpand
))
1704 /* Don't macroexpand in .elc files, since it should have been done
1705 already. We actually don't know whether we're in a .elc file or not,
1706 so we use circumstantial evidence: .el files normally go through
1707 Vload_source_file_function -> load-with-code-conversion
1709 || EQ (readcharfun
, Qget_file_char
)
1710 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1713 if (MARKERP (readcharfun
))
1716 start
= readcharfun
;
1719 if (BUFFERP (readcharfun
))
1720 b
= XBUFFER (readcharfun
);
1721 else if (MARKERP (readcharfun
))
1722 b
= XMARKER (readcharfun
)->buffer
;
1724 /* We assume START is nil when input is not from a buffer. */
1725 if (! NILP (start
) && !b
)
1728 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1729 specbind (Qcurrent_load_list
, Qnil
);
1730 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1731 load_convert_to_unibyte
= !NILP (unibyte
);
1733 /* If lexical binding is active (either because it was specified in
1734 the file's header, or via a buffer-local variable), create an empty
1735 lexical environment, otherwise, turn off lexical binding. */
1736 lex_bound
= find_symbol_value (Qlexical_binding
);
1737 specbind (Qinternal_interpreter_environment
,
1738 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1739 ? Qnil
: Fcons (Qt
, Qnil
));
1741 GCPRO4 (sourcename
, readfun
, start
, end
);
1743 /* Try to ensure sourcename is a truename, except whilst preloading. */
1744 if (NILP (Vpurify_flag
)
1745 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1746 && !NILP (Ffboundp (Qfile_truename
)))
1747 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1749 LOADHIST_ATTACH (sourcename
);
1751 continue_reading_p
= 1;
1752 while (continue_reading_p
)
1754 ptrdiff_t count1
= SPECPDL_INDEX ();
1756 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1757 error ("Reading from killed buffer");
1761 /* Switch to the buffer we are reading from. */
1762 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1763 set_buffer_internal (b
);
1765 /* Save point in it. */
1766 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1767 /* Save ZV in it. */
1768 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1769 /* Those get unbound after we read one expression. */
1771 /* Set point and ZV around stuff to be read. */
1774 Fnarrow_to_region (make_number (BEGV
), end
);
1776 /* Just for cleanliness, convert END to a marker
1777 if it is an integer. */
1779 end
= Fpoint_max_marker ();
1782 /* On the first cycle, we can easily test here
1783 whether we are reading the whole buffer. */
1784 if (b
&& first_sexp
)
1785 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1792 while ((c
= READCHAR
) != '\n' && c
!= -1);
1797 unbind_to (count1
, Qnil
);
1801 /* Ignore whitespace here, so we can detect eof. */
1802 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1803 || c
== 0xa0) /* NBSP */
1806 if (!NILP (Vpurify_flag
) && c
== '(')
1808 val
= read_list (0, readcharfun
);
1813 read_objects
= Qnil
;
1814 if (!NILP (readfun
))
1816 val
= call1 (readfun
, readcharfun
);
1818 /* If READCHARFUN has set point to ZV, we should
1819 stop reading, even if the form read sets point
1820 to a different value when evaluated. */
1821 if (BUFFERP (readcharfun
))
1823 struct buffer
*buf
= XBUFFER (readcharfun
);
1824 if (BUF_PT (buf
) == BUF_ZV (buf
))
1825 continue_reading_p
= 0;
1828 else if (! NILP (Vload_read_function
))
1829 val
= call1 (Vload_read_function
, readcharfun
);
1831 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1834 if (!NILP (start
) && continue_reading_p
)
1835 start
= Fpoint_marker ();
1837 /* Restore saved point and BEGV. */
1838 unbind_to (count1
, Qnil
);
1840 /* Now eval what we just read. */
1841 if (!NILP (macroexpand
))
1842 val
= call1 (macroexpand
, val
);
1843 val
= eval_sub (val
);
1847 Vvalues
= Fcons (val
, Vvalues
);
1848 if (EQ (Vstandard_output
, Qt
))
1857 build_load_history (sourcename
,
1858 stream
|| whole_buffer
);
1862 unbind_to (count
, Qnil
);
1865 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1866 doc
: /* Execute the current buffer as Lisp code.
1867 When called from a Lisp program (i.e., not interactively), this
1868 function accepts up to five optional arguments:
1869 BUFFER is the buffer to evaluate (nil means use current buffer).
1870 PRINTFLAG controls printing of output:
1871 A value of nil means discard it; anything else is stream for print.
1872 FILENAME specifies the file name to use for `load-history'.
1873 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1875 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1876 functions should work normally even if PRINTFLAG is nil.
1878 This function preserves the position of point. */)
1879 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1881 ptrdiff_t count
= SPECPDL_INDEX ();
1882 Lisp_Object tem
, buf
;
1885 buf
= Fcurrent_buffer ();
1887 buf
= Fget_buffer (buffer
);
1889 error ("No such buffer");
1891 if (NILP (printflag
) && NILP (do_allow_print
))
1896 if (NILP (filename
))
1897 filename
= BVAR (XBUFFER (buf
), filename
);
1899 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1900 specbind (Qstandard_output
, tem
);
1901 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1902 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1903 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1904 readevalloop (buf
, 0, filename
,
1905 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1906 unbind_to (count
, Qnil
);
1911 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1912 doc
: /* Execute the region as Lisp code.
1913 When called from programs, expects two arguments,
1914 giving starting and ending indices in the current buffer
1915 of the text to be executed.
1916 Programs can pass third argument PRINTFLAG which controls output:
1917 A value of nil means discard it; anything else is stream for printing it.
1918 Also the fourth argument READ-FUNCTION, if non-nil, is used
1919 instead of `read' to read each expression. It gets one argument
1920 which is the input stream for reading characters.
1922 This function does not move point. */)
1923 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1925 /* FIXME: Do the eval-sexp-add-defvars dance! */
1926 ptrdiff_t count
= SPECPDL_INDEX ();
1927 Lisp_Object tem
, cbuf
;
1929 cbuf
= Fcurrent_buffer ();
1931 if (NILP (printflag
))
1935 specbind (Qstandard_output
, tem
);
1936 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1938 /* `readevalloop' calls functions which check the type of start and end. */
1939 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1940 !NILP (printflag
), Qnil
, read_function
,
1943 return unbind_to (count
, Qnil
);
1947 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1948 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1949 If STREAM is nil, use the value of `standard-input' (which see).
1950 STREAM or the value of `standard-input' may be:
1951 a buffer (read from point and advance it)
1952 a marker (read from where it points and advance it)
1953 a function (call it with no arguments for each character,
1954 call it with a char as argument to push a char back)
1955 a string (takes text from string, starting at the beginning)
1956 t (read text line using minibuffer and use it, or read from
1957 standard input in batch mode). */)
1958 (Lisp_Object stream
)
1961 stream
= Vstandard_input
;
1962 if (EQ (stream
, Qt
))
1963 stream
= Qread_char
;
1964 if (EQ (stream
, Qread_char
))
1965 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1967 return read_internal_start (stream
, Qnil
, Qnil
);
1970 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1971 doc
: /* Read one Lisp expression which is represented as text by STRING.
1972 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1973 FINAL-STRING-INDEX is an integer giving the position of the next
1974 remaining character in STRING.
1975 START and END optionally delimit a substring of STRING from which to read;
1976 they default to 0 and (length STRING) respectively. */)
1977 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1980 CHECK_STRING (string
);
1981 /* `read_internal_start' sets `read_from_string_index'. */
1982 ret
= read_internal_start (string
, start
, end
);
1983 return Fcons (ret
, make_number (read_from_string_index
));
1986 /* Function to set up the global context we need in toplevel read
1989 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1990 /* `start', `end' only used when stream is a string. */
1995 new_backquote_flag
= 0;
1996 read_objects
= Qnil
;
1997 if (EQ (Vread_with_symbol_positions
, Qt
)
1998 || EQ (Vread_with_symbol_positions
, stream
))
1999 Vread_symbol_positions_list
= Qnil
;
2001 if (STRINGP (stream
)
2002 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2004 ptrdiff_t startval
, endval
;
2007 if (STRINGP (stream
))
2010 string
= XCAR (stream
);
2013 endval
= SCHARS (string
);
2017 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2018 args_out_of_range (string
, end
);
2019 endval
= XINT (end
);
2026 CHECK_NUMBER (start
);
2027 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2028 args_out_of_range (string
, start
);
2029 startval
= XINT (start
);
2031 read_from_string_index
= startval
;
2032 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2033 read_from_string_limit
= endval
;
2036 retval
= read0 (stream
);
2037 if (EQ (Vread_with_symbol_positions
, Qt
)
2038 || EQ (Vread_with_symbol_positions
, stream
))
2039 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2044 /* Signal Qinvalid_read_syntax error.
2045 S is error string of length N (if > 0) */
2047 static _Noreturn
void
2048 invalid_syntax (const char *s
)
2050 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2054 /* Use this for recursive reads, in contexts where internal tokens
2058 read0 (Lisp_Object readcharfun
)
2060 register Lisp_Object val
;
2063 val
= read1 (readcharfun
, &c
, 0);
2067 xsignal1 (Qinvalid_read_syntax
,
2068 Fmake_string (make_number (1), make_number (c
)));
2071 static ptrdiff_t read_buffer_size
;
2072 static char *read_buffer
;
2074 /* Read a \-escape sequence, assuming we already read the `\'.
2075 If the escape sequence forces unibyte, return eight-bit char. */
2078 read_escape (Lisp_Object readcharfun
, bool stringp
)
2081 /* \u allows up to four hex digits, \U up to eight. Default to the
2082 behavior for \u, and change this value in the case that \U is seen. */
2083 int unicode_hex_count
= 4;
2088 end_of_file_error ();
2118 error ("Invalid escape character syntax");
2121 c
= read_escape (readcharfun
, 0);
2122 return c
| meta_modifier
;
2127 error ("Invalid escape character syntax");
2130 c
= read_escape (readcharfun
, 0);
2131 return c
| shift_modifier
;
2136 error ("Invalid escape character syntax");
2139 c
= read_escape (readcharfun
, 0);
2140 return c
| hyper_modifier
;
2145 error ("Invalid escape character syntax");
2148 c
= read_escape (readcharfun
, 0);
2149 return c
| alt_modifier
;
2153 if (stringp
|| c
!= '-')
2160 c
= read_escape (readcharfun
, 0);
2161 return c
| super_modifier
;
2166 error ("Invalid escape character syntax");
2170 c
= read_escape (readcharfun
, 0);
2171 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2172 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2173 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2174 return c
| ctrl_modifier
;
2175 /* ASCII control chars are made from letters (both cases),
2176 as well as the non-letters within 0100...0137. */
2177 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2178 return (c
& (037 | ~0177));
2179 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2180 return (c
& (037 | ~0177));
2182 return c
| ctrl_modifier
;
2192 /* An octal escape, as in ANSI C. */
2194 register int i
= c
- '0';
2195 register int count
= 0;
2198 if ((c
= READCHAR
) >= '0' && c
<= '7')
2210 if (i
>= 0x80 && i
< 0x100)
2211 i
= BYTE8_TO_CHAR (i
);
2216 /* A hex escape, as in ANSI C. */
2223 if (c
>= '0' && c
<= '9')
2228 else if ((c
>= 'a' && c
<= 'f')
2229 || (c
>= 'A' && c
<= 'F'))
2232 if (c
>= 'a' && c
<= 'f')
2242 /* Allow hex escapes as large as ?\xfffffff, because some
2243 packages use them to denote characters with modifiers. */
2244 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2245 error ("Hex character out of range: \\x%x...", i
);
2249 if (count
< 3 && i
>= 0x80)
2250 return BYTE8_TO_CHAR (i
);
2255 /* Post-Unicode-2.0: Up to eight hex chars. */
2256 unicode_hex_count
= 8;
2259 /* A Unicode escape. We only permit them in strings and characters,
2260 not arbitrarily in the source code, as in some other languages. */
2265 while (++count
<= unicode_hex_count
)
2268 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2270 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2271 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2272 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2274 error ("Non-hex digit used for Unicode escape");
2277 error ("Non-Unicode character: 0x%x", i
);
2286 /* Return the digit that CHARACTER stands for in the given BASE.
2287 Return -1 if CHARACTER is out of range for BASE,
2288 and -2 if CHARACTER is not valid for any supported BASE. */
2290 digit_to_number (int character
, int base
)
2294 if ('0' <= character
&& character
<= '9')
2295 digit
= character
- '0';
2296 else if ('a' <= character
&& character
<= 'z')
2297 digit
= character
- 'a' + 10;
2298 else if ('A' <= character
&& character
<= 'Z')
2299 digit
= character
- 'A' + 10;
2303 return digit
< base
? digit
: -1;
2306 /* Read an integer in radix RADIX using READCHARFUN to read
2307 characters. RADIX must be in the interval [2..36]; if it isn't, a
2308 read error is signaled . Value is the integer read. Signals an
2309 error if encountering invalid read syntax or if RADIX is out of
2313 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2315 /* Room for sign, leading 0, other digits, trailing null byte.
2316 Also, room for invalid syntax diagnostic. */
2317 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2318 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2320 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2322 if (radix
< 2 || radix
> 36)
2330 if (c
== '-' || c
== '+')
2341 /* Ignore redundant leading zeros, so the buffer doesn't
2342 fill up with them. */
2348 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2355 if (p
< buf
+ sizeof buf
- 1)
2369 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2370 invalid_syntax (buf
);
2373 return string_to_number (buf
, radix
, 0);
2377 /* If the next token is ')' or ']' or '.', we store that character
2378 in *PCH and the return value is not interesting. Else, we store
2379 zero in *PCH and we read and return one lisp object.
2381 FIRST_IN_LIST is true if this is the first element of a list. */
2384 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2387 bool uninterned_symbol
= 0;
2395 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2397 end_of_file_error ();
2402 return read_list (0, readcharfun
);
2405 return read_vector (readcharfun
, 0);
2421 /* Accept extended format for hashtables (extensible to
2423 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2424 Lisp_Object tmp
= read_list (0, readcharfun
);
2425 Lisp_Object head
= CAR_SAFE (tmp
);
2426 Lisp_Object data
= Qnil
;
2427 Lisp_Object val
= Qnil
;
2428 /* The size is 2 * number of allowed keywords to
2430 Lisp_Object params
[10];
2432 Lisp_Object key
= Qnil
;
2433 int param_count
= 0;
2435 if (!EQ (head
, Qhash_table
))
2436 error ("Invalid extended read marker at head of #s list "
2437 "(only hash-table allowed)");
2439 tmp
= CDR_SAFE (tmp
);
2441 /* This is repetitive but fast and simple. */
2442 params
[param_count
] = QCsize
;
2443 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2444 if (!NILP (params
[param_count
+ 1]))
2447 params
[param_count
] = QCtest
;
2448 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2449 if (!NILP (params
[param_count
+ 1]))
2452 params
[param_count
] = QCweakness
;
2453 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2454 if (!NILP (params
[param_count
+ 1]))
2457 params
[param_count
] = QCrehash_size
;
2458 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2459 if (!NILP (params
[param_count
+ 1]))
2462 params
[param_count
] = QCrehash_threshold
;
2463 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2464 if (!NILP (params
[param_count
+ 1]))
2467 /* This is the hashtable data. */
2468 data
= Fplist_get (tmp
, Qdata
);
2470 /* Now use params to make a new hashtable and fill it. */
2471 ht
= Fmake_hash_table (param_count
, params
);
2473 while (CONSP (data
))
2478 error ("Odd number of elements in hashtable data");
2481 Fputhash (key
, val
, ht
);
2487 invalid_syntax ("#");
2495 tmp
= read_vector (readcharfun
, 0);
2496 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2497 error ("Invalid size char-table");
2498 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2510 tmp
= read_vector (readcharfun
, 0);
2513 error ("Invalid size char-table");
2514 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2515 error ("Invalid depth in char-table");
2516 depth
= XINT (AREF (tmp
, 0));
2517 if (chartab_size
[depth
] != size
- 2)
2518 error ("Invalid size char-table");
2519 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2522 invalid_syntax ("#^^");
2524 invalid_syntax ("#^");
2529 length
= read1 (readcharfun
, pch
, first_in_list
);
2533 Lisp_Object tmp
, val
;
2534 EMACS_INT size_in_chars
2535 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2536 / BOOL_VECTOR_BITS_PER_CHAR
);
2539 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2540 if (STRING_MULTIBYTE (tmp
)
2541 || (size_in_chars
!= SCHARS (tmp
)
2542 /* We used to print 1 char too many
2543 when the number of bits was a multiple of 8.
2544 Accept such input in case it came from an old
2546 && ! (XFASTINT (length
)
2547 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2548 invalid_syntax ("#&...");
2550 val
= Fmake_bool_vector (length
, Qnil
);
2551 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2552 /* Clear the extraneous bits in the last byte. */
2553 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2554 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2555 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2558 invalid_syntax ("#&...");
2562 /* Accept compiled functions at read-time so that we don't have to
2563 build them using function calls. */
2565 tmp
= read_vector (readcharfun
, 1);
2566 make_byte_code (XVECTOR (tmp
));
2572 struct gcpro gcpro1
;
2575 /* Read the string itself. */
2576 tmp
= read1 (readcharfun
, &ch
, 0);
2577 if (ch
!= 0 || !STRINGP (tmp
))
2578 invalid_syntax ("#");
2580 /* Read the intervals and their properties. */
2583 Lisp_Object beg
, end
, plist
;
2585 beg
= read1 (readcharfun
, &ch
, 0);
2590 end
= read1 (readcharfun
, &ch
, 0);
2592 plist
= read1 (readcharfun
, &ch
, 0);
2594 invalid_syntax ("Invalid string property list");
2595 Fset_text_properties (beg
, end
, plist
, tmp
);
2601 /* #@NUMBER is used to skip NUMBER following characters.
2602 That's used in .elc files to skip over doc strings
2603 and function definitions. */
2606 enum { extra
= 100 };
2607 ptrdiff_t i
, nskip
= 0;
2610 /* Read a decimal integer. */
2611 while ((c
= READCHAR
) >= 0
2612 && c
>= '0' && c
<= '9')
2614 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2621 if (load_force_doc_strings
2622 && (EQ (readcharfun
, Qget_file_char
)
2623 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2625 /* If we are supposed to force doc strings into core right now,
2626 record the last string that we skipped,
2627 and record where in the file it comes from. */
2629 /* But first exchange saved_doc_string
2630 with prev_saved_doc_string, so we save two strings. */
2632 char *temp
= saved_doc_string
;
2633 ptrdiff_t temp_size
= saved_doc_string_size
;
2634 file_offset temp_pos
= saved_doc_string_position
;
2635 ptrdiff_t temp_len
= saved_doc_string_length
;
2637 saved_doc_string
= prev_saved_doc_string
;
2638 saved_doc_string_size
= prev_saved_doc_string_size
;
2639 saved_doc_string_position
= prev_saved_doc_string_position
;
2640 saved_doc_string_length
= prev_saved_doc_string_length
;
2642 prev_saved_doc_string
= temp
;
2643 prev_saved_doc_string_size
= temp_size
;
2644 prev_saved_doc_string_position
= temp_pos
;
2645 prev_saved_doc_string_length
= temp_len
;
2648 if (saved_doc_string_size
== 0)
2650 saved_doc_string
= xmalloc (nskip
+ extra
);
2651 saved_doc_string_size
= nskip
+ extra
;
2653 if (nskip
> saved_doc_string_size
)
2655 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2656 saved_doc_string_size
= nskip
+ extra
;
2659 saved_doc_string_position
= file_tell (instream
);
2661 /* Copy that many characters into saved_doc_string. */
2662 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2663 saved_doc_string
[i
] = c
= READCHAR
;
2665 saved_doc_string_length
= i
;
2669 /* Skip that many characters. */
2670 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2679 /* #! appears at the beginning of an executable file.
2680 Skip the first line. */
2681 while (c
!= '\n' && c
>= 0)
2686 return Vload_file_name
;
2688 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2689 /* #:foo is the uninterned symbol named foo. */
2692 uninterned_symbol
= 1;
2695 && c
!= 0xa0 /* NBSP */
2697 || strchr ("\"';()[]#`,", c
) == NULL
)))
2699 /* No symbol character follows, this is the empty
2702 return Fmake_symbol (empty_unibyte_string
);
2706 /* ## is the empty symbol. */
2708 return Fintern (empty_unibyte_string
, Qnil
);
2709 /* Reader forms that can reuse previously read objects. */
2710 if (c
>= '0' && c
<= '9')
2715 /* Read a non-negative integer. */
2716 while (c
>= '0' && c
<= '9')
2718 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2719 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2720 n
= MOST_POSITIVE_FIXNUM
+ 1;
2722 n
= n
* 10 + c
- '0';
2726 if (n
<= MOST_POSITIVE_FIXNUM
)
2728 if (c
== 'r' || c
== 'R')
2729 return read_integer (readcharfun
, n
);
2731 if (! NILP (Vread_circle
))
2733 /* #n=object returns object, but associates it with
2737 /* Make a placeholder for #n# to use temporarily. */
2738 Lisp_Object placeholder
;
2741 placeholder
= Fcons (Qnil
, Qnil
);
2742 cell
= Fcons (make_number (n
), placeholder
);
2743 read_objects
= Fcons (cell
, read_objects
);
2745 /* Read the object itself. */
2746 tem
= read0 (readcharfun
);
2748 /* Now put it everywhere the placeholder was... */
2749 substitute_object_in_subtree (tem
, placeholder
);
2751 /* ...and #n# will use the real value from now on. */
2752 Fsetcdr (cell
, tem
);
2757 /* #n# returns a previously read object. */
2760 tem
= Fassq (make_number (n
), read_objects
);
2766 /* Fall through to error message. */
2768 else if (c
== 'x' || c
== 'X')
2769 return read_integer (readcharfun
, 16);
2770 else if (c
== 'o' || c
== 'O')
2771 return read_integer (readcharfun
, 8);
2772 else if (c
== 'b' || c
== 'B')
2773 return read_integer (readcharfun
, 2);
2776 invalid_syntax ("#");
2779 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2784 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2789 int next_char
= READCHAR
;
2791 /* Transition from old-style to new-style:
2792 If we see "(`" it used to mean old-style, which usually works
2793 fine because ` should almost never appear in such a position
2794 for new-style. But occasionally we need "(`" to mean new
2795 style, so we try to distinguish the two by the fact that we
2796 can either write "( `foo" or "(` foo", where the first
2797 intends to use new-style whereas the second intends to use
2798 old-style. For Emacs-25, we should completely remove this
2799 first_in_list exception (old-style can still be obtained via
2801 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2803 Vold_style_backquotes
= Qt
;
2809 bool saved_new_backquote_flag
= new_backquote_flag
;
2811 new_backquote_flag
= 1;
2812 value
= read0 (readcharfun
);
2813 new_backquote_flag
= saved_new_backquote_flag
;
2815 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2820 int next_char
= READCHAR
;
2822 /* Transition from old-style to new-style:
2823 It used to be impossible to have a new-style , other than within
2824 a new-style `. This is sufficient when ` and , are used in the
2825 normal way, but ` and , can also appear in args to macros that
2826 will not interpret them in the usual way, in which case , may be
2827 used without any ` anywhere near.
2828 So we now use the same heuristic as for backquote: old-style
2829 unquotes are only recognized when first on a list, and when
2830 followed by a space.
2831 Because it's more difficult to peek 2 chars ahead, a new-style
2832 ,@ can still not be used outside of a `, unless it's in the middle
2834 if (new_backquote_flag
2836 || (next_char
!= ' ' && next_char
!= '@'))
2838 Lisp_Object comma_type
= Qnil
;
2843 comma_type
= Qcomma_at
;
2845 comma_type
= Qcomma_dot
;
2848 if (ch
>= 0) UNREAD (ch
);
2849 comma_type
= Qcomma
;
2852 value
= read0 (readcharfun
);
2853 return Fcons (comma_type
, Fcons (value
, Qnil
));
2857 Vold_style_backquotes
= Qt
;
2869 end_of_file_error ();
2871 /* Accept `single space' syntax like (list ? x) where the
2872 whitespace character is SPC or TAB.
2873 Other literal whitespace like NL, CR, and FF are not accepted,
2874 as there are well-established escape sequences for these. */
2875 if (c
== ' ' || c
== '\t')
2876 return make_number (c
);
2879 c
= read_escape (readcharfun
, 0);
2880 modifiers
= c
& CHAR_MODIFIER_MASK
;
2881 c
&= ~CHAR_MODIFIER_MASK
;
2882 if (CHAR_BYTE8_P (c
))
2883 c
= CHAR_TO_BYTE8 (c
);
2886 next_char
= READCHAR
;
2887 ok
= (next_char
<= 040
2888 || (next_char
< 0200
2889 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2892 return make_number (c
);
2894 invalid_syntax ("?");
2899 char *p
= read_buffer
;
2900 char *end
= read_buffer
+ read_buffer_size
;
2902 /* True if we saw an escape sequence specifying
2903 a multibyte character. */
2904 bool force_multibyte
= 0;
2905 /* True if we saw an escape sequence specifying
2906 a single-byte character. */
2907 bool force_singlebyte
= 0;
2909 ptrdiff_t nchars
= 0;
2911 while ((ch
= READCHAR
) >= 0
2914 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2916 ptrdiff_t offset
= p
- read_buffer
;
2917 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2918 memory_full (SIZE_MAX
);
2919 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
2920 read_buffer_size
*= 2;
2921 p
= read_buffer
+ offset
;
2922 end
= read_buffer
+ read_buffer_size
;
2929 ch
= read_escape (readcharfun
, 1);
2931 /* CH is -1 if \ newline has just been seen. */
2934 if (p
== read_buffer
)
2939 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2940 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2942 if (CHAR_BYTE8_P (ch
))
2943 force_singlebyte
= 1;
2944 else if (! ASCII_CHAR_P (ch
))
2945 force_multibyte
= 1;
2946 else /* I.e. ASCII_CHAR_P (ch). */
2948 /* Allow `\C- ' and `\C-?'. */
2949 if (modifiers
== CHAR_CTL
)
2952 ch
= 0, modifiers
= 0;
2954 ch
= 127, modifiers
= 0;
2956 if (modifiers
& CHAR_SHIFT
)
2958 /* Shift modifier is valid only with [A-Za-z]. */
2959 if (ch
>= 'A' && ch
<= 'Z')
2960 modifiers
&= ~CHAR_SHIFT
;
2961 else if (ch
>= 'a' && ch
<= 'z')
2962 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2965 if (modifiers
& CHAR_META
)
2967 /* Move the meta bit to the right place for a
2969 modifiers
&= ~CHAR_META
;
2970 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2971 force_singlebyte
= 1;
2975 /* Any modifiers remaining are invalid. */
2977 error ("Invalid modifier in string");
2978 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2982 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2983 if (CHAR_BYTE8_P (ch
))
2984 force_singlebyte
= 1;
2985 else if (! ASCII_CHAR_P (ch
))
2986 force_multibyte
= 1;
2992 end_of_file_error ();
2994 /* If purifying, and string starts with \ newline,
2995 return zero instead. This is for doc strings
2996 that we are really going to find in etc/DOC.nn.nn. */
2997 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2998 return make_number (0);
3000 if (! force_multibyte
&& force_singlebyte
)
3002 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3003 forms. Convert it to unibyte. */
3004 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3006 p
= read_buffer
+ nchars
;
3009 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3011 || (p
- read_buffer
!= nchars
)));
3016 int next_char
= READCHAR
;
3019 if (next_char
<= 040
3020 || (next_char
< 0200
3021 && strchr ("\"';([#?`,", next_char
) != NULL
))
3027 /* Otherwise, we fall through! Note that the atom-reading loop
3028 below will now loop at least once, assuring that we will not
3029 try to UNREAD two characters in a row. */
3033 if (c
<= 040) goto retry
;
3034 if (c
== 0xa0) /* NBSP */
3039 char *p
= read_buffer
;
3041 EMACS_INT start_position
= readchar_count
- 1;
3044 char *end
= read_buffer
+ read_buffer_size
;
3048 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3050 ptrdiff_t offset
= p
- read_buffer
;
3051 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3052 memory_full (SIZE_MAX
);
3053 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3054 read_buffer_size
*= 2;
3055 p
= read_buffer
+ offset
;
3056 end
= read_buffer
+ read_buffer_size
;
3063 end_of_file_error ();
3068 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3074 && c
!= 0xa0 /* NBSP */
3076 || strchr ("\"';()[]#`,", c
) == NULL
));
3080 ptrdiff_t offset
= p
- read_buffer
;
3081 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3082 memory_full (SIZE_MAX
);
3083 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3084 read_buffer_size
*= 2;
3085 p
= read_buffer
+ offset
;
3086 end
= read_buffer
+ read_buffer_size
;
3092 if (!quoted
&& !uninterned_symbol
)
3094 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3095 if (! NILP (result
))
3099 Lisp_Object name
, result
;
3100 ptrdiff_t nbytes
= p
- read_buffer
;
3103 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3107 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3108 ? make_pure_string
: make_specified_string
)
3109 (read_buffer
, nchars
, nbytes
, multibyte
));
3110 result
= (uninterned_symbol
? Fmake_symbol (name
)
3111 : Fintern (name
, Qnil
));
3113 if (EQ (Vread_with_symbol_positions
, Qt
)
3114 || EQ (Vread_with_symbol_positions
, readcharfun
))
3115 Vread_symbol_positions_list
3116 = Fcons (Fcons (result
, make_number (start_position
)),
3117 Vread_symbol_positions_list
);
3125 /* List of nodes we've seen during substitute_object_in_subtree. */
3126 static Lisp_Object seen_list
;
3129 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3131 Lisp_Object check_object
;
3133 /* We haven't seen any objects when we start. */
3136 /* Make all the substitutions. */
3138 = substitute_object_recurse (object
, placeholder
, object
);
3140 /* Clear seen_list because we're done with it. */
3143 /* The returned object here is expected to always eq the
3145 if (!EQ (check_object
, object
))
3146 error ("Unexpected mutation error in reader");
3149 /* Feval doesn't get called from here, so no gc protection is needed. */
3150 #define SUBSTITUTE(get_val, set_val) \
3152 Lisp_Object old_value = get_val; \
3153 Lisp_Object true_value \
3154 = substitute_object_recurse (object, placeholder, \
3157 if (!EQ (old_value, true_value)) \
3164 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3166 /* If we find the placeholder, return the target object. */
3167 if (EQ (placeholder
, subtree
))
3170 /* If we've been to this node before, don't explore it again. */
3171 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3174 /* If this node can be the entry point to a cycle, remember that
3175 we've seen it. It can only be such an entry point if it was made
3176 by #n=, which means that we can find it as a value in
3178 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3179 seen_list
= Fcons (subtree
, seen_list
);
3181 /* Recurse according to subtree's type.
3182 Every branch must return a Lisp_Object. */
3183 switch (XTYPE (subtree
))
3185 case Lisp_Vectorlike
:
3187 ptrdiff_t i
, length
= 0;
3188 if (BOOL_VECTOR_P (subtree
))
3189 return subtree
; /* No sub-objects anyway. */
3190 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3191 || COMPILEDP (subtree
))
3192 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3193 else if (VECTORP (subtree
))
3194 length
= ASIZE (subtree
);
3196 /* An unknown pseudovector may contain non-Lisp fields, so we
3197 can't just blindly traverse all its fields. We used to call
3198 `Flength' which signaled `sequencep', so I just preserved this
3200 wrong_type_argument (Qsequencep
, subtree
);
3202 for (i
= 0; i
< length
; i
++)
3203 SUBSTITUTE (AREF (subtree
, i
),
3204 ASET (subtree
, i
, true_value
));
3210 SUBSTITUTE (XCAR (subtree
),
3211 XSETCAR (subtree
, true_value
));
3212 SUBSTITUTE (XCDR (subtree
),
3213 XSETCDR (subtree
, true_value
));
3219 /* Check for text properties in each interval.
3220 substitute_in_interval contains part of the logic. */
3222 INTERVAL root_interval
= string_intervals (subtree
);
3223 Lisp_Object arg
= Fcons (object
, placeholder
);
3225 traverse_intervals_noorder (root_interval
,
3226 &substitute_in_interval
, arg
);
3231 /* Other types don't recurse any further. */
3237 /* Helper function for substitute_object_recurse. */
3239 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3241 Lisp_Object object
= Fcar (arg
);
3242 Lisp_Object placeholder
= Fcdr (arg
);
3244 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3254 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3255 integer syntax and fits in a fixnum, else return the nearest float if CP has
3256 either floating point or integer syntax and BASE is 10, else return nil. If
3257 IGNORE_TRAILING, consider just the longest prefix of CP that has
3258 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3259 number has integer syntax but does not fit. */
3262 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3265 char const *cp
= string
;
3267 bool float_syntax
= 0;
3270 /* Compute NaN and infinities using a variable, to cope with compilers that
3271 think they are smarter than we are. */
3274 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3275 IEEE floating point hosts, and works around a formerly-common bug where
3276 atof ("-0.0") drops the sign. */
3277 bool negative
= *cp
== '-';
3279 bool signedp
= negative
|| *cp
== '+';
3284 leading_digit
= digit_to_number (*cp
, base
);
3285 if (0 <= leading_digit
)
3290 while (0 <= digit_to_number (*cp
, base
));
3300 if ('0' <= *cp
&& *cp
<= '9')
3305 while ('0' <= *cp
&& *cp
<= '9');
3307 if (*cp
== 'e' || *cp
== 'E')
3309 char const *ecp
= cp
;
3311 if (*cp
== '+' || *cp
== '-')
3313 if ('0' <= *cp
&& *cp
<= '9')
3318 while ('0' <= *cp
&& *cp
<= '9');
3320 else if (cp
[-1] == '+'
3321 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3327 else if (cp
[-1] == '+'
3328 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3332 value
= zero
/ zero
;
3334 /* If that made a "negative" NaN, negate it. */
3337 union { double d
; char c
[sizeof (double)]; }
3338 u_data
, u_minus_zero
;
3340 u_minus_zero
.d
= -0.0;
3341 for (i
= 0; i
< sizeof (double); i
++)
3342 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3348 /* Now VALUE is a positive NaN. */
3354 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3355 || state
== (LEAD_INT
|E_EXP
));
3358 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3359 any prefix that matches. Otherwise, the entire string must match. */
3360 if (! (ignore_trailing
3361 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3362 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3365 /* If the number uses integer and not float syntax, and is in C-language
3366 range, use its value, preferably as a fixnum. */
3367 if (0 <= leading_digit
&& ! float_syntax
)
3371 /* Fast special case for single-digit integers. This also avoids a
3372 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3373 case some versions of strtoumax accept numbers like "0x1" that Emacs
3375 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3376 return make_number (negative
? -leading_digit
: leading_digit
);
3379 n
= strtoumax (string
+ signedp
, NULL
, base
);
3380 if (errno
== ERANGE
)
3382 /* Unfortunately there's no simple and accurate way to convert
3383 non-base-10 numbers that are out of C-language range. */
3385 xsignal1 (Qoverflow_error
, build_string (string
));
3387 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3389 EMACS_INT signed_n
= n
;
3390 return make_number (negative
? -signed_n
: signed_n
);
3396 /* Either the number uses float syntax, or it does not fit into a fixnum.
3397 Convert it from string to floating point, unless the value is already
3398 known because it is an infinity, a NAN, or its absolute value fits in
3401 value
= atof (string
+ signedp
);
3403 return make_float (negative
? -value
: value
);
3408 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3412 Lisp_Object tem
, item
, vector
;
3413 struct Lisp_Cons
*otem
;
3416 tem
= read_list (1, readcharfun
);
3417 len
= Flength (tem
);
3418 vector
= Fmake_vector (len
, Qnil
);
3420 size
= ASIZE (vector
);
3421 ptr
= XVECTOR (vector
)->contents
;
3422 for (i
= 0; i
< size
; i
++)
3425 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3426 bytecode object, the docstring containing the bytecode and
3427 constants values must be treated as unibyte and passed to
3428 Fread, to get the actual bytecode string and constants vector. */
3429 if (bytecodeflag
&& load_force_doc_strings
)
3431 if (i
== COMPILED_BYTECODE
)
3433 if (!STRINGP (item
))
3434 error ("Invalid byte code");
3436 /* Delay handling the bytecode slot until we know whether
3437 it is lazily-loaded (we can tell by whether the
3438 constants slot is nil). */
3439 ASET (vector
, COMPILED_CONSTANTS
, item
);
3442 else if (i
== COMPILED_CONSTANTS
)
3444 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3448 /* Coerce string to unibyte (like string-as-unibyte,
3449 but without generating extra garbage and
3450 guaranteeing no change in the contents). */
3451 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3452 STRING_SET_UNIBYTE (bytestr
);
3454 item
= Fread (Fcons (bytestr
, readcharfun
));
3456 error ("Invalid byte code");
3458 otem
= XCONS (item
);
3459 bytestr
= XCAR (item
);
3464 /* Now handle the bytecode slot. */
3465 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3467 else if (i
== COMPILED_DOC_STRING
3469 && ! STRING_MULTIBYTE (item
))
3471 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3472 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3474 item
= Fstring_as_multibyte (item
);
3477 ASET (vector
, i
, item
);
3485 /* FLAG means check for ] to terminate rather than ) and . */
3488 read_list (bool flag
, Lisp_Object readcharfun
)
3490 Lisp_Object val
, tail
;
3491 Lisp_Object elt
, tem
;
3492 struct gcpro gcpro1
, gcpro2
;
3493 /* 0 is the normal case.
3494 1 means this list is a doc reference; replace it with the number 0.
3495 2 means this list is a doc reference; replace it with the doc string. */
3496 int doc_reference
= 0;
3498 /* Initialize this to 1 if we are reading a list. */
3499 bool first_in_list
= flag
<= 0;
3508 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3513 /* While building, if the list starts with #$, treat it specially. */
3514 if (EQ (elt
, Vload_file_name
)
3516 && !NILP (Vpurify_flag
))
3518 if (NILP (Vdoc_file_name
))
3519 /* We have not yet called Snarf-documentation, so assume
3520 this file is described in the DOC-MM.NN file
3521 and Snarf-documentation will fill in the right value later.
3522 For now, replace the whole list with 0. */
3525 /* We have already called Snarf-documentation, so make a relative
3526 file name for this file, so it can be found properly
3527 in the installed Lisp directory.
3528 We don't use Fexpand_file_name because that would make
3529 the directory absolute now. */
3530 elt
= concat2 (build_string ("../lisp/"),
3531 Ffile_name_nondirectory (elt
));
3533 else if (EQ (elt
, Vload_file_name
)
3535 && load_force_doc_strings
)
3544 invalid_syntax (") or . in a vector");
3552 XSETCDR (tail
, read0 (readcharfun
));
3554 val
= read0 (readcharfun
);
3555 read1 (readcharfun
, &ch
, 0);
3559 if (doc_reference
== 1)
3560 return make_number (0);
3561 if (doc_reference
== 2)
3563 /* Get a doc string from the file we are loading.
3564 If it's in saved_doc_string, get it from there.
3566 Here, we don't know if the string is a
3567 bytecode string or a doc string. As a
3568 bytecode string must be unibyte, we always
3569 return a unibyte string. If it is actually a
3570 doc string, caller must make it
3573 EMACS_INT pos
= XINT (XCDR (val
));
3574 /* Position is negative for user variables. */
3575 if (pos
< 0) pos
= -pos
;
3576 if (pos
>= saved_doc_string_position
3577 && pos
< (saved_doc_string_position
3578 + saved_doc_string_length
))
3580 ptrdiff_t start
= pos
- saved_doc_string_position
;
3583 /* Process quoting with ^A,
3584 and find the end of the string,
3585 which is marked with ^_ (037). */
3586 for (from
= start
, to
= start
;
3587 saved_doc_string
[from
] != 037;)
3589 int c
= saved_doc_string
[from
++];
3592 c
= saved_doc_string
[from
++];
3594 saved_doc_string
[to
++] = c
;
3596 saved_doc_string
[to
++] = 0;
3598 saved_doc_string
[to
++] = 037;
3601 saved_doc_string
[to
++] = c
;
3604 return make_unibyte_string (saved_doc_string
+ start
,
3607 /* Look in prev_saved_doc_string the same way. */
3608 else if (pos
>= prev_saved_doc_string_position
3609 && pos
< (prev_saved_doc_string_position
3610 + prev_saved_doc_string_length
))
3613 pos
- prev_saved_doc_string_position
;
3616 /* Process quoting with ^A,
3617 and find the end of the string,
3618 which is marked with ^_ (037). */
3619 for (from
= start
, to
= start
;
3620 prev_saved_doc_string
[from
] != 037;)
3622 int c
= prev_saved_doc_string
[from
++];
3625 c
= prev_saved_doc_string
[from
++];
3627 prev_saved_doc_string
[to
++] = c
;
3629 prev_saved_doc_string
[to
++] = 0;
3631 prev_saved_doc_string
[to
++] = 037;
3634 prev_saved_doc_string
[to
++] = c
;
3637 return make_unibyte_string (prev_saved_doc_string
3642 return get_doc_string (val
, 1, 0);
3647 invalid_syntax (". in wrong context");
3649 invalid_syntax ("] in a list");
3651 tem
= Fcons (elt
, Qnil
);
3653 XSETCDR (tail
, tem
);
3660 static Lisp_Object initial_obarray
;
3662 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3664 static size_t oblookup_last_bucket_number
;
3666 /* Get an error if OBARRAY is not an obarray.
3667 If it is one, return it. */
3670 check_obarray (Lisp_Object obarray
)
3672 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3674 /* If Vobarray is now invalid, force it to be valid. */
3675 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3676 wrong_type_argument (Qvectorp
, obarray
);
3681 /* Intern the C string STR: return a symbol with that name,
3682 interned in the current obarray. */
3685 intern_1 (const char *str
, ptrdiff_t len
)
3687 Lisp_Object obarray
= check_obarray (Vobarray
);
3688 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3690 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3694 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3696 Lisp_Object obarray
= check_obarray (Vobarray
);
3697 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3702 if (NILP (Vpurify_flag
))
3703 /* Creating a non-pure string from a string literal not
3704 implemented yet. We could just use make_string here and live
3705 with the extra copy. */
3708 return Fintern (make_pure_c_string (str
, len
), obarray
);
3711 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3712 doc
: /* Return the canonical symbol whose name is STRING.
3713 If there is none, one is created by this function and returned.
3714 A second optional argument specifies the obarray to use;
3715 it defaults to the value of `obarray'. */)
3716 (Lisp_Object string
, Lisp_Object obarray
)
3718 register Lisp_Object tem
, sym
, *ptr
;
3720 if (NILP (obarray
)) obarray
= Vobarray
;
3721 obarray
= check_obarray (obarray
);
3723 CHECK_STRING (string
);
3725 tem
= oblookup (obarray
, SSDATA (string
),
3728 if (!INTEGERP (tem
))
3731 if (!NILP (Vpurify_flag
))
3732 string
= Fpurecopy (string
);
3733 sym
= Fmake_symbol (string
);
3735 if (EQ (obarray
, initial_obarray
))
3736 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3738 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3740 if ((SREF (string
, 0) == ':')
3741 && EQ (obarray
, initial_obarray
))
3743 XSYMBOL (sym
)->constant
= 1;
3744 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3745 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3748 ptr
= aref_addr (obarray
, XINT(tem
));
3750 set_symbol_next (sym
, XSYMBOL (*ptr
));
3752 set_symbol_next (sym
, NULL
);
3757 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3758 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3759 NAME may be a string or a symbol. If it is a symbol, that exact
3760 symbol is searched for.
3761 A second optional argument specifies the obarray to use;
3762 it defaults to the value of `obarray'. */)
3763 (Lisp_Object name
, Lisp_Object obarray
)
3765 register Lisp_Object tem
, string
;
3767 if (NILP (obarray
)) obarray
= Vobarray
;
3768 obarray
= check_obarray (obarray
);
3770 if (!SYMBOLP (name
))
3772 CHECK_STRING (name
);
3776 string
= SYMBOL_NAME (name
);
3778 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3779 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3785 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3786 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3787 The value is t if a symbol was found and deleted, nil otherwise.
3788 NAME may be a string or a symbol. If it is a symbol, that symbol
3789 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3790 OBARRAY defaults to the value of the variable `obarray'. */)
3791 (Lisp_Object name
, Lisp_Object obarray
)
3793 register Lisp_Object string
, tem
;
3796 if (NILP (obarray
)) obarray
= Vobarray
;
3797 obarray
= check_obarray (obarray
);
3800 string
= SYMBOL_NAME (name
);
3803 CHECK_STRING (name
);
3807 tem
= oblookup (obarray
, SSDATA (string
),
3812 /* If arg was a symbol, don't delete anything but that symbol itself. */
3813 if (SYMBOLP (name
) && !EQ (name
, tem
))
3816 /* There are plenty of other symbols which will screw up the Emacs
3817 session if we unintern them, as well as even more ways to use
3818 `setq' or `fset' or whatnot to make the Emacs session
3819 unusable. Let's not go down this silly road. --Stef */
3820 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3821 error ("Attempt to unintern t or nil"); */
3823 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3825 hash
= oblookup_last_bucket_number
;
3827 if (EQ (AREF (obarray
, hash
), tem
))
3829 if (XSYMBOL (tem
)->next
)
3832 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3833 ASET (obarray
, hash
, sym
);
3836 ASET (obarray
, hash
, make_number (0));
3840 Lisp_Object tail
, following
;
3842 for (tail
= AREF (obarray
, hash
);
3843 XSYMBOL (tail
)->next
;
3846 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3847 if (EQ (following
, tem
))
3849 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3858 /* Return the symbol in OBARRAY whose names matches the string
3859 of SIZE characters (SIZE_BYTE bytes) at PTR.
3860 If there is no such symbol in OBARRAY, return nil.
3862 Also store the bucket number in oblookup_last_bucket_number. */
3865 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3869 register Lisp_Object tail
;
3870 Lisp_Object bucket
, tem
;
3872 obarray
= check_obarray (obarray
);
3873 obsize
= ASIZE (obarray
);
3875 /* This is sometimes needed in the middle of GC. */
3876 obsize
&= ~ARRAY_MARK_FLAG
;
3877 hash
= hash_string (ptr
, size_byte
) % obsize
;
3878 bucket
= AREF (obarray
, hash
);
3879 oblookup_last_bucket_number
= hash
;
3880 if (EQ (bucket
, make_number (0)))
3882 else if (!SYMBOLP (bucket
))
3883 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3885 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3887 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3888 && SCHARS (SYMBOL_NAME (tail
)) == size
3889 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3891 else if (XSYMBOL (tail
)->next
== 0)
3894 XSETINT (tem
, hash
);
3899 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3902 register Lisp_Object tail
;
3903 CHECK_VECTOR (obarray
);
3904 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3906 tail
= AREF (obarray
, i
);
3911 if (XSYMBOL (tail
)->next
== 0)
3913 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3919 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3921 call1 (function
, sym
);
3924 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3925 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3926 OBARRAY defaults to the value of `obarray'. */)
3927 (Lisp_Object function
, Lisp_Object obarray
)
3929 if (NILP (obarray
)) obarray
= Vobarray
;
3930 obarray
= check_obarray (obarray
);
3932 map_obarray (obarray
, mapatoms_1
, function
);
3936 #define OBARRAY_SIZE 1511
3941 Lisp_Object oblength
;
3942 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3944 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3946 Vobarray
= Fmake_vector (oblength
, make_number (0));
3947 initial_obarray
= Vobarray
;
3948 staticpro (&initial_obarray
);
3950 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
3951 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3952 NILP (Vpurify_flag) check in intern_c_string. */
3953 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3954 Qnil
= intern_c_string ("nil");
3956 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3957 so those two need to be fixed manually. */
3958 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3959 set_symbol_function (Qunbound
, Qunbound
);
3960 set_symbol_plist (Qunbound
, Qnil
);
3961 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3962 XSYMBOL (Qnil
)->constant
= 1;
3963 XSYMBOL (Qnil
)->declared_special
= 1;
3964 set_symbol_plist (Qnil
, Qnil
);
3966 Qt
= intern_c_string ("t");
3967 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3968 XSYMBOL (Qnil
)->declared_special
= 1;
3969 XSYMBOL (Qt
)->constant
= 1;
3971 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3974 DEFSYM (Qvariable_documentation
, "variable-documentation");
3976 read_buffer
= xmalloc (size
);
3977 read_buffer_size
= size
;
3981 defsubr (struct Lisp_Subr
*sname
)
3983 Lisp_Object sym
, tem
;
3984 sym
= intern_c_string (sname
->symbol_name
);
3985 XSETTYPED_PVECTYPE (sname
, size
, PVEC_SUBR
);
3986 XSETSUBR (tem
, sname
);
3987 set_symbol_function (sym
, tem
);
3990 #ifdef NOTDEF /* Use fset in subr.el now! */
3992 defalias (struct Lisp_Subr
*sname
, char *string
)
3995 sym
= intern (string
);
3996 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4000 /* Define an "integer variable"; a symbol whose value is forwarded to a
4001 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4002 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4004 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4005 const char *namestring
, EMACS_INT
*address
)
4008 sym
= intern_c_string (namestring
);
4009 i_fwd
->type
= Lisp_Fwd_Int
;
4010 i_fwd
->intvar
= address
;
4011 XSYMBOL (sym
)->declared_special
= 1;
4012 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4013 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4016 /* Similar but define a variable whose value is t if address contains 1,
4017 nil if address contains 0. */
4019 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4020 const char *namestring
, bool *address
)
4023 sym
= intern_c_string (namestring
);
4024 b_fwd
->type
= Lisp_Fwd_Bool
;
4025 b_fwd
->boolvar
= address
;
4026 XSYMBOL (sym
)->declared_special
= 1;
4027 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4028 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4029 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4032 /* Similar but define a variable whose value is the Lisp Object stored
4033 at address. Two versions: with and without gc-marking of the C
4034 variable. The nopro version is used when that variable will be
4035 gc-marked for some other reason, since marking the same slot twice
4036 can cause trouble with strings. */
4038 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4039 const char *namestring
, Lisp_Object
*address
)
4042 sym
= intern_c_string (namestring
);
4043 o_fwd
->type
= Lisp_Fwd_Obj
;
4044 o_fwd
->objvar
= address
;
4045 XSYMBOL (sym
)->declared_special
= 1;
4046 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4047 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4051 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4052 const char *namestring
, Lisp_Object
*address
)
4054 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4055 staticpro (address
);
4058 /* Similar but define a variable whose value is the Lisp Object stored
4059 at a particular offset in the current kboard object. */
4062 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4063 const char *namestring
, int offset
)
4066 sym
= intern_c_string (namestring
);
4067 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4068 ko_fwd
->offset
= offset
;
4069 XSYMBOL (sym
)->declared_special
= 1;
4070 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4071 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4074 /* Check that the elements of Vload_path exist. */
4077 load_path_check (void)
4079 Lisp_Object path_tail
;
4081 /* The only elements that might not exist are those from
4082 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4084 for (path_tail
= Vload_path
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4086 Lisp_Object dirfile
;
4087 dirfile
= Fcar (path_tail
);
4088 if (STRINGP (dirfile
))
4090 dirfile
= Fdirectory_file_name (dirfile
);
4091 if (access (SSDATA (dirfile
), 0) < 0)
4092 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
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 exists. 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_exists_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 exists. */
4227 tem
= Fexpand_file_name (build_string ("leim"),
4228 Vinstallation_directory
);
4229 tem1
= Ffile_exists_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_exists_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_exists_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, using format string FORMAT, that directory DIRNAME
4343 does not exist. Print it on stderr and put it in *Messages*. */
4346 dir_warning (const char *format
, Lisp_Object dirname
)
4348 fprintf (stderr
, format
, SDATA (dirname
));
4350 /* Don't log the warning before we've initialized!! */
4354 char *buffer
= SAFE_ALLOCA (SBYTES (dirname
)
4355 + strlen (format
) - (sizeof "%s" - 1) + 1);
4356 ptrdiff_t message_len
= esprintf (buffer
, format
, SDATA (dirname
));
4357 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4363 syms_of_lread (void)
4366 defsubr (&Sread_from_string
);
4368 defsubr (&Sintern_soft
);
4369 defsubr (&Sunintern
);
4370 defsubr (&Sget_load_suffixes
);
4372 defsubr (&Seval_buffer
);
4373 defsubr (&Seval_region
);
4374 defsubr (&Sread_char
);
4375 defsubr (&Sread_char_exclusive
);
4376 defsubr (&Sread_event
);
4377 defsubr (&Sget_file_char
);
4378 defsubr (&Smapatoms
);
4379 defsubr (&Slocate_file_internal
);
4381 DEFVAR_LISP ("obarray", Vobarray
,
4382 doc
: /* Symbol table for use by `intern' and `read'.
4383 It is a vector whose length ought to be prime for best results.
4384 The vector's contents don't make sense if examined from Lisp programs;
4385 to find all the symbols in an obarray, use `mapatoms'. */);
4387 DEFVAR_LISP ("values", Vvalues
,
4388 doc
: /* List of values of all expressions which were read, evaluated and printed.
4389 Order is reverse chronological. */);
4390 XSYMBOL (intern ("values"))->declared_special
= 0;
4392 DEFVAR_LISP ("standard-input", Vstandard_input
,
4393 doc
: /* Stream for read to get input from.
4394 See documentation of `read' for possible values. */);
4395 Vstandard_input
= Qt
;
4397 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4398 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4400 If this variable is a buffer, then only forms read from that buffer
4401 will be added to `read-symbol-positions-list'.
4402 If this variable is t, then all read forms will be added.
4403 The effect of all other values other than nil are not currently
4404 defined, although they may be in the future.
4406 The positions are relative to the last call to `read' or
4407 `read-from-string'. It is probably a bad idea to set this variable at
4408 the toplevel; bind it instead. */);
4409 Vread_with_symbol_positions
= Qnil
;
4411 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4412 doc
: /* A list mapping read symbols to their positions.
4413 This variable is modified during calls to `read' or
4414 `read-from-string', but only when `read-with-symbol-positions' is
4417 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4418 CHAR-POSITION is an integer giving the offset of that occurrence of the
4419 symbol from the position where `read' or `read-from-string' started.
4421 Note that a symbol will appear multiple times in this list, if it was
4422 read multiple times. The list is in the same order as the symbols
4424 Vread_symbol_positions_list
= Qnil
;
4426 DEFVAR_LISP ("read-circle", Vread_circle
,
4427 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4430 DEFVAR_LISP ("load-path", Vload_path
,
4431 doc
: /* List of directories to search for files to load.
4432 Each element is a string (directory name) or nil (try default directory).
4433 Initialized based on EMACSLOADPATH environment variable, if any,
4434 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4436 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4437 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4438 This list should not include the empty string.
4439 `load' and related functions try to append these suffixes, in order,
4440 to the specified file name if a Lisp suffix is allowed or required. */);
4441 Vload_suffixes
= Fcons (build_pure_c_string (".elc"),
4442 Fcons (build_pure_c_string (".el"), Qnil
));
4443 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4444 doc
: /* List of suffixes that indicate representations of \
4446 This list should normally start with the empty string.
4448 Enabling Auto Compression mode appends the suffixes in
4449 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4450 mode removes them again. `load' and related functions use this list to
4451 determine whether they should look for compressed versions of a file
4452 and, if so, which suffixes they should try to append to the file name
4453 in order to do so. However, if you want to customize which suffixes
4454 the loading functions recognize as compression suffixes, you should
4455 customize `jka-compr-load-suffixes' rather than the present variable. */);
4456 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4458 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4459 doc
: /* Non-nil if inside of `load'. */);
4460 DEFSYM (Qload_in_progress
, "load-in-progress");
4462 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4463 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4464 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4466 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4467 a symbol \(a feature name).
4469 When `load' is run and the file-name argument matches an element's
4470 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4471 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4473 An error in FORMS does not undo the load, but does prevent execution of
4474 the rest of the FORMS. */);
4475 Vafter_load_alist
= Qnil
;
4477 DEFVAR_LISP ("load-history", Vload_history
,
4478 doc
: /* Alist mapping loaded file names to symbols and features.
4479 Each alist element should be a list (FILE-NAME ENTRIES...), where
4480 FILE-NAME is the name of a file that has been loaded into Emacs.
4481 The file name is absolute and true (i.e. it doesn't contain symlinks).
4482 As an exception, one of the alist elements may have FILE-NAME nil,
4483 for symbols and features not associated with any file.
4485 The remaining ENTRIES in the alist element describe the functions and
4486 variables defined in that file, the features provided, and the
4487 features required. Each entry has the form `(provide . FEATURE)',
4488 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4489 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4490 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4491 autoload before this file redefined it as a function. In addition,
4492 entries may also be single symbols, which means that SYMBOL was
4493 defined by `defvar' or `defconst'.
4495 During preloading, the file name recorded is relative to the main Lisp
4496 directory. These file names are converted to absolute at startup. */);
4497 Vload_history
= Qnil
;
4499 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4500 doc
: /* Full name of file being loaded by `load'. */);
4501 Vload_file_name
= Qnil
;
4503 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4504 doc
: /* File name, including directory, of user's initialization file.
4505 If the file loaded had extension `.elc', and the corresponding source file
4506 exists, this variable contains the name of source file, suitable for use
4507 by functions like `custom-save-all' which edit the init file.
4508 While Emacs loads and evaluates the init file, value is the real name
4509 of the file, regardless of whether or not it has the `.elc' extension. */);
4510 Vuser_init_file
= Qnil
;
4512 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4513 doc
: /* Used for internal purposes by `load'. */);
4514 Vcurrent_load_list
= Qnil
;
4516 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4517 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4518 The default is nil, which means use the function `read'. */);
4519 Vload_read_function
= Qnil
;
4521 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4522 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4523 This function is for doing code conversion before reading the source file.
4524 If nil, loading is done without any code conversion.
4525 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4526 FULLNAME is the full name of FILE.
4527 See `load' for the meaning of the remaining arguments. */);
4528 Vload_source_file_function
= Qnil
;
4530 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4531 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4532 This is useful when the file being loaded is a temporary copy. */);
4533 load_force_doc_strings
= 0;
4535 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4536 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4537 This is normally bound by `load' and `eval-buffer' to control `read',
4538 and is not meant for users to change. */);
4539 load_convert_to_unibyte
= 0;
4541 DEFVAR_LISP ("source-directory", Vsource_directory
,
4542 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4543 You cannot count on them to still be there! */);
4545 = Fexpand_file_name (build_string ("../"),
4546 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4548 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4549 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4550 Vpreloaded_file_list
= Qnil
;
4552 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4553 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4554 Vbyte_boolean_vars
= Qnil
;
4556 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4557 doc
: /* Non-nil means load dangerous compiled Lisp files.
4558 Some versions of XEmacs use different byte codes than Emacs. These
4559 incompatible byte codes can make Emacs crash when it tries to execute
4561 load_dangerous_libraries
= 0;
4563 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4564 doc
: /* Non-nil means force printing messages when loading Lisp files.
4565 This overrides the value of the NOMESSAGE argument to `load'. */);
4566 force_load_messages
= 0;
4568 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4569 doc
: /* Regular expression matching safe to load compiled Lisp files.
4570 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4571 from the file, and matches them against this regular expression.
4572 When the regular expression matches, the file is considered to be safe
4573 to load. See also `load-dangerous-libraries'. */);
4574 Vbytecomp_version_regexp
4575 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4577 DEFSYM (Qlexical_binding
, "lexical-binding");
4578 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4579 doc
: /* Whether to use lexical binding when evaluating code.
4580 Non-nil means that the code in the current buffer should be evaluated
4581 with lexical binding.
4582 This variable is automatically set from the file variables of an
4583 interpreted Lisp file read using `load'. Unlike other file local
4584 variables, this must be set in the first line of a file. */);
4585 Vlexical_binding
= Qnil
;
4586 Fmake_variable_buffer_local (Qlexical_binding
);
4588 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4589 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4590 Veval_buffer_list
= Qnil
;
4592 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4593 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4594 Vold_style_backquotes
= Qnil
;
4595 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4597 /* Vsource_directory was initialized in init_lread. */
4599 load_descriptor_list
= Qnil
;
4600 staticpro (&load_descriptor_list
);
4602 DEFSYM (Qcurrent_load_list
, "current-load-list");
4603 DEFSYM (Qstandard_input
, "standard-input");
4604 DEFSYM (Qread_char
, "read-char");
4605 DEFSYM (Qget_file_char
, "get-file-char");
4606 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4607 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4609 DEFSYM (Qbackquote
, "`");
4610 DEFSYM (Qcomma
, ",");
4611 DEFSYM (Qcomma_at
, ",@");
4612 DEFSYM (Qcomma_dot
, ",.");
4614 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4615 DEFSYM (Qascii_character
, "ascii-character");
4616 DEFSYM (Qfunction
, "function");
4617 DEFSYM (Qload
, "load");
4618 DEFSYM (Qload_file_name
, "load-file-name");
4619 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4620 DEFSYM (Qfile_truename
, "file-truename");
4621 DEFSYM (Qdir_ok
, "dir-ok");
4622 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4624 staticpro (&dump_path
);
4626 staticpro (&read_objects
);
4627 read_objects
= Qnil
;
4628 staticpro (&seen_list
);
4631 Vloads_in_progress
= Qnil
;
4632 staticpro (&Vloads_in_progress
);
4634 DEFSYM (Qhash_table
, "hash-table");
4635 DEFSYM (Qdata
, "data");
4636 DEFSYM (Qtest
, "test");
4637 DEFSYM (Qsize
, "size");
4638 DEFSYM (Qweakness
, "weakness");
4639 DEFSYM (Qrehash_size
, "rehash-size");
4640 DEFSYM (Qrehash_threshold
, "rehash-threshold");