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. */
29 #include <stat-time.h>
31 #include "intervals.h"
32 #include "character.h"
40 #include "termhooks.h"
42 #include "blockinput.h"
57 #endif /* HAVE_SETLOCALE */
62 #define file_offset off_t
63 #define file_tell ftello
65 #define file_offset long
66 #define file_tell ftell
69 /* Hash table read constants. */
70 static Lisp_Object Qhash_table
, Qdata
;
71 static Lisp_Object Qtest
, Qsize
;
72 static Lisp_Object Qweakness
;
73 static Lisp_Object Qrehash_size
;
74 static Lisp_Object Qrehash_threshold
;
76 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
77 Lisp_Object Qstandard_input
;
78 Lisp_Object Qvariable_documentation
;
79 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
80 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
81 static Lisp_Object Qinhibit_file_name_operation
;
82 static Lisp_Object Qeval_buffer_list
;
83 static Lisp_Object Qlexical_binding
;
84 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
86 /* Used instead of Qget_file_char while loading *.elc files compiled
87 by Emacs 21 or older. */
88 static Lisp_Object Qget_emacs_mule_file_char
;
90 static Lisp_Object Qload_force_doc_strings
;
92 extern Lisp_Object Qinternal_interpreter_environment
;
94 static Lisp_Object Qload_in_progress
;
96 /* The association list of objects read with the #n=object form.
97 Each member of the list has the form (n . object), and is used to
98 look up the object for the corresponding #n# construct.
99 It must be set to nil before all top-level calls to read0. */
100 static Lisp_Object read_objects
;
102 /* Nonzero means READCHAR should read bytes one by one (not character)
103 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
104 This is set to 1 by read1 temporarily while handling #@NUMBER. */
105 static int load_each_byte
;
107 /* List of descriptors now open for Fload. */
108 static Lisp_Object load_descriptor_list
;
110 /* File for get_file_char to read from. Use by load. */
111 static FILE *instream
;
113 /* For use within read-from-string (this reader is non-reentrant!!) */
114 static ptrdiff_t read_from_string_index
;
115 static ptrdiff_t read_from_string_index_byte
;
116 static ptrdiff_t read_from_string_limit
;
118 /* Number of characters read in the current call to Fread or
119 Fread_from_string. */
120 static EMACS_INT readchar_count
;
122 /* This contains the last string skipped with #@. */
123 static char *saved_doc_string
;
124 /* Length of buffer allocated in saved_doc_string. */
125 static ptrdiff_t saved_doc_string_size
;
126 /* Length of actual data in saved_doc_string. */
127 static ptrdiff_t saved_doc_string_length
;
128 /* This is the file position that string came from. */
129 static file_offset saved_doc_string_position
;
131 /* This contains the previous string skipped with #@.
132 We copy it from saved_doc_string when a new string
133 is put in saved_doc_string. */
134 static char *prev_saved_doc_string
;
135 /* Length of buffer allocated in prev_saved_doc_string. */
136 static ptrdiff_t prev_saved_doc_string_size
;
137 /* Length of actual data in prev_saved_doc_string. */
138 static ptrdiff_t prev_saved_doc_string_length
;
139 /* This is the file position that string came from. */
140 static file_offset prev_saved_doc_string_position
;
142 /* Nonzero means inside a new-style backquote
143 with no surrounding parentheses.
144 Fread initializes this to zero, so we need not specbind it
145 or worry about what happens to it when there is an error. */
146 static int new_backquote_flag
;
147 static Lisp_Object Qold_style_backquotes
;
149 /* A list of file names for files being loaded in Fload. Used to
150 check for recursive loads. */
152 static Lisp_Object Vloads_in_progress
;
154 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
157 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
, int,
158 Lisp_Object
, Lisp_Object
,
159 Lisp_Object
, Lisp_Object
);
160 static Lisp_Object
load_unwind (Lisp_Object
);
161 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
163 /* Functions that read one byte from the current source READCHARFUN
164 or unreads one byte. If the integer argument C is -1, it returns
165 one read byte, or -1 when there's no more byte in the source. If C
166 is 0 or positive, it unreads C, and the return value is not
169 static int readbyte_for_lambda (int, Lisp_Object
);
170 static int readbyte_from_file (int, Lisp_Object
);
171 static int readbyte_from_string (int, Lisp_Object
);
173 /* Handle unreading and rereading of characters.
174 Write READCHAR to read a character,
175 UNREAD(c) to unread c to be read again.
177 These macros correctly read/unread multibyte characters. */
179 #define READCHAR readchar (readcharfun, NULL)
180 #define UNREAD(c) unreadchar (readcharfun, c)
182 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
183 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
185 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
186 Qlambda, or a cons, we use this to keep an unread character because
187 a file stream can't handle multibyte-char unreading. The value -1
188 means that there's no unread character. */
189 static int unread_char
;
192 readchar (Lisp_Object readcharfun
, int *multibyte
)
196 int (*readbyte
) (int, Lisp_Object
);
197 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
199 int emacs_mule_encoding
= 0;
206 if (BUFFERP (readcharfun
))
208 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
210 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
212 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
215 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
217 /* Fetch the character code from the buffer. */
218 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
219 BUF_INC_POS (inbuffer
, pt_byte
);
226 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
227 if (! ASCII_BYTE_P (c
))
228 c
= BYTE8_TO_CHAR (c
);
231 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
235 if (MARKERP (readcharfun
))
237 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
239 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
241 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
244 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
246 /* Fetch the character code from the buffer. */
247 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
248 BUF_INC_POS (inbuffer
, bytepos
);
255 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
256 if (! ASCII_BYTE_P (c
))
257 c
= BYTE8_TO_CHAR (c
);
261 XMARKER (readcharfun
)->bytepos
= bytepos
;
262 XMARKER (readcharfun
)->charpos
++;
267 if (EQ (readcharfun
, Qlambda
))
269 readbyte
= readbyte_for_lambda
;
273 if (EQ (readcharfun
, Qget_file_char
))
275 readbyte
= readbyte_from_file
;
279 if (STRINGP (readcharfun
))
281 if (read_from_string_index
>= read_from_string_limit
)
283 else if (STRING_MULTIBYTE (readcharfun
))
287 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
288 read_from_string_index
,
289 read_from_string_index_byte
);
293 c
= SREF (readcharfun
, read_from_string_index_byte
);
294 read_from_string_index
++;
295 read_from_string_index_byte
++;
300 if (CONSP (readcharfun
))
302 /* This is the case that read_vector is reading from a unibyte
303 string that contains a byte sequence previously skipped
304 because of #@NUMBER. The car part of readcharfun is that
305 string, and the cdr part is a value of readcharfun given to
307 readbyte
= readbyte_from_string
;
308 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
309 emacs_mule_encoding
= 1;
313 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
315 readbyte
= readbyte_from_file
;
316 emacs_mule_encoding
= 1;
320 tem
= call0 (readcharfun
);
327 if (unread_char
>= 0)
333 c
= (*readbyte
) (-1, readcharfun
);
334 if (c
< 0 || load_each_byte
)
338 if (ASCII_BYTE_P (c
))
340 if (emacs_mule_encoding
)
341 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
344 len
= BYTES_BY_CHAR_HEAD (c
);
347 c
= (*readbyte
) (-1, readcharfun
);
348 if (c
< 0 || ! TRAILING_CODE_P (c
))
351 (*readbyte
) (buf
[i
], readcharfun
);
352 return BYTE8_TO_CHAR (buf
[0]);
356 return STRING_CHAR (buf
);
359 /* Unread the character C in the way appropriate for the stream READCHARFUN.
360 If the stream is a user function, call it with the char as argument. */
363 unreadchar (Lisp_Object readcharfun
, int c
)
367 /* Don't back up the pointer if we're unreading the end-of-input mark,
368 since readchar didn't advance it when we read it. */
370 else if (BUFFERP (readcharfun
))
372 struct buffer
*b
= XBUFFER (readcharfun
);
373 ptrdiff_t charpos
= BUF_PT (b
);
374 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
376 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
377 BUF_DEC_POS (b
, bytepos
);
381 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
383 else if (MARKERP (readcharfun
))
385 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
386 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
388 XMARKER (readcharfun
)->charpos
--;
389 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
390 BUF_DEC_POS (b
, bytepos
);
394 XMARKER (readcharfun
)->bytepos
= bytepos
;
396 else if (STRINGP (readcharfun
))
398 read_from_string_index
--;
399 read_from_string_index_byte
400 = string_char_to_byte (readcharfun
, read_from_string_index
);
402 else if (CONSP (readcharfun
))
406 else if (EQ (readcharfun
, Qlambda
))
410 else if (EQ (readcharfun
, Qget_file_char
)
411 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
416 ungetc (c
, instream
);
423 call1 (readcharfun
, make_number (c
));
427 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
429 return read_bytecode_char (c
>= 0);
434 readbyte_from_file (int c
, Lisp_Object readcharfun
)
439 ungetc (c
, instream
);
448 /* Interrupted reads have been observed while reading over the network. */
449 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
461 return (c
== EOF
? -1 : c
);
465 readbyte_from_string (int c
, Lisp_Object readcharfun
)
467 Lisp_Object string
= XCAR (readcharfun
);
471 read_from_string_index
--;
472 read_from_string_index_byte
473 = string_char_to_byte (string
, read_from_string_index
);
476 if (read_from_string_index
>= read_from_string_limit
)
479 FETCH_STRING_CHAR_ADVANCE (c
, string
,
480 read_from_string_index
,
481 read_from_string_index_byte
);
486 /* Read one non-ASCII character from INSTREAM. The character is
487 encoded in `emacs-mule' and the first byte is already read in
491 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
493 /* Emacs-mule coding uses at most 4-byte for one character. */
494 unsigned char buf
[4];
495 int len
= emacs_mule_bytes
[c
];
496 struct charset
*charset
;
501 /* C is not a valid leading-code of `emacs-mule'. */
502 return BYTE8_TO_CHAR (c
);
508 c
= (*readbyte
) (-1, readcharfun
);
512 (*readbyte
) (buf
[i
], readcharfun
);
513 return BYTE8_TO_CHAR (buf
[0]);
520 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
521 code
= buf
[1] & 0x7F;
525 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
526 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
528 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
529 code
= buf
[2] & 0x7F;
533 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
534 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
539 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
540 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
542 c
= DECODE_CHAR (charset
, code
);
544 Fsignal (Qinvalid_read_syntax
,
545 Fcons (build_string ("invalid multibyte form"), Qnil
));
550 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
552 static Lisp_Object
read0 (Lisp_Object
);
553 static Lisp_Object
read1 (Lisp_Object
, int *, int);
555 static Lisp_Object
read_list (int, Lisp_Object
);
556 static Lisp_Object
read_vector (Lisp_Object
, int);
558 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
560 static void substitute_object_in_subtree (Lisp_Object
,
562 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
565 /* Get a character from the tty. */
567 /* Read input events until we get one that's acceptable for our purposes.
569 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
570 until we get a character we like, and then stuffed into
573 If ASCII_REQUIRED is non-zero, we check function key events to see
574 if the unmodified version of the symbol has a Qascii_character
575 property, and use that character, if present.
577 If ERROR_NONASCII is non-zero, we signal an error if the input we
578 get isn't an ASCII character with modifiers. If it's zero but
579 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
582 If INPUT_METHOD is nonzero, we invoke the current input method
583 if the character warrants that.
585 If SECONDS is a number, we wait that many seconds for input, and
586 return Qnil if no input arrives within that time. */
589 read_filtered_event (int no_switch_frame
, int ascii_required
,
590 int error_nonascii
, int input_method
, Lisp_Object seconds
)
592 Lisp_Object val
, delayed_switch_frame
;
595 #ifdef HAVE_WINDOW_SYSTEM
596 if (display_hourglass_p
)
600 delayed_switch_frame
= Qnil
;
602 /* Compute timeout. */
603 if (NUMBERP (seconds
))
605 double duration
= extract_float (seconds
);
606 EMACS_TIME wait_time
= EMACS_TIME_FROM_DOUBLE (duration
);
607 EMACS_GET_TIME (end_time
);
608 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
611 /* Read until we get an acceptable event. */
614 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
615 NUMBERP (seconds
) ? &end_time
: NULL
);
616 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
621 /* switch-frame events are put off until after the next ASCII
622 character. This is better than signaling an error just because
623 the last characters were typed to a separate minibuffer frame,
624 for example. Eventually, some code which can deal with
625 switch-frame events will read it and process it. */
627 && EVENT_HAS_PARAMETERS (val
)
628 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
630 delayed_switch_frame
= val
;
634 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
636 /* Convert certain symbols to their ASCII equivalents. */
639 Lisp_Object tem
, tem1
;
640 tem
= Fget (val
, Qevent_symbol_element_mask
);
643 tem1
= Fget (Fcar (tem
), Qascii_character
);
644 /* Merge this symbol's modifier bits
645 with the ASCII equivalent of its basic code. */
647 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
651 /* If we don't have a character now, deal with it appropriately. */
656 Vunread_command_events
= Fcons (val
, Qnil
);
657 error ("Non-character input-event");
664 if (! NILP (delayed_switch_frame
))
665 unread_switch_frame
= delayed_switch_frame
;
669 #ifdef HAVE_WINDOW_SYSTEM
670 if (display_hourglass_p
)
679 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
680 doc
: /* Read a character from the command input (keyboard or macro).
681 It is returned as a number.
682 If the character has modifiers, they are resolved and reflected to the
683 character code if possible (e.g. C-SPC -> 0).
685 If the user generates an event which is not a character (i.e. a mouse
686 click or function key event), `read-char' signals an error. As an
687 exception, switch-frame events are put off until non-character events
689 If you want to read non-character events, or ignore them, call
690 `read-event' or `read-char-exclusive' instead.
692 If the optional argument PROMPT is non-nil, display that as a prompt.
693 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
694 input method is turned on in the current buffer, that input method
695 is used for reading a character.
696 If the optional argument SECONDS is non-nil, it should be a number
697 specifying the maximum number of seconds to wait for input. If no
698 input arrives in that time, return nil. SECONDS may be a
699 floating-point value. */)
700 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
705 message_with_string ("%s", prompt
, 0);
706 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
708 return (NILP (val
) ? Qnil
709 : make_number (char_resolve_modifier_mask (XINT (val
))));
712 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
713 doc
: /* Read an event object from the input stream.
714 If the optional argument PROMPT is non-nil, display that as a prompt.
715 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
716 input method is turned on in the current buffer, that input method
717 is used for reading a character.
718 If the optional argument SECONDS is non-nil, it should be a number
719 specifying the maximum number of seconds to wait for input. If no
720 input arrives in that time, return nil. SECONDS may be a
721 floating-point value. */)
722 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
725 message_with_string ("%s", prompt
, 0);
726 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
729 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
730 doc
: /* Read a character from the command input (keyboard or macro).
731 It is returned as a number. Non-character events are ignored.
732 If the character has modifiers, they are resolved and reflected to the
733 character code if possible (e.g. C-SPC -> 0).
735 If the optional argument PROMPT is non-nil, display that as a prompt.
736 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
737 input method is turned on in the current buffer, that input method
738 is used for reading a character.
739 If the optional argument SECONDS is non-nil, it should be a number
740 specifying the maximum number of seconds to wait for input. If no
741 input arrives in that time, return nil. SECONDS may be a
742 floating-point value. */)
743 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
748 message_with_string ("%s", prompt
, 0);
750 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
752 return (NILP (val
) ? Qnil
753 : make_number (char_resolve_modifier_mask (XINT (val
))));
756 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
757 doc
: /* Don't use this yourself. */)
760 register Lisp_Object val
;
762 XSETINT (val
, getc (instream
));
770 /* Return true if the lisp code read using READCHARFUN defines a non-nil
771 `lexical-binding' file variable. After returning, the stream is
772 positioned following the first line, if it is a comment, otherwise
776 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
780 /* The first line isn't a comment, just give up. */
786 /* Look for an appropriate file-variable in the first line. */
790 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
791 } beg_end_state
= NOMINAL
;
792 int in_file_vars
= 0;
794 #define UPDATE_BEG_END_STATE(ch) \
795 if (beg_end_state == NOMINAL) \
796 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
797 else if (beg_end_state == AFTER_FIRST_DASH) \
798 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
799 else if (beg_end_state == AFTER_ASTERIX) \
802 in_file_vars = !in_file_vars; \
803 beg_end_state = NOMINAL; \
806 /* Skip until we get to the file vars, if any. */
810 UPDATE_BEG_END_STATE (ch
);
812 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
816 char var
[100], val
[100];
821 /* Read a variable name. */
822 while (ch
== ' ' || ch
== '\t')
826 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
828 if (i
< sizeof var
- 1)
830 UPDATE_BEG_END_STATE (ch
);
834 /* Stop scanning if no colon was found before end marker. */
835 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
838 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
844 /* Read a variable value. */
847 while (ch
== ' ' || ch
== '\t')
851 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
853 if (i
< sizeof val
- 1)
855 UPDATE_BEG_END_STATE (ch
);
859 /* The value was terminated by an end-marker, which remove. */
861 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
865 if (strcmp (var
, "lexical-binding") == 0)
868 rv
= (strcmp (val
, "nil") != 0);
874 while (ch
!= '\n' && ch
!= EOF
)
881 /* Value is a version number of byte compiled code if the file
882 associated with file descriptor FD is a compiled Lisp file that's
883 safe to load. Only files compiled with Emacs are safe to load.
884 Files compiled with XEmacs can lead to a crash in Fbyte_code
885 because of an incompatible change in the byte compiler. */
888 safe_to_load_p (int fd
)
895 /* Read the first few bytes from the file, and look for a line
896 specifying the byte compiler version used. */
897 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
902 /* Skip to the next newline, skipping over the initial `ELC'
903 with NUL bytes following it, but note the version. */
904 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
909 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
916 lseek (fd
, 0, SEEK_SET
);
921 /* Callback for record_unwind_protect. Restore the old load list OLD,
922 after loading a file successfully. */
925 record_load_unwind (Lisp_Object old
)
927 return Vloads_in_progress
= old
;
930 /* This handler function is used via internal_condition_case_1. */
933 load_error_handler (Lisp_Object data
)
939 load_warn_old_style_backquotes (Lisp_Object file
)
941 if (!NILP (Vold_style_backquotes
))
944 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
951 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
952 doc
: /* Return the suffixes that `load' should try if a suffix is \
954 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
957 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
958 while (CONSP (suffixes
))
960 Lisp_Object exts
= Vload_file_rep_suffixes
;
961 suffix
= XCAR (suffixes
);
962 suffixes
= XCDR (suffixes
);
967 lst
= Fcons (concat2 (suffix
, ext
), lst
);
970 return Fnreverse (lst
);
973 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
974 doc
: /* Execute a file of Lisp code named FILE.
975 First try FILE with `.elc' appended, then try with `.el',
976 then try FILE unmodified (the exact suffixes in the exact order are
977 determined by `load-suffixes'). Environment variable references in
978 FILE are replaced with their values by calling `substitute-in-file-name'.
979 This function searches the directories in `load-path'.
981 If optional second arg NOERROR is non-nil,
982 report no error if FILE doesn't exist.
983 Print messages at start and end of loading unless
984 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
986 If optional fourth arg NOSUFFIX is non-nil, don't try adding
987 suffixes `.elc' or `.el' to the specified name FILE.
988 If optional fifth arg MUST-SUFFIX is non-nil, insist on
989 the suffix `.elc' or `.el'; don't accept just FILE unless
990 it ends in one of those suffixes or includes a directory name.
992 If this function fails to find a file, it may look for different
993 representations of that file before trying another file.
994 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
995 to the file name. Emacs uses this feature mainly to find compressed
996 versions of files when Auto Compression mode is enabled.
998 The exact suffixes that this function tries out, in the exact order,
999 are given by the value of the variable `load-file-rep-suffixes' if
1000 NOSUFFIX is non-nil and by the return value of the function
1001 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1002 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1003 and then the former.
1005 Loading a file records its definitions, and its `provide' and
1006 `require' calls, in an element of `load-history' whose
1007 car is the file name loaded. See `load-history'.
1009 While the file is in the process of being loaded, the variable
1010 `load-in-progress' is non-nil and the variable `load-file-name'
1011 is bound to the file's name.
1013 Return t if the file exists and loads successfully. */)
1014 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1016 register FILE *stream
;
1017 register int fd
= -1;
1018 ptrdiff_t count
= SPECPDL_INDEX ();
1019 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1020 Lisp_Object found
, efound
, hist_file_name
;
1021 /* 1 means we printed the ".el is newer" message. */
1023 /* 1 means we are loading a compiled file. */
1025 Lisp_Object handler
;
1027 const char *fmode
= "r";
1035 CHECK_STRING (file
);
1037 /* If file name is magic, call the handler. */
1038 /* This shouldn't be necessary any more now that `openp' handles it right.
1039 handler = Ffind_file_name_handler (file, Qload);
1040 if (!NILP (handler))
1041 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1043 /* Do this after the handler to avoid
1044 the need to gcpro noerror, nomessage and nosuffix.
1045 (Below here, we care only whether they are nil or not.)
1046 The presence of this call is the result of a historical accident:
1047 it used to be in every file-operation and when it got removed
1048 everywhere, it accidentally stayed here. Since then, enough people
1049 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1050 that it seemed risky to remove. */
1051 if (! NILP (noerror
))
1053 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1054 Qt
, load_error_handler
);
1059 file
= Fsubstitute_in_file_name (file
);
1062 /* Avoid weird lossage with null string as arg,
1063 since it would try to load a directory as a Lisp file. */
1064 if (SBYTES (file
) > 0)
1066 ptrdiff_t size
= SBYTES (file
);
1069 GCPRO2 (file
, found
);
1071 if (! NILP (must_suffix
))
1073 /* Don't insist on adding a suffix if FILE already ends with one. */
1075 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1078 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1080 /* Don't insist on adding a suffix
1081 if the argument includes a directory name. */
1082 else if (! NILP (Ffile_name_directory (file
)))
1086 fd
= openp (Vload_path
, file
,
1087 (!NILP (nosuffix
) ? Qnil
1088 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1089 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1090 tmp
[1] = Vload_file_rep_suffixes
,
1099 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1103 /* Tell startup.el whether or not we found the user's init file. */
1104 if (EQ (Qt
, Vuser_init_file
))
1105 Vuser_init_file
= found
;
1107 /* If FD is -2, that means openp found a magic file. */
1110 if (NILP (Fequal (found
, file
)))
1111 /* If FOUND is a different file name from FILE,
1112 find its handler even if we have already inhibited
1113 the `load' operation on FILE. */
1114 handler
= Ffind_file_name_handler (found
, Qt
);
1116 handler
= Ffind_file_name_handler (found
, Qload
);
1117 if (! NILP (handler
))
1118 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1120 /* Tramp has to deal with semi-broken packages that prepend
1121 drive letters to remote files. For that reason, Tramp
1122 catches file operations that test for file existence, which
1123 makes openp think X:/foo.elc files are remote. However,
1124 Tramp does not catch `load' operations for such files, so we
1125 end up with a nil as the `load' handler above. If we would
1126 continue with fd = -2, we will behave wrongly, and in
1127 particular try reading a .elc file in the "rt" mode instead
1128 of "rb". See bug #9311 for the results. To work around
1129 this, we try to open the file locally, and go with that if it
1131 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1137 /* Check if we're stuck in a recursive load cycle.
1139 2000-09-21: It's not possible to just check for the file loaded
1140 being a member of Vloads_in_progress. This fails because of the
1141 way the byte compiler currently works; `provide's are not
1142 evaluated, see font-lock.el/jit-lock.el as an example. This
1143 leads to a certain amount of ``normal'' recursion.
1145 Also, just loading a file recursively is not always an error in
1146 the general case; the second load may do something different. */
1150 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1151 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1155 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1157 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1158 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1161 /* All loads are by default dynamic, unless the file itself specifies
1162 otherwise using a file-variable in the first line. This is bound here
1163 so that it takes effect whether or not we use
1164 Vload_source_file_function. */
1165 specbind (Qlexical_binding
, Qnil
);
1167 /* Get the name for load-history. */
1168 hist_file_name
= (! NILP (Vpurify_flag
)
1169 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1170 tmp
[1] = Ffile_name_nondirectory (found
),
1176 /* Check for the presence of old-style quotes and warn about them. */
1177 specbind (Qold_style_backquotes
, Qnil
);
1178 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1180 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1181 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1182 /* Load .elc files directly, but not when they are
1183 remote and have no handler! */
1190 GCPRO3 (file
, found
, hist_file_name
);
1193 && ! (version
= safe_to_load_p (fd
)))
1196 if (!load_dangerous_libraries
)
1200 error ("File `%s' was not compiled in Emacs",
1203 else if (!NILP (nomessage
) && !force_load_messages
)
1204 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1209 efound
= ENCODE_FILE (found
);
1214 result
= stat (SSDATA (efound
), &s1
);
1217 SSET (efound
, SBYTES (efound
) - 1, 0);
1218 result
= stat (SSDATA (efound
), &s2
);
1219 SSET (efound
, SBYTES (efound
) - 1, 'c');
1223 && EMACS_TIME_LT (get_stat_mtime (&s1
), get_stat_mtime (&s2
)))
1225 /* Make the progress messages mention that source is newer. */
1228 /* If we won't print another message, mention this anyway. */
1229 if (!NILP (nomessage
) && !force_load_messages
)
1231 Lisp_Object msg_file
;
1232 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1233 message_with_string ("Source file `%s' newer than byte-compiled file",
1242 /* We are loading a source file (*.el). */
1243 if (!NILP (Vload_source_file_function
))
1249 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1250 NILP (noerror
) ? Qnil
: Qt
,
1251 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1252 return unbind_to (count
, val
);
1256 GCPRO3 (file
, found
, hist_file_name
);
1259 efound
= ENCODE_FILE (found
);
1260 /* If we somehow got here with fd == -2, meaning the file is deemed
1261 to be remote, don't even try to reopen the file locally; just
1262 force a failure instead. */
1266 stream
= fopen (SSDATA (efound
), fmode
);
1270 #else /* not WINDOWSNT */
1271 stream
= fdopen (fd
, fmode
);
1272 #endif /* not WINDOWSNT */
1276 error ("Failure to create stdio stream for %s", SDATA (file
));
1279 if (! NILP (Vpurify_flag
))
1280 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1282 if (NILP (nomessage
) || force_load_messages
)
1285 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1288 message_with_string ("Loading %s (source)...", file
, 1);
1290 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1292 else /* The typical case; compiled file newer than source file. */
1293 message_with_string ("Loading %s...", file
, 1);
1296 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1297 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1298 specbind (Qload_file_name
, found
);
1299 specbind (Qinhibit_file_name_operation
, Qnil
);
1300 load_descriptor_list
1301 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1302 specbind (Qload_in_progress
, Qt
);
1305 if (lisp_file_lexically_bound_p (Qget_file_char
))
1306 Fset (Qlexical_binding
, Qt
);
1308 if (! version
|| version
>= 22)
1309 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1310 0, Qnil
, Qnil
, Qnil
, Qnil
);
1313 /* We can't handle a file which was compiled with
1314 byte-compile-dynamic by older version of Emacs. */
1315 specbind (Qload_force_doc_strings
, Qt
);
1316 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1317 0, Qnil
, Qnil
, Qnil
, Qnil
);
1319 unbind_to (count
, Qnil
);
1321 /* Run any eval-after-load forms for this file. */
1322 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1323 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1327 xfree (saved_doc_string
);
1328 saved_doc_string
= 0;
1329 saved_doc_string_size
= 0;
1331 xfree (prev_saved_doc_string
);
1332 prev_saved_doc_string
= 0;
1333 prev_saved_doc_string_size
= 0;
1335 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1338 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1341 message_with_string ("Loading %s (source)...done", file
, 1);
1343 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1345 else /* The typical case; compiled file newer than source file. */
1346 message_with_string ("Loading %s...done", file
, 1);
1353 load_unwind (Lisp_Object arg
) /* Used as unwind-protect function in load. */
1355 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1366 load_descriptor_unwind (Lisp_Object oldlist
)
1368 load_descriptor_list
= oldlist
;
1372 /* Close all descriptors in use for Floads.
1373 This is used when starting a subprocess. */
1376 close_load_descs (void)
1380 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1381 emacs_close (XFASTINT (XCAR (tail
)));
1386 complete_filename_p (Lisp_Object pathname
)
1388 register const unsigned char *s
= SDATA (pathname
);
1389 return (IS_DIRECTORY_SEP (s
[0])
1390 || (SCHARS (pathname
) > 2
1391 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1394 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1395 doc
: /* Search for FILENAME through PATH.
1396 Returns the file's name in absolute form, or nil if not found.
1397 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1398 file name when searching.
1399 If non-nil, PREDICATE is used instead of `file-readable-p'.
1400 PREDICATE can also be an integer to pass to the access(2) function,
1401 in which case file-name-handlers are ignored.
1402 This function will normally skip directories, so if you want it to find
1403 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1404 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1407 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1408 if (NILP (predicate
) && fd
> 0)
1413 static Lisp_Object Qdir_ok
;
1415 /* Search for a file whose name is STR, looking in directories
1416 in the Lisp list PATH, and trying suffixes from SUFFIX.
1417 On success, returns a file descriptor. On failure, returns -1.
1419 SUFFIXES is a list of strings containing possible suffixes.
1420 The empty suffix is automatically added if the list is empty.
1422 PREDICATE non-nil means don't open the files,
1423 just look for one that satisfies the predicate. In this case,
1424 returns 1 on success. The predicate can be a lisp function or
1425 an integer to pass to `access' (in which case file-name-handlers
1428 If STOREPTR is nonzero, it points to a slot where the name of
1429 the file actually found should be stored as a Lisp string.
1430 nil is stored there on failure.
1432 If the file we find is remote, return -2
1433 but store the found remote file name in *STOREPTR. */
1436 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1439 ptrdiff_t fn_size
= 100;
1441 register char *fn
= buf
;
1443 ptrdiff_t want_length
;
1444 Lisp_Object filename
;
1446 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1447 Lisp_Object string
, tail
, encoded_fn
;
1448 ptrdiff_t max_suffix_len
= 0;
1452 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1454 CHECK_STRING_CAR (tail
);
1455 max_suffix_len
= max (max_suffix_len
,
1456 SBYTES (XCAR (tail
)));
1459 string
= filename
= encoded_fn
= Qnil
;
1460 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1465 if (complete_filename_p (str
))
1468 for (; CONSP (path
); path
= XCDR (path
))
1470 filename
= Fexpand_file_name (str
, XCAR (path
));
1471 if (!complete_filename_p (filename
))
1472 /* If there are non-absolute elts in PATH (eg "."). */
1473 /* Of course, this could conceivably lose if luser sets
1474 default-directory to be something non-absolute... */
1476 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1477 if (!complete_filename_p (filename
))
1478 /* Give up on this path element! */
1482 /* Calculate maximum length of any filename made from
1483 this path element/specified file name and any possible suffix. */
1484 want_length
= max_suffix_len
+ SBYTES (filename
);
1485 if (fn_size
<= want_length
)
1486 fn
= alloca (fn_size
= 100 + want_length
);
1488 /* Loop over suffixes. */
1489 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1490 CONSP (tail
); tail
= XCDR (tail
))
1492 ptrdiff_t fnlen
, lsuffix
= SBYTES (XCAR (tail
));
1493 Lisp_Object handler
;
1496 /* Concatenate path element/specified name with the suffix.
1497 If the directory starts with /:, remove that. */
1498 int prefixlen
= ((SCHARS (filename
) > 2
1499 && SREF (filename
, 0) == '/'
1500 && SREF (filename
, 1) == ':')
1502 fnlen
= SBYTES (filename
) - prefixlen
;
1503 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1504 memcpy (fn
+ fnlen
, SDATA (XCAR (tail
)), lsuffix
+ 1);
1506 /* Check that the file exists and is not a directory. */
1507 /* We used to only check for handlers on non-absolute file names:
1511 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1512 It's not clear why that was the case and it breaks things like
1513 (load "/bar.el") where the file is actually "/bar.el.gz". */
1514 string
= make_string (fn
, fnlen
);
1515 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1516 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1518 if (NILP (predicate
))
1519 exists
= !NILP (Ffile_readable_p (string
));
1522 Lisp_Object tmp
= call1 (predicate
, string
);
1523 exists
= !NILP (tmp
)
1524 && (EQ (tmp
, Qdir_ok
)
1525 || NILP (Ffile_directory_p (string
)));
1530 /* We succeeded; return this descriptor and filename. */
1541 encoded_fn
= ENCODE_FILE (string
);
1542 pfn
= SSDATA (encoded_fn
);
1543 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1546 /* Check that we can access or open it. */
1547 if (NATNUMP (predicate
))
1548 fd
= (((XFASTINT (predicate
) & ~INT_MAX
) == 0
1549 && access (pfn
, XFASTINT (predicate
)) == 0)
1552 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1556 /* We succeeded; return this descriptor and filename. */
1574 /* Merge the list we've accumulated of globals from the current input source
1575 into the load_history variable. The details depend on whether
1576 the source has an associated file name or not.
1578 FILENAME is the file name that we are loading from.
1579 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1582 build_load_history (Lisp_Object filename
, int entire
)
1584 register Lisp_Object tail
, prev
, newelt
;
1585 register Lisp_Object tem
, tem2
;
1586 register int foundit
= 0;
1588 tail
= Vload_history
;
1591 while (CONSP (tail
))
1595 /* Find the feature's previous assoc list... */
1596 if (!NILP (Fequal (filename
, Fcar (tem
))))
1600 /* If we're loading the entire file, remove old data. */
1604 Vload_history
= XCDR (tail
);
1606 Fsetcdr (prev
, XCDR (tail
));
1609 /* Otherwise, cons on new symbols that are not already members. */
1612 tem2
= Vcurrent_load_list
;
1614 while (CONSP (tem2
))
1616 newelt
= XCAR (tem2
);
1618 if (NILP (Fmember (newelt
, tem
)))
1619 Fsetcar (tail
, Fcons (XCAR (tem
),
1620 Fcons (newelt
, XCDR (tem
))));
1633 /* If we're loading an entire file, cons the new assoc onto the
1634 front of load-history, the most-recently-loaded position. Also
1635 do this if we didn't find an existing member for the file. */
1636 if (entire
|| !foundit
)
1637 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1642 readevalloop_1 (Lisp_Object old
)
1644 load_convert_to_unibyte
= ! NILP (old
);
1648 /* Signal an `end-of-file' error, if possible with file name
1651 static _Noreturn
void
1652 end_of_file_error (void)
1654 if (STRINGP (Vload_file_name
))
1655 xsignal1 (Qend_of_file
, Vload_file_name
);
1657 xsignal0 (Qend_of_file
);
1660 /* UNIBYTE specifies how to set load_convert_to_unibyte
1661 for this invocation.
1662 READFUN, if non-nil, is used instead of `read'.
1664 START, END specify region to read in current buffer (from eval-region).
1665 If the input is not from a buffer, they must be nil. */
1668 readevalloop (Lisp_Object readcharfun
,
1670 Lisp_Object sourcename
,
1672 Lisp_Object unibyte
, Lisp_Object readfun
,
1673 Lisp_Object start
, Lisp_Object end
)
1676 register Lisp_Object val
;
1677 ptrdiff_t count
= SPECPDL_INDEX ();
1678 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1679 struct buffer
*b
= 0;
1680 int continue_reading_p
;
1681 Lisp_Object lex_bound
;
1682 /* Nonzero if reading an entire buffer. */
1683 int whole_buffer
= 0;
1684 /* 1 on the first time around. */
1687 if (MARKERP (readcharfun
))
1690 start
= readcharfun
;
1693 if (BUFFERP (readcharfun
))
1694 b
= XBUFFER (readcharfun
);
1695 else if (MARKERP (readcharfun
))
1696 b
= XMARKER (readcharfun
)->buffer
;
1698 /* We assume START is nil when input is not from a buffer. */
1699 if (! NILP (start
) && !b
)
1702 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1703 specbind (Qcurrent_load_list
, Qnil
);
1704 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1705 load_convert_to_unibyte
= !NILP (unibyte
);
1707 /* If lexical binding is active (either because it was specified in
1708 the file's header, or via a buffer-local variable), create an empty
1709 lexical environment, otherwise, turn off lexical binding. */
1710 lex_bound
= find_symbol_value (Qlexical_binding
);
1711 specbind (Qinternal_interpreter_environment
,
1712 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1713 ? Qnil
: Fcons (Qt
, Qnil
));
1715 GCPRO4 (sourcename
, readfun
, start
, end
);
1717 /* Try to ensure sourcename is a truename, except whilst preloading. */
1718 if (NILP (Vpurify_flag
)
1719 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1720 && !NILP (Ffboundp (Qfile_truename
)))
1721 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1723 LOADHIST_ATTACH (sourcename
);
1725 continue_reading_p
= 1;
1726 while (continue_reading_p
)
1728 ptrdiff_t count1
= SPECPDL_INDEX ();
1730 if (b
!= 0 && NILP (BVAR (b
, name
)))
1731 error ("Reading from killed buffer");
1735 /* Switch to the buffer we are reading from. */
1736 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1737 set_buffer_internal (b
);
1739 /* Save point in it. */
1740 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1741 /* Save ZV in it. */
1742 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1743 /* Those get unbound after we read one expression. */
1745 /* Set point and ZV around stuff to be read. */
1748 Fnarrow_to_region (make_number (BEGV
), end
);
1750 /* Just for cleanliness, convert END to a marker
1751 if it is an integer. */
1753 end
= Fpoint_max_marker ();
1756 /* On the first cycle, we can easily test here
1757 whether we are reading the whole buffer. */
1758 if (b
&& first_sexp
)
1759 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1766 while ((c
= READCHAR
) != '\n' && c
!= -1);
1771 unbind_to (count1
, Qnil
);
1775 /* Ignore whitespace here, so we can detect eof. */
1776 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1777 || c
== 0xa0) /* NBSP */
1780 if (!NILP (Vpurify_flag
) && c
== '(')
1782 val
= read_list (0, readcharfun
);
1787 read_objects
= Qnil
;
1788 if (!NILP (readfun
))
1790 val
= call1 (readfun
, readcharfun
);
1792 /* If READCHARFUN has set point to ZV, we should
1793 stop reading, even if the form read sets point
1794 to a different value when evaluated. */
1795 if (BUFFERP (readcharfun
))
1797 struct buffer
*buf
= XBUFFER (readcharfun
);
1798 if (BUF_PT (buf
) == BUF_ZV (buf
))
1799 continue_reading_p
= 0;
1802 else if (! NILP (Vload_read_function
))
1803 val
= call1 (Vload_read_function
, readcharfun
);
1805 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1808 if (!NILP (start
) && continue_reading_p
)
1809 start
= Fpoint_marker ();
1811 /* Restore saved point and BEGV. */
1812 unbind_to (count1
, Qnil
);
1814 /* Now eval what we just read. */
1815 val
= eval_sub (val
);
1819 Vvalues
= Fcons (val
, Vvalues
);
1820 if (EQ (Vstandard_output
, Qt
))
1829 build_load_history (sourcename
,
1830 stream
|| whole_buffer
);
1834 unbind_to (count
, Qnil
);
1837 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1838 doc
: /* Execute the current buffer as Lisp code.
1839 When called from a Lisp program (i.e., not interactively), this
1840 function accepts up to five optional arguments:
1841 BUFFER is the buffer to evaluate (nil means use current buffer).
1842 PRINTFLAG controls printing of output:
1843 A value of nil means discard it; anything else is stream for print.
1844 FILENAME specifies the file name to use for `load-history'.
1845 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1847 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1848 functions should work normally even if PRINTFLAG is nil.
1850 This function preserves the position of point. */)
1851 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1853 ptrdiff_t count
= SPECPDL_INDEX ();
1854 Lisp_Object tem
, buf
;
1857 buf
= Fcurrent_buffer ();
1859 buf
= Fget_buffer (buffer
);
1861 error ("No such buffer");
1863 if (NILP (printflag
) && NILP (do_allow_print
))
1868 if (NILP (filename
))
1869 filename
= BVAR (XBUFFER (buf
), filename
);
1871 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1872 specbind (Qstandard_output
, tem
);
1873 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1874 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1875 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1876 readevalloop (buf
, 0, filename
,
1877 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1878 unbind_to (count
, Qnil
);
1883 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1884 doc
: /* Execute the region as Lisp code.
1885 When called from programs, expects two arguments,
1886 giving starting and ending indices in the current buffer
1887 of the text to be executed.
1888 Programs can pass third argument PRINTFLAG which controls output:
1889 A value of nil means discard it; anything else is stream for printing it.
1890 Also the fourth argument READ-FUNCTION, if non-nil, is used
1891 instead of `read' to read each expression. It gets one argument
1892 which is the input stream for reading characters.
1894 This function does not move point. */)
1895 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1897 /* FIXME: Do the eval-sexp-add-defvars dance! */
1898 ptrdiff_t count
= SPECPDL_INDEX ();
1899 Lisp_Object tem
, cbuf
;
1901 cbuf
= Fcurrent_buffer ();
1903 if (NILP (printflag
))
1907 specbind (Qstandard_output
, tem
);
1908 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1910 /* `readevalloop' calls functions which check the type of start and end. */
1911 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1912 !NILP (printflag
), Qnil
, read_function
,
1915 return unbind_to (count
, Qnil
);
1919 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1920 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1921 If STREAM is nil, use the value of `standard-input' (which see).
1922 STREAM or the value of `standard-input' may be:
1923 a buffer (read from point and advance it)
1924 a marker (read from where it points and advance it)
1925 a function (call it with no arguments for each character,
1926 call it with a char as argument to push a char back)
1927 a string (takes text from string, starting at the beginning)
1928 t (read text line using minibuffer and use it, or read from
1929 standard input in batch mode). */)
1930 (Lisp_Object stream
)
1933 stream
= Vstandard_input
;
1934 if (EQ (stream
, Qt
))
1935 stream
= Qread_char
;
1936 if (EQ (stream
, Qread_char
))
1937 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1939 return read_internal_start (stream
, Qnil
, Qnil
);
1942 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1943 doc
: /* Read one Lisp expression which is represented as text by STRING.
1944 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1945 FINAL-STRING-INDEX is an integer giving the position of the next
1946 remaining character in STRING.
1947 START and END optionally delimit a substring of STRING from which to read;
1948 they default to 0 and (length STRING) respectively. */)
1949 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1952 CHECK_STRING (string
);
1953 /* `read_internal_start' sets `read_from_string_index'. */
1954 ret
= read_internal_start (string
, start
, end
);
1955 return Fcons (ret
, make_number (read_from_string_index
));
1958 /* Function to set up the global context we need in toplevel read
1961 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1962 /* `start', `end' only used when stream is a string. */
1967 new_backquote_flag
= 0;
1968 read_objects
= Qnil
;
1969 if (EQ (Vread_with_symbol_positions
, Qt
)
1970 || EQ (Vread_with_symbol_positions
, stream
))
1971 Vread_symbol_positions_list
= Qnil
;
1973 if (STRINGP (stream
)
1974 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1976 ptrdiff_t startval
, endval
;
1979 if (STRINGP (stream
))
1982 string
= XCAR (stream
);
1985 endval
= SCHARS (string
);
1989 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
1990 args_out_of_range (string
, end
);
1991 endval
= XINT (end
);
1998 CHECK_NUMBER (start
);
1999 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2000 args_out_of_range (string
, start
);
2001 startval
= XINT (start
);
2003 read_from_string_index
= startval
;
2004 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2005 read_from_string_limit
= endval
;
2008 retval
= read0 (stream
);
2009 if (EQ (Vread_with_symbol_positions
, Qt
)
2010 || EQ (Vread_with_symbol_positions
, stream
))
2011 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2016 /* Signal Qinvalid_read_syntax error.
2017 S is error string of length N (if > 0) */
2019 static _Noreturn
void
2020 invalid_syntax (const char *s
)
2022 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2026 /* Use this for recursive reads, in contexts where internal tokens
2030 read0 (Lisp_Object readcharfun
)
2032 register Lisp_Object val
;
2035 val
= read1 (readcharfun
, &c
, 0);
2039 xsignal1 (Qinvalid_read_syntax
,
2040 Fmake_string (make_number (1), make_number (c
)));
2043 static ptrdiff_t read_buffer_size
;
2044 static char *read_buffer
;
2046 /* Read a \-escape sequence, assuming we already read the `\'.
2047 If the escape sequence forces unibyte, return eight-bit char. */
2050 read_escape (Lisp_Object readcharfun
, int stringp
)
2052 register int c
= READCHAR
;
2053 /* \u allows up to four hex digits, \U up to eight. Default to the
2054 behavior for \u, and change this value in the case that \U is seen. */
2055 int unicode_hex_count
= 4;
2060 end_of_file_error ();
2090 error ("Invalid escape character syntax");
2093 c
= read_escape (readcharfun
, 0);
2094 return c
| meta_modifier
;
2099 error ("Invalid escape character syntax");
2102 c
= read_escape (readcharfun
, 0);
2103 return c
| shift_modifier
;
2108 error ("Invalid escape character syntax");
2111 c
= read_escape (readcharfun
, 0);
2112 return c
| hyper_modifier
;
2117 error ("Invalid escape character syntax");
2120 c
= read_escape (readcharfun
, 0);
2121 return c
| alt_modifier
;
2125 if (stringp
|| c
!= '-')
2132 c
= read_escape (readcharfun
, 0);
2133 return c
| super_modifier
;
2138 error ("Invalid escape character syntax");
2142 c
= read_escape (readcharfun
, 0);
2143 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2144 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2145 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2146 return c
| ctrl_modifier
;
2147 /* ASCII control chars are made from letters (both cases),
2148 as well as the non-letters within 0100...0137. */
2149 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2150 return (c
& (037 | ~0177));
2151 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2152 return (c
& (037 | ~0177));
2154 return c
| ctrl_modifier
;
2164 /* An octal escape, as in ANSI C. */
2166 register int i
= c
- '0';
2167 register int count
= 0;
2170 if ((c
= READCHAR
) >= '0' && c
<= '7')
2182 if (i
>= 0x80 && i
< 0x100)
2183 i
= BYTE8_TO_CHAR (i
);
2188 /* A hex escape, as in ANSI C. */
2195 if (c
>= '0' && c
<= '9')
2200 else if ((c
>= 'a' && c
<= 'f')
2201 || (c
>= 'A' && c
<= 'F'))
2204 if (c
>= 'a' && c
<= 'f')
2214 /* Allow hex escapes as large as ?\xfffffff, because some
2215 packages use them to denote characters with modifiers. */
2216 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2217 error ("Hex character out of range: \\x%x...", i
);
2221 if (count
< 3 && i
>= 0x80)
2222 return BYTE8_TO_CHAR (i
);
2227 /* Post-Unicode-2.0: Up to eight hex chars. */
2228 unicode_hex_count
= 8;
2231 /* A Unicode escape. We only permit them in strings and characters,
2232 not arbitrarily in the source code, as in some other languages. */
2237 while (++count
<= unicode_hex_count
)
2240 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2242 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2243 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2244 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2246 error ("Non-hex digit used for Unicode escape");
2249 error ("Non-Unicode character: 0x%x", i
);
2258 /* Return the digit that CHARACTER stands for in the given BASE.
2259 Return -1 if CHARACTER is out of range for BASE,
2260 and -2 if CHARACTER is not valid for any supported BASE. */
2262 digit_to_number (int character
, int base
)
2266 if ('0' <= character
&& character
<= '9')
2267 digit
= character
- '0';
2268 else if ('a' <= character
&& character
<= 'z')
2269 digit
= character
- 'a' + 10;
2270 else if ('A' <= character
&& character
<= 'Z')
2271 digit
= character
- 'A' + 10;
2275 return digit
< base
? digit
: -1;
2278 /* Read an integer in radix RADIX using READCHARFUN to read
2279 characters. RADIX must be in the interval [2..36]; if it isn't, a
2280 read error is signaled . Value is the integer read. Signals an
2281 error if encountering invalid read syntax or if RADIX is out of
2285 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2287 /* Room for sign, leading 0, other digits, trailing null byte.
2288 Also, room for invalid syntax diagnostic. */
2289 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2290 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2292 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2294 if (radix
< 2 || radix
> 36)
2302 if (c
== '-' || c
== '+')
2313 /* Ignore redundant leading zeros, so the buffer doesn't
2314 fill up with them. */
2320 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2327 if (p
< buf
+ sizeof buf
- 1)
2341 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2342 invalid_syntax (buf
);
2345 return string_to_number (buf
, radix
, 0);
2349 /* If the next token is ')' or ']' or '.', we store that character
2350 in *PCH and the return value is not interesting. Else, we store
2351 zero in *PCH and we read and return one lisp object.
2353 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2356 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2359 unsigned uninterned_symbol
= 0;
2367 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2369 end_of_file_error ();
2374 return read_list (0, readcharfun
);
2377 return read_vector (readcharfun
, 0);
2393 /* Accept extended format for hashtables (extensible to
2395 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2396 Lisp_Object tmp
= read_list (0, readcharfun
);
2397 Lisp_Object head
= CAR_SAFE (tmp
);
2398 Lisp_Object data
= Qnil
;
2399 Lisp_Object val
= Qnil
;
2400 /* The size is 2 * number of allowed keywords to
2402 Lisp_Object params
[10];
2404 Lisp_Object key
= Qnil
;
2405 int param_count
= 0;
2407 if (!EQ (head
, Qhash_table
))
2408 error ("Invalid extended read marker at head of #s list "
2409 "(only hash-table allowed)");
2411 tmp
= CDR_SAFE (tmp
);
2413 /* This is repetitive but fast and simple. */
2414 params
[param_count
] = QCsize
;
2415 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2416 if (!NILP (params
[param_count
+ 1]))
2419 params
[param_count
] = QCtest
;
2420 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2421 if (!NILP (params
[param_count
+ 1]))
2424 params
[param_count
] = QCweakness
;
2425 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2426 if (!NILP (params
[param_count
+ 1]))
2429 params
[param_count
] = QCrehash_size
;
2430 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2431 if (!NILP (params
[param_count
+ 1]))
2434 params
[param_count
] = QCrehash_threshold
;
2435 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2436 if (!NILP (params
[param_count
+ 1]))
2439 /* This is the hashtable data. */
2440 data
= Fplist_get (tmp
, Qdata
);
2442 /* Now use params to make a new hashtable and fill it. */
2443 ht
= Fmake_hash_table (param_count
, params
);
2445 while (CONSP (data
))
2450 error ("Odd number of elements in hashtable data");
2453 Fputhash (key
, val
, ht
);
2459 invalid_syntax ("#");
2467 tmp
= read_vector (readcharfun
, 0);
2468 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2469 error ("Invalid size char-table");
2470 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2482 tmp
= read_vector (readcharfun
, 0);
2485 error ("Invalid size char-table");
2486 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2487 error ("Invalid depth in char-table");
2488 depth
= XINT (AREF (tmp
, 0));
2489 if (chartab_size
[depth
] != size
- 2)
2490 error ("Invalid size char-table");
2491 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2494 invalid_syntax ("#^^");
2496 invalid_syntax ("#^");
2501 length
= read1 (readcharfun
, pch
, first_in_list
);
2505 Lisp_Object tmp
, val
;
2506 EMACS_INT size_in_chars
2507 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2508 / BOOL_VECTOR_BITS_PER_CHAR
);
2511 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2512 if (STRING_MULTIBYTE (tmp
)
2513 || (size_in_chars
!= SCHARS (tmp
)
2514 /* We used to print 1 char too many
2515 when the number of bits was a multiple of 8.
2516 Accept such input in case it came from an old
2518 && ! (XFASTINT (length
)
2519 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2520 invalid_syntax ("#&...");
2522 val
= Fmake_bool_vector (length
, Qnil
);
2523 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2524 /* Clear the extraneous bits in the last byte. */
2525 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2526 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2527 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2530 invalid_syntax ("#&...");
2534 /* Accept compiled functions at read-time so that we don't have to
2535 build them using function calls. */
2537 tmp
= read_vector (readcharfun
, 1);
2538 make_byte_code (XVECTOR (tmp
));
2544 struct gcpro gcpro1
;
2547 /* Read the string itself. */
2548 tmp
= read1 (readcharfun
, &ch
, 0);
2549 if (ch
!= 0 || !STRINGP (tmp
))
2550 invalid_syntax ("#");
2552 /* Read the intervals and their properties. */
2555 Lisp_Object beg
, end
, plist
;
2557 beg
= read1 (readcharfun
, &ch
, 0);
2562 end
= read1 (readcharfun
, &ch
, 0);
2564 plist
= read1 (readcharfun
, &ch
, 0);
2566 invalid_syntax ("Invalid string property list");
2567 Fset_text_properties (beg
, end
, plist
, tmp
);
2573 /* #@NUMBER is used to skip NUMBER following characters.
2574 That's used in .elc files to skip over doc strings
2575 and function definitions. */
2578 enum { extra
= 100 };
2579 ptrdiff_t i
, nskip
= 0;
2582 /* Read a decimal integer. */
2583 while ((c
= READCHAR
) >= 0
2584 && c
>= '0' && c
<= '9')
2586 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2593 if (load_force_doc_strings
2594 && (EQ (readcharfun
, Qget_file_char
)
2595 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2597 /* If we are supposed to force doc strings into core right now,
2598 record the last string that we skipped,
2599 and record where in the file it comes from. */
2601 /* But first exchange saved_doc_string
2602 with prev_saved_doc_string, so we save two strings. */
2604 char *temp
= saved_doc_string
;
2605 ptrdiff_t temp_size
= saved_doc_string_size
;
2606 file_offset temp_pos
= saved_doc_string_position
;
2607 ptrdiff_t temp_len
= saved_doc_string_length
;
2609 saved_doc_string
= prev_saved_doc_string
;
2610 saved_doc_string_size
= prev_saved_doc_string_size
;
2611 saved_doc_string_position
= prev_saved_doc_string_position
;
2612 saved_doc_string_length
= prev_saved_doc_string_length
;
2614 prev_saved_doc_string
= temp
;
2615 prev_saved_doc_string_size
= temp_size
;
2616 prev_saved_doc_string_position
= temp_pos
;
2617 prev_saved_doc_string_length
= temp_len
;
2620 if (saved_doc_string_size
== 0)
2622 saved_doc_string
= xmalloc (nskip
+ extra
);
2623 saved_doc_string_size
= nskip
+ extra
;
2625 if (nskip
> saved_doc_string_size
)
2627 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2628 saved_doc_string_size
= nskip
+ extra
;
2631 saved_doc_string_position
= file_tell (instream
);
2633 /* Copy that many characters into saved_doc_string. */
2634 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2635 saved_doc_string
[i
] = c
= READCHAR
;
2637 saved_doc_string_length
= i
;
2641 /* Skip that many characters. */
2642 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2651 /* #! appears at the beginning of an executable file.
2652 Skip the first line. */
2653 while (c
!= '\n' && c
>= 0)
2658 return Vload_file_name
;
2660 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2661 /* #:foo is the uninterned symbol named foo. */
2664 uninterned_symbol
= 1;
2667 && c
!= 0xa0 /* NBSP */
2669 || strchr ("\"';()[]#`,", c
) == NULL
)))
2671 /* No symbol character follows, this is the empty
2674 return Fmake_symbol (build_string (""));
2678 /* ## is the empty symbol. */
2680 return Fintern (build_string (""), Qnil
);
2681 /* Reader forms that can reuse previously read objects. */
2682 if (c
>= '0' && c
<= '9')
2687 /* Read a non-negative integer. */
2688 while (c
>= '0' && c
<= '9')
2690 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2691 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2692 n
= MOST_POSITIVE_FIXNUM
+ 1;
2694 n
= n
* 10 + c
- '0';
2698 if (n
<= MOST_POSITIVE_FIXNUM
)
2700 if (c
== 'r' || c
== 'R')
2701 return read_integer (readcharfun
, n
);
2703 if (! NILP (Vread_circle
))
2705 /* #n=object returns object, but associates it with
2709 /* Make a placeholder for #n# to use temporarily. */
2710 Lisp_Object placeholder
;
2713 placeholder
= Fcons (Qnil
, Qnil
);
2714 cell
= Fcons (make_number (n
), placeholder
);
2715 read_objects
= Fcons (cell
, read_objects
);
2717 /* Read the object itself. */
2718 tem
= read0 (readcharfun
);
2720 /* Now put it everywhere the placeholder was... */
2721 substitute_object_in_subtree (tem
, placeholder
);
2723 /* ...and #n# will use the real value from now on. */
2724 Fsetcdr (cell
, tem
);
2729 /* #n# returns a previously read object. */
2732 tem
= Fassq (make_number (n
), read_objects
);
2738 /* Fall through to error message. */
2740 else if (c
== 'x' || c
== 'X')
2741 return read_integer (readcharfun
, 16);
2742 else if (c
== 'o' || c
== 'O')
2743 return read_integer (readcharfun
, 8);
2744 else if (c
== 'b' || c
== 'B')
2745 return read_integer (readcharfun
, 2);
2748 invalid_syntax ("#");
2751 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2756 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2761 int next_char
= READCHAR
;
2763 /* Transition from old-style to new-style:
2764 If we see "(`" it used to mean old-style, which usually works
2765 fine because ` should almost never appear in such a position
2766 for new-style. But occasionally we need "(`" to mean new
2767 style, so we try to distinguish the two by the fact that we
2768 can either write "( `foo" or "(` foo", where the first
2769 intends to use new-style whereas the second intends to use
2770 old-style. For Emacs-25, we should completely remove this
2771 first_in_list exception (old-style can still be obtained via
2773 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2775 Vold_style_backquotes
= Qt
;
2782 new_backquote_flag
++;
2783 value
= read0 (readcharfun
);
2784 new_backquote_flag
--;
2786 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2791 int next_char
= READCHAR
;
2793 /* Transition from old-style to new-style:
2794 It used to be impossible to have a new-style , other than within
2795 a new-style `. This is sufficient when ` and , are used in the
2796 normal way, but ` and , can also appear in args to macros that
2797 will not interpret them in the usual way, in which case , may be
2798 used without any ` anywhere near.
2799 So we now use the same heuristic as for backquote: old-style
2800 unquotes are only recognized when first on a list, and when
2801 followed by a space.
2802 Because it's more difficult to peek 2 chars ahead, a new-style
2803 ,@ can still not be used outside of a `, unless it's in the middle
2805 if (new_backquote_flag
2807 || (next_char
!= ' ' && next_char
!= '@'))
2809 Lisp_Object comma_type
= Qnil
;
2814 comma_type
= Qcomma_at
;
2816 comma_type
= Qcomma_dot
;
2819 if (ch
>= 0) UNREAD (ch
);
2820 comma_type
= Qcomma
;
2823 value
= read0 (readcharfun
);
2824 return Fcons (comma_type
, Fcons (value
, Qnil
));
2828 Vold_style_backquotes
= Qt
;
2840 end_of_file_error ();
2842 /* Accept `single space' syntax like (list ? x) where the
2843 whitespace character is SPC or TAB.
2844 Other literal whitespace like NL, CR, and FF are not accepted,
2845 as there are well-established escape sequences for these. */
2846 if (c
== ' ' || c
== '\t')
2847 return make_number (c
);
2850 c
= read_escape (readcharfun
, 0);
2851 modifiers
= c
& CHAR_MODIFIER_MASK
;
2852 c
&= ~CHAR_MODIFIER_MASK
;
2853 if (CHAR_BYTE8_P (c
))
2854 c
= CHAR_TO_BYTE8 (c
);
2857 next_char
= READCHAR
;
2858 ok
= (next_char
<= 040
2859 || (next_char
< 0200
2860 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2863 return make_number (c
);
2865 invalid_syntax ("?");
2870 char *p
= read_buffer
;
2871 char *end
= read_buffer
+ read_buffer_size
;
2873 /* Nonzero if we saw an escape sequence specifying
2874 a multibyte character. */
2875 int force_multibyte
= 0;
2876 /* Nonzero if we saw an escape sequence specifying
2877 a single-byte character. */
2878 int force_singlebyte
= 0;
2880 ptrdiff_t nchars
= 0;
2882 while ((ch
= READCHAR
) >= 0
2885 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2887 ptrdiff_t offset
= p
- read_buffer
;
2888 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2889 memory_full (SIZE_MAX
);
2890 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
2891 read_buffer_size
*= 2;
2892 p
= read_buffer
+ offset
;
2893 end
= read_buffer
+ read_buffer_size
;
2900 ch
= read_escape (readcharfun
, 1);
2902 /* CH is -1 if \ newline has just been seen. */
2905 if (p
== read_buffer
)
2910 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2911 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2913 if (CHAR_BYTE8_P (ch
))
2914 force_singlebyte
= 1;
2915 else if (! ASCII_CHAR_P (ch
))
2916 force_multibyte
= 1;
2917 else /* I.e. ASCII_CHAR_P (ch). */
2919 /* Allow `\C- ' and `\C-?'. */
2920 if (modifiers
== CHAR_CTL
)
2923 ch
= 0, modifiers
= 0;
2925 ch
= 127, modifiers
= 0;
2927 if (modifiers
& CHAR_SHIFT
)
2929 /* Shift modifier is valid only with [A-Za-z]. */
2930 if (ch
>= 'A' && ch
<= 'Z')
2931 modifiers
&= ~CHAR_SHIFT
;
2932 else if (ch
>= 'a' && ch
<= 'z')
2933 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2936 if (modifiers
& CHAR_META
)
2938 /* Move the meta bit to the right place for a
2940 modifiers
&= ~CHAR_META
;
2941 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2942 force_singlebyte
= 1;
2946 /* Any modifiers remaining are invalid. */
2948 error ("Invalid modifier in string");
2949 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2953 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2954 if (CHAR_BYTE8_P (ch
))
2955 force_singlebyte
= 1;
2956 else if (! ASCII_CHAR_P (ch
))
2957 force_multibyte
= 1;
2963 end_of_file_error ();
2965 /* If purifying, and string starts with \ newline,
2966 return zero instead. This is for doc strings
2967 that we are really going to find in etc/DOC.nn.nn. */
2968 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2969 return make_number (0);
2971 if (! force_multibyte
&& force_singlebyte
)
2973 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
2974 forms. Convert it to unibyte. */
2975 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
2977 p
= read_buffer
+ nchars
;
2980 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2982 || (p
- read_buffer
!= nchars
)));
2987 int next_char
= READCHAR
;
2990 if (next_char
<= 040
2991 || (next_char
< 0200
2992 && strchr ("\"';([#?`,", next_char
) != NULL
))
2998 /* Otherwise, we fall through! Note that the atom-reading loop
2999 below will now loop at least once, assuring that we will not
3000 try to UNREAD two characters in a row. */
3004 if (c
<= 040) goto retry
;
3005 if (c
== 0xa0) /* NBSP */
3010 char *p
= read_buffer
;
3012 EMACS_INT start_position
= readchar_count
- 1;
3015 char *end
= read_buffer
+ read_buffer_size
;
3019 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3021 ptrdiff_t offset
= p
- read_buffer
;
3022 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3023 memory_full (SIZE_MAX
);
3024 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3025 read_buffer_size
*= 2;
3026 p
= read_buffer
+ offset
;
3027 end
= read_buffer
+ read_buffer_size
;
3034 end_of_file_error ();
3039 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3045 && c
!= 0xa0 /* NBSP */
3047 || strchr ("\"';()[]#`,", c
) == NULL
));
3051 ptrdiff_t offset
= p
- read_buffer
;
3052 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3053 memory_full (SIZE_MAX
);
3054 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3055 read_buffer_size
*= 2;
3056 p
= read_buffer
+ offset
;
3057 end
= read_buffer
+ read_buffer_size
;
3063 if (!quoted
&& !uninterned_symbol
)
3065 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3066 if (! NILP (result
))
3070 Lisp_Object name
, result
;
3071 ptrdiff_t nbytes
= p
- read_buffer
;
3074 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3078 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3079 ? make_pure_string
: make_specified_string
)
3080 (read_buffer
, nchars
, nbytes
, multibyte
));
3081 result
= (uninterned_symbol
? Fmake_symbol (name
)
3082 : Fintern (name
, Qnil
));
3084 if (EQ (Vread_with_symbol_positions
, Qt
)
3085 || EQ (Vread_with_symbol_positions
, readcharfun
))
3086 Vread_symbol_positions_list
3087 = Fcons (Fcons (result
, make_number (start_position
)),
3088 Vread_symbol_positions_list
);
3096 /* List of nodes we've seen during substitute_object_in_subtree. */
3097 static Lisp_Object seen_list
;
3100 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3102 Lisp_Object check_object
;
3104 /* We haven't seen any objects when we start. */
3107 /* Make all the substitutions. */
3109 = substitute_object_recurse (object
, placeholder
, object
);
3111 /* Clear seen_list because we're done with it. */
3114 /* The returned object here is expected to always eq the
3116 if (!EQ (check_object
, object
))
3117 error ("Unexpected mutation error in reader");
3120 /* Feval doesn't get called from here, so no gc protection is needed. */
3121 #define SUBSTITUTE(get_val, set_val) \
3123 Lisp_Object old_value = get_val; \
3124 Lisp_Object true_value \
3125 = substitute_object_recurse (object, placeholder, \
3128 if (!EQ (old_value, true_value)) \
3135 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3137 /* If we find the placeholder, return the target object. */
3138 if (EQ (placeholder
, subtree
))
3141 /* If we've been to this node before, don't explore it again. */
3142 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3145 /* If this node can be the entry point to a cycle, remember that
3146 we've seen it. It can only be such an entry point if it was made
3147 by #n=, which means that we can find it as a value in
3149 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3150 seen_list
= Fcons (subtree
, seen_list
);
3152 /* Recurse according to subtree's type.
3153 Every branch must return a Lisp_Object. */
3154 switch (XTYPE (subtree
))
3156 case Lisp_Vectorlike
:
3158 ptrdiff_t i
, length
= 0;
3159 if (BOOL_VECTOR_P (subtree
))
3160 return subtree
; /* No sub-objects anyway. */
3161 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3162 || COMPILEDP (subtree
))
3163 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3164 else if (VECTORP (subtree
))
3165 length
= ASIZE (subtree
);
3167 /* An unknown pseudovector may contain non-Lisp fields, so we
3168 can't just blindly traverse all its fields. We used to call
3169 `Flength' which signaled `sequencep', so I just preserved this
3171 wrong_type_argument (Qsequencep
, subtree
);
3173 for (i
= 0; i
< length
; i
++)
3174 SUBSTITUTE (AREF (subtree
, i
),
3175 ASET (subtree
, i
, true_value
));
3181 SUBSTITUTE (XCAR (subtree
),
3182 XSETCAR (subtree
, true_value
));
3183 SUBSTITUTE (XCDR (subtree
),
3184 XSETCDR (subtree
, true_value
));
3190 /* Check for text properties in each interval.
3191 substitute_in_interval contains part of the logic. */
3193 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3194 Lisp_Object arg
= Fcons (object
, placeholder
);
3196 traverse_intervals_noorder (root_interval
,
3197 &substitute_in_interval
, arg
);
3202 /* Other types don't recurse any further. */
3208 /* Helper function for substitute_object_recurse. */
3210 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3212 Lisp_Object object
= Fcar (arg
);
3213 Lisp_Object placeholder
= Fcdr (arg
);
3215 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3225 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3226 integer syntax and fits in a fixnum, else return the nearest float if CP has
3227 either floating point or integer syntax and BASE is 10, else return nil. If
3228 IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
3229 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3230 number has integer syntax but does not fit. */
3233 string_to_number (char const *string
, int base
, int ignore_trailing
)
3236 char const *cp
= string
;
3238 int float_syntax
= 0;
3241 /* Compute NaN and infinities using a variable, to cope with compilers that
3242 think they are smarter than we are. */
3245 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3246 IEEE floating point hosts, and works around a formerly-common bug where
3247 atof ("-0.0") drops the sign. */
3248 int negative
= *cp
== '-';
3250 int signedp
= negative
|| *cp
== '+';
3255 leading_digit
= digit_to_number (*cp
, base
);
3256 if (0 <= leading_digit
)
3261 while (0 <= digit_to_number (*cp
, base
));
3271 if ('0' <= *cp
&& *cp
<= '9')
3276 while ('0' <= *cp
&& *cp
<= '9');
3278 if (*cp
== 'e' || *cp
== 'E')
3280 char const *ecp
= cp
;
3282 if (*cp
== '+' || *cp
== '-')
3284 if ('0' <= *cp
&& *cp
<= '9')
3289 while ('0' <= *cp
&& *cp
<= '9');
3291 else if (cp
[-1] == '+'
3292 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3298 else if (cp
[-1] == '+'
3299 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3303 value
= zero
/ zero
;
3305 /* If that made a "negative" NaN, negate it. */
3308 union { double d
; char c
[sizeof (double)]; }
3309 u_data
, u_minus_zero
;
3311 u_minus_zero
.d
= -0.0;
3312 for (i
= 0; i
< sizeof (double); i
++)
3313 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3319 /* Now VALUE is a positive NaN. */
3325 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3326 || state
== (LEAD_INT
|E_EXP
));
3329 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3330 any prefix that matches. Otherwise, the entire string must match. */
3331 if (! (ignore_trailing
3332 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3333 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3336 /* If the number uses integer and not float syntax, and is in C-language
3337 range, use its value, preferably as a fixnum. */
3338 if (0 <= leading_digit
&& ! float_syntax
)
3342 /* Fast special case for single-digit integers. This also avoids a
3343 glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
3344 case some versions of strtoumax accept numbers like "0x1" that Emacs
3346 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3347 return make_number (negative
? -leading_digit
: leading_digit
);
3350 n
= strtoumax (string
+ signedp
, NULL
, base
);
3351 if (errno
== ERANGE
)
3353 /* Unfortunately there's no simple and accurate way to convert
3354 non-base-10 numbers that are out of C-language range. */
3356 xsignal1 (Qoverflow_error
, build_string (string
));
3358 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3360 EMACS_INT signed_n
= n
;
3361 return make_number (negative
? -signed_n
: signed_n
);
3367 /* Either the number uses float syntax, or it does not fit into a fixnum.
3368 Convert it from string to floating point, unless the value is already
3369 known because it is an infinity, a NAN, or its absolute value fits in
3372 value
= atof (string
+ signedp
);
3374 return make_float (negative
? -value
: value
);
3379 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3382 register Lisp_Object
*ptr
;
3383 register Lisp_Object tem
, item
, vector
;
3384 register struct Lisp_Cons
*otem
;
3387 tem
= read_list (1, readcharfun
);
3388 len
= Flength (tem
);
3389 vector
= Fmake_vector (len
, Qnil
);
3391 size
= ASIZE (vector
);
3392 ptr
= XVECTOR (vector
)->contents
;
3393 for (i
= 0; i
< size
; i
++)
3396 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3397 bytecode object, the docstring containing the bytecode and
3398 constants values must be treated as unibyte and passed to
3399 Fread, to get the actual bytecode string and constants vector. */
3400 if (bytecodeflag
&& load_force_doc_strings
)
3402 if (i
== COMPILED_BYTECODE
)
3404 if (!STRINGP (item
))
3405 error ("Invalid byte code");
3407 /* Delay handling the bytecode slot until we know whether
3408 it is lazily-loaded (we can tell by whether the
3409 constants slot is nil). */
3410 ptr
[COMPILED_CONSTANTS
] = item
;
3413 else if (i
== COMPILED_CONSTANTS
)
3415 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3419 /* Coerce string to unibyte (like string-as-unibyte,
3420 but without generating extra garbage and
3421 guaranteeing no change in the contents). */
3422 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3423 STRING_SET_UNIBYTE (bytestr
);
3425 item
= Fread (Fcons (bytestr
, readcharfun
));
3427 error ("Invalid byte code");
3429 otem
= XCONS (item
);
3430 bytestr
= XCAR (item
);
3435 /* Now handle the bytecode slot. */
3436 ptr
[COMPILED_BYTECODE
] = bytestr
;
3438 else if (i
== COMPILED_DOC_STRING
3440 && ! STRING_MULTIBYTE (item
))
3442 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3443 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3445 item
= Fstring_as_multibyte (item
);
3456 /* FLAG = 1 means check for ] to terminate rather than ) and . */
3459 read_list (int flag
, register Lisp_Object readcharfun
)
3461 Lisp_Object val
, tail
;
3462 register Lisp_Object elt
, tem
;
3463 struct gcpro gcpro1
, gcpro2
;
3464 /* 0 is the normal case.
3465 1 means this list is a doc reference; replace it with the number 0.
3466 2 means this list is a doc reference; replace it with the doc string. */
3467 int doc_reference
= 0;
3469 /* Initialize this to 1 if we are reading a list. */
3470 int first_in_list
= flag
<= 0;
3479 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3484 /* While building, if the list starts with #$, treat it specially. */
3485 if (EQ (elt
, Vload_file_name
)
3487 && !NILP (Vpurify_flag
))
3489 if (NILP (Vdoc_file_name
))
3490 /* We have not yet called Snarf-documentation, so assume
3491 this file is described in the DOC-MM.NN file
3492 and Snarf-documentation will fill in the right value later.
3493 For now, replace the whole list with 0. */
3496 /* We have already called Snarf-documentation, so make a relative
3497 file name for this file, so it can be found properly
3498 in the installed Lisp directory.
3499 We don't use Fexpand_file_name because that would make
3500 the directory absolute now. */
3501 elt
= concat2 (build_string ("../lisp/"),
3502 Ffile_name_nondirectory (elt
));
3504 else if (EQ (elt
, Vload_file_name
)
3506 && load_force_doc_strings
)
3515 invalid_syntax (") or . in a vector");
3523 XSETCDR (tail
, read0 (readcharfun
));
3525 val
= read0 (readcharfun
);
3526 read1 (readcharfun
, &ch
, 0);
3530 if (doc_reference
== 1)
3531 return make_number (0);
3532 if (doc_reference
== 2)
3534 /* Get a doc string from the file we are loading.
3535 If it's in saved_doc_string, get it from there.
3537 Here, we don't know if the string is a
3538 bytecode string or a doc string. As a
3539 bytecode string must be unibyte, we always
3540 return a unibyte string. If it is actually a
3541 doc string, caller must make it
3544 EMACS_INT pos
= XINT (XCDR (val
));
3545 /* Position is negative for user variables. */
3546 if (pos
< 0) pos
= -pos
;
3547 if (pos
>= saved_doc_string_position
3548 && pos
< (saved_doc_string_position
3549 + saved_doc_string_length
))
3551 ptrdiff_t start
= pos
- saved_doc_string_position
;
3554 /* Process quoting with ^A,
3555 and find the end of the string,
3556 which is marked with ^_ (037). */
3557 for (from
= start
, to
= start
;
3558 saved_doc_string
[from
] != 037;)
3560 int c
= saved_doc_string
[from
++];
3563 c
= saved_doc_string
[from
++];
3565 saved_doc_string
[to
++] = c
;
3567 saved_doc_string
[to
++] = 0;
3569 saved_doc_string
[to
++] = 037;
3572 saved_doc_string
[to
++] = c
;
3575 return make_unibyte_string (saved_doc_string
+ start
,
3578 /* Look in prev_saved_doc_string the same way. */
3579 else if (pos
>= prev_saved_doc_string_position
3580 && pos
< (prev_saved_doc_string_position
3581 + prev_saved_doc_string_length
))
3584 pos
- prev_saved_doc_string_position
;
3587 /* Process quoting with ^A,
3588 and find the end of the string,
3589 which is marked with ^_ (037). */
3590 for (from
= start
, to
= start
;
3591 prev_saved_doc_string
[from
] != 037;)
3593 int c
= prev_saved_doc_string
[from
++];
3596 c
= prev_saved_doc_string
[from
++];
3598 prev_saved_doc_string
[to
++] = c
;
3600 prev_saved_doc_string
[to
++] = 0;
3602 prev_saved_doc_string
[to
++] = 037;
3605 prev_saved_doc_string
[to
++] = c
;
3608 return make_unibyte_string (prev_saved_doc_string
3613 return get_doc_string (val
, 1, 0);
3618 invalid_syntax (". in wrong context");
3620 invalid_syntax ("] in a list");
3622 tem
= Fcons (elt
, Qnil
);
3624 XSETCDR (tail
, tem
);
3631 static Lisp_Object initial_obarray
;
3633 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3635 static size_t oblookup_last_bucket_number
;
3637 /* Get an error if OBARRAY is not an obarray.
3638 If it is one, return it. */
3641 check_obarray (Lisp_Object obarray
)
3643 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3645 /* If Vobarray is now invalid, force it to be valid. */
3646 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3647 wrong_type_argument (Qvectorp
, obarray
);
3652 /* Intern the C string STR: return a symbol with that name,
3653 interned in the current obarray. */
3656 intern (const char *str
)
3659 ptrdiff_t len
= strlen (str
);
3660 Lisp_Object obarray
;
3663 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3664 obarray
= check_obarray (obarray
);
3665 tem
= oblookup (obarray
, str
, len
, len
);
3668 return Fintern (make_string (str
, len
), obarray
);
3672 intern_c_string (const char *str
)
3675 ptrdiff_t len
= strlen (str
);
3676 Lisp_Object obarray
;
3679 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3680 obarray
= check_obarray (obarray
);
3681 tem
= oblookup (obarray
, str
, len
, len
);
3685 if (NILP (Vpurify_flag
))
3686 /* Creating a non-pure string from a string literal not
3687 implemented yet. We could just use make_string here and live
3688 with the extra copy. */
3691 return Fintern (make_pure_c_string (str
, len
), obarray
);
3694 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3695 doc
: /* Return the canonical symbol whose name is STRING.
3696 If there is none, one is created by this function and returned.
3697 A second optional argument specifies the obarray to use;
3698 it defaults to the value of `obarray'. */)
3699 (Lisp_Object string
, Lisp_Object obarray
)
3701 register Lisp_Object tem
, sym
, *ptr
;
3703 if (NILP (obarray
)) obarray
= Vobarray
;
3704 obarray
= check_obarray (obarray
);
3706 CHECK_STRING (string
);
3708 tem
= oblookup (obarray
, SSDATA (string
),
3711 if (!INTEGERP (tem
))
3714 if (!NILP (Vpurify_flag
))
3715 string
= Fpurecopy (string
);
3716 sym
= Fmake_symbol (string
);
3718 if (EQ (obarray
, initial_obarray
))
3719 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3721 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3723 if ((SREF (string
, 0) == ':')
3724 && EQ (obarray
, initial_obarray
))
3726 XSYMBOL (sym
)->constant
= 1;
3727 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3728 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3731 ptr
= &AREF (obarray
, XINT(tem
));
3733 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3735 XSYMBOL (sym
)->next
= 0;
3740 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3741 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3742 NAME may be a string or a symbol. If it is a symbol, that exact
3743 symbol is searched for.
3744 A second optional argument specifies the obarray to use;
3745 it defaults to the value of `obarray'. */)
3746 (Lisp_Object name
, Lisp_Object obarray
)
3748 register Lisp_Object tem
, string
;
3750 if (NILP (obarray
)) obarray
= Vobarray
;
3751 obarray
= check_obarray (obarray
);
3753 if (!SYMBOLP (name
))
3755 CHECK_STRING (name
);
3759 string
= SYMBOL_NAME (name
);
3761 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3762 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3768 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3769 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3770 The value is t if a symbol was found and deleted, nil otherwise.
3771 NAME may be a string or a symbol. If it is a symbol, that symbol
3772 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3773 OBARRAY defaults to the value of the variable `obarray'. */)
3774 (Lisp_Object name
, Lisp_Object obarray
)
3776 register Lisp_Object string
, tem
;
3779 if (NILP (obarray
)) obarray
= Vobarray
;
3780 obarray
= check_obarray (obarray
);
3783 string
= SYMBOL_NAME (name
);
3786 CHECK_STRING (name
);
3790 tem
= oblookup (obarray
, SSDATA (string
),
3795 /* If arg was a symbol, don't delete anything but that symbol itself. */
3796 if (SYMBOLP (name
) && !EQ (name
, tem
))
3799 /* There are plenty of other symbols which will screw up the Emacs
3800 session if we unintern them, as well as even more ways to use
3801 `setq' or `fset' or whatnot to make the Emacs session
3802 unusable. Let's not go down this silly road. --Stef */
3803 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3804 error ("Attempt to unintern t or nil"); */
3806 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3808 hash
= oblookup_last_bucket_number
;
3810 if (EQ (AREF (obarray
, hash
), tem
))
3812 if (XSYMBOL (tem
)->next
)
3813 XSETSYMBOL (AREF (obarray
, hash
), XSYMBOL (tem
)->next
);
3815 XSETINT (AREF (obarray
, hash
), 0);
3819 Lisp_Object tail
, following
;
3821 for (tail
= AREF (obarray
, hash
);
3822 XSYMBOL (tail
)->next
;
3825 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3826 if (EQ (following
, tem
))
3828 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3837 /* Return the symbol in OBARRAY whose names matches the string
3838 of SIZE characters (SIZE_BYTE bytes) at PTR.
3839 If there is no such symbol in OBARRAY, return nil.
3841 Also store the bucket number in oblookup_last_bucket_number. */
3844 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3848 register Lisp_Object tail
;
3849 Lisp_Object bucket
, tem
;
3851 if (!VECTORP (obarray
)
3852 || (obsize
= ASIZE (obarray
)) == 0)
3854 obarray
= check_obarray (obarray
);
3855 obsize
= ASIZE (obarray
);
3857 /* This is sometimes needed in the middle of GC. */
3858 obsize
&= ~ARRAY_MARK_FLAG
;
3859 hash
= hash_string (ptr
, size_byte
) % obsize
;
3860 bucket
= AREF (obarray
, hash
);
3861 oblookup_last_bucket_number
= hash
;
3862 if (EQ (bucket
, make_number (0)))
3864 else if (!SYMBOLP (bucket
))
3865 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3867 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3869 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3870 && SCHARS (SYMBOL_NAME (tail
)) == size
3871 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3873 else if (XSYMBOL (tail
)->next
== 0)
3876 XSETINT (tem
, hash
);
3881 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3884 register Lisp_Object tail
;
3885 CHECK_VECTOR (obarray
);
3886 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3888 tail
= AREF (obarray
, i
);
3893 if (XSYMBOL (tail
)->next
== 0)
3895 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3901 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3903 call1 (function
, sym
);
3906 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3907 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3908 OBARRAY defaults to the value of `obarray'. */)
3909 (Lisp_Object function
, Lisp_Object obarray
)
3911 if (NILP (obarray
)) obarray
= Vobarray
;
3912 obarray
= check_obarray (obarray
);
3914 map_obarray (obarray
, mapatoms_1
, function
);
3918 #define OBARRAY_SIZE 1511
3923 Lisp_Object oblength
;
3924 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3926 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3928 Vobarray
= Fmake_vector (oblength
, make_number (0));
3929 initial_obarray
= Vobarray
;
3930 staticpro (&initial_obarray
);
3932 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
3933 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3934 NILP (Vpurify_flag) check in intern_c_string. */
3935 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3936 Qnil
= intern_c_string ("nil");
3938 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3939 so those two need to be fixed manually. */
3940 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3941 XSYMBOL (Qunbound
)->function
= Qunbound
;
3942 XSYMBOL (Qunbound
)->plist
= Qnil
;
3943 /* XSYMBOL (Qnil)->function = Qunbound; */
3944 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3945 XSYMBOL (Qnil
)->constant
= 1;
3946 XSYMBOL (Qnil
)->declared_special
= 1;
3947 XSYMBOL (Qnil
)->plist
= Qnil
;
3949 Qt
= intern_c_string ("t");
3950 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3951 XSYMBOL (Qnil
)->declared_special
= 1;
3952 XSYMBOL (Qt
)->constant
= 1;
3954 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3957 DEFSYM (Qvariable_documentation
, "variable-documentation");
3959 read_buffer
= xmalloc (size
);
3960 read_buffer_size
= size
;
3964 defsubr (struct Lisp_Subr
*sname
)
3967 sym
= intern_c_string (sname
->symbol_name
);
3968 XSETTYPED_PVECTYPE (sname
, size
, PVEC_SUBR
);
3969 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3972 #ifdef NOTDEF /* Use fset in subr.el now! */
3974 defalias (struct Lisp_Subr
*sname
, char *string
)
3977 sym
= intern (string
);
3978 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3982 /* Define an "integer variable"; a symbol whose value is forwarded to a
3983 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
3984 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3986 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3987 const char *namestring
, EMACS_INT
*address
)
3990 sym
= intern_c_string (namestring
);
3991 i_fwd
->type
= Lisp_Fwd_Int
;
3992 i_fwd
->intvar
= address
;
3993 XSYMBOL (sym
)->declared_special
= 1;
3994 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3995 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
3998 /* Similar but define a variable whose value is t if address contains 1,
3999 nil if address contains 0. */
4001 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4002 const char *namestring
, int *address
)
4005 sym
= intern_c_string (namestring
);
4006 b_fwd
->type
= Lisp_Fwd_Bool
;
4007 b_fwd
->boolvar
= address
;
4008 XSYMBOL (sym
)->declared_special
= 1;
4009 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4010 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4011 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4014 /* Similar but define a variable whose value is the Lisp Object stored
4015 at address. Two versions: with and without gc-marking of the C
4016 variable. The nopro version is used when that variable will be
4017 gc-marked for some other reason, since marking the same slot twice
4018 can cause trouble with strings. */
4020 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4021 const char *namestring
, Lisp_Object
*address
)
4024 sym
= intern_c_string (namestring
);
4025 o_fwd
->type
= Lisp_Fwd_Obj
;
4026 o_fwd
->objvar
= address
;
4027 XSYMBOL (sym
)->declared_special
= 1;
4028 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4029 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4033 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4034 const char *namestring
, Lisp_Object
*address
)
4036 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4037 staticpro (address
);
4040 /* Similar but define a variable whose value is the Lisp Object stored
4041 at a particular offset in the current kboard object. */
4044 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4045 const char *namestring
, int offset
)
4048 sym
= intern_c_string (namestring
);
4049 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4050 ko_fwd
->offset
= offset
;
4051 XSYMBOL (sym
)->declared_special
= 1;
4052 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4053 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4056 /* Check that the elements of Vload_path exist. */
4059 load_path_check (void)
4061 Lisp_Object path_tail
;
4063 /* The only elements that might not exist are those from
4064 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4066 for (path_tail
= Vload_path
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4068 Lisp_Object dirfile
;
4069 dirfile
= Fcar (path_tail
);
4070 if (STRINGP (dirfile
))
4072 dirfile
= Fdirectory_file_name (dirfile
);
4073 if (access (SSDATA (dirfile
), 0) < 0)
4074 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4080 /* Record the value of load-path used at the start of dumping
4081 so we can see if the site changed it later during dumping. */
4082 static Lisp_Object dump_path
;
4084 /* Compute the default Vload_path, with the following logic:
4086 use EMACSLOADPATH env-var if set; otherwise use PATH_LOADSEARCH,
4087 prepending PATH_SITELOADSEARCH unless --no-site-lisp.
4088 The remainder is what happens when dumping works:
4089 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4090 Otherwise use EMACSLOADPATH if set, else PATH_LOADSEARCH.
4092 If !initialized, then just set both Vload_path and dump_path.
4093 If initialized, then if Vload_path != dump_path, do nothing.
4094 (Presumably the load-path has already been changed by something.
4095 This can only be from a site-load file during dumping,
4096 or because EMACSLOADPATH is set.)
4097 If Vinstallation_directory is not nil (ie, running uninstalled):
4098 If installation-dir/lisp exists and not already a member,
4099 we must be running uninstalled. Reset the load-path
4100 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4101 refers to the eventual installation directories. Since we
4102 are not yet installed, we should not use them, even if they exist.)
4103 If installation-dir/lisp does not exist, just add dump_path at the
4105 Add installation-dir/leim (if exists and not already a member) at the front.
4106 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4107 and not already a member) at the front.
4108 If installation-dir != source-dir (ie running an uninstalled,
4109 out-of-tree build) AND install-dir/src/Makefile exists BUT
4110 install-dir/src/Makefile.in does NOT exist (this is a sanity
4111 check), then repeat the above steps for source-dir/lisp,
4113 Finally, add the site-lisp directories at the front (if !no_site_lisp).
4123 const char *loadpath
= ns_load_path ();
4126 normal
= PATH_LOADSEARCH
;
4128 Vload_path
= decode_env_path ("EMACSLOADPATH", loadpath
? loadpath
: normal
);
4130 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4135 /* FIXME CANNOT_DUMP platforms should get source-dir/lisp etc added
4136 to their load-path too, AFAICS. I don't think we can tell the
4137 difference between initialized and !initialized in this case,
4138 so we'll have to do it unconditionally when Vinstallation_directory
4141 /* loadpath already includes the app-bundle's site-lisp. */
4142 if (!no_site_lisp
&& !egetenv ("EMACSLOADPATH") && !loadpath
)
4144 if (!no_site_lisp
&& !egetenv ("EMACSLOADPATH"))
4147 Lisp_Object sitelisp
;
4148 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4149 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4152 if (NILP (Vpurify_flag
))
4154 normal
= PATH_LOADSEARCH
;
4155 /* If the EMACSLOADPATH environment variable is set, use its value.
4156 This doesn't apply if we're dumping. */
4157 if (egetenv ("EMACSLOADPATH"))
4158 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4161 normal
= PATH_DUMPLOADSEARCH
;
4163 /* In a dumped Emacs, we normally reset the value of Vload_path using
4164 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4165 the source directory, instead of the path of the installed elisp
4166 libraries. However, if it appears that Vload_path has already been
4167 changed from the default that was saved before dumping, don't
4168 change it further. Changes can only be due to EMACSLOADPATH, or
4169 site-lisp files that were processed during dumping. */
4172 if (NILP (Fequal (dump_path
, Vload_path
)))
4174 /* Do not make any changes, just check the elements exist. */
4175 /* Note: --no-site-lisp is ignored.
4176 I don't know what to do about this. */
4182 const char *loadpath
= ns_load_path ();
4183 Vload_path
= decode_env_path (0, loadpath
? loadpath
: normal
);
4185 Vload_path
= decode_env_path (0, normal
);
4187 if (!NILP (Vinstallation_directory
))
4189 Lisp_Object tem
, tem1
;
4191 /* Add to the path the lisp subdir of the installation
4192 dir, if it exists. Note: in out-of-tree builds,
4193 this directory is empty save for Makefile. */
4194 tem
= Fexpand_file_name (build_string ("lisp"),
4195 Vinstallation_directory
);
4196 tem1
= Ffile_exists_p (tem
);
4199 if (NILP (Fmember (tem
, Vload_path
)))
4201 /* We are running uninstalled. The default load-path
4202 points to the eventual installed lisp, leim
4203 directories. We should not use those now, even
4204 if they exist, so start over from a clean slate. */
4205 Vload_path
= Fcons (tem
, Qnil
);
4209 /* That dir doesn't exist, so add the build-time
4210 Lisp dirs instead. */
4211 Vload_path
= nconc2 (Vload_path
, dump_path
);
4213 /* Add leim under the installation dir, if it exists. */
4214 tem
= Fexpand_file_name (build_string ("leim"),
4215 Vinstallation_directory
);
4216 tem1
= Ffile_exists_p (tem
);
4219 if (NILP (Fmember (tem
, Vload_path
)))
4220 Vload_path
= Fcons (tem
, Vload_path
);
4223 /* Add site-lisp under the installation dir, if it exists. */
4226 tem
= Fexpand_file_name (build_string ("site-lisp"),
4227 Vinstallation_directory
);
4228 tem1
= Ffile_exists_p (tem
);
4231 if (NILP (Fmember (tem
, Vload_path
)))
4232 Vload_path
= Fcons (tem
, Vload_path
);
4236 /* If Emacs was not built in the source directory,
4237 and it is run from where it was built, add to load-path
4238 the lisp, leim and site-lisp dirs under that directory. */
4240 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4244 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4245 Vinstallation_directory
);
4246 tem1
= Ffile_exists_p (tem
);
4248 /* Don't be fooled if they moved the entire source tree
4249 AFTER dumping Emacs. If the build directory is indeed
4250 different from the source dir, src/Makefile.in and
4251 src/Makefile will not be found together. */
4252 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4253 Vinstallation_directory
);
4254 tem2
= Ffile_exists_p (tem
);
4255 if (!NILP (tem1
) && NILP (tem2
))
4257 tem
= Fexpand_file_name (build_string ("lisp"),
4260 if (NILP (Fmember (tem
, Vload_path
)))
4261 Vload_path
= Fcons (tem
, Vload_path
);
4263 tem
= Fexpand_file_name (build_string ("leim"),
4266 if (NILP (Fmember (tem
, Vload_path
)))
4267 Vload_path
= Fcons (tem
, Vload_path
);
4271 tem
= Fexpand_file_name (build_string ("site-lisp"),
4274 if (NILP (Fmember (tem
, Vload_path
)))
4275 Vload_path
= Fcons (tem
, Vload_path
);
4278 } /* Vinstallation_directory != Vsource_directory */
4280 } /* if Vinstallation_directory */
4282 /* Check before adding the site-lisp directories.
4283 The install should have created them, but they are not
4284 required, so no need to warn if they are absent.
4285 Or we might be running before installation. */
4288 /* Add the site-lisp directories at the front. */
4290 /* loadpath already includes the app-bundle's site-lisp. */
4291 if (!no_site_lisp
&& !loadpath
)
4296 Lisp_Object sitelisp
;
4297 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4298 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4300 } /* if dump_path == Vload_path */
4302 else /* !initialized */
4304 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4305 source directory. We used to add ../lisp (ie the lisp dir in
4306 the build directory) at the front here, but that caused trouble
4307 because it was copied from dump_path into Vload_path, above,
4308 when Vinstallation_directory was non-nil. It should not be
4309 necessary, since in out of tree builds lisp/ is empty, save
4311 Vload_path
= decode_env_path (0, normal
);
4312 dump_path
= Vload_path
;
4313 /* No point calling load_path_check; load-path only contains essential
4314 elements from the source directory at this point. They cannot
4315 be missing unless something went extremely (and improbably)
4316 wrong, in which case the build will fail in obvious ways. */
4318 #endif /* CANNOT_DUMP */
4322 load_in_progress
= 0;
4323 Vload_file_name
= Qnil
;
4325 load_descriptor_list
= Qnil
;
4327 Vstandard_input
= Qt
;
4328 Vloads_in_progress
= Qnil
;
4331 /* Print a warning, using format string FORMAT, that directory DIRNAME
4332 does not exist. Print it on stderr and put it in *Messages*. */
4335 dir_warning (const char *format
, Lisp_Object dirname
)
4337 fprintf (stderr
, format
, SDATA (dirname
));
4339 /* Don't log the warning before we've initialized!! */
4343 ptrdiff_t message_len
;
4345 SAFE_ALLOCA (buffer
, char *,
4346 SBYTES (dirname
) + strlen (format
) - (sizeof "%s" - 1) + 1);
4347 message_len
= esprintf (buffer
, format
, SDATA (dirname
));
4348 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4354 syms_of_lread (void)
4357 defsubr (&Sread_from_string
);
4359 defsubr (&Sintern_soft
);
4360 defsubr (&Sunintern
);
4361 defsubr (&Sget_load_suffixes
);
4363 defsubr (&Seval_buffer
);
4364 defsubr (&Seval_region
);
4365 defsubr (&Sread_char
);
4366 defsubr (&Sread_char_exclusive
);
4367 defsubr (&Sread_event
);
4368 defsubr (&Sget_file_char
);
4369 defsubr (&Smapatoms
);
4370 defsubr (&Slocate_file_internal
);
4372 DEFVAR_LISP ("obarray", Vobarray
,
4373 doc
: /* Symbol table for use by `intern' and `read'.
4374 It is a vector whose length ought to be prime for best results.
4375 The vector's contents don't make sense if examined from Lisp programs;
4376 to find all the symbols in an obarray, use `mapatoms'. */);
4378 DEFVAR_LISP ("values", Vvalues
,
4379 doc
: /* List of values of all expressions which were read, evaluated and printed.
4380 Order is reverse chronological. */);
4381 XSYMBOL (intern ("values"))->declared_special
= 0;
4383 DEFVAR_LISP ("standard-input", Vstandard_input
,
4384 doc
: /* Stream for read to get input from.
4385 See documentation of `read' for possible values. */);
4386 Vstandard_input
= Qt
;
4388 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4389 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4391 If this variable is a buffer, then only forms read from that buffer
4392 will be added to `read-symbol-positions-list'.
4393 If this variable is t, then all read forms will be added.
4394 The effect of all other values other than nil are not currently
4395 defined, although they may be in the future.
4397 The positions are relative to the last call to `read' or
4398 `read-from-string'. It is probably a bad idea to set this variable at
4399 the toplevel; bind it instead. */);
4400 Vread_with_symbol_positions
= Qnil
;
4402 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4403 doc
: /* A list mapping read symbols to their positions.
4404 This variable is modified during calls to `read' or
4405 `read-from-string', but only when `read-with-symbol-positions' is
4408 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4409 CHAR-POSITION is an integer giving the offset of that occurrence of the
4410 symbol from the position where `read' or `read-from-string' started.
4412 Note that a symbol will appear multiple times in this list, if it was
4413 read multiple times. The list is in the same order as the symbols
4415 Vread_symbol_positions_list
= Qnil
;
4417 DEFVAR_LISP ("read-circle", Vread_circle
,
4418 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4421 DEFVAR_LISP ("load-path", Vload_path
,
4422 doc
: /* List of directories to search for files to load.
4423 Each element is a string (directory name) or nil (try default directory).
4424 Initialized based on EMACSLOADPATH environment variable, if any,
4425 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4427 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4428 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4429 This list should not include the empty string.
4430 `load' and related functions try to append these suffixes, in order,
4431 to the specified file name if a Lisp suffix is allowed or required. */);
4432 Vload_suffixes
= Fcons (build_pure_c_string (".elc"),
4433 Fcons (build_pure_c_string (".el"), Qnil
));
4434 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4435 doc
: /* List of suffixes that indicate representations of \
4437 This list should normally start with the empty string.
4439 Enabling Auto Compression mode appends the suffixes in
4440 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4441 mode removes them again. `load' and related functions use this list to
4442 determine whether they should look for compressed versions of a file
4443 and, if so, which suffixes they should try to append to the file name
4444 in order to do so. However, if you want to customize which suffixes
4445 the loading functions recognize as compression suffixes, you should
4446 customize `jka-compr-load-suffixes' rather than the present variable. */);
4447 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4449 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4450 doc
: /* Non-nil if inside of `load'. */);
4451 DEFSYM (Qload_in_progress
, "load-in-progress");
4453 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4454 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4455 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4457 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4458 a symbol \(a feature name).
4460 When `load' is run and the file-name argument matches an element's
4461 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4462 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4464 An error in FORMS does not undo the load, but does prevent execution of
4465 the rest of the FORMS. */);
4466 Vafter_load_alist
= Qnil
;
4468 DEFVAR_LISP ("load-history", Vload_history
,
4469 doc
: /* Alist mapping loaded file names to symbols and features.
4470 Each alist element should be a list (FILE-NAME ENTRIES...), where
4471 FILE-NAME is the name of a file that has been loaded into Emacs.
4472 The file name is absolute and true (i.e. it doesn't contain symlinks).
4473 As an exception, one of the alist elements may have FILE-NAME nil,
4474 for symbols and features not associated with any file.
4476 The remaining ENTRIES in the alist element describe the functions and
4477 variables defined in that file, the features provided, and the
4478 features required. Each entry has the form `(provide . FEATURE)',
4479 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4480 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4481 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4482 autoload before this file redefined it as a function. In addition,
4483 entries may also be single symbols, which means that SYMBOL was
4484 defined by `defvar' or `defconst'.
4486 During preloading, the file name recorded is relative to the main Lisp
4487 directory. These file names are converted to absolute at startup. */);
4488 Vload_history
= Qnil
;
4490 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4491 doc
: /* Full name of file being loaded by `load'. */);
4492 Vload_file_name
= Qnil
;
4494 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4495 doc
: /* File name, including directory, of user's initialization file.
4496 If the file loaded had extension `.elc', and the corresponding source file
4497 exists, this variable contains the name of source file, suitable for use
4498 by functions like `custom-save-all' which edit the init file.
4499 While Emacs loads and evaluates the init file, value is the real name
4500 of the file, regardless of whether or not it has the `.elc' extension. */);
4501 Vuser_init_file
= Qnil
;
4503 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4504 doc
: /* Used for internal purposes by `load'. */);
4505 Vcurrent_load_list
= Qnil
;
4507 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4508 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4509 The default is nil, which means use the function `read'. */);
4510 Vload_read_function
= Qnil
;
4512 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4513 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4514 This function is for doing code conversion before reading the source file.
4515 If nil, loading is done without any code conversion.
4516 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4517 FULLNAME is the full name of FILE.
4518 See `load' for the meaning of the remaining arguments. */);
4519 Vload_source_file_function
= Qnil
;
4521 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4522 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4523 This is useful when the file being loaded is a temporary copy. */);
4524 load_force_doc_strings
= 0;
4526 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4527 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4528 This is normally bound by `load' and `eval-buffer' to control `read',
4529 and is not meant for users to change. */);
4530 load_convert_to_unibyte
= 0;
4532 DEFVAR_LISP ("source-directory", Vsource_directory
,
4533 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4534 You cannot count on them to still be there! */);
4536 = Fexpand_file_name (build_string ("../"),
4537 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4539 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4540 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4541 Vpreloaded_file_list
= Qnil
;
4543 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4544 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4545 Vbyte_boolean_vars
= Qnil
;
4547 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4548 doc
: /* Non-nil means load dangerous compiled Lisp files.
4549 Some versions of XEmacs use different byte codes than Emacs. These
4550 incompatible byte codes can make Emacs crash when it tries to execute
4552 load_dangerous_libraries
= 0;
4554 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4555 doc
: /* Non-nil means force printing messages when loading Lisp files.
4556 This overrides the value of the NOMESSAGE argument to `load'. */);
4557 force_load_messages
= 0;
4559 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4560 doc
: /* Regular expression matching safe to load compiled Lisp files.
4561 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4562 from the file, and matches them against this regular expression.
4563 When the regular expression matches, the file is considered to be safe
4564 to load. See also `load-dangerous-libraries'. */);
4565 Vbytecomp_version_regexp
4566 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4568 Qlexical_binding
= intern ("lexical-binding");
4569 staticpro (&Qlexical_binding
);
4570 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4571 doc
: /* Whether to use lexical binding when evaluating code.
4572 Non-nil means that the code in the current buffer should be evaluated
4573 with lexical binding.
4574 This variable is automatically set from the file variables of an
4575 interpreted Lisp file read using `load'. Unlike other file local
4576 variables, this must be set in the first line of a file. */);
4577 Fmake_variable_buffer_local (Qlexical_binding
);
4579 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4580 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4581 Veval_buffer_list
= Qnil
;
4583 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4584 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4585 Vold_style_backquotes
= Qnil
;
4586 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4588 /* Vsource_directory was initialized in init_lread. */
4590 load_descriptor_list
= Qnil
;
4591 staticpro (&load_descriptor_list
);
4593 DEFSYM (Qcurrent_load_list
, "current-load-list");
4594 DEFSYM (Qstandard_input
, "standard-input");
4595 DEFSYM (Qread_char
, "read-char");
4596 DEFSYM (Qget_file_char
, "get-file-char");
4597 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4598 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4600 DEFSYM (Qbackquote
, "`");
4601 DEFSYM (Qcomma
, ",");
4602 DEFSYM (Qcomma_at
, ",@");
4603 DEFSYM (Qcomma_dot
, ",.");
4605 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4606 DEFSYM (Qascii_character
, "ascii-character");
4607 DEFSYM (Qfunction
, "function");
4608 DEFSYM (Qload
, "load");
4609 DEFSYM (Qload_file_name
, "load-file-name");
4610 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4611 DEFSYM (Qfile_truename
, "file-truename");
4612 DEFSYM (Qdir_ok
, "dir-ok");
4613 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4615 staticpro (&dump_path
);
4617 staticpro (&read_objects
);
4618 read_objects
= Qnil
;
4619 staticpro (&seen_list
);
4622 Vloads_in_progress
= Qnil
;
4623 staticpro (&Vloads_in_progress
);
4625 DEFSYM (Qhash_table
, "hash-table");
4626 DEFSYM (Qdata
, "data");
4627 DEFSYM (Qtest
, "test");
4628 DEFSYM (Qsize
, "size");
4629 DEFSYM (Qweakness
, "weakness");
4630 DEFSYM (Qrehash_size
, "rehash-size");
4631 DEFSYM (Qrehash_threshold
, "rehash-threshold");