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
;
1453 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1454 Lisp_Object string
, tail
, encoded_fn
;
1455 ptrdiff_t max_suffix_len
= 0;
1459 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1461 CHECK_STRING_CAR (tail
);
1462 max_suffix_len
= max (max_suffix_len
,
1463 SBYTES (XCAR (tail
)));
1466 string
= filename
= encoded_fn
= Qnil
;
1467 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1472 if (complete_filename_p (str
))
1475 for (; CONSP (path
); path
= XCDR (path
))
1477 filename
= Fexpand_file_name (str
, XCAR (path
));
1478 if (!complete_filename_p (filename
))
1479 /* If there are non-absolute elts in PATH (eg "."). */
1480 /* Of course, this could conceivably lose if luser sets
1481 default-directory to be something non-absolute... */
1483 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1484 if (!complete_filename_p (filename
))
1485 /* Give up on this path element! */
1489 /* Calculate maximum length of any filename made from
1490 this path element/specified file name and any possible suffix. */
1491 want_length
= max_suffix_len
+ SBYTES (filename
);
1492 if (fn_size
<= want_length
)
1493 fn
= alloca (fn_size
= 100 + want_length
);
1495 /* Loop over suffixes. */
1496 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1497 CONSP (tail
); tail
= XCDR (tail
))
1499 ptrdiff_t fnlen
, lsuffix
= SBYTES (XCAR (tail
));
1500 Lisp_Object handler
;
1503 /* Concatenate path element/specified name with the suffix.
1504 If the directory starts with /:, remove that. */
1505 int prefixlen
= ((SCHARS (filename
) > 2
1506 && SREF (filename
, 0) == '/'
1507 && SREF (filename
, 1) == ':')
1509 fnlen
= SBYTES (filename
) - prefixlen
;
1510 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1511 memcpy (fn
+ fnlen
, SDATA (XCAR (tail
)), lsuffix
+ 1);
1513 /* Check that the file exists and is not a directory. */
1514 /* We used to only check for handlers on non-absolute file names:
1518 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1519 It's not clear why that was the case and it breaks things like
1520 (load "/bar.el") where the file is actually "/bar.el.gz". */
1521 string
= make_string (fn
, fnlen
);
1522 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1523 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1525 if (NILP (predicate
))
1526 exists
= !NILP (Ffile_readable_p (string
));
1529 Lisp_Object tmp
= call1 (predicate
, string
);
1530 exists
= !NILP (tmp
)
1531 && (EQ (tmp
, Qdir_ok
)
1532 || NILP (Ffile_directory_p (string
)));
1537 /* We succeeded; return this descriptor and filename. */
1548 encoded_fn
= ENCODE_FILE (string
);
1549 pfn
= SSDATA (encoded_fn
);
1550 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1553 /* Check that we can access or open it. */
1554 if (NATNUMP (predicate
))
1555 fd
= (((XFASTINT (predicate
) & ~INT_MAX
) == 0
1556 && access (pfn
, XFASTINT (predicate
)) == 0)
1559 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1563 /* We succeeded; return this descriptor and filename. */
1581 /* Merge the list we've accumulated of globals from the current input source
1582 into the load_history variable. The details depend on whether
1583 the source has an associated file name or not.
1585 FILENAME is the file name that we are loading from.
1587 ENTIRE is true if loading that entire file, false if evaluating
1591 build_load_history (Lisp_Object filename
, bool entire
)
1593 Lisp_Object tail
, prev
, newelt
;
1594 Lisp_Object tem
, tem2
;
1597 tail
= Vload_history
;
1600 while (CONSP (tail
))
1604 /* Find the feature's previous assoc list... */
1605 if (!NILP (Fequal (filename
, Fcar (tem
))))
1609 /* If we're loading the entire file, remove old data. */
1613 Vload_history
= XCDR (tail
);
1615 Fsetcdr (prev
, XCDR (tail
));
1618 /* Otherwise, cons on new symbols that are not already members. */
1621 tem2
= Vcurrent_load_list
;
1623 while (CONSP (tem2
))
1625 newelt
= XCAR (tem2
);
1627 if (NILP (Fmember (newelt
, tem
)))
1628 Fsetcar (tail
, Fcons (XCAR (tem
),
1629 Fcons (newelt
, XCDR (tem
))));
1642 /* If we're loading an entire file, cons the new assoc onto the
1643 front of load-history, the most-recently-loaded position. Also
1644 do this if we didn't find an existing member for the file. */
1645 if (entire
|| !foundit
)
1646 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1651 readevalloop_1 (Lisp_Object old
)
1653 load_convert_to_unibyte
= ! NILP (old
);
1657 /* Signal an `end-of-file' error, if possible with file name
1660 static _Noreturn
void
1661 end_of_file_error (void)
1663 if (STRINGP (Vload_file_name
))
1664 xsignal1 (Qend_of_file
, Vload_file_name
);
1666 xsignal0 (Qend_of_file
);
1669 /* UNIBYTE specifies how to set load_convert_to_unibyte
1670 for this invocation.
1671 READFUN, if non-nil, is used instead of `read'.
1673 START, END specify region to read in current buffer (from eval-region).
1674 If the input is not from a buffer, they must be nil. */
1677 readevalloop (Lisp_Object readcharfun
,
1679 Lisp_Object sourcename
,
1681 Lisp_Object unibyte
, Lisp_Object readfun
,
1682 Lisp_Object start
, Lisp_Object end
)
1685 register Lisp_Object val
;
1686 ptrdiff_t count
= SPECPDL_INDEX ();
1687 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1688 struct buffer
*b
= 0;
1689 bool continue_reading_p
;
1690 Lisp_Object lex_bound
;
1691 /* True if reading an entire buffer. */
1692 bool whole_buffer
= 0;
1693 /* True on the first time around. */
1694 bool first_sexp
= 1;
1695 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1697 if (NILP (Ffboundp (macroexpand
))
1698 /* Don't macroexpand in .elc files, since it should have been done
1699 already. We actually don't know whether we're in a .elc file or not,
1700 so we use circumstantial evidence: .el files normally go through
1701 Vload_source_file_function -> load-with-code-conversion
1703 || EQ (readcharfun
, Qget_file_char
)
1704 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1707 if (MARKERP (readcharfun
))
1710 start
= readcharfun
;
1713 if (BUFFERP (readcharfun
))
1714 b
= XBUFFER (readcharfun
);
1715 else if (MARKERP (readcharfun
))
1716 b
= XMARKER (readcharfun
)->buffer
;
1718 /* We assume START is nil when input is not from a buffer. */
1719 if (! NILP (start
) && !b
)
1722 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1723 specbind (Qcurrent_load_list
, Qnil
);
1724 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1725 load_convert_to_unibyte
= !NILP (unibyte
);
1727 /* If lexical binding is active (either because it was specified in
1728 the file's header, or via a buffer-local variable), create an empty
1729 lexical environment, otherwise, turn off lexical binding. */
1730 lex_bound
= find_symbol_value (Qlexical_binding
);
1731 specbind (Qinternal_interpreter_environment
,
1732 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1733 ? Qnil
: Fcons (Qt
, Qnil
));
1735 GCPRO4 (sourcename
, readfun
, start
, end
);
1737 /* Try to ensure sourcename is a truename, except whilst preloading. */
1738 if (NILP (Vpurify_flag
)
1739 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1740 && !NILP (Ffboundp (Qfile_truename
)))
1741 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1743 LOADHIST_ATTACH (sourcename
);
1745 continue_reading_p
= 1;
1746 while (continue_reading_p
)
1748 ptrdiff_t count1
= SPECPDL_INDEX ();
1750 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1751 error ("Reading from killed buffer");
1755 /* Switch to the buffer we are reading from. */
1756 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1757 set_buffer_internal (b
);
1759 /* Save point in it. */
1760 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1761 /* Save ZV in it. */
1762 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1763 /* Those get unbound after we read one expression. */
1765 /* Set point and ZV around stuff to be read. */
1768 Fnarrow_to_region (make_number (BEGV
), end
);
1770 /* Just for cleanliness, convert END to a marker
1771 if it is an integer. */
1773 end
= Fpoint_max_marker ();
1776 /* On the first cycle, we can easily test here
1777 whether we are reading the whole buffer. */
1778 if (b
&& first_sexp
)
1779 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1786 while ((c
= READCHAR
) != '\n' && c
!= -1);
1791 unbind_to (count1
, Qnil
);
1795 /* Ignore whitespace here, so we can detect eof. */
1796 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1797 || c
== 0xa0) /* NBSP */
1800 if (!NILP (Vpurify_flag
) && c
== '(')
1802 val
= read_list (0, readcharfun
);
1807 read_objects
= Qnil
;
1808 if (!NILP (readfun
))
1810 val
= call1 (readfun
, readcharfun
);
1812 /* If READCHARFUN has set point to ZV, we should
1813 stop reading, even if the form read sets point
1814 to a different value when evaluated. */
1815 if (BUFFERP (readcharfun
))
1817 struct buffer
*buf
= XBUFFER (readcharfun
);
1818 if (BUF_PT (buf
) == BUF_ZV (buf
))
1819 continue_reading_p
= 0;
1822 else if (! NILP (Vload_read_function
))
1823 val
= call1 (Vload_read_function
, readcharfun
);
1825 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1828 if (!NILP (start
) && continue_reading_p
)
1829 start
= Fpoint_marker ();
1831 /* Restore saved point and BEGV. */
1832 unbind_to (count1
, Qnil
);
1834 /* Now eval what we just read. */
1835 if (!NILP (macroexpand
))
1836 val
= call1 (macroexpand
, val
);
1837 val
= eval_sub (val
);
1841 Vvalues
= Fcons (val
, Vvalues
);
1842 if (EQ (Vstandard_output
, Qt
))
1851 build_load_history (sourcename
,
1852 stream
|| whole_buffer
);
1856 unbind_to (count
, Qnil
);
1859 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1860 doc
: /* Execute the current buffer as Lisp code.
1861 When called from a Lisp program (i.e., not interactively), this
1862 function accepts up to five optional arguments:
1863 BUFFER is the buffer to evaluate (nil means use current buffer).
1864 PRINTFLAG controls printing of output:
1865 A value of nil means discard it; anything else is stream for print.
1866 FILENAME specifies the file name to use for `load-history'.
1867 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1869 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1870 functions should work normally even if PRINTFLAG is nil.
1872 This function preserves the position of point. */)
1873 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1875 ptrdiff_t count
= SPECPDL_INDEX ();
1876 Lisp_Object tem
, buf
;
1879 buf
= Fcurrent_buffer ();
1881 buf
= Fget_buffer (buffer
);
1883 error ("No such buffer");
1885 if (NILP (printflag
) && NILP (do_allow_print
))
1890 if (NILP (filename
))
1891 filename
= BVAR (XBUFFER (buf
), filename
);
1893 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1894 specbind (Qstandard_output
, tem
);
1895 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1896 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1897 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1898 readevalloop (buf
, 0, filename
,
1899 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1900 unbind_to (count
, Qnil
);
1905 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1906 doc
: /* Execute the region as Lisp code.
1907 When called from programs, expects two arguments,
1908 giving starting and ending indices in the current buffer
1909 of the text to be executed.
1910 Programs can pass third argument PRINTFLAG which controls output:
1911 A value of nil means discard it; anything else is stream for printing it.
1912 Also the fourth argument READ-FUNCTION, if non-nil, is used
1913 instead of `read' to read each expression. It gets one argument
1914 which is the input stream for reading characters.
1916 This function does not move point. */)
1917 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1919 /* FIXME: Do the eval-sexp-add-defvars dance! */
1920 ptrdiff_t count
= SPECPDL_INDEX ();
1921 Lisp_Object tem
, cbuf
;
1923 cbuf
= Fcurrent_buffer ();
1925 if (NILP (printflag
))
1929 specbind (Qstandard_output
, tem
);
1930 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1932 /* `readevalloop' calls functions which check the type of start and end. */
1933 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1934 !NILP (printflag
), Qnil
, read_function
,
1937 return unbind_to (count
, Qnil
);
1941 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1942 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1943 If STREAM is nil, use the value of `standard-input' (which see).
1944 STREAM or the value of `standard-input' may be:
1945 a buffer (read from point and advance it)
1946 a marker (read from where it points and advance it)
1947 a function (call it with no arguments for each character,
1948 call it with a char as argument to push a char back)
1949 a string (takes text from string, starting at the beginning)
1950 t (read text line using minibuffer and use it, or read from
1951 standard input in batch mode). */)
1952 (Lisp_Object stream
)
1955 stream
= Vstandard_input
;
1956 if (EQ (stream
, Qt
))
1957 stream
= Qread_char
;
1958 if (EQ (stream
, Qread_char
))
1959 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1961 return read_internal_start (stream
, Qnil
, Qnil
);
1964 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1965 doc
: /* Read one Lisp expression which is represented as text by STRING.
1966 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1967 FINAL-STRING-INDEX is an integer giving the position of the next
1968 remaining character in STRING.
1969 START and END optionally delimit a substring of STRING from which to read;
1970 they default to 0 and (length STRING) respectively. */)
1971 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1974 CHECK_STRING (string
);
1975 /* `read_internal_start' sets `read_from_string_index'. */
1976 ret
= read_internal_start (string
, start
, end
);
1977 return Fcons (ret
, make_number (read_from_string_index
));
1980 /* Function to set up the global context we need in toplevel read
1983 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1984 /* `start', `end' only used when stream is a string. */
1989 new_backquote_flag
= 0;
1990 read_objects
= Qnil
;
1991 if (EQ (Vread_with_symbol_positions
, Qt
)
1992 || EQ (Vread_with_symbol_positions
, stream
))
1993 Vread_symbol_positions_list
= Qnil
;
1995 if (STRINGP (stream
)
1996 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1998 ptrdiff_t startval
, endval
;
2001 if (STRINGP (stream
))
2004 string
= XCAR (stream
);
2007 endval
= SCHARS (string
);
2011 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2012 args_out_of_range (string
, end
);
2013 endval
= XINT (end
);
2020 CHECK_NUMBER (start
);
2021 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2022 args_out_of_range (string
, start
);
2023 startval
= XINT (start
);
2025 read_from_string_index
= startval
;
2026 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2027 read_from_string_limit
= endval
;
2030 retval
= read0 (stream
);
2031 if (EQ (Vread_with_symbol_positions
, Qt
)
2032 || EQ (Vread_with_symbol_positions
, stream
))
2033 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2038 /* Signal Qinvalid_read_syntax error.
2039 S is error string of length N (if > 0) */
2041 static _Noreturn
void
2042 invalid_syntax (const char *s
)
2044 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2048 /* Use this for recursive reads, in contexts where internal tokens
2052 read0 (Lisp_Object readcharfun
)
2054 register Lisp_Object val
;
2057 val
= read1 (readcharfun
, &c
, 0);
2061 xsignal1 (Qinvalid_read_syntax
,
2062 Fmake_string (make_number (1), make_number (c
)));
2065 static ptrdiff_t read_buffer_size
;
2066 static char *read_buffer
;
2068 /* Read a \-escape sequence, assuming we already read the `\'.
2069 If the escape sequence forces unibyte, return eight-bit char. */
2072 read_escape (Lisp_Object readcharfun
, bool stringp
)
2075 /* \u allows up to four hex digits, \U up to eight. Default to the
2076 behavior for \u, and change this value in the case that \U is seen. */
2077 int unicode_hex_count
= 4;
2082 end_of_file_error ();
2112 error ("Invalid escape character syntax");
2115 c
= read_escape (readcharfun
, 0);
2116 return c
| meta_modifier
;
2121 error ("Invalid escape character syntax");
2124 c
= read_escape (readcharfun
, 0);
2125 return c
| shift_modifier
;
2130 error ("Invalid escape character syntax");
2133 c
= read_escape (readcharfun
, 0);
2134 return c
| hyper_modifier
;
2139 error ("Invalid escape character syntax");
2142 c
= read_escape (readcharfun
, 0);
2143 return c
| alt_modifier
;
2147 if (stringp
|| c
!= '-')
2154 c
= read_escape (readcharfun
, 0);
2155 return c
| super_modifier
;
2160 error ("Invalid escape character syntax");
2164 c
= read_escape (readcharfun
, 0);
2165 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2166 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2167 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2168 return c
| ctrl_modifier
;
2169 /* ASCII control chars are made from letters (both cases),
2170 as well as the non-letters within 0100...0137. */
2171 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2172 return (c
& (037 | ~0177));
2173 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2174 return (c
& (037 | ~0177));
2176 return c
| ctrl_modifier
;
2186 /* An octal escape, as in ANSI C. */
2188 register int i
= c
- '0';
2189 register int count
= 0;
2192 if ((c
= READCHAR
) >= '0' && c
<= '7')
2204 if (i
>= 0x80 && i
< 0x100)
2205 i
= BYTE8_TO_CHAR (i
);
2210 /* A hex escape, as in ANSI C. */
2217 if (c
>= '0' && c
<= '9')
2222 else if ((c
>= 'a' && c
<= 'f')
2223 || (c
>= 'A' && c
<= 'F'))
2226 if (c
>= 'a' && c
<= 'f')
2236 /* Allow hex escapes as large as ?\xfffffff, because some
2237 packages use them to denote characters with modifiers. */
2238 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2239 error ("Hex character out of range: \\x%x...", i
);
2243 if (count
< 3 && i
>= 0x80)
2244 return BYTE8_TO_CHAR (i
);
2249 /* Post-Unicode-2.0: Up to eight hex chars. */
2250 unicode_hex_count
= 8;
2253 /* A Unicode escape. We only permit them in strings and characters,
2254 not arbitrarily in the source code, as in some other languages. */
2259 while (++count
<= unicode_hex_count
)
2262 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2264 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2265 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2266 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2268 error ("Non-hex digit used for Unicode escape");
2271 error ("Non-Unicode character: 0x%x", i
);
2280 /* Return the digit that CHARACTER stands for in the given BASE.
2281 Return -1 if CHARACTER is out of range for BASE,
2282 and -2 if CHARACTER is not valid for any supported BASE. */
2284 digit_to_number (int character
, int base
)
2288 if ('0' <= character
&& character
<= '9')
2289 digit
= character
- '0';
2290 else if ('a' <= character
&& character
<= 'z')
2291 digit
= character
- 'a' + 10;
2292 else if ('A' <= character
&& character
<= 'Z')
2293 digit
= character
- 'A' + 10;
2297 return digit
< base
? digit
: -1;
2300 /* Read an integer in radix RADIX using READCHARFUN to read
2301 characters. RADIX must be in the interval [2..36]; if it isn't, a
2302 read error is signaled . Value is the integer read. Signals an
2303 error if encountering invalid read syntax or if RADIX is out of
2307 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2309 /* Room for sign, leading 0, other digits, trailing null byte.
2310 Also, room for invalid syntax diagnostic. */
2311 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2312 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2314 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2316 if (radix
< 2 || radix
> 36)
2324 if (c
== '-' || c
== '+')
2335 /* Ignore redundant leading zeros, so the buffer doesn't
2336 fill up with them. */
2342 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2349 if (p
< buf
+ sizeof buf
- 1)
2363 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2364 invalid_syntax (buf
);
2367 return string_to_number (buf
, radix
, 0);
2371 /* If the next token is ')' or ']' or '.', we store that character
2372 in *PCH and the return value is not interesting. Else, we store
2373 zero in *PCH and we read and return one lisp object.
2375 FIRST_IN_LIST is true if this is the first element of a list. */
2378 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2381 bool uninterned_symbol
= 0;
2389 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2391 end_of_file_error ();
2396 return read_list (0, readcharfun
);
2399 return read_vector (readcharfun
, 0);
2415 /* Accept extended format for hashtables (extensible to
2417 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2418 Lisp_Object tmp
= read_list (0, readcharfun
);
2419 Lisp_Object head
= CAR_SAFE (tmp
);
2420 Lisp_Object data
= Qnil
;
2421 Lisp_Object val
= Qnil
;
2422 /* The size is 2 * number of allowed keywords to
2424 Lisp_Object params
[10];
2426 Lisp_Object key
= Qnil
;
2427 int param_count
= 0;
2429 if (!EQ (head
, Qhash_table
))
2430 error ("Invalid extended read marker at head of #s list "
2431 "(only hash-table allowed)");
2433 tmp
= CDR_SAFE (tmp
);
2435 /* This is repetitive but fast and simple. */
2436 params
[param_count
] = QCsize
;
2437 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2438 if (!NILP (params
[param_count
+ 1]))
2441 params
[param_count
] = QCtest
;
2442 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2443 if (!NILP (params
[param_count
+ 1]))
2446 params
[param_count
] = QCweakness
;
2447 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2448 if (!NILP (params
[param_count
+ 1]))
2451 params
[param_count
] = QCrehash_size
;
2452 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2453 if (!NILP (params
[param_count
+ 1]))
2456 params
[param_count
] = QCrehash_threshold
;
2457 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2458 if (!NILP (params
[param_count
+ 1]))
2461 /* This is the hashtable data. */
2462 data
= Fplist_get (tmp
, Qdata
);
2464 /* Now use params to make a new hashtable and fill it. */
2465 ht
= Fmake_hash_table (param_count
, params
);
2467 while (CONSP (data
))
2472 error ("Odd number of elements in hashtable data");
2475 Fputhash (key
, val
, ht
);
2481 invalid_syntax ("#");
2489 tmp
= read_vector (readcharfun
, 0);
2490 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2491 error ("Invalid size char-table");
2492 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2504 tmp
= read_vector (readcharfun
, 0);
2507 error ("Invalid size char-table");
2508 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2509 error ("Invalid depth in char-table");
2510 depth
= XINT (AREF (tmp
, 0));
2511 if (chartab_size
[depth
] != size
- 2)
2512 error ("Invalid size char-table");
2513 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2516 invalid_syntax ("#^^");
2518 invalid_syntax ("#^");
2523 length
= read1 (readcharfun
, pch
, first_in_list
);
2527 Lisp_Object tmp
, val
;
2528 EMACS_INT size_in_chars
2529 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2530 / BOOL_VECTOR_BITS_PER_CHAR
);
2533 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2534 if (STRING_MULTIBYTE (tmp
)
2535 || (size_in_chars
!= SCHARS (tmp
)
2536 /* We used to print 1 char too many
2537 when the number of bits was a multiple of 8.
2538 Accept such input in case it came from an old
2540 && ! (XFASTINT (length
)
2541 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2542 invalid_syntax ("#&...");
2544 val
= Fmake_bool_vector (length
, Qnil
);
2545 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2546 /* Clear the extraneous bits in the last byte. */
2547 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2548 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2549 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2552 invalid_syntax ("#&...");
2556 /* Accept compiled functions at read-time so that we don't have to
2557 build them using function calls. */
2559 tmp
= read_vector (readcharfun
, 1);
2560 make_byte_code (XVECTOR (tmp
));
2566 struct gcpro gcpro1
;
2569 /* Read the string itself. */
2570 tmp
= read1 (readcharfun
, &ch
, 0);
2571 if (ch
!= 0 || !STRINGP (tmp
))
2572 invalid_syntax ("#");
2574 /* Read the intervals and their properties. */
2577 Lisp_Object beg
, end
, plist
;
2579 beg
= read1 (readcharfun
, &ch
, 0);
2584 end
= read1 (readcharfun
, &ch
, 0);
2586 plist
= read1 (readcharfun
, &ch
, 0);
2588 invalid_syntax ("Invalid string property list");
2589 Fset_text_properties (beg
, end
, plist
, tmp
);
2595 /* #@NUMBER is used to skip NUMBER following characters.
2596 That's used in .elc files to skip over doc strings
2597 and function definitions. */
2600 enum { extra
= 100 };
2601 ptrdiff_t i
, nskip
= 0;
2604 /* Read a decimal integer. */
2605 while ((c
= READCHAR
) >= 0
2606 && c
>= '0' && c
<= '9')
2608 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2615 if (load_force_doc_strings
2616 && (EQ (readcharfun
, Qget_file_char
)
2617 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2619 /* If we are supposed to force doc strings into core right now,
2620 record the last string that we skipped,
2621 and record where in the file it comes from. */
2623 /* But first exchange saved_doc_string
2624 with prev_saved_doc_string, so we save two strings. */
2626 char *temp
= saved_doc_string
;
2627 ptrdiff_t temp_size
= saved_doc_string_size
;
2628 file_offset temp_pos
= saved_doc_string_position
;
2629 ptrdiff_t temp_len
= saved_doc_string_length
;
2631 saved_doc_string
= prev_saved_doc_string
;
2632 saved_doc_string_size
= prev_saved_doc_string_size
;
2633 saved_doc_string_position
= prev_saved_doc_string_position
;
2634 saved_doc_string_length
= prev_saved_doc_string_length
;
2636 prev_saved_doc_string
= temp
;
2637 prev_saved_doc_string_size
= temp_size
;
2638 prev_saved_doc_string_position
= temp_pos
;
2639 prev_saved_doc_string_length
= temp_len
;
2642 if (saved_doc_string_size
== 0)
2644 saved_doc_string
= xmalloc (nskip
+ extra
);
2645 saved_doc_string_size
= nskip
+ extra
;
2647 if (nskip
> saved_doc_string_size
)
2649 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2650 saved_doc_string_size
= nskip
+ extra
;
2653 saved_doc_string_position
= file_tell (instream
);
2655 /* Copy that many characters into saved_doc_string. */
2656 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2657 saved_doc_string
[i
] = c
= READCHAR
;
2659 saved_doc_string_length
= i
;
2663 /* Skip that many characters. */
2664 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2673 /* #! appears at the beginning of an executable file.
2674 Skip the first line. */
2675 while (c
!= '\n' && c
>= 0)
2680 return Vload_file_name
;
2682 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2683 /* #:foo is the uninterned symbol named foo. */
2686 uninterned_symbol
= 1;
2689 && c
!= 0xa0 /* NBSP */
2691 || strchr ("\"';()[]#`,", c
) == NULL
)))
2693 /* No symbol character follows, this is the empty
2696 return Fmake_symbol (empty_unibyte_string
);
2700 /* ## is the empty symbol. */
2702 return Fintern (empty_unibyte_string
, Qnil
);
2703 /* Reader forms that can reuse previously read objects. */
2704 if (c
>= '0' && c
<= '9')
2709 /* Read a non-negative integer. */
2710 while (c
>= '0' && c
<= '9')
2712 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2713 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2714 n
= MOST_POSITIVE_FIXNUM
+ 1;
2716 n
= n
* 10 + c
- '0';
2720 if (n
<= MOST_POSITIVE_FIXNUM
)
2722 if (c
== 'r' || c
== 'R')
2723 return read_integer (readcharfun
, n
);
2725 if (! NILP (Vread_circle
))
2727 /* #n=object returns object, but associates it with
2731 /* Make a placeholder for #n# to use temporarily. */
2732 Lisp_Object placeholder
;
2735 placeholder
= Fcons (Qnil
, Qnil
);
2736 cell
= Fcons (make_number (n
), placeholder
);
2737 read_objects
= Fcons (cell
, read_objects
);
2739 /* Read the object itself. */
2740 tem
= read0 (readcharfun
);
2742 /* Now put it everywhere the placeholder was... */
2743 substitute_object_in_subtree (tem
, placeholder
);
2745 /* ...and #n# will use the real value from now on. */
2746 Fsetcdr (cell
, tem
);
2751 /* #n# returns a previously read object. */
2754 tem
= Fassq (make_number (n
), read_objects
);
2760 /* Fall through to error message. */
2762 else if (c
== 'x' || c
== 'X')
2763 return read_integer (readcharfun
, 16);
2764 else if (c
== 'o' || c
== 'O')
2765 return read_integer (readcharfun
, 8);
2766 else if (c
== 'b' || c
== 'B')
2767 return read_integer (readcharfun
, 2);
2770 invalid_syntax ("#");
2773 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2778 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2783 int next_char
= READCHAR
;
2785 /* Transition from old-style to new-style:
2786 If we see "(`" it used to mean old-style, which usually works
2787 fine because ` should almost never appear in such a position
2788 for new-style. But occasionally we need "(`" to mean new
2789 style, so we try to distinguish the two by the fact that we
2790 can either write "( `foo" or "(` foo", where the first
2791 intends to use new-style whereas the second intends to use
2792 old-style. For Emacs-25, we should completely remove this
2793 first_in_list exception (old-style can still be obtained via
2795 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2797 Vold_style_backquotes
= Qt
;
2803 bool saved_new_backquote_flag
= new_backquote_flag
;
2805 new_backquote_flag
= 1;
2806 value
= read0 (readcharfun
);
2807 new_backquote_flag
= saved_new_backquote_flag
;
2809 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2814 int next_char
= READCHAR
;
2816 /* Transition from old-style to new-style:
2817 It used to be impossible to have a new-style , other than within
2818 a new-style `. This is sufficient when ` and , are used in the
2819 normal way, but ` and , can also appear in args to macros that
2820 will not interpret them in the usual way, in which case , may be
2821 used without any ` anywhere near.
2822 So we now use the same heuristic as for backquote: old-style
2823 unquotes are only recognized when first on a list, and when
2824 followed by a space.
2825 Because it's more difficult to peek 2 chars ahead, a new-style
2826 ,@ can still not be used outside of a `, unless it's in the middle
2828 if (new_backquote_flag
2830 || (next_char
!= ' ' && next_char
!= '@'))
2832 Lisp_Object comma_type
= Qnil
;
2837 comma_type
= Qcomma_at
;
2839 comma_type
= Qcomma_dot
;
2842 if (ch
>= 0) UNREAD (ch
);
2843 comma_type
= Qcomma
;
2846 value
= read0 (readcharfun
);
2847 return Fcons (comma_type
, Fcons (value
, Qnil
));
2851 Vold_style_backquotes
= Qt
;
2863 end_of_file_error ();
2865 /* Accept `single space' syntax like (list ? x) where the
2866 whitespace character is SPC or TAB.
2867 Other literal whitespace like NL, CR, and FF are not accepted,
2868 as there are well-established escape sequences for these. */
2869 if (c
== ' ' || c
== '\t')
2870 return make_number (c
);
2873 c
= read_escape (readcharfun
, 0);
2874 modifiers
= c
& CHAR_MODIFIER_MASK
;
2875 c
&= ~CHAR_MODIFIER_MASK
;
2876 if (CHAR_BYTE8_P (c
))
2877 c
= CHAR_TO_BYTE8 (c
);
2880 next_char
= READCHAR
;
2881 ok
= (next_char
<= 040
2882 || (next_char
< 0200
2883 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2886 return make_number (c
);
2888 invalid_syntax ("?");
2893 char *p
= read_buffer
;
2894 char *end
= read_buffer
+ read_buffer_size
;
2896 /* True if we saw an escape sequence specifying
2897 a multibyte character. */
2898 bool force_multibyte
= 0;
2899 /* True if we saw an escape sequence specifying
2900 a single-byte character. */
2901 bool force_singlebyte
= 0;
2903 ptrdiff_t nchars
= 0;
2905 while ((ch
= READCHAR
) >= 0
2908 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2910 ptrdiff_t offset
= p
- read_buffer
;
2911 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2912 memory_full (SIZE_MAX
);
2913 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
2914 read_buffer_size
*= 2;
2915 p
= read_buffer
+ offset
;
2916 end
= read_buffer
+ read_buffer_size
;
2923 ch
= read_escape (readcharfun
, 1);
2925 /* CH is -1 if \ newline has just been seen. */
2928 if (p
== read_buffer
)
2933 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2934 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2936 if (CHAR_BYTE8_P (ch
))
2937 force_singlebyte
= 1;
2938 else if (! ASCII_CHAR_P (ch
))
2939 force_multibyte
= 1;
2940 else /* I.e. ASCII_CHAR_P (ch). */
2942 /* Allow `\C- ' and `\C-?'. */
2943 if (modifiers
== CHAR_CTL
)
2946 ch
= 0, modifiers
= 0;
2948 ch
= 127, modifiers
= 0;
2950 if (modifiers
& CHAR_SHIFT
)
2952 /* Shift modifier is valid only with [A-Za-z]. */
2953 if (ch
>= 'A' && ch
<= 'Z')
2954 modifiers
&= ~CHAR_SHIFT
;
2955 else if (ch
>= 'a' && ch
<= 'z')
2956 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2959 if (modifiers
& CHAR_META
)
2961 /* Move the meta bit to the right place for a
2963 modifiers
&= ~CHAR_META
;
2964 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2965 force_singlebyte
= 1;
2969 /* Any modifiers remaining are invalid. */
2971 error ("Invalid modifier in string");
2972 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2976 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2977 if (CHAR_BYTE8_P (ch
))
2978 force_singlebyte
= 1;
2979 else if (! ASCII_CHAR_P (ch
))
2980 force_multibyte
= 1;
2986 end_of_file_error ();
2988 /* If purifying, and string starts with \ newline,
2989 return zero instead. This is for doc strings
2990 that we are really going to find in etc/DOC.nn.nn. */
2991 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2992 return make_number (0);
2994 if (! force_multibyte
&& force_singlebyte
)
2996 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
2997 forms. Convert it to unibyte. */
2998 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3000 p
= read_buffer
+ nchars
;
3003 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3005 || (p
- read_buffer
!= nchars
)));
3010 int next_char
= READCHAR
;
3013 if (next_char
<= 040
3014 || (next_char
< 0200
3015 && strchr ("\"';([#?`,", next_char
) != NULL
))
3021 /* Otherwise, we fall through! Note that the atom-reading loop
3022 below will now loop at least once, assuring that we will not
3023 try to UNREAD two characters in a row. */
3027 if (c
<= 040) goto retry
;
3028 if (c
== 0xa0) /* NBSP */
3033 char *p
= read_buffer
;
3035 EMACS_INT start_position
= readchar_count
- 1;
3038 char *end
= read_buffer
+ read_buffer_size
;
3042 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3044 ptrdiff_t offset
= p
- read_buffer
;
3045 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3046 memory_full (SIZE_MAX
);
3047 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3048 read_buffer_size
*= 2;
3049 p
= read_buffer
+ offset
;
3050 end
= read_buffer
+ read_buffer_size
;
3057 end_of_file_error ();
3062 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3068 && c
!= 0xa0 /* NBSP */
3070 || strchr ("\"';()[]#`,", c
) == NULL
));
3074 ptrdiff_t offset
= p
- read_buffer
;
3075 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3076 memory_full (SIZE_MAX
);
3077 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3078 read_buffer_size
*= 2;
3079 p
= read_buffer
+ offset
;
3080 end
= read_buffer
+ read_buffer_size
;
3086 if (!quoted
&& !uninterned_symbol
)
3088 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3089 if (! NILP (result
))
3093 Lisp_Object name
, result
;
3094 ptrdiff_t nbytes
= p
- read_buffer
;
3097 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3101 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3102 ? make_pure_string
: make_specified_string
)
3103 (read_buffer
, nchars
, nbytes
, multibyte
));
3104 result
= (uninterned_symbol
? Fmake_symbol (name
)
3105 : Fintern (name
, Qnil
));
3107 if (EQ (Vread_with_symbol_positions
, Qt
)
3108 || EQ (Vread_with_symbol_positions
, readcharfun
))
3109 Vread_symbol_positions_list
3110 = Fcons (Fcons (result
, make_number (start_position
)),
3111 Vread_symbol_positions_list
);
3119 /* List of nodes we've seen during substitute_object_in_subtree. */
3120 static Lisp_Object seen_list
;
3123 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3125 Lisp_Object check_object
;
3127 /* We haven't seen any objects when we start. */
3130 /* Make all the substitutions. */
3132 = substitute_object_recurse (object
, placeholder
, object
);
3134 /* Clear seen_list because we're done with it. */
3137 /* The returned object here is expected to always eq the
3139 if (!EQ (check_object
, object
))
3140 error ("Unexpected mutation error in reader");
3143 /* Feval doesn't get called from here, so no gc protection is needed. */
3144 #define SUBSTITUTE(get_val, set_val) \
3146 Lisp_Object old_value = get_val; \
3147 Lisp_Object true_value \
3148 = substitute_object_recurse (object, placeholder, \
3151 if (!EQ (old_value, true_value)) \
3158 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3160 /* If we find the placeholder, return the target object. */
3161 if (EQ (placeholder
, subtree
))
3164 /* If we've been to this node before, don't explore it again. */
3165 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3168 /* If this node can be the entry point to a cycle, remember that
3169 we've seen it. It can only be such an entry point if it was made
3170 by #n=, which means that we can find it as a value in
3172 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3173 seen_list
= Fcons (subtree
, seen_list
);
3175 /* Recurse according to subtree's type.
3176 Every branch must return a Lisp_Object. */
3177 switch (XTYPE (subtree
))
3179 case Lisp_Vectorlike
:
3181 ptrdiff_t i
, length
= 0;
3182 if (BOOL_VECTOR_P (subtree
))
3183 return subtree
; /* No sub-objects anyway. */
3184 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3185 || COMPILEDP (subtree
))
3186 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3187 else if (VECTORP (subtree
))
3188 length
= ASIZE (subtree
);
3190 /* An unknown pseudovector may contain non-Lisp fields, so we
3191 can't just blindly traverse all its fields. We used to call
3192 `Flength' which signaled `sequencep', so I just preserved this
3194 wrong_type_argument (Qsequencep
, subtree
);
3196 for (i
= 0; i
< length
; i
++)
3197 SUBSTITUTE (AREF (subtree
, i
),
3198 ASET (subtree
, i
, true_value
));
3204 SUBSTITUTE (XCAR (subtree
),
3205 XSETCAR (subtree
, true_value
));
3206 SUBSTITUTE (XCDR (subtree
),
3207 XSETCDR (subtree
, true_value
));
3213 /* Check for text properties in each interval.
3214 substitute_in_interval contains part of the logic. */
3216 INTERVAL root_interval
= string_intervals (subtree
);
3217 Lisp_Object arg
= Fcons (object
, placeholder
);
3219 traverse_intervals_noorder (root_interval
,
3220 &substitute_in_interval
, arg
);
3225 /* Other types don't recurse any further. */
3231 /* Helper function for substitute_object_recurse. */
3233 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3235 Lisp_Object object
= Fcar (arg
);
3236 Lisp_Object placeholder
= Fcdr (arg
);
3238 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3248 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3249 integer syntax and fits in a fixnum, else return the nearest float if CP has
3250 either floating point or integer syntax and BASE is 10, else return nil. If
3251 IGNORE_TRAILING, consider just the longest prefix of CP that has
3252 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3253 number has integer syntax but does not fit. */
3256 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3259 char const *cp
= string
;
3261 bool float_syntax
= 0;
3264 /* Compute NaN and infinities using a variable, to cope with compilers that
3265 think they are smarter than we are. */
3268 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3269 IEEE floating point hosts, and works around a formerly-common bug where
3270 atof ("-0.0") drops the sign. */
3271 bool negative
= *cp
== '-';
3273 bool signedp
= negative
|| *cp
== '+';
3278 leading_digit
= digit_to_number (*cp
, base
);
3279 if (0 <= leading_digit
)
3284 while (0 <= digit_to_number (*cp
, base
));
3294 if ('0' <= *cp
&& *cp
<= '9')
3299 while ('0' <= *cp
&& *cp
<= '9');
3301 if (*cp
== 'e' || *cp
== 'E')
3303 char const *ecp
= cp
;
3305 if (*cp
== '+' || *cp
== '-')
3307 if ('0' <= *cp
&& *cp
<= '9')
3312 while ('0' <= *cp
&& *cp
<= '9');
3314 else if (cp
[-1] == '+'
3315 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3321 else if (cp
[-1] == '+'
3322 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3326 value
= zero
/ zero
;
3328 /* If that made a "negative" NaN, negate it. */
3331 union { double d
; char c
[sizeof (double)]; }
3332 u_data
, u_minus_zero
;
3334 u_minus_zero
.d
= -0.0;
3335 for (i
= 0; i
< sizeof (double); i
++)
3336 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3342 /* Now VALUE is a positive NaN. */
3348 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3349 || state
== (LEAD_INT
|E_EXP
));
3352 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3353 any prefix that matches. Otherwise, the entire string must match. */
3354 if (! (ignore_trailing
3355 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3356 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3359 /* If the number uses integer and not float syntax, and is in C-language
3360 range, use its value, preferably as a fixnum. */
3361 if (0 <= leading_digit
&& ! float_syntax
)
3365 /* Fast special case for single-digit integers. This also avoids a
3366 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3367 case some versions of strtoumax accept numbers like "0x1" that Emacs
3369 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3370 return make_number (negative
? -leading_digit
: leading_digit
);
3373 n
= strtoumax (string
+ signedp
, NULL
, base
);
3374 if (errno
== ERANGE
)
3376 /* Unfortunately there's no simple and accurate way to convert
3377 non-base-10 numbers that are out of C-language range. */
3379 xsignal1 (Qoverflow_error
, build_string (string
));
3381 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3383 EMACS_INT signed_n
= n
;
3384 return make_number (negative
? -signed_n
: signed_n
);
3390 /* Either the number uses float syntax, or it does not fit into a fixnum.
3391 Convert it from string to floating point, unless the value is already
3392 known because it is an infinity, a NAN, or its absolute value fits in
3395 value
= atof (string
+ signedp
);
3397 return make_float (negative
? -value
: value
);
3402 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3406 Lisp_Object tem
, item
, vector
;
3407 struct Lisp_Cons
*otem
;
3410 tem
= read_list (1, readcharfun
);
3411 len
= Flength (tem
);
3412 vector
= Fmake_vector (len
, Qnil
);
3414 size
= ASIZE (vector
);
3415 ptr
= XVECTOR (vector
)->contents
;
3416 for (i
= 0; i
< size
; i
++)
3419 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3420 bytecode object, the docstring containing the bytecode and
3421 constants values must be treated as unibyte and passed to
3422 Fread, to get the actual bytecode string and constants vector. */
3423 if (bytecodeflag
&& load_force_doc_strings
)
3425 if (i
== COMPILED_BYTECODE
)
3427 if (!STRINGP (item
))
3428 error ("Invalid byte code");
3430 /* Delay handling the bytecode slot until we know whether
3431 it is lazily-loaded (we can tell by whether the
3432 constants slot is nil). */
3433 ASET (vector
, COMPILED_CONSTANTS
, item
);
3436 else if (i
== COMPILED_CONSTANTS
)
3438 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3442 /* Coerce string to unibyte (like string-as-unibyte,
3443 but without generating extra garbage and
3444 guaranteeing no change in the contents). */
3445 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3446 STRING_SET_UNIBYTE (bytestr
);
3448 item
= Fread (Fcons (bytestr
, readcharfun
));
3450 error ("Invalid byte code");
3452 otem
= XCONS (item
);
3453 bytestr
= XCAR (item
);
3458 /* Now handle the bytecode slot. */
3459 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3461 else if (i
== COMPILED_DOC_STRING
3463 && ! STRING_MULTIBYTE (item
))
3465 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3466 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3468 item
= Fstring_as_multibyte (item
);
3471 ASET (vector
, i
, item
);
3479 /* FLAG means check for ] to terminate rather than ) and . */
3482 read_list (bool flag
, Lisp_Object readcharfun
)
3484 Lisp_Object val
, tail
;
3485 Lisp_Object elt
, tem
;
3486 struct gcpro gcpro1
, gcpro2
;
3487 /* 0 is the normal case.
3488 1 means this list is a doc reference; replace it with the number 0.
3489 2 means this list is a doc reference; replace it with the doc string. */
3490 int doc_reference
= 0;
3492 /* Initialize this to 1 if we are reading a list. */
3493 bool first_in_list
= flag
<= 0;
3502 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3507 /* While building, if the list starts with #$, treat it specially. */
3508 if (EQ (elt
, Vload_file_name
)
3510 && !NILP (Vpurify_flag
))
3512 if (NILP (Vdoc_file_name
))
3513 /* We have not yet called Snarf-documentation, so assume
3514 this file is described in the DOC-MM.NN file
3515 and Snarf-documentation will fill in the right value later.
3516 For now, replace the whole list with 0. */
3519 /* We have already called Snarf-documentation, so make a relative
3520 file name for this file, so it can be found properly
3521 in the installed Lisp directory.
3522 We don't use Fexpand_file_name because that would make
3523 the directory absolute now. */
3524 elt
= concat2 (build_string ("../lisp/"),
3525 Ffile_name_nondirectory (elt
));
3527 else if (EQ (elt
, Vload_file_name
)
3529 && load_force_doc_strings
)
3538 invalid_syntax (") or . in a vector");
3546 XSETCDR (tail
, read0 (readcharfun
));
3548 val
= read0 (readcharfun
);
3549 read1 (readcharfun
, &ch
, 0);
3553 if (doc_reference
== 1)
3554 return make_number (0);
3555 if (doc_reference
== 2)
3557 /* Get a doc string from the file we are loading.
3558 If it's in saved_doc_string, get it from there.
3560 Here, we don't know if the string is a
3561 bytecode string or a doc string. As a
3562 bytecode string must be unibyte, we always
3563 return a unibyte string. If it is actually a
3564 doc string, caller must make it
3567 EMACS_INT pos
= XINT (XCDR (val
));
3568 /* Position is negative for user variables. */
3569 if (pos
< 0) pos
= -pos
;
3570 if (pos
>= saved_doc_string_position
3571 && pos
< (saved_doc_string_position
3572 + saved_doc_string_length
))
3574 ptrdiff_t start
= pos
- saved_doc_string_position
;
3577 /* Process quoting with ^A,
3578 and find the end of the string,
3579 which is marked with ^_ (037). */
3580 for (from
= start
, to
= start
;
3581 saved_doc_string
[from
] != 037;)
3583 int c
= saved_doc_string
[from
++];
3586 c
= saved_doc_string
[from
++];
3588 saved_doc_string
[to
++] = c
;
3590 saved_doc_string
[to
++] = 0;
3592 saved_doc_string
[to
++] = 037;
3595 saved_doc_string
[to
++] = c
;
3598 return make_unibyte_string (saved_doc_string
+ start
,
3601 /* Look in prev_saved_doc_string the same way. */
3602 else if (pos
>= prev_saved_doc_string_position
3603 && pos
< (prev_saved_doc_string_position
3604 + prev_saved_doc_string_length
))
3607 pos
- prev_saved_doc_string_position
;
3610 /* Process quoting with ^A,
3611 and find the end of the string,
3612 which is marked with ^_ (037). */
3613 for (from
= start
, to
= start
;
3614 prev_saved_doc_string
[from
] != 037;)
3616 int c
= prev_saved_doc_string
[from
++];
3619 c
= prev_saved_doc_string
[from
++];
3621 prev_saved_doc_string
[to
++] = c
;
3623 prev_saved_doc_string
[to
++] = 0;
3625 prev_saved_doc_string
[to
++] = 037;
3628 prev_saved_doc_string
[to
++] = c
;
3631 return make_unibyte_string (prev_saved_doc_string
3636 return get_doc_string (val
, 1, 0);
3641 invalid_syntax (". in wrong context");
3643 invalid_syntax ("] in a list");
3645 tem
= Fcons (elt
, Qnil
);
3647 XSETCDR (tail
, tem
);
3654 static Lisp_Object initial_obarray
;
3656 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3658 static size_t oblookup_last_bucket_number
;
3660 /* Get an error if OBARRAY is not an obarray.
3661 If it is one, return it. */
3664 check_obarray (Lisp_Object obarray
)
3666 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3668 /* If Vobarray is now invalid, force it to be valid. */
3669 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3670 wrong_type_argument (Qvectorp
, obarray
);
3675 /* Intern the C string STR: return a symbol with that name,
3676 interned in the current obarray. */
3679 intern_1 (const char *str
, ptrdiff_t len
)
3681 Lisp_Object obarray
= check_obarray (Vobarray
);
3682 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3684 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3688 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3690 Lisp_Object obarray
= check_obarray (Vobarray
);
3691 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3696 if (NILP (Vpurify_flag
))
3697 /* Creating a non-pure string from a string literal not
3698 implemented yet. We could just use make_string here and live
3699 with the extra copy. */
3702 return Fintern (make_pure_c_string (str
, len
), obarray
);
3705 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3706 doc
: /* Return the canonical symbol whose name is STRING.
3707 If there is none, one is created by this function and returned.
3708 A second optional argument specifies the obarray to use;
3709 it defaults to the value of `obarray'. */)
3710 (Lisp_Object string
, Lisp_Object obarray
)
3712 register Lisp_Object tem
, sym
, *ptr
;
3714 if (NILP (obarray
)) obarray
= Vobarray
;
3715 obarray
= check_obarray (obarray
);
3717 CHECK_STRING (string
);
3719 tem
= oblookup (obarray
, SSDATA (string
),
3722 if (!INTEGERP (tem
))
3725 if (!NILP (Vpurify_flag
))
3726 string
= Fpurecopy (string
);
3727 sym
= Fmake_symbol (string
);
3729 if (EQ (obarray
, initial_obarray
))
3730 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3732 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3734 if ((SREF (string
, 0) == ':')
3735 && EQ (obarray
, initial_obarray
))
3737 XSYMBOL (sym
)->constant
= 1;
3738 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3739 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3742 ptr
= aref_addr (obarray
, XINT(tem
));
3744 set_symbol_next (sym
, XSYMBOL (*ptr
));
3746 set_symbol_next (sym
, NULL
);
3751 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3752 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3753 NAME may be a string or a symbol. If it is a symbol, that exact
3754 symbol is searched for.
3755 A second optional argument specifies the obarray to use;
3756 it defaults to the value of `obarray'. */)
3757 (Lisp_Object name
, Lisp_Object obarray
)
3759 register Lisp_Object tem
, string
;
3761 if (NILP (obarray
)) obarray
= Vobarray
;
3762 obarray
= check_obarray (obarray
);
3764 if (!SYMBOLP (name
))
3766 CHECK_STRING (name
);
3770 string
= SYMBOL_NAME (name
);
3772 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3773 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3779 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3780 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3781 The value is t if a symbol was found and deleted, nil otherwise.
3782 NAME may be a string or a symbol. If it is a symbol, that symbol
3783 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3784 OBARRAY defaults to the value of the variable `obarray'. */)
3785 (Lisp_Object name
, Lisp_Object obarray
)
3787 register Lisp_Object string
, tem
;
3790 if (NILP (obarray
)) obarray
= Vobarray
;
3791 obarray
= check_obarray (obarray
);
3794 string
= SYMBOL_NAME (name
);
3797 CHECK_STRING (name
);
3801 tem
= oblookup (obarray
, SSDATA (string
),
3806 /* If arg was a symbol, don't delete anything but that symbol itself. */
3807 if (SYMBOLP (name
) && !EQ (name
, tem
))
3810 /* There are plenty of other symbols which will screw up the Emacs
3811 session if we unintern them, as well as even more ways to use
3812 `setq' or `fset' or whatnot to make the Emacs session
3813 unusable. Let's not go down this silly road. --Stef */
3814 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3815 error ("Attempt to unintern t or nil"); */
3817 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3819 hash
= oblookup_last_bucket_number
;
3821 if (EQ (AREF (obarray
, hash
), tem
))
3823 if (XSYMBOL (tem
)->next
)
3826 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3827 ASET (obarray
, hash
, sym
);
3830 ASET (obarray
, hash
, make_number (0));
3834 Lisp_Object tail
, following
;
3836 for (tail
= AREF (obarray
, hash
);
3837 XSYMBOL (tail
)->next
;
3840 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3841 if (EQ (following
, tem
))
3843 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3852 /* Return the symbol in OBARRAY whose names matches the string
3853 of SIZE characters (SIZE_BYTE bytes) at PTR.
3854 If there is no such symbol in OBARRAY, return nil.
3856 Also store the bucket number in oblookup_last_bucket_number. */
3859 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3863 register Lisp_Object tail
;
3864 Lisp_Object bucket
, tem
;
3866 obarray
= check_obarray (obarray
);
3867 obsize
= ASIZE (obarray
);
3869 /* This is sometimes needed in the middle of GC. */
3870 obsize
&= ~ARRAY_MARK_FLAG
;
3871 hash
= hash_string (ptr
, size_byte
) % obsize
;
3872 bucket
= AREF (obarray
, hash
);
3873 oblookup_last_bucket_number
= hash
;
3874 if (EQ (bucket
, make_number (0)))
3876 else if (!SYMBOLP (bucket
))
3877 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3879 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3881 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3882 && SCHARS (SYMBOL_NAME (tail
)) == size
3883 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3885 else if (XSYMBOL (tail
)->next
== 0)
3888 XSETINT (tem
, hash
);
3893 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3896 register Lisp_Object tail
;
3897 CHECK_VECTOR (obarray
);
3898 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3900 tail
= AREF (obarray
, i
);
3905 if (XSYMBOL (tail
)->next
== 0)
3907 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3913 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3915 call1 (function
, sym
);
3918 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3919 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3920 OBARRAY defaults to the value of `obarray'. */)
3921 (Lisp_Object function
, Lisp_Object obarray
)
3923 if (NILP (obarray
)) obarray
= Vobarray
;
3924 obarray
= check_obarray (obarray
);
3926 map_obarray (obarray
, mapatoms_1
, function
);
3930 #define OBARRAY_SIZE 1511
3935 Lisp_Object oblength
;
3936 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3938 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3940 Vobarray
= Fmake_vector (oblength
, make_number (0));
3941 initial_obarray
= Vobarray
;
3942 staticpro (&initial_obarray
);
3944 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
3945 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3946 NILP (Vpurify_flag) check in intern_c_string. */
3947 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3948 Qnil
= intern_c_string ("nil");
3950 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3951 so those two need to be fixed manually. */
3952 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3953 set_symbol_function (Qunbound
, Qunbound
);
3954 set_symbol_plist (Qunbound
, Qnil
);
3955 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3956 XSYMBOL (Qnil
)->constant
= 1;
3957 XSYMBOL (Qnil
)->declared_special
= 1;
3958 set_symbol_plist (Qnil
, Qnil
);
3960 Qt
= intern_c_string ("t");
3961 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3962 XSYMBOL (Qnil
)->declared_special
= 1;
3963 XSYMBOL (Qt
)->constant
= 1;
3965 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3968 DEFSYM (Qvariable_documentation
, "variable-documentation");
3970 read_buffer
= xmalloc (size
);
3971 read_buffer_size
= size
;
3975 defsubr (struct Lisp_Subr
*sname
)
3977 Lisp_Object sym
, tem
;
3978 sym
= intern_c_string (sname
->symbol_name
);
3979 XSETTYPED_PVECTYPE (sname
, size
, PVEC_SUBR
);
3980 XSETSUBR (tem
, sname
);
3981 set_symbol_function (sym
, tem
);
3984 #ifdef NOTDEF /* Use fset in subr.el now! */
3986 defalias (struct Lisp_Subr
*sname
, char *string
)
3989 sym
= intern (string
);
3990 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3994 /* Define an "integer variable"; a symbol whose value is forwarded to a
3995 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
3996 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3998 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3999 const char *namestring
, EMACS_INT
*address
)
4002 sym
= intern_c_string (namestring
);
4003 i_fwd
->type
= Lisp_Fwd_Int
;
4004 i_fwd
->intvar
= address
;
4005 XSYMBOL (sym
)->declared_special
= 1;
4006 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4007 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4010 /* Similar but define a variable whose value is t if address contains 1,
4011 nil if address contains 0. */
4013 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4014 const char *namestring
, bool *address
)
4017 sym
= intern_c_string (namestring
);
4018 b_fwd
->type
= Lisp_Fwd_Bool
;
4019 b_fwd
->boolvar
= address
;
4020 XSYMBOL (sym
)->declared_special
= 1;
4021 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4022 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4023 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4026 /* Similar but define a variable whose value is the Lisp Object stored
4027 at address. Two versions: with and without gc-marking of the C
4028 variable. The nopro version is used when that variable will be
4029 gc-marked for some other reason, since marking the same slot twice
4030 can cause trouble with strings. */
4032 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4033 const char *namestring
, Lisp_Object
*address
)
4036 sym
= intern_c_string (namestring
);
4037 o_fwd
->type
= Lisp_Fwd_Obj
;
4038 o_fwd
->objvar
= address
;
4039 XSYMBOL (sym
)->declared_special
= 1;
4040 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4041 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4045 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4046 const char *namestring
, Lisp_Object
*address
)
4048 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4049 staticpro (address
);
4052 /* Similar but define a variable whose value is the Lisp Object stored
4053 at a particular offset in the current kboard object. */
4056 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4057 const char *namestring
, int offset
)
4060 sym
= intern_c_string (namestring
);
4061 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4062 ko_fwd
->offset
= offset
;
4063 XSYMBOL (sym
)->declared_special
= 1;
4064 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4065 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4068 /* Check that the elements of Vload_path exist. */
4071 load_path_check (void)
4073 Lisp_Object path_tail
;
4075 /* The only elements that might not exist are those from
4076 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4078 for (path_tail
= Vload_path
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4080 Lisp_Object dirfile
;
4081 dirfile
= Fcar (path_tail
);
4082 if (STRINGP (dirfile
))
4084 dirfile
= Fdirectory_file_name (dirfile
);
4085 if (access (SSDATA (dirfile
), 0) < 0)
4086 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4092 /* Record the value of load-path used at the start of dumping
4093 so we can see if the site changed it later during dumping. */
4094 static Lisp_Object dump_path
;
4096 /* Compute the default Vload_path, with the following logic:
4098 use EMACSLOADPATH env-var if set; otherwise use PATH_LOADSEARCH,
4099 prepending PATH_SITELOADSEARCH unless --no-site-lisp.
4100 The remainder is what happens when dumping works:
4101 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4102 Otherwise use EMACSLOADPATH if set, else PATH_LOADSEARCH.
4104 If !initialized, then just set both Vload_path and dump_path.
4105 If initialized, then if Vload_path != dump_path, do nothing.
4106 (Presumably the load-path has already been changed by something.
4107 This can only be from a site-load file during dumping,
4108 or because EMACSLOADPATH is set.)
4109 If Vinstallation_directory is not nil (ie, running uninstalled):
4110 If installation-dir/lisp exists and not already a member,
4111 we must be running uninstalled. Reset the load-path
4112 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4113 refers to the eventual installation directories. Since we
4114 are not yet installed, we should not use them, even if they exist.)
4115 If installation-dir/lisp does not exist, just add dump_path at the
4117 Add installation-dir/leim (if exists and not already a member) at the front.
4118 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4119 and not already a member) at the front.
4120 If installation-dir != source-dir (ie running an uninstalled,
4121 out-of-tree build) AND install-dir/src/Makefile exists BUT
4122 install-dir/src/Makefile.in does NOT exist (this is a sanity
4123 check), then repeat the above steps for source-dir/lisp,
4125 Finally, add the site-lisp directories at the front (if !no_site_lisp).
4135 const char *loadpath
= ns_load_path ();
4138 normal
= PATH_LOADSEARCH
;
4140 Vload_path
= decode_env_path ("EMACSLOADPATH", loadpath
? loadpath
: normal
);
4142 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4147 /* FIXME CANNOT_DUMP platforms should get source-dir/lisp etc added
4148 to their load-path too, AFAICS. I don't think we can tell the
4149 difference between initialized and !initialized in this case,
4150 so we'll have to do it unconditionally when Vinstallation_directory
4152 if (!no_site_lisp
&& !egetenv ("EMACSLOADPATH"))
4154 Lisp_Object sitelisp
;
4155 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4156 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4158 #else /* !CANNOT_DUMP */
4159 if (NILP (Vpurify_flag
))
4161 normal
= PATH_LOADSEARCH
;
4162 /* If the EMACSLOADPATH environment variable is set, use its value.
4163 This doesn't apply if we're dumping. */
4164 if (egetenv ("EMACSLOADPATH"))
4165 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4168 normal
= PATH_DUMPLOADSEARCH
;
4170 /* In a dumped Emacs, we normally reset the value of Vload_path using
4171 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4172 the source directory, instead of the path of the installed elisp
4173 libraries. However, if it appears that Vload_path has already been
4174 changed from the default that was saved before dumping, don't
4175 change it further. Changes can only be due to EMACSLOADPATH, or
4176 site-lisp files that were processed during dumping. */
4179 if (NILP (Fequal (dump_path
, Vload_path
)))
4181 /* Do not make any changes, just check the elements exist. */
4182 /* Note: --no-site-lisp is ignored.
4183 I don't know what to do about this. */
4189 const char *loadpath
= ns_load_path ();
4190 Vload_path
= decode_env_path (0, loadpath
? loadpath
: normal
);
4192 Vload_path
= decode_env_path (0, normal
);
4194 if (!NILP (Vinstallation_directory
))
4196 Lisp_Object tem
, tem1
;
4198 /* Add to the path the lisp subdir of the installation
4199 dir, if it exists. Note: in out-of-tree builds,
4200 this directory is empty save for Makefile. */
4201 tem
= Fexpand_file_name (build_string ("lisp"),
4202 Vinstallation_directory
);
4203 tem1
= Ffile_exists_p (tem
);
4206 if (NILP (Fmember (tem
, Vload_path
)))
4208 /* We are running uninstalled. The default load-path
4209 points to the eventual installed lisp, leim
4210 directories. We should not use those now, even
4211 if they exist, so start over from a clean slate. */
4212 Vload_path
= Fcons (tem
, Qnil
);
4216 /* That dir doesn't exist, so add the build-time
4217 Lisp dirs instead. */
4218 Vload_path
= nconc2 (Vload_path
, dump_path
);
4220 /* Add leim under the installation dir, if it exists. */
4221 tem
= Fexpand_file_name (build_string ("leim"),
4222 Vinstallation_directory
);
4223 tem1
= Ffile_exists_p (tem
);
4226 if (NILP (Fmember (tem
, Vload_path
)))
4227 Vload_path
= Fcons (tem
, Vload_path
);
4230 /* Add site-lisp under the installation dir, if it exists. */
4233 tem
= Fexpand_file_name (build_string ("site-lisp"),
4234 Vinstallation_directory
);
4235 tem1
= Ffile_exists_p (tem
);
4238 if (NILP (Fmember (tem
, Vload_path
)))
4239 Vload_path
= Fcons (tem
, Vload_path
);
4243 /* If Emacs was not built in the source directory,
4244 and it is run from where it was built, add to load-path
4245 the lisp, leim and site-lisp dirs under that directory. */
4247 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4251 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4252 Vinstallation_directory
);
4253 tem1
= Ffile_exists_p (tem
);
4255 /* Don't be fooled if they moved the entire source tree
4256 AFTER dumping Emacs. If the build directory is indeed
4257 different from the source dir, src/Makefile.in and
4258 src/Makefile will not be found together. */
4259 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4260 Vinstallation_directory
);
4261 tem2
= Ffile_exists_p (tem
);
4262 if (!NILP (tem1
) && NILP (tem2
))
4264 tem
= Fexpand_file_name (build_string ("lisp"),
4267 if (NILP (Fmember (tem
, Vload_path
)))
4268 Vload_path
= Fcons (tem
, Vload_path
);
4270 tem
= Fexpand_file_name (build_string ("leim"),
4273 if (NILP (Fmember (tem
, Vload_path
)))
4274 Vload_path
= Fcons (tem
, Vload_path
);
4278 tem
= Fexpand_file_name (build_string ("site-lisp"),
4280 tem1
= Ffile_exists_p (tem
);
4283 if (NILP (Fmember (tem
, Vload_path
)))
4284 Vload_path
= Fcons (tem
, Vload_path
);
4288 } /* Vinstallation_directory != Vsource_directory */
4290 } /* if Vinstallation_directory */
4292 /* Check before adding the site-lisp directories.
4293 The install should have created them, but they are not
4294 required, so no need to warn if they are absent.
4295 Or we might be running before installation. */
4298 /* Add the site-lisp directories at the front. */
4301 Lisp_Object sitelisp
;
4302 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4303 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4305 } /* if dump_path == Vload_path */
4307 else /* !initialized */
4309 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4310 source directory. We used to add ../lisp (ie the lisp dir in
4311 the build directory) at the front here, but that caused trouble
4312 because it was copied from dump_path into Vload_path, above,
4313 when Vinstallation_directory was non-nil. It should not be
4314 necessary, since in out of tree builds lisp/ is empty, save
4316 Vload_path
= decode_env_path (0, normal
);
4317 dump_path
= Vload_path
;
4318 /* No point calling load_path_check; load-path only contains essential
4319 elements from the source directory at this point. They cannot
4320 be missing unless something went extremely (and improbably)
4321 wrong, in which case the build will fail in obvious ways. */
4323 #endif /* !CANNOT_DUMP */
4327 load_in_progress
= 0;
4328 Vload_file_name
= Qnil
;
4330 load_descriptor_list
= Qnil
;
4332 Vstandard_input
= Qt
;
4333 Vloads_in_progress
= Qnil
;
4336 /* Print a warning, using format string FORMAT, that directory DIRNAME
4337 does not exist. Print it on stderr and put it in *Messages*. */
4340 dir_warning (const char *format
, Lisp_Object dirname
)
4342 fprintf (stderr
, format
, SDATA (dirname
));
4344 /* Don't log the warning before we've initialized!! */
4348 char *buffer
= SAFE_ALLOCA (SBYTES (dirname
)
4349 + strlen (format
) - (sizeof "%s" - 1) + 1);
4350 ptrdiff_t message_len
= esprintf (buffer
, format
, SDATA (dirname
));
4351 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4357 syms_of_lread (void)
4360 defsubr (&Sread_from_string
);
4362 defsubr (&Sintern_soft
);
4363 defsubr (&Sunintern
);
4364 defsubr (&Sget_load_suffixes
);
4366 defsubr (&Seval_buffer
);
4367 defsubr (&Seval_region
);
4368 defsubr (&Sread_char
);
4369 defsubr (&Sread_char_exclusive
);
4370 defsubr (&Sread_event
);
4371 defsubr (&Sget_file_char
);
4372 defsubr (&Smapatoms
);
4373 defsubr (&Slocate_file_internal
);
4375 DEFVAR_LISP ("obarray", Vobarray
,
4376 doc
: /* Symbol table for use by `intern' and `read'.
4377 It is a vector whose length ought to be prime for best results.
4378 The vector's contents don't make sense if examined from Lisp programs;
4379 to find all the symbols in an obarray, use `mapatoms'. */);
4381 DEFVAR_LISP ("values", Vvalues
,
4382 doc
: /* List of values of all expressions which were read, evaluated and printed.
4383 Order is reverse chronological. */);
4384 XSYMBOL (intern ("values"))->declared_special
= 0;
4386 DEFVAR_LISP ("standard-input", Vstandard_input
,
4387 doc
: /* Stream for read to get input from.
4388 See documentation of `read' for possible values. */);
4389 Vstandard_input
= Qt
;
4391 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4392 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4394 If this variable is a buffer, then only forms read from that buffer
4395 will be added to `read-symbol-positions-list'.
4396 If this variable is t, then all read forms will be added.
4397 The effect of all other values other than nil are not currently
4398 defined, although they may be in the future.
4400 The positions are relative to the last call to `read' or
4401 `read-from-string'. It is probably a bad idea to set this variable at
4402 the toplevel; bind it instead. */);
4403 Vread_with_symbol_positions
= Qnil
;
4405 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4406 doc
: /* A list mapping read symbols to their positions.
4407 This variable is modified during calls to `read' or
4408 `read-from-string', but only when `read-with-symbol-positions' is
4411 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4412 CHAR-POSITION is an integer giving the offset of that occurrence of the
4413 symbol from the position where `read' or `read-from-string' started.
4415 Note that a symbol will appear multiple times in this list, if it was
4416 read multiple times. The list is in the same order as the symbols
4418 Vread_symbol_positions_list
= Qnil
;
4420 DEFVAR_LISP ("read-circle", Vread_circle
,
4421 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4424 DEFVAR_LISP ("load-path", Vload_path
,
4425 doc
: /* List of directories to search for files to load.
4426 Each element is a string (directory name) or nil (try default directory).
4427 Initialized based on EMACSLOADPATH environment variable, if any,
4428 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4430 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4431 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4432 This list should not include the empty string.
4433 `load' and related functions try to append these suffixes, in order,
4434 to the specified file name if a Lisp suffix is allowed or required. */);
4435 Vload_suffixes
= Fcons (build_pure_c_string (".elc"),
4436 Fcons (build_pure_c_string (".el"), Qnil
));
4437 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4438 doc
: /* List of suffixes that indicate representations of \
4440 This list should normally start with the empty string.
4442 Enabling Auto Compression mode appends the suffixes in
4443 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4444 mode removes them again. `load' and related functions use this list to
4445 determine whether they should look for compressed versions of a file
4446 and, if so, which suffixes they should try to append to the file name
4447 in order to do so. However, if you want to customize which suffixes
4448 the loading functions recognize as compression suffixes, you should
4449 customize `jka-compr-load-suffixes' rather than the present variable. */);
4450 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4452 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4453 doc
: /* Non-nil if inside of `load'. */);
4454 DEFSYM (Qload_in_progress
, "load-in-progress");
4456 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4457 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4458 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4460 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4461 a symbol \(a feature name).
4463 When `load' is run and the file-name argument matches an element's
4464 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4465 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4467 An error in FORMS does not undo the load, but does prevent execution of
4468 the rest of the FORMS. */);
4469 Vafter_load_alist
= Qnil
;
4471 DEFVAR_LISP ("load-history", Vload_history
,
4472 doc
: /* Alist mapping loaded file names to symbols and features.
4473 Each alist element should be a list (FILE-NAME ENTRIES...), where
4474 FILE-NAME is the name of a file that has been loaded into Emacs.
4475 The file name is absolute and true (i.e. it doesn't contain symlinks).
4476 As an exception, one of the alist elements may have FILE-NAME nil,
4477 for symbols and features not associated with any file.
4479 The remaining ENTRIES in the alist element describe the functions and
4480 variables defined in that file, the features provided, and the
4481 features required. Each entry has the form `(provide . FEATURE)',
4482 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4483 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4484 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4485 autoload before this file redefined it as a function. In addition,
4486 entries may also be single symbols, which means that SYMBOL was
4487 defined by `defvar' or `defconst'.
4489 During preloading, the file name recorded is relative to the main Lisp
4490 directory. These file names are converted to absolute at startup. */);
4491 Vload_history
= Qnil
;
4493 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4494 doc
: /* Full name of file being loaded by `load'. */);
4495 Vload_file_name
= Qnil
;
4497 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4498 doc
: /* File name, including directory, of user's initialization file.
4499 If the file loaded had extension `.elc', and the corresponding source file
4500 exists, this variable contains the name of source file, suitable for use
4501 by functions like `custom-save-all' which edit the init file.
4502 While Emacs loads and evaluates the init file, value is the real name
4503 of the file, regardless of whether or not it has the `.elc' extension. */);
4504 Vuser_init_file
= Qnil
;
4506 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4507 doc
: /* Used for internal purposes by `load'. */);
4508 Vcurrent_load_list
= Qnil
;
4510 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4511 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4512 The default is nil, which means use the function `read'. */);
4513 Vload_read_function
= Qnil
;
4515 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4516 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4517 This function is for doing code conversion before reading the source file.
4518 If nil, loading is done without any code conversion.
4519 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4520 FULLNAME is the full name of FILE.
4521 See `load' for the meaning of the remaining arguments. */);
4522 Vload_source_file_function
= Qnil
;
4524 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4525 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4526 This is useful when the file being loaded is a temporary copy. */);
4527 load_force_doc_strings
= 0;
4529 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4530 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4531 This is normally bound by `load' and `eval-buffer' to control `read',
4532 and is not meant for users to change. */);
4533 load_convert_to_unibyte
= 0;
4535 DEFVAR_LISP ("source-directory", Vsource_directory
,
4536 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4537 You cannot count on them to still be there! */);
4539 = Fexpand_file_name (build_string ("../"),
4540 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4542 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4543 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4544 Vpreloaded_file_list
= Qnil
;
4546 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4547 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4548 Vbyte_boolean_vars
= Qnil
;
4550 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4551 doc
: /* Non-nil means load dangerous compiled Lisp files.
4552 Some versions of XEmacs use different byte codes than Emacs. These
4553 incompatible byte codes can make Emacs crash when it tries to execute
4555 load_dangerous_libraries
= 0;
4557 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4558 doc
: /* Non-nil means force printing messages when loading Lisp files.
4559 This overrides the value of the NOMESSAGE argument to `load'. */);
4560 force_load_messages
= 0;
4562 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4563 doc
: /* Regular expression matching safe to load compiled Lisp files.
4564 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4565 from the file, and matches them against this regular expression.
4566 When the regular expression matches, the file is considered to be safe
4567 to load. See also `load-dangerous-libraries'. */);
4568 Vbytecomp_version_regexp
4569 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4571 DEFSYM (Qlexical_binding
, "lexical-binding");
4572 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4573 doc
: /* Whether to use lexical binding when evaluating code.
4574 Non-nil means that the code in the current buffer should be evaluated
4575 with lexical binding.
4576 This variable is automatically set from the file variables of an
4577 interpreted Lisp file read using `load'. Unlike other file local
4578 variables, this must be set in the first line of a file. */);
4579 Vlexical_binding
= Qnil
;
4580 Fmake_variable_buffer_local (Qlexical_binding
);
4582 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4583 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4584 Veval_buffer_list
= Qnil
;
4586 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4587 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4588 Vold_style_backquotes
= Qnil
;
4589 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4591 /* Vsource_directory was initialized in init_lread. */
4593 load_descriptor_list
= Qnil
;
4594 staticpro (&load_descriptor_list
);
4596 DEFSYM (Qcurrent_load_list
, "current-load-list");
4597 DEFSYM (Qstandard_input
, "standard-input");
4598 DEFSYM (Qread_char
, "read-char");
4599 DEFSYM (Qget_file_char
, "get-file-char");
4600 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4601 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4603 DEFSYM (Qbackquote
, "`");
4604 DEFSYM (Qcomma
, ",");
4605 DEFSYM (Qcomma_at
, ",@");
4606 DEFSYM (Qcomma_dot
, ",.");
4608 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4609 DEFSYM (Qascii_character
, "ascii-character");
4610 DEFSYM (Qfunction
, "function");
4611 DEFSYM (Qload
, "load");
4612 DEFSYM (Qload_file_name
, "load-file-name");
4613 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4614 DEFSYM (Qfile_truename
, "file-truename");
4615 DEFSYM (Qdir_ok
, "dir-ok");
4616 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4618 staticpro (&dump_path
);
4620 staticpro (&read_objects
);
4621 read_objects
= Qnil
;
4622 staticpro (&seen_list
);
4625 Vloads_in_progress
= Qnil
;
4626 staticpro (&Vloads_in_progress
);
4628 DEFSYM (Qhash_table
, "hash-table");
4629 DEFSYM (Qdata
, "data");
4630 DEFSYM (Qtest
, "test");
4631 DEFSYM (Qsize
, "size");
4632 DEFSYM (Qweakness
, "weakness");
4633 DEFSYM (Qrehash_size
, "rehash-size");
4634 DEFSYM (Qrehash_threshold
, "rehash-threshold");