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 if (SCHARS (filename
) > 2
1499 && SREF (filename
, 0) == '/'
1500 && SREF (filename
, 1) == ':')
1502 fnlen
= SBYTES (filename
) - 2;
1503 strncpy (fn
, SSDATA (filename
) + 2, fnlen
);
1508 fnlen
= SBYTES (filename
);
1509 strncpy (fn
, SSDATA (filename
), fnlen
);
1513 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1515 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1518 /* Check that the file exists and is not a directory. */
1519 /* We used to only check for handlers on non-absolute file names:
1523 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1524 It's not clear why that was the case and it breaks things like
1525 (load "/bar.el") where the file is actually "/bar.el.gz". */
1526 string
= make_string (fn
, fnlen
);
1527 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1528 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1530 if (NILP (predicate
))
1531 exists
= !NILP (Ffile_readable_p (string
));
1534 Lisp_Object tmp
= call1 (predicate
, string
);
1535 exists
= !NILP (tmp
)
1536 && (EQ (tmp
, Qdir_ok
)
1537 || NILP (Ffile_directory_p (string
)));
1542 /* We succeeded; return this descriptor and filename. */
1553 encoded_fn
= ENCODE_FILE (string
);
1554 pfn
= SSDATA (encoded_fn
);
1555 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1558 /* Check that we can access or open it. */
1559 if (NATNUMP (predicate
))
1560 fd
= (((XFASTINT (predicate
) & ~INT_MAX
) == 0
1561 && access (pfn
, XFASTINT (predicate
)) == 0)
1564 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1568 /* We succeeded; return this descriptor and filename. */
1586 /* Merge the list we've accumulated of globals from the current input source
1587 into the load_history variable. The details depend on whether
1588 the source has an associated file name or not.
1590 FILENAME is the file name that we are loading from.
1591 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1594 build_load_history (Lisp_Object filename
, int entire
)
1596 register Lisp_Object tail
, prev
, newelt
;
1597 register Lisp_Object tem
, tem2
;
1598 register int foundit
= 0;
1600 tail
= Vload_history
;
1603 while (CONSP (tail
))
1607 /* Find the feature's previous assoc list... */
1608 if (!NILP (Fequal (filename
, Fcar (tem
))))
1612 /* If we're loading the entire file, remove old data. */
1616 Vload_history
= XCDR (tail
);
1618 Fsetcdr (prev
, XCDR (tail
));
1621 /* Otherwise, cons on new symbols that are not already members. */
1624 tem2
= Vcurrent_load_list
;
1626 while (CONSP (tem2
))
1628 newelt
= XCAR (tem2
);
1630 if (NILP (Fmember (newelt
, tem
)))
1631 Fsetcar (tail
, Fcons (XCAR (tem
),
1632 Fcons (newelt
, XCDR (tem
))));
1645 /* If we're loading an entire file, cons the new assoc onto the
1646 front of load-history, the most-recently-loaded position. Also
1647 do this if we didn't find an existing member for the file. */
1648 if (entire
|| !foundit
)
1649 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1654 readevalloop_1 (Lisp_Object old
)
1656 load_convert_to_unibyte
= ! NILP (old
);
1660 /* Signal an `end-of-file' error, if possible with file name
1663 static _Noreturn
void
1664 end_of_file_error (void)
1666 if (STRINGP (Vload_file_name
))
1667 xsignal1 (Qend_of_file
, Vload_file_name
);
1669 xsignal0 (Qend_of_file
);
1672 /* UNIBYTE specifies how to set load_convert_to_unibyte
1673 for this invocation.
1674 READFUN, if non-nil, is used instead of `read'.
1676 START, END specify region to read in current buffer (from eval-region).
1677 If the input is not from a buffer, they must be nil. */
1680 readevalloop (Lisp_Object readcharfun
,
1682 Lisp_Object sourcename
,
1684 Lisp_Object unibyte
, Lisp_Object readfun
,
1685 Lisp_Object start
, Lisp_Object end
)
1688 register Lisp_Object val
;
1689 ptrdiff_t count
= SPECPDL_INDEX ();
1690 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1691 struct buffer
*b
= 0;
1692 int continue_reading_p
;
1693 Lisp_Object lex_bound
;
1694 /* Nonzero if reading an entire buffer. */
1695 int whole_buffer
= 0;
1696 /* 1 on the first time around. */
1699 if (MARKERP (readcharfun
))
1702 start
= readcharfun
;
1705 if (BUFFERP (readcharfun
))
1706 b
= XBUFFER (readcharfun
);
1707 else if (MARKERP (readcharfun
))
1708 b
= XMARKER (readcharfun
)->buffer
;
1710 /* We assume START is nil when input is not from a buffer. */
1711 if (! NILP (start
) && !b
)
1714 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1715 specbind (Qcurrent_load_list
, Qnil
);
1716 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1717 load_convert_to_unibyte
= !NILP (unibyte
);
1719 /* If lexical binding is active (either because it was specified in
1720 the file's header, or via a buffer-local variable), create an empty
1721 lexical environment, otherwise, turn off lexical binding. */
1722 lex_bound
= find_symbol_value (Qlexical_binding
);
1723 specbind (Qinternal_interpreter_environment
,
1724 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1725 ? Qnil
: Fcons (Qt
, Qnil
));
1727 GCPRO4 (sourcename
, readfun
, start
, end
);
1729 /* Try to ensure sourcename is a truename, except whilst preloading. */
1730 if (NILP (Vpurify_flag
)
1731 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1732 && !NILP (Ffboundp (Qfile_truename
)))
1733 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1735 LOADHIST_ATTACH (sourcename
);
1737 continue_reading_p
= 1;
1738 while (continue_reading_p
)
1740 ptrdiff_t count1
= SPECPDL_INDEX ();
1742 if (b
!= 0 && NILP (BVAR (b
, name
)))
1743 error ("Reading from killed buffer");
1747 /* Switch to the buffer we are reading from. */
1748 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1749 set_buffer_internal (b
);
1751 /* Save point in it. */
1752 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1753 /* Save ZV in it. */
1754 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1755 /* Those get unbound after we read one expression. */
1757 /* Set point and ZV around stuff to be read. */
1760 Fnarrow_to_region (make_number (BEGV
), end
);
1762 /* Just for cleanliness, convert END to a marker
1763 if it is an integer. */
1765 end
= Fpoint_max_marker ();
1768 /* On the first cycle, we can easily test here
1769 whether we are reading the whole buffer. */
1770 if (b
&& first_sexp
)
1771 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1778 while ((c
= READCHAR
) != '\n' && c
!= -1);
1783 unbind_to (count1
, Qnil
);
1787 /* Ignore whitespace here, so we can detect eof. */
1788 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1789 || c
== 0xa0) /* NBSP */
1792 if (!NILP (Vpurify_flag
) && c
== '(')
1794 val
= read_list (0, readcharfun
);
1799 read_objects
= Qnil
;
1800 if (!NILP (readfun
))
1802 val
= call1 (readfun
, readcharfun
);
1804 /* If READCHARFUN has set point to ZV, we should
1805 stop reading, even if the form read sets point
1806 to a different value when evaluated. */
1807 if (BUFFERP (readcharfun
))
1809 struct buffer
*buf
= XBUFFER (readcharfun
);
1810 if (BUF_PT (buf
) == BUF_ZV (buf
))
1811 continue_reading_p
= 0;
1814 else if (! NILP (Vload_read_function
))
1815 val
= call1 (Vload_read_function
, readcharfun
);
1817 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1820 if (!NILP (start
) && continue_reading_p
)
1821 start
= Fpoint_marker ();
1823 /* Restore saved point and BEGV. */
1824 unbind_to (count1
, Qnil
);
1826 /* Now eval what we just read. */
1827 val
= eval_sub (val
);
1831 Vvalues
= Fcons (val
, Vvalues
);
1832 if (EQ (Vstandard_output
, Qt
))
1841 build_load_history (sourcename
,
1842 stream
|| whole_buffer
);
1846 unbind_to (count
, Qnil
);
1849 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1850 doc
: /* Execute the current buffer as Lisp code.
1851 When called from a Lisp program (i.e., not interactively), this
1852 function accepts up to five optional arguments:
1853 BUFFER is the buffer to evaluate (nil means use current buffer).
1854 PRINTFLAG controls printing of output:
1855 A value of nil means discard it; anything else is stream for print.
1856 FILENAME specifies the file name to use for `load-history'.
1857 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1859 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1860 functions should work normally even if PRINTFLAG is nil.
1862 This function preserves the position of point. */)
1863 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1865 ptrdiff_t count
= SPECPDL_INDEX ();
1866 Lisp_Object tem
, buf
;
1869 buf
= Fcurrent_buffer ();
1871 buf
= Fget_buffer (buffer
);
1873 error ("No such buffer");
1875 if (NILP (printflag
) && NILP (do_allow_print
))
1880 if (NILP (filename
))
1881 filename
= BVAR (XBUFFER (buf
), filename
);
1883 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1884 specbind (Qstandard_output
, tem
);
1885 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1886 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1887 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1888 readevalloop (buf
, 0, filename
,
1889 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1890 unbind_to (count
, Qnil
);
1895 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1896 doc
: /* Execute the region as Lisp code.
1897 When called from programs, expects two arguments,
1898 giving starting and ending indices in the current buffer
1899 of the text to be executed.
1900 Programs can pass third argument PRINTFLAG which controls output:
1901 A value of nil means discard it; anything else is stream for printing it.
1902 Also the fourth argument READ-FUNCTION, if non-nil, is used
1903 instead of `read' to read each expression. It gets one argument
1904 which is the input stream for reading characters.
1906 This function does not move point. */)
1907 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1909 /* FIXME: Do the eval-sexp-add-defvars dance! */
1910 ptrdiff_t count
= SPECPDL_INDEX ();
1911 Lisp_Object tem
, cbuf
;
1913 cbuf
= Fcurrent_buffer ();
1915 if (NILP (printflag
))
1919 specbind (Qstandard_output
, tem
);
1920 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1922 /* `readevalloop' calls functions which check the type of start and end. */
1923 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1924 !NILP (printflag
), Qnil
, read_function
,
1927 return unbind_to (count
, Qnil
);
1931 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1932 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1933 If STREAM is nil, use the value of `standard-input' (which see).
1934 STREAM or the value of `standard-input' may be:
1935 a buffer (read from point and advance it)
1936 a marker (read from where it points and advance it)
1937 a function (call it with no arguments for each character,
1938 call it with a char as argument to push a char back)
1939 a string (takes text from string, starting at the beginning)
1940 t (read text line using minibuffer and use it, or read from
1941 standard input in batch mode). */)
1942 (Lisp_Object stream
)
1945 stream
= Vstandard_input
;
1946 if (EQ (stream
, Qt
))
1947 stream
= Qread_char
;
1948 if (EQ (stream
, Qread_char
))
1949 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1951 return read_internal_start (stream
, Qnil
, Qnil
);
1954 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1955 doc
: /* Read one Lisp expression which is represented as text by STRING.
1956 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1957 FINAL-STRING-INDEX is an integer giving the position of the next
1958 remaining character in STRING.
1959 START and END optionally delimit a substring of STRING from which to read;
1960 they default to 0 and (length STRING) respectively. */)
1961 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1964 CHECK_STRING (string
);
1965 /* `read_internal_start' sets `read_from_string_index'. */
1966 ret
= read_internal_start (string
, start
, end
);
1967 return Fcons (ret
, make_number (read_from_string_index
));
1970 /* Function to set up the global context we need in toplevel read
1973 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1974 /* `start', `end' only used when stream is a string. */
1979 new_backquote_flag
= 0;
1980 read_objects
= Qnil
;
1981 if (EQ (Vread_with_symbol_positions
, Qt
)
1982 || EQ (Vread_with_symbol_positions
, stream
))
1983 Vread_symbol_positions_list
= Qnil
;
1985 if (STRINGP (stream
)
1986 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1988 ptrdiff_t startval
, endval
;
1991 if (STRINGP (stream
))
1994 string
= XCAR (stream
);
1997 endval
= SCHARS (string
);
2001 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2002 args_out_of_range (string
, end
);
2003 endval
= XINT (end
);
2010 CHECK_NUMBER (start
);
2011 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2012 args_out_of_range (string
, start
);
2013 startval
= XINT (start
);
2015 read_from_string_index
= startval
;
2016 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2017 read_from_string_limit
= endval
;
2020 retval
= read0 (stream
);
2021 if (EQ (Vread_with_symbol_positions
, Qt
)
2022 || EQ (Vread_with_symbol_positions
, stream
))
2023 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2028 /* Signal Qinvalid_read_syntax error.
2029 S is error string of length N (if > 0) */
2031 static _Noreturn
void
2032 invalid_syntax (const char *s
)
2034 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2038 /* Use this for recursive reads, in contexts where internal tokens
2042 read0 (Lisp_Object readcharfun
)
2044 register Lisp_Object val
;
2047 val
= read1 (readcharfun
, &c
, 0);
2051 xsignal1 (Qinvalid_read_syntax
,
2052 Fmake_string (make_number (1), make_number (c
)));
2055 static ptrdiff_t read_buffer_size
;
2056 static char *read_buffer
;
2058 /* Read a \-escape sequence, assuming we already read the `\'.
2059 If the escape sequence forces unibyte, return eight-bit char. */
2062 read_escape (Lisp_Object readcharfun
, int stringp
)
2064 register int c
= READCHAR
;
2065 /* \u allows up to four hex digits, \U up to eight. Default to the
2066 behavior for \u, and change this value in the case that \U is seen. */
2067 int unicode_hex_count
= 4;
2072 end_of_file_error ();
2102 error ("Invalid escape character syntax");
2105 c
= read_escape (readcharfun
, 0);
2106 return c
| meta_modifier
;
2111 error ("Invalid escape character syntax");
2114 c
= read_escape (readcharfun
, 0);
2115 return c
| shift_modifier
;
2120 error ("Invalid escape character syntax");
2123 c
= read_escape (readcharfun
, 0);
2124 return c
| hyper_modifier
;
2129 error ("Invalid escape character syntax");
2132 c
= read_escape (readcharfun
, 0);
2133 return c
| alt_modifier
;
2137 if (stringp
|| c
!= '-')
2144 c
= read_escape (readcharfun
, 0);
2145 return c
| super_modifier
;
2150 error ("Invalid escape character syntax");
2154 c
= read_escape (readcharfun
, 0);
2155 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2156 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2157 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2158 return c
| ctrl_modifier
;
2159 /* ASCII control chars are made from letters (both cases),
2160 as well as the non-letters within 0100...0137. */
2161 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2162 return (c
& (037 | ~0177));
2163 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2164 return (c
& (037 | ~0177));
2166 return c
| ctrl_modifier
;
2176 /* An octal escape, as in ANSI C. */
2178 register int i
= c
- '0';
2179 register int count
= 0;
2182 if ((c
= READCHAR
) >= '0' && c
<= '7')
2194 if (i
>= 0x80 && i
< 0x100)
2195 i
= BYTE8_TO_CHAR (i
);
2200 /* A hex escape, as in ANSI C. */
2207 if (c
>= '0' && c
<= '9')
2212 else if ((c
>= 'a' && c
<= 'f')
2213 || (c
>= 'A' && c
<= 'F'))
2216 if (c
>= 'a' && c
<= 'f')
2226 /* Allow hex escapes as large as ?\xfffffff, because some
2227 packages use them to denote characters with modifiers. */
2228 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2229 error ("Hex character out of range: \\x%x...", i
);
2233 if (count
< 3 && i
>= 0x80)
2234 return BYTE8_TO_CHAR (i
);
2239 /* Post-Unicode-2.0: Up to eight hex chars. */
2240 unicode_hex_count
= 8;
2243 /* A Unicode escape. We only permit them in strings and characters,
2244 not arbitrarily in the source code, as in some other languages. */
2249 while (++count
<= unicode_hex_count
)
2252 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2254 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2255 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2256 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2258 error ("Non-hex digit used for Unicode escape");
2261 error ("Non-Unicode character: 0x%x", i
);
2270 /* Return the digit that CHARACTER stands for in the given BASE.
2271 Return -1 if CHARACTER is out of range for BASE,
2272 and -2 if CHARACTER is not valid for any supported BASE. */
2274 digit_to_number (int character
, int base
)
2278 if ('0' <= character
&& character
<= '9')
2279 digit
= character
- '0';
2280 else if ('a' <= character
&& character
<= 'z')
2281 digit
= character
- 'a' + 10;
2282 else if ('A' <= character
&& character
<= 'Z')
2283 digit
= character
- 'A' + 10;
2287 return digit
< base
? digit
: -1;
2290 /* Read an integer in radix RADIX using READCHARFUN to read
2291 characters. RADIX must be in the interval [2..36]; if it isn't, a
2292 read error is signaled . Value is the integer read. Signals an
2293 error if encountering invalid read syntax or if RADIX is out of
2297 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2299 /* Room for sign, leading 0, other digits, trailing null byte.
2300 Also, room for invalid syntax diagnostic. */
2301 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2302 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2304 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2306 if (radix
< 2 || radix
> 36)
2314 if (c
== '-' || c
== '+')
2325 /* Ignore redundant leading zeros, so the buffer doesn't
2326 fill up with them. */
2332 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2339 if (p
< buf
+ sizeof buf
- 1)
2353 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2354 invalid_syntax (buf
);
2357 return string_to_number (buf
, radix
, 0);
2361 /* If the next token is ')' or ']' or '.', we store that character
2362 in *PCH and the return value is not interesting. Else, we store
2363 zero in *PCH and we read and return one lisp object.
2365 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2368 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2371 unsigned uninterned_symbol
= 0;
2379 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2381 end_of_file_error ();
2386 return read_list (0, readcharfun
);
2389 return read_vector (readcharfun
, 0);
2405 /* Accept extended format for hashtables (extensible to
2407 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2408 Lisp_Object tmp
= read_list (0, readcharfun
);
2409 Lisp_Object head
= CAR_SAFE (tmp
);
2410 Lisp_Object data
= Qnil
;
2411 Lisp_Object val
= Qnil
;
2412 /* The size is 2 * number of allowed keywords to
2414 Lisp_Object params
[10];
2416 Lisp_Object key
= Qnil
;
2417 int param_count
= 0;
2419 if (!EQ (head
, Qhash_table
))
2420 error ("Invalid extended read marker at head of #s list "
2421 "(only hash-table allowed)");
2423 tmp
= CDR_SAFE (tmp
);
2425 /* This is repetitive but fast and simple. */
2426 params
[param_count
] = QCsize
;
2427 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2428 if (!NILP (params
[param_count
+ 1]))
2431 params
[param_count
] = QCtest
;
2432 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2433 if (!NILP (params
[param_count
+ 1]))
2436 params
[param_count
] = QCweakness
;
2437 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2438 if (!NILP (params
[param_count
+ 1]))
2441 params
[param_count
] = QCrehash_size
;
2442 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2443 if (!NILP (params
[param_count
+ 1]))
2446 params
[param_count
] = QCrehash_threshold
;
2447 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2448 if (!NILP (params
[param_count
+ 1]))
2451 /* This is the hashtable data. */
2452 data
= Fplist_get (tmp
, Qdata
);
2454 /* Now use params to make a new hashtable and fill it. */
2455 ht
= Fmake_hash_table (param_count
, params
);
2457 while (CONSP (data
))
2462 error ("Odd number of elements in hashtable data");
2465 Fputhash (key
, val
, ht
);
2471 invalid_syntax ("#");
2479 tmp
= read_vector (readcharfun
, 0);
2480 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2481 error ("Invalid size char-table");
2482 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2494 tmp
= read_vector (readcharfun
, 0);
2497 error ("Invalid size char-table");
2498 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2499 error ("Invalid depth in char-table");
2500 depth
= XINT (AREF (tmp
, 0));
2501 if (chartab_size
[depth
] != size
- 2)
2502 error ("Invalid size char-table");
2503 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2506 invalid_syntax ("#^^");
2508 invalid_syntax ("#^");
2513 length
= read1 (readcharfun
, pch
, first_in_list
);
2517 Lisp_Object tmp
, val
;
2518 EMACS_INT size_in_chars
2519 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2520 / BOOL_VECTOR_BITS_PER_CHAR
);
2523 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2524 if (STRING_MULTIBYTE (tmp
)
2525 || (size_in_chars
!= SCHARS (tmp
)
2526 /* We used to print 1 char too many
2527 when the number of bits was a multiple of 8.
2528 Accept such input in case it came from an old
2530 && ! (XFASTINT (length
)
2531 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2532 invalid_syntax ("#&...");
2534 val
= Fmake_bool_vector (length
, Qnil
);
2535 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2536 /* Clear the extraneous bits in the last byte. */
2537 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2538 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2539 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2542 invalid_syntax ("#&...");
2546 /* Accept compiled functions at read-time so that we don't have to
2547 build them using function calls. */
2549 tmp
= read_vector (readcharfun
, 1);
2550 make_byte_code (XVECTOR (tmp
));
2556 struct gcpro gcpro1
;
2559 /* Read the string itself. */
2560 tmp
= read1 (readcharfun
, &ch
, 0);
2561 if (ch
!= 0 || !STRINGP (tmp
))
2562 invalid_syntax ("#");
2564 /* Read the intervals and their properties. */
2567 Lisp_Object beg
, end
, plist
;
2569 beg
= read1 (readcharfun
, &ch
, 0);
2574 end
= read1 (readcharfun
, &ch
, 0);
2576 plist
= read1 (readcharfun
, &ch
, 0);
2578 invalid_syntax ("Invalid string property list");
2579 Fset_text_properties (beg
, end
, plist
, tmp
);
2585 /* #@NUMBER is used to skip NUMBER following characters.
2586 That's used in .elc files to skip over doc strings
2587 and function definitions. */
2590 enum { extra
= 100 };
2591 ptrdiff_t i
, nskip
= 0;
2594 /* Read a decimal integer. */
2595 while ((c
= READCHAR
) >= 0
2596 && c
>= '0' && c
<= '9')
2598 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2605 if (load_force_doc_strings
2606 && (EQ (readcharfun
, Qget_file_char
)
2607 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2609 /* If we are supposed to force doc strings into core right now,
2610 record the last string that we skipped,
2611 and record where in the file it comes from. */
2613 /* But first exchange saved_doc_string
2614 with prev_saved_doc_string, so we save two strings. */
2616 char *temp
= saved_doc_string
;
2617 ptrdiff_t temp_size
= saved_doc_string_size
;
2618 file_offset temp_pos
= saved_doc_string_position
;
2619 ptrdiff_t temp_len
= saved_doc_string_length
;
2621 saved_doc_string
= prev_saved_doc_string
;
2622 saved_doc_string_size
= prev_saved_doc_string_size
;
2623 saved_doc_string_position
= prev_saved_doc_string_position
;
2624 saved_doc_string_length
= prev_saved_doc_string_length
;
2626 prev_saved_doc_string
= temp
;
2627 prev_saved_doc_string_size
= temp_size
;
2628 prev_saved_doc_string_position
= temp_pos
;
2629 prev_saved_doc_string_length
= temp_len
;
2632 if (saved_doc_string_size
== 0)
2634 saved_doc_string
= xmalloc (nskip
+ extra
);
2635 saved_doc_string_size
= nskip
+ extra
;
2637 if (nskip
> saved_doc_string_size
)
2639 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2640 saved_doc_string_size
= nskip
+ extra
;
2643 saved_doc_string_position
= file_tell (instream
);
2645 /* Copy that many characters into saved_doc_string. */
2646 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2647 saved_doc_string
[i
] = c
= READCHAR
;
2649 saved_doc_string_length
= i
;
2653 /* Skip that many characters. */
2654 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2663 /* #! appears at the beginning of an executable file.
2664 Skip the first line. */
2665 while (c
!= '\n' && c
>= 0)
2670 return Vload_file_name
;
2672 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2673 /* #:foo is the uninterned symbol named foo. */
2676 uninterned_symbol
= 1;
2679 && c
!= 0xa0 /* NBSP */
2681 || strchr ("\"';()[]#`,", c
) == NULL
)))
2683 /* No symbol character follows, this is the empty
2686 return Fmake_symbol (build_string (""));
2690 /* ## is the empty symbol. */
2692 return Fintern (build_string (""), Qnil
);
2693 /* Reader forms that can reuse previously read objects. */
2694 if (c
>= '0' && c
<= '9')
2699 /* Read a non-negative integer. */
2700 while (c
>= '0' && c
<= '9')
2702 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2703 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2704 n
= MOST_POSITIVE_FIXNUM
+ 1;
2706 n
= n
* 10 + c
- '0';
2710 if (n
<= MOST_POSITIVE_FIXNUM
)
2712 if (c
== 'r' || c
== 'R')
2713 return read_integer (readcharfun
, n
);
2715 if (! NILP (Vread_circle
))
2717 /* #n=object returns object, but associates it with
2721 /* Make a placeholder for #n# to use temporarily. */
2722 Lisp_Object placeholder
;
2725 placeholder
= Fcons (Qnil
, Qnil
);
2726 cell
= Fcons (make_number (n
), placeholder
);
2727 read_objects
= Fcons (cell
, read_objects
);
2729 /* Read the object itself. */
2730 tem
= read0 (readcharfun
);
2732 /* Now put it everywhere the placeholder was... */
2733 substitute_object_in_subtree (tem
, placeholder
);
2735 /* ...and #n# will use the real value from now on. */
2736 Fsetcdr (cell
, tem
);
2741 /* #n# returns a previously read object. */
2744 tem
= Fassq (make_number (n
), read_objects
);
2750 /* Fall through to error message. */
2752 else if (c
== 'x' || c
== 'X')
2753 return read_integer (readcharfun
, 16);
2754 else if (c
== 'o' || c
== 'O')
2755 return read_integer (readcharfun
, 8);
2756 else if (c
== 'b' || c
== 'B')
2757 return read_integer (readcharfun
, 2);
2760 invalid_syntax ("#");
2763 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2768 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2773 int next_char
= READCHAR
;
2775 /* Transition from old-style to new-style:
2776 If we see "(`" it used to mean old-style, which usually works
2777 fine because ` should almost never appear in such a position
2778 for new-style. But occasionally we need "(`" to mean new
2779 style, so we try to distinguish the two by the fact that we
2780 can either write "( `foo" or "(` foo", where the first
2781 intends to use new-style whereas the second intends to use
2782 old-style. For Emacs-25, we should completely remove this
2783 first_in_list exception (old-style can still be obtained via
2785 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2787 Vold_style_backquotes
= Qt
;
2794 new_backquote_flag
++;
2795 value
= read0 (readcharfun
);
2796 new_backquote_flag
--;
2798 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2803 int next_char
= READCHAR
;
2805 /* Transition from old-style to new-style:
2806 It used to be impossible to have a new-style , other than within
2807 a new-style `. This is sufficient when ` and , are used in the
2808 normal way, but ` and , can also appear in args to macros that
2809 will not interpret them in the usual way, in which case , may be
2810 used without any ` anywhere near.
2811 So we now use the same heuristic as for backquote: old-style
2812 unquotes are only recognized when first on a list, and when
2813 followed by a space.
2814 Because it's more difficult to peek 2 chars ahead, a new-style
2815 ,@ can still not be used outside of a `, unless it's in the middle
2817 if (new_backquote_flag
2819 || (next_char
!= ' ' && next_char
!= '@'))
2821 Lisp_Object comma_type
= Qnil
;
2826 comma_type
= Qcomma_at
;
2828 comma_type
= Qcomma_dot
;
2831 if (ch
>= 0) UNREAD (ch
);
2832 comma_type
= Qcomma
;
2835 value
= read0 (readcharfun
);
2836 return Fcons (comma_type
, Fcons (value
, Qnil
));
2840 Vold_style_backquotes
= Qt
;
2852 end_of_file_error ();
2854 /* Accept `single space' syntax like (list ? x) where the
2855 whitespace character is SPC or TAB.
2856 Other literal whitespace like NL, CR, and FF are not accepted,
2857 as there are well-established escape sequences for these. */
2858 if (c
== ' ' || c
== '\t')
2859 return make_number (c
);
2862 c
= read_escape (readcharfun
, 0);
2863 modifiers
= c
& CHAR_MODIFIER_MASK
;
2864 c
&= ~CHAR_MODIFIER_MASK
;
2865 if (CHAR_BYTE8_P (c
))
2866 c
= CHAR_TO_BYTE8 (c
);
2869 next_char
= READCHAR
;
2870 ok
= (next_char
<= 040
2871 || (next_char
< 0200
2872 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2875 return make_number (c
);
2877 invalid_syntax ("?");
2882 char *p
= read_buffer
;
2883 char *end
= read_buffer
+ read_buffer_size
;
2885 /* Nonzero if we saw an escape sequence specifying
2886 a multibyte character. */
2887 int force_multibyte
= 0;
2888 /* Nonzero if we saw an escape sequence specifying
2889 a single-byte character. */
2890 int force_singlebyte
= 0;
2892 ptrdiff_t nchars
= 0;
2894 while ((ch
= READCHAR
) >= 0
2897 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2899 ptrdiff_t offset
= p
- read_buffer
;
2900 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2901 memory_full (SIZE_MAX
);
2902 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
2903 read_buffer_size
*= 2;
2904 p
= read_buffer
+ offset
;
2905 end
= read_buffer
+ read_buffer_size
;
2912 ch
= read_escape (readcharfun
, 1);
2914 /* CH is -1 if \ newline has just been seen. */
2917 if (p
== read_buffer
)
2922 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2923 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2925 if (CHAR_BYTE8_P (ch
))
2926 force_singlebyte
= 1;
2927 else if (! ASCII_CHAR_P (ch
))
2928 force_multibyte
= 1;
2929 else /* I.e. ASCII_CHAR_P (ch). */
2931 /* Allow `\C- ' and `\C-?'. */
2932 if (modifiers
== CHAR_CTL
)
2935 ch
= 0, modifiers
= 0;
2937 ch
= 127, modifiers
= 0;
2939 if (modifiers
& CHAR_SHIFT
)
2941 /* Shift modifier is valid only with [A-Za-z]. */
2942 if (ch
>= 'A' && ch
<= 'Z')
2943 modifiers
&= ~CHAR_SHIFT
;
2944 else if (ch
>= 'a' && ch
<= 'z')
2945 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2948 if (modifiers
& CHAR_META
)
2950 /* Move the meta bit to the right place for a
2952 modifiers
&= ~CHAR_META
;
2953 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2954 force_singlebyte
= 1;
2958 /* Any modifiers remaining are invalid. */
2960 error ("Invalid modifier in string");
2961 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2965 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2966 if (CHAR_BYTE8_P (ch
))
2967 force_singlebyte
= 1;
2968 else if (! ASCII_CHAR_P (ch
))
2969 force_multibyte
= 1;
2975 end_of_file_error ();
2977 /* If purifying, and string starts with \ newline,
2978 return zero instead. This is for doc strings
2979 that we are really going to find in etc/DOC.nn.nn. */
2980 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2981 return make_number (0);
2983 if (! force_multibyte
&& force_singlebyte
)
2985 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
2986 forms. Convert it to unibyte. */
2987 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
2989 p
= read_buffer
+ nchars
;
2992 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2994 || (p
- read_buffer
!= nchars
)));
2999 int next_char
= READCHAR
;
3002 if (next_char
<= 040
3003 || (next_char
< 0200
3004 && strchr ("\"';([#?`,", next_char
) != NULL
))
3010 /* Otherwise, we fall through! Note that the atom-reading loop
3011 below will now loop at least once, assuring that we will not
3012 try to UNREAD two characters in a row. */
3016 if (c
<= 040) goto retry
;
3017 if (c
== 0xa0) /* NBSP */
3022 char *p
= read_buffer
;
3024 EMACS_INT start_position
= readchar_count
- 1;
3027 char *end
= read_buffer
+ read_buffer_size
;
3031 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3033 ptrdiff_t offset
= p
- read_buffer
;
3034 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3035 memory_full (SIZE_MAX
);
3036 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3037 read_buffer_size
*= 2;
3038 p
= read_buffer
+ offset
;
3039 end
= read_buffer
+ read_buffer_size
;
3046 end_of_file_error ();
3051 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3057 && c
!= 0xa0 /* NBSP */
3059 || strchr ("\"';()[]#`,", c
) == NULL
));
3063 ptrdiff_t offset
= p
- read_buffer
;
3064 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3065 memory_full (SIZE_MAX
);
3066 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3067 read_buffer_size
*= 2;
3068 p
= read_buffer
+ offset
;
3069 end
= read_buffer
+ read_buffer_size
;
3075 if (!quoted
&& !uninterned_symbol
)
3077 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3078 if (! NILP (result
))
3082 Lisp_Object name
, result
;
3083 ptrdiff_t nbytes
= p
- read_buffer
;
3086 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3090 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3091 ? make_pure_string
: make_specified_string
)
3092 (read_buffer
, nchars
, nbytes
, multibyte
));
3093 result
= (uninterned_symbol
? Fmake_symbol (name
)
3094 : Fintern (name
, Qnil
));
3096 if (EQ (Vread_with_symbol_positions
, Qt
)
3097 || EQ (Vread_with_symbol_positions
, readcharfun
))
3098 Vread_symbol_positions_list
3099 = Fcons (Fcons (result
, make_number (start_position
)),
3100 Vread_symbol_positions_list
);
3108 /* List of nodes we've seen during substitute_object_in_subtree. */
3109 static Lisp_Object seen_list
;
3112 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3114 Lisp_Object check_object
;
3116 /* We haven't seen any objects when we start. */
3119 /* Make all the substitutions. */
3121 = substitute_object_recurse (object
, placeholder
, object
);
3123 /* Clear seen_list because we're done with it. */
3126 /* The returned object here is expected to always eq the
3128 if (!EQ (check_object
, object
))
3129 error ("Unexpected mutation error in reader");
3132 /* Feval doesn't get called from here, so no gc protection is needed. */
3133 #define SUBSTITUTE(get_val, set_val) \
3135 Lisp_Object old_value = get_val; \
3136 Lisp_Object true_value \
3137 = substitute_object_recurse (object, placeholder, \
3140 if (!EQ (old_value, true_value)) \
3147 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3149 /* If we find the placeholder, return the target object. */
3150 if (EQ (placeholder
, subtree
))
3153 /* If we've been to this node before, don't explore it again. */
3154 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3157 /* If this node can be the entry point to a cycle, remember that
3158 we've seen it. It can only be such an entry point if it was made
3159 by #n=, which means that we can find it as a value in
3161 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3162 seen_list
= Fcons (subtree
, seen_list
);
3164 /* Recurse according to subtree's type.
3165 Every branch must return a Lisp_Object. */
3166 switch (XTYPE (subtree
))
3168 case Lisp_Vectorlike
:
3170 ptrdiff_t i
, length
= 0;
3171 if (BOOL_VECTOR_P (subtree
))
3172 return subtree
; /* No sub-objects anyway. */
3173 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3174 || COMPILEDP (subtree
))
3175 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3176 else if (VECTORP (subtree
))
3177 length
= ASIZE (subtree
);
3179 /* An unknown pseudovector may contain non-Lisp fields, so we
3180 can't just blindly traverse all its fields. We used to call
3181 `Flength' which signaled `sequencep', so I just preserved this
3183 wrong_type_argument (Qsequencep
, subtree
);
3185 for (i
= 0; i
< length
; i
++)
3186 SUBSTITUTE (AREF (subtree
, i
),
3187 ASET (subtree
, i
, true_value
));
3193 SUBSTITUTE (XCAR (subtree
),
3194 XSETCAR (subtree
, true_value
));
3195 SUBSTITUTE (XCDR (subtree
),
3196 XSETCDR (subtree
, true_value
));
3202 /* Check for text properties in each interval.
3203 substitute_in_interval contains part of the logic. */
3205 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3206 Lisp_Object arg
= Fcons (object
, placeholder
);
3208 traverse_intervals_noorder (root_interval
,
3209 &substitute_in_interval
, arg
);
3214 /* Other types don't recurse any further. */
3220 /* Helper function for substitute_object_recurse. */
3222 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3224 Lisp_Object object
= Fcar (arg
);
3225 Lisp_Object placeholder
= Fcdr (arg
);
3227 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3237 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3238 integer syntax and fits in a fixnum, else return the nearest float if CP has
3239 either floating point or integer syntax and BASE is 10, else return nil. If
3240 IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
3241 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3242 number has integer syntax but does not fit. */
3245 string_to_number (char const *string
, int base
, int ignore_trailing
)
3248 char const *cp
= string
;
3250 int float_syntax
= 0;
3253 /* Compute NaN and infinities using a variable, to cope with compilers that
3254 think they are smarter than we are. */
3257 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3258 IEEE floating point hosts, and works around a formerly-common bug where
3259 atof ("-0.0") drops the sign. */
3260 int negative
= *cp
== '-';
3262 int signedp
= negative
|| *cp
== '+';
3267 leading_digit
= digit_to_number (*cp
, base
);
3268 if (0 <= leading_digit
)
3273 while (0 <= digit_to_number (*cp
, base
));
3283 if ('0' <= *cp
&& *cp
<= '9')
3288 while ('0' <= *cp
&& *cp
<= '9');
3290 if (*cp
== 'e' || *cp
== 'E')
3292 char const *ecp
= cp
;
3294 if (*cp
== '+' || *cp
== '-')
3296 if ('0' <= *cp
&& *cp
<= '9')
3301 while ('0' <= *cp
&& *cp
<= '9');
3303 else if (cp
[-1] == '+'
3304 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3310 else if (cp
[-1] == '+'
3311 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3315 value
= zero
/ zero
;
3317 /* If that made a "negative" NaN, negate it. */
3320 union { double d
; char c
[sizeof (double)]; }
3321 u_data
, u_minus_zero
;
3323 u_minus_zero
.d
= -0.0;
3324 for (i
= 0; i
< sizeof (double); i
++)
3325 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3331 /* Now VALUE is a positive NaN. */
3337 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3338 || state
== (LEAD_INT
|E_EXP
));
3341 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3342 any prefix that matches. Otherwise, the entire string must match. */
3343 if (! (ignore_trailing
3344 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3345 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3348 /* If the number uses integer and not float syntax, and is in C-language
3349 range, use its value, preferably as a fixnum. */
3350 if (0 <= leading_digit
&& ! float_syntax
)
3354 /* Fast special case for single-digit integers. This also avoids a
3355 glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
3356 case some versions of strtoumax accept numbers like "0x1" that Emacs
3358 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3359 return make_number (negative
? -leading_digit
: leading_digit
);
3362 n
= strtoumax (string
+ signedp
, NULL
, base
);
3363 if (errno
== ERANGE
)
3365 /* Unfortunately there's no simple and accurate way to convert
3366 non-base-10 numbers that are out of C-language range. */
3368 xsignal1 (Qoverflow_error
, build_string (string
));
3370 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3372 EMACS_INT signed_n
= n
;
3373 return make_number (negative
? -signed_n
: signed_n
);
3379 /* Either the number uses float syntax, or it does not fit into a fixnum.
3380 Convert it from string to floating point, unless the value is already
3381 known because it is an infinity, a NAN, or its absolute value fits in
3384 value
= atof (string
+ signedp
);
3386 return make_float (negative
? -value
: value
);
3391 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3394 register Lisp_Object
*ptr
;
3395 register Lisp_Object tem
, item
, vector
;
3396 register struct Lisp_Cons
*otem
;
3399 tem
= read_list (1, readcharfun
);
3400 len
= Flength (tem
);
3401 vector
= Fmake_vector (len
, Qnil
);
3403 size
= ASIZE (vector
);
3404 ptr
= XVECTOR (vector
)->contents
;
3405 for (i
= 0; i
< size
; i
++)
3408 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3409 bytecode object, the docstring containing the bytecode and
3410 constants values must be treated as unibyte and passed to
3411 Fread, to get the actual bytecode string and constants vector. */
3412 if (bytecodeflag
&& load_force_doc_strings
)
3414 if (i
== COMPILED_BYTECODE
)
3416 if (!STRINGP (item
))
3417 error ("Invalid byte code");
3419 /* Delay handling the bytecode slot until we know whether
3420 it is lazily-loaded (we can tell by whether the
3421 constants slot is nil). */
3422 ptr
[COMPILED_CONSTANTS
] = item
;
3425 else if (i
== COMPILED_CONSTANTS
)
3427 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3431 /* Coerce string to unibyte (like string-as-unibyte,
3432 but without generating extra garbage and
3433 guaranteeing no change in the contents). */
3434 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3435 STRING_SET_UNIBYTE (bytestr
);
3437 item
= Fread (Fcons (bytestr
, readcharfun
));
3439 error ("Invalid byte code");
3441 otem
= XCONS (item
);
3442 bytestr
= XCAR (item
);
3447 /* Now handle the bytecode slot. */
3448 ptr
[COMPILED_BYTECODE
] = bytestr
;
3450 else if (i
== COMPILED_DOC_STRING
3452 && ! STRING_MULTIBYTE (item
))
3454 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3455 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3457 item
= Fstring_as_multibyte (item
);
3468 /* FLAG = 1 means check for ] to terminate rather than ) and . */
3471 read_list (int flag
, register Lisp_Object readcharfun
)
3473 Lisp_Object val
, tail
;
3474 register Lisp_Object elt
, tem
;
3475 struct gcpro gcpro1
, gcpro2
;
3476 /* 0 is the normal case.
3477 1 means this list is a doc reference; replace it with the number 0.
3478 2 means this list is a doc reference; replace it with the doc string. */
3479 int doc_reference
= 0;
3481 /* Initialize this to 1 if we are reading a list. */
3482 int first_in_list
= flag
<= 0;
3491 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3496 /* While building, if the list starts with #$, treat it specially. */
3497 if (EQ (elt
, Vload_file_name
)
3499 && !NILP (Vpurify_flag
))
3501 if (NILP (Vdoc_file_name
))
3502 /* We have not yet called Snarf-documentation, so assume
3503 this file is described in the DOC-MM.NN file
3504 and Snarf-documentation will fill in the right value later.
3505 For now, replace the whole list with 0. */
3508 /* We have already called Snarf-documentation, so make a relative
3509 file name for this file, so it can be found properly
3510 in the installed Lisp directory.
3511 We don't use Fexpand_file_name because that would make
3512 the directory absolute now. */
3513 elt
= concat2 (build_string ("../lisp/"),
3514 Ffile_name_nondirectory (elt
));
3516 else if (EQ (elt
, Vload_file_name
)
3518 && load_force_doc_strings
)
3527 invalid_syntax (") or . in a vector");
3535 XSETCDR (tail
, read0 (readcharfun
));
3537 val
= read0 (readcharfun
);
3538 read1 (readcharfun
, &ch
, 0);
3542 if (doc_reference
== 1)
3543 return make_number (0);
3544 if (doc_reference
== 2)
3546 /* Get a doc string from the file we are loading.
3547 If it's in saved_doc_string, get it from there.
3549 Here, we don't know if the string is a
3550 bytecode string or a doc string. As a
3551 bytecode string must be unibyte, we always
3552 return a unibyte string. If it is actually a
3553 doc string, caller must make it
3556 EMACS_INT pos
= XINT (XCDR (val
));
3557 /* Position is negative for user variables. */
3558 if (pos
< 0) pos
= -pos
;
3559 if (pos
>= saved_doc_string_position
3560 && pos
< (saved_doc_string_position
3561 + saved_doc_string_length
))
3563 ptrdiff_t start
= pos
- saved_doc_string_position
;
3566 /* Process quoting with ^A,
3567 and find the end of the string,
3568 which is marked with ^_ (037). */
3569 for (from
= start
, to
= start
;
3570 saved_doc_string
[from
] != 037;)
3572 int c
= saved_doc_string
[from
++];
3575 c
= saved_doc_string
[from
++];
3577 saved_doc_string
[to
++] = c
;
3579 saved_doc_string
[to
++] = 0;
3581 saved_doc_string
[to
++] = 037;
3584 saved_doc_string
[to
++] = c
;
3587 return make_unibyte_string (saved_doc_string
+ start
,
3590 /* Look in prev_saved_doc_string the same way. */
3591 else if (pos
>= prev_saved_doc_string_position
3592 && pos
< (prev_saved_doc_string_position
3593 + prev_saved_doc_string_length
))
3596 pos
- prev_saved_doc_string_position
;
3599 /* Process quoting with ^A,
3600 and find the end of the string,
3601 which is marked with ^_ (037). */
3602 for (from
= start
, to
= start
;
3603 prev_saved_doc_string
[from
] != 037;)
3605 int c
= prev_saved_doc_string
[from
++];
3608 c
= prev_saved_doc_string
[from
++];
3610 prev_saved_doc_string
[to
++] = c
;
3612 prev_saved_doc_string
[to
++] = 0;
3614 prev_saved_doc_string
[to
++] = 037;
3617 prev_saved_doc_string
[to
++] = c
;
3620 return make_unibyte_string (prev_saved_doc_string
3625 return get_doc_string (val
, 1, 0);
3630 invalid_syntax (". in wrong context");
3632 invalid_syntax ("] in a list");
3634 tem
= Fcons (elt
, Qnil
);
3636 XSETCDR (tail
, tem
);
3643 static Lisp_Object initial_obarray
;
3645 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3647 static size_t oblookup_last_bucket_number
;
3649 /* Get an error if OBARRAY is not an obarray.
3650 If it is one, return it. */
3653 check_obarray (Lisp_Object obarray
)
3655 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3657 /* If Vobarray is now invalid, force it to be valid. */
3658 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3659 wrong_type_argument (Qvectorp
, obarray
);
3664 /* Intern the C string STR: return a symbol with that name,
3665 interned in the current obarray. */
3668 intern (const char *str
)
3671 ptrdiff_t len
= strlen (str
);
3672 Lisp_Object obarray
;
3675 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3676 obarray
= check_obarray (obarray
);
3677 tem
= oblookup (obarray
, str
, len
, len
);
3680 return Fintern (make_string (str
, len
), obarray
);
3684 intern_c_string (const char *str
)
3687 ptrdiff_t len
= strlen (str
);
3688 Lisp_Object obarray
;
3691 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3692 obarray
= check_obarray (obarray
);
3693 tem
= oblookup (obarray
, str
, len
, len
);
3697 if (NILP (Vpurify_flag
))
3698 /* Creating a non-pure string from a string literal not
3699 implemented yet. We could just use make_string here and live
3700 with the extra copy. */
3703 return Fintern (make_pure_c_string (str
, len
), obarray
);
3706 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3707 doc
: /* Return the canonical symbol whose name is STRING.
3708 If there is none, one is created by this function and returned.
3709 A second optional argument specifies the obarray to use;
3710 it defaults to the value of `obarray'. */)
3711 (Lisp_Object string
, Lisp_Object obarray
)
3713 register Lisp_Object tem
, sym
, *ptr
;
3715 if (NILP (obarray
)) obarray
= Vobarray
;
3716 obarray
= check_obarray (obarray
);
3718 CHECK_STRING (string
);
3720 tem
= oblookup (obarray
, SSDATA (string
),
3723 if (!INTEGERP (tem
))
3726 if (!NILP (Vpurify_flag
))
3727 string
= Fpurecopy (string
);
3728 sym
= Fmake_symbol (string
);
3730 if (EQ (obarray
, initial_obarray
))
3731 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3733 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3735 if ((SREF (string
, 0) == ':')
3736 && EQ (obarray
, initial_obarray
))
3738 XSYMBOL (sym
)->constant
= 1;
3739 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3740 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3743 ptr
= &AREF (obarray
, XINT(tem
));
3745 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3747 XSYMBOL (sym
)->next
= 0;
3752 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3753 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3754 NAME may be a string or a symbol. If it is a symbol, that exact
3755 symbol is searched for.
3756 A second optional argument specifies the obarray to use;
3757 it defaults to the value of `obarray'. */)
3758 (Lisp_Object name
, Lisp_Object obarray
)
3760 register Lisp_Object tem
, string
;
3762 if (NILP (obarray
)) obarray
= Vobarray
;
3763 obarray
= check_obarray (obarray
);
3765 if (!SYMBOLP (name
))
3767 CHECK_STRING (name
);
3771 string
= SYMBOL_NAME (name
);
3773 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3774 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3780 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3781 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3782 The value is t if a symbol was found and deleted, nil otherwise.
3783 NAME may be a string or a symbol. If it is a symbol, that symbol
3784 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3785 OBARRAY defaults to the value of the variable `obarray'. */)
3786 (Lisp_Object name
, Lisp_Object obarray
)
3788 register Lisp_Object string
, tem
;
3791 if (NILP (obarray
)) obarray
= Vobarray
;
3792 obarray
= check_obarray (obarray
);
3795 string
= SYMBOL_NAME (name
);
3798 CHECK_STRING (name
);
3802 tem
= oblookup (obarray
, SSDATA (string
),
3807 /* If arg was a symbol, don't delete anything but that symbol itself. */
3808 if (SYMBOLP (name
) && !EQ (name
, tem
))
3811 /* There are plenty of other symbols which will screw up the Emacs
3812 session if we unintern them, as well as even more ways to use
3813 `setq' or `fset' or whatnot to make the Emacs session
3814 unusable. Let's not go down this silly road. --Stef */
3815 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3816 error ("Attempt to unintern t or nil"); */
3818 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3820 hash
= oblookup_last_bucket_number
;
3822 if (EQ (AREF (obarray
, hash
), tem
))
3824 if (XSYMBOL (tem
)->next
)
3825 XSETSYMBOL (AREF (obarray
, hash
), XSYMBOL (tem
)->next
);
3827 XSETINT (AREF (obarray
, hash
), 0);
3831 Lisp_Object tail
, following
;
3833 for (tail
= AREF (obarray
, hash
);
3834 XSYMBOL (tail
)->next
;
3837 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3838 if (EQ (following
, tem
))
3840 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3849 /* Return the symbol in OBARRAY whose names matches the string
3850 of SIZE characters (SIZE_BYTE bytes) at PTR.
3851 If there is no such symbol in OBARRAY, return nil.
3853 Also store the bucket number in oblookup_last_bucket_number. */
3856 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3860 register Lisp_Object tail
;
3861 Lisp_Object bucket
, tem
;
3863 if (!VECTORP (obarray
)
3864 || (obsize
= ASIZE (obarray
)) == 0)
3866 obarray
= check_obarray (obarray
);
3867 obsize
= ASIZE (obarray
);
3869 /* This is sometimes needed in the middle of GC. */
3870 obsize
&= ~ARRAY_MARK_FLAG
;
3871 hash
= hash_string (ptr
, size_byte
) % obsize
;
3872 bucket
= AREF (obarray
, hash
);
3873 oblookup_last_bucket_number
= hash
;
3874 if (EQ (bucket
, make_number (0)))
3876 else if (!SYMBOLP (bucket
))
3877 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3879 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3881 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3882 && SCHARS (SYMBOL_NAME (tail
)) == size
3883 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3885 else if (XSYMBOL (tail
)->next
== 0)
3888 XSETINT (tem
, hash
);
3893 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3896 register Lisp_Object tail
;
3897 CHECK_VECTOR (obarray
);
3898 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3900 tail
= AREF (obarray
, i
);
3905 if (XSYMBOL (tail
)->next
== 0)
3907 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3913 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3915 call1 (function
, sym
);
3918 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3919 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3920 OBARRAY defaults to the value of `obarray'. */)
3921 (Lisp_Object function
, Lisp_Object obarray
)
3923 if (NILP (obarray
)) obarray
= Vobarray
;
3924 obarray
= check_obarray (obarray
);
3926 map_obarray (obarray
, mapatoms_1
, function
);
3930 #define OBARRAY_SIZE 1511
3935 Lisp_Object oblength
;
3936 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3938 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3940 Vobarray
= Fmake_vector (oblength
, make_number (0));
3941 initial_obarray
= Vobarray
;
3942 staticpro (&initial_obarray
);
3944 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
3945 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3946 NILP (Vpurify_flag) check in intern_c_string. */
3947 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3948 Qnil
= intern_c_string ("nil");
3950 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3951 so those two need to be fixed manually. */
3952 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3953 XSYMBOL (Qunbound
)->function
= Qunbound
;
3954 XSYMBOL (Qunbound
)->plist
= Qnil
;
3955 /* XSYMBOL (Qnil)->function = Qunbound; */
3956 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3957 XSYMBOL (Qnil
)->constant
= 1;
3958 XSYMBOL (Qnil
)->declared_special
= 1;
3959 XSYMBOL (Qnil
)->plist
= Qnil
;
3961 Qt
= intern_c_string ("t");
3962 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3963 XSYMBOL (Qnil
)->declared_special
= 1;
3964 XSYMBOL (Qt
)->constant
= 1;
3966 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3969 DEFSYM (Qvariable_documentation
, "variable-documentation");
3971 read_buffer
= xmalloc (size
);
3972 read_buffer_size
= size
;
3976 defsubr (struct Lisp_Subr
*sname
)
3979 sym
= intern_c_string (sname
->symbol_name
);
3980 XSETTYPED_PVECTYPE (sname
, size
, PVEC_SUBR
);
3981 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3984 #ifdef NOTDEF /* Use fset in subr.el now! */
3986 defalias (struct Lisp_Subr
*sname
, char *string
)
3989 sym
= intern (string
);
3990 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3994 /* Define an "integer variable"; a symbol whose value is forwarded to a
3995 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
3996 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3998 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3999 const char *namestring
, EMACS_INT
*address
)
4002 sym
= intern_c_string (namestring
);
4003 i_fwd
->type
= Lisp_Fwd_Int
;
4004 i_fwd
->intvar
= address
;
4005 XSYMBOL (sym
)->declared_special
= 1;
4006 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4007 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4010 /* Similar but define a variable whose value is t if address contains 1,
4011 nil if address contains 0. */
4013 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4014 const char *namestring
, int *address
)
4017 sym
= intern_c_string (namestring
);
4018 b_fwd
->type
= Lisp_Fwd_Bool
;
4019 b_fwd
->boolvar
= address
;
4020 XSYMBOL (sym
)->declared_special
= 1;
4021 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4022 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4023 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4026 /* Similar but define a variable whose value is the Lisp Object stored
4027 at address. Two versions: with and without gc-marking of the C
4028 variable. The nopro version is used when that variable will be
4029 gc-marked for some other reason, since marking the same slot twice
4030 can cause trouble with strings. */
4032 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4033 const char *namestring
, Lisp_Object
*address
)
4036 sym
= intern_c_string (namestring
);
4037 o_fwd
->type
= Lisp_Fwd_Obj
;
4038 o_fwd
->objvar
= address
;
4039 XSYMBOL (sym
)->declared_special
= 1;
4040 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4041 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4045 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4046 const char *namestring
, Lisp_Object
*address
)
4048 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4049 staticpro (address
);
4052 /* Similar but define a variable whose value is the Lisp Object stored
4053 at a particular offset in the current kboard object. */
4056 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4057 const char *namestring
, int offset
)
4060 sym
= intern_c_string (namestring
);
4061 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4062 ko_fwd
->offset
= offset
;
4063 XSYMBOL (sym
)->declared_special
= 1;
4064 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4065 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4068 /* Check that the elements of Vload_path exist. */
4071 load_path_check (void)
4073 Lisp_Object path_tail
;
4075 /* The only elements that might not exist are those from
4076 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4078 for (path_tail
= Vload_path
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4080 Lisp_Object dirfile
;
4081 dirfile
= Fcar (path_tail
);
4082 if (STRINGP (dirfile
))
4084 dirfile
= Fdirectory_file_name (dirfile
);
4085 if (access (SSDATA (dirfile
), 0) < 0)
4086 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4092 /* Record the value of load-path used at the start of dumping
4093 so we can see if the site changed it later during dumping. */
4094 static Lisp_Object dump_path
;
4096 /* Compute the default Vload_path, with the following logic:
4098 use EMACSLOADPATH env-var if set; otherwise use PATH_LOADSEARCH,
4099 prepending PATH_SITELOADSEARCH unless --no-site-lisp.
4100 The remainder is what happens when dumping works:
4101 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4102 Otherwise use EMACSLOADPATH if set, else PATH_LOADSEARCH.
4104 If !initialized, then just set both Vload_path and dump_path.
4105 If initialized, then if Vload_path != dump_path, do nothing.
4106 (Presumably the load-path has already been changed by something.
4107 This can only be from a site-load file during dumping,
4108 or because EMACSLOADPATH is set.)
4109 If Vinstallation_directory is not nil (ie, running uninstalled):
4110 If installation-dir/lisp exists and not already a member,
4111 we must be running uninstalled. Reset the load-path
4112 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4113 refers to the eventual installation directories. Since we
4114 are not yet installed, we should not use them, even if they exist.)
4115 If installation-dir/lisp does not exist, just add dump_path at the
4117 Add installation-dir/leim (if exists and not already a member) at the front.
4118 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4119 and not already a member) at the front.
4120 If installation-dir != source-dir (ie running an uninstalled,
4121 out-of-tree build) AND install-dir/src/Makefile exists BUT
4122 install-dir/src/Makefile.in does NOT exist (this is a sanity
4123 check), then repeat the above steps for source-dir/lisp,
4125 Finally, add the site-lisp directories at the front (if !no_site_lisp).
4135 const char *loadpath
= ns_load_path ();
4138 normal
= PATH_LOADSEARCH
;
4140 Vload_path
= decode_env_path ("EMACSLOADPATH", loadpath
? loadpath
: normal
);
4142 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4147 /* FIXME CANNOT_DUMP platforms should get source-dir/lisp etc added
4148 to their load-path too, AFAICS. I don't think we can tell the
4149 difference between initialized and !initialized in this case,
4150 so we'll have to do it unconditionally when Vinstallation_directory
4153 /* loadpath already includes the app-bundle's site-lisp. */
4154 if (!no_site_lisp
&& !egetenv ("EMACSLOADPATH") && !loadpath
)
4156 if (!no_site_lisp
&& !egetenv ("EMACSLOADPATH"))
4159 Lisp_Object sitelisp
;
4160 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4161 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4164 if (NILP (Vpurify_flag
))
4166 normal
= PATH_LOADSEARCH
;
4167 /* If the EMACSLOADPATH environment variable is set, use its value.
4168 This doesn't apply if we're dumping. */
4169 if (egetenv ("EMACSLOADPATH"))
4170 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4173 normal
= PATH_DUMPLOADSEARCH
;
4175 /* In a dumped Emacs, we normally reset the value of Vload_path using
4176 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4177 the source directory, instead of the path of the installed elisp
4178 libraries. However, if it appears that Vload_path has already been
4179 changed from the default that was saved before dumping, don't
4180 change it further. Changes can only be due to EMACSLOADPATH, or
4181 site-lisp files that were processed during dumping. */
4184 if (NILP (Fequal (dump_path
, Vload_path
)))
4186 /* Do not make any changes, just check the elements exist. */
4187 /* Note: --no-site-lisp is ignored.
4188 I don't know what to do about this. */
4194 const char *loadpath
= ns_load_path ();
4195 Vload_path
= decode_env_path (0, loadpath
? loadpath
: normal
);
4197 Vload_path
= decode_env_path (0, normal
);
4199 if (!NILP (Vinstallation_directory
))
4201 Lisp_Object tem
, tem1
;
4203 /* Add to the path the lisp subdir of the installation
4204 dir, if it exists. Note: in out-of-tree builds,
4205 this directory is empty save for Makefile. */
4206 tem
= Fexpand_file_name (build_string ("lisp"),
4207 Vinstallation_directory
);
4208 tem1
= Ffile_exists_p (tem
);
4211 if (NILP (Fmember (tem
, Vload_path
)))
4213 /* We are running uninstalled. The default load-path
4214 points to the eventual installed lisp, leim
4215 directories. We should not use those now, even
4216 if they exist, so start over from a clean slate. */
4217 Vload_path
= Fcons (tem
, Qnil
);
4221 /* That dir doesn't exist, so add the build-time
4222 Lisp dirs instead. */
4223 Vload_path
= nconc2 (Vload_path
, dump_path
);
4225 /* Add leim under the installation dir, if it exists. */
4226 tem
= Fexpand_file_name (build_string ("leim"),
4227 Vinstallation_directory
);
4228 tem1
= Ffile_exists_p (tem
);
4231 if (NILP (Fmember (tem
, Vload_path
)))
4232 Vload_path
= Fcons (tem
, Vload_path
);
4235 /* Add site-lisp under the installation dir, if it exists. */
4238 tem
= Fexpand_file_name (build_string ("site-lisp"),
4239 Vinstallation_directory
);
4240 tem1
= Ffile_exists_p (tem
);
4243 if (NILP (Fmember (tem
, Vload_path
)))
4244 Vload_path
= Fcons (tem
, Vload_path
);
4248 /* If Emacs was not built in the source directory,
4249 and it is run from where it was built, add to load-path
4250 the lisp, leim and site-lisp dirs under that directory. */
4252 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4256 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4257 Vinstallation_directory
);
4258 tem1
= Ffile_exists_p (tem
);
4260 /* Don't be fooled if they moved the entire source tree
4261 AFTER dumping Emacs. If the build directory is indeed
4262 different from the source dir, src/Makefile.in and
4263 src/Makefile will not be found together. */
4264 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4265 Vinstallation_directory
);
4266 tem2
= Ffile_exists_p (tem
);
4267 if (!NILP (tem1
) && NILP (tem2
))
4269 tem
= Fexpand_file_name (build_string ("lisp"),
4272 if (NILP (Fmember (tem
, Vload_path
)))
4273 Vload_path
= Fcons (tem
, Vload_path
);
4275 tem
= Fexpand_file_name (build_string ("leim"),
4278 if (NILP (Fmember (tem
, Vload_path
)))
4279 Vload_path
= Fcons (tem
, Vload_path
);
4283 tem
= Fexpand_file_name (build_string ("site-lisp"),
4286 if (NILP (Fmember (tem
, Vload_path
)))
4287 Vload_path
= Fcons (tem
, Vload_path
);
4290 } /* Vinstallation_directory != Vsource_directory */
4292 } /* if Vinstallation_directory */
4294 /* Check before adding the site-lisp directories.
4295 The install should have created them, but they are not
4296 required, so no need to warn if they are absent.
4297 Or we might be running before installation. */
4300 /* Add the site-lisp directories at the front. */
4302 /* loadpath already includes the app-bundle's site-lisp. */
4303 if (!no_site_lisp
&& !loadpath
)
4308 Lisp_Object sitelisp
;
4309 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4310 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4312 } /* if dump_path == Vload_path */
4314 else /* !initialized */
4316 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4317 source directory. We used to add ../lisp (ie the lisp dir in
4318 the build directory) at the front here, but that caused trouble
4319 because it was copied from dump_path into Vload_path, above,
4320 when Vinstallation_directory was non-nil. It should not be
4321 necessary, since in out of tree builds lisp/ is empty, save
4323 Vload_path
= decode_env_path (0, normal
);
4324 dump_path
= Vload_path
;
4325 /* No point calling load_path_check; load-path only contains essential
4326 elements from the source directory at this point. They cannot
4327 be missing unless something went extremely (and improbably)
4328 wrong, in which case the build will fail in obvious ways. */
4330 #endif /* CANNOT_DUMP */
4334 load_in_progress
= 0;
4335 Vload_file_name
= Qnil
;
4337 load_descriptor_list
= Qnil
;
4339 Vstandard_input
= Qt
;
4340 Vloads_in_progress
= Qnil
;
4343 /* Print a warning, using format string FORMAT, that directory DIRNAME
4344 does not exist. Print it on stderr and put it in *Messages*. */
4347 dir_warning (const char *format
, Lisp_Object dirname
)
4349 fprintf (stderr
, format
, SDATA (dirname
));
4351 /* Don't log the warning before we've initialized!! */
4355 ptrdiff_t message_len
;
4357 SAFE_ALLOCA (buffer
, char *,
4358 SBYTES (dirname
) + strlen (format
) - (sizeof "%s" - 1) + 1);
4359 message_len
= esprintf (buffer
, format
, SDATA (dirname
));
4360 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4366 syms_of_lread (void)
4369 defsubr (&Sread_from_string
);
4371 defsubr (&Sintern_soft
);
4372 defsubr (&Sunintern
);
4373 defsubr (&Sget_load_suffixes
);
4375 defsubr (&Seval_buffer
);
4376 defsubr (&Seval_region
);
4377 defsubr (&Sread_char
);
4378 defsubr (&Sread_char_exclusive
);
4379 defsubr (&Sread_event
);
4380 defsubr (&Sget_file_char
);
4381 defsubr (&Smapatoms
);
4382 defsubr (&Slocate_file_internal
);
4384 DEFVAR_LISP ("obarray", Vobarray
,
4385 doc
: /* Symbol table for use by `intern' and `read'.
4386 It is a vector whose length ought to be prime for best results.
4387 The vector's contents don't make sense if examined from Lisp programs;
4388 to find all the symbols in an obarray, use `mapatoms'. */);
4390 DEFVAR_LISP ("values", Vvalues
,
4391 doc
: /* List of values of all expressions which were read, evaluated and printed.
4392 Order is reverse chronological. */);
4393 XSYMBOL (intern ("values"))->declared_special
= 0;
4395 DEFVAR_LISP ("standard-input", Vstandard_input
,
4396 doc
: /* Stream for read to get input from.
4397 See documentation of `read' for possible values. */);
4398 Vstandard_input
= Qt
;
4400 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4401 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4403 If this variable is a buffer, then only forms read from that buffer
4404 will be added to `read-symbol-positions-list'.
4405 If this variable is t, then all read forms will be added.
4406 The effect of all other values other than nil are not currently
4407 defined, although they may be in the future.
4409 The positions are relative to the last call to `read' or
4410 `read-from-string'. It is probably a bad idea to set this variable at
4411 the toplevel; bind it instead. */);
4412 Vread_with_symbol_positions
= Qnil
;
4414 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4415 doc
: /* A list mapping read symbols to their positions.
4416 This variable is modified during calls to `read' or
4417 `read-from-string', but only when `read-with-symbol-positions' is
4420 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4421 CHAR-POSITION is an integer giving the offset of that occurrence of the
4422 symbol from the position where `read' or `read-from-string' started.
4424 Note that a symbol will appear multiple times in this list, if it was
4425 read multiple times. The list is in the same order as the symbols
4427 Vread_symbol_positions_list
= Qnil
;
4429 DEFVAR_LISP ("read-circle", Vread_circle
,
4430 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4433 DEFVAR_LISP ("load-path", Vload_path
,
4434 doc
: /* List of directories to search for files to load.
4435 Each element is a string (directory name) or nil (try default directory).
4436 Initialized based on EMACSLOADPATH environment variable, if any,
4437 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4439 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4440 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4441 This list should not include the empty string.
4442 `load' and related functions try to append these suffixes, in order,
4443 to the specified file name if a Lisp suffix is allowed or required. */);
4444 Vload_suffixes
= Fcons (build_pure_c_string (".elc"),
4445 Fcons (build_pure_c_string (".el"), Qnil
));
4446 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4447 doc
: /* List of suffixes that indicate representations of \
4449 This list should normally start with the empty string.
4451 Enabling Auto Compression mode appends the suffixes in
4452 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4453 mode removes them again. `load' and related functions use this list to
4454 determine whether they should look for compressed versions of a file
4455 and, if so, which suffixes they should try to append to the file name
4456 in order to do so. However, if you want to customize which suffixes
4457 the loading functions recognize as compression suffixes, you should
4458 customize `jka-compr-load-suffixes' rather than the present variable. */);
4459 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4461 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4462 doc
: /* Non-nil if inside of `load'. */);
4463 DEFSYM (Qload_in_progress
, "load-in-progress");
4465 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4466 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4467 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4469 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4470 a symbol \(a feature name).
4472 When `load' is run and the file-name argument matches an element's
4473 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4474 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4476 An error in FORMS does not undo the load, but does prevent execution of
4477 the rest of the FORMS. */);
4478 Vafter_load_alist
= Qnil
;
4480 DEFVAR_LISP ("load-history", Vload_history
,
4481 doc
: /* Alist mapping loaded file names to symbols and features.
4482 Each alist element should be a list (FILE-NAME ENTRIES...), where
4483 FILE-NAME is the name of a file that has been loaded into Emacs.
4484 The file name is absolute and true (i.e. it doesn't contain symlinks).
4485 As an exception, one of the alist elements may have FILE-NAME nil,
4486 for symbols and features not associated with any file.
4488 The remaining ENTRIES in the alist element describe the functions and
4489 variables defined in that file, the features provided, and the
4490 features required. Each entry has the form `(provide . FEATURE)',
4491 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4492 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4493 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4494 autoload before this file redefined it as a function. In addition,
4495 entries may also be single symbols, which means that SYMBOL was
4496 defined by `defvar' or `defconst'.
4498 During preloading, the file name recorded is relative to the main Lisp
4499 directory. These file names are converted to absolute at startup. */);
4500 Vload_history
= Qnil
;
4502 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4503 doc
: /* Full name of file being loaded by `load'. */);
4504 Vload_file_name
= Qnil
;
4506 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4507 doc
: /* File name, including directory, of user's initialization file.
4508 If the file loaded had extension `.elc', and the corresponding source file
4509 exists, this variable contains the name of source file, suitable for use
4510 by functions like `custom-save-all' which edit the init file.
4511 While Emacs loads and evaluates the init file, value is the real name
4512 of the file, regardless of whether or not it has the `.elc' extension. */);
4513 Vuser_init_file
= Qnil
;
4515 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4516 doc
: /* Used for internal purposes by `load'. */);
4517 Vcurrent_load_list
= Qnil
;
4519 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4520 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4521 The default is nil, which means use the function `read'. */);
4522 Vload_read_function
= Qnil
;
4524 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4525 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4526 This function is for doing code conversion before reading the source file.
4527 If nil, loading is done without any code conversion.
4528 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4529 FULLNAME is the full name of FILE.
4530 See `load' for the meaning of the remaining arguments. */);
4531 Vload_source_file_function
= Qnil
;
4533 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4534 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4535 This is useful when the file being loaded is a temporary copy. */);
4536 load_force_doc_strings
= 0;
4538 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4539 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4540 This is normally bound by `load' and `eval-buffer' to control `read',
4541 and is not meant for users to change. */);
4542 load_convert_to_unibyte
= 0;
4544 DEFVAR_LISP ("source-directory", Vsource_directory
,
4545 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4546 You cannot count on them to still be there! */);
4548 = Fexpand_file_name (build_string ("../"),
4549 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4551 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4552 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4553 Vpreloaded_file_list
= Qnil
;
4555 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4556 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4557 Vbyte_boolean_vars
= Qnil
;
4559 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4560 doc
: /* Non-nil means load dangerous compiled Lisp files.
4561 Some versions of XEmacs use different byte codes than Emacs. These
4562 incompatible byte codes can make Emacs crash when it tries to execute
4564 load_dangerous_libraries
= 0;
4566 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4567 doc
: /* Non-nil means force printing messages when loading Lisp files.
4568 This overrides the value of the NOMESSAGE argument to `load'. */);
4569 force_load_messages
= 0;
4571 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4572 doc
: /* Regular expression matching safe to load compiled Lisp files.
4573 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4574 from the file, and matches them against this regular expression.
4575 When the regular expression matches, the file is considered to be safe
4576 to load. See also `load-dangerous-libraries'. */);
4577 Vbytecomp_version_regexp
4578 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4580 Qlexical_binding
= intern ("lexical-binding");
4581 staticpro (&Qlexical_binding
);
4582 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4583 doc
: /* Whether to use lexical binding when evaluating code.
4584 Non-nil means that the code in the current buffer should be evaluated
4585 with lexical binding.
4586 This variable is automatically set from the file variables of an
4587 interpreted Lisp file read using `load'. Unlike other file local
4588 variables, this must be set in the first line of a file. */);
4589 Fmake_variable_buffer_local (Qlexical_binding
);
4591 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4592 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4593 Veval_buffer_list
= Qnil
;
4595 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4596 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4597 Vold_style_backquotes
= Qnil
;
4598 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4600 /* Vsource_directory was initialized in init_lread. */
4602 load_descriptor_list
= Qnil
;
4603 staticpro (&load_descriptor_list
);
4605 DEFSYM (Qcurrent_load_list
, "current-load-list");
4606 DEFSYM (Qstandard_input
, "standard-input");
4607 DEFSYM (Qread_char
, "read-char");
4608 DEFSYM (Qget_file_char
, "get-file-char");
4609 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4610 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4612 DEFSYM (Qbackquote
, "`");
4613 DEFSYM (Qcomma
, ",");
4614 DEFSYM (Qcomma_at
, ",@");
4615 DEFSYM (Qcomma_dot
, ",.");
4617 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4618 DEFSYM (Qascii_character
, "ascii-character");
4619 DEFSYM (Qfunction
, "function");
4620 DEFSYM (Qload
, "load");
4621 DEFSYM (Qload_file_name
, "load-file-name");
4622 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4623 DEFSYM (Qfile_truename
, "file-truename");
4624 DEFSYM (Qdir_ok
, "dir-ok");
4625 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4627 staticpro (&dump_path
);
4629 staticpro (&read_objects
);
4630 read_objects
= Qnil
;
4631 staticpro (&seen_list
);
4634 Vloads_in_progress
= Qnil
;
4635 staticpro (&Vloads_in_progress
);
4637 DEFSYM (Qhash_table
, "hash-table");
4638 DEFSYM (Qdata
, "data");
4639 DEFSYM (Qtest
, "test");
4640 DEFSYM (Qsize
, "size");
4641 DEFSYM (Qweakness
, "weakness");
4642 DEFSYM (Qrehash_size
, "rehash-size");
4643 DEFSYM (Qrehash_threshold
, "rehash-threshold");