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"
56 #endif /* HAVE_SETLOCALE */
61 #define file_offset off_t
62 #define file_tell ftello
64 #define file_offset long
65 #define file_tell ftell
68 /* Hash table read constants. */
69 static Lisp_Object Qhash_table
, Qdata
;
70 static Lisp_Object Qtest
, Qsize
;
71 static Lisp_Object Qweakness
;
72 static Lisp_Object Qrehash_size
;
73 static Lisp_Object Qrehash_threshold
;
75 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
76 Lisp_Object Qstandard_input
;
77 Lisp_Object Qvariable_documentation
;
78 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
79 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
80 static Lisp_Object Qinhibit_file_name_operation
;
81 static Lisp_Object Qeval_buffer_list
;
82 Lisp_Object Qlexical_binding
;
83 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
85 /* Used instead of Qget_file_char while loading *.elc files compiled
86 by Emacs 21 or older. */
87 static Lisp_Object Qget_emacs_mule_file_char
;
89 static Lisp_Object Qload_force_doc_strings
;
91 static Lisp_Object Qload_in_progress
;
93 /* The association list of objects read with the #n=object form.
94 Each member of the list has the form (n . object), and is used to
95 look up the object for the corresponding #n# construct.
96 It must be set to nil before all top-level calls to read0. */
97 static Lisp_Object read_objects
;
99 /* Nonzero means READCHAR should read bytes one by one (not character)
100 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
101 This is set to 1 by read1 temporarily while handling #@NUMBER. */
102 static int load_each_byte
;
104 /* List of descriptors now open for Fload. */
105 static Lisp_Object load_descriptor_list
;
107 /* File for get_file_char to read from. Use by load. */
108 static FILE *instream
;
110 /* For use within read-from-string (this reader is non-reentrant!!) */
111 static ptrdiff_t read_from_string_index
;
112 static ptrdiff_t read_from_string_index_byte
;
113 static ptrdiff_t read_from_string_limit
;
115 /* Number of characters read in the current call to Fread or
116 Fread_from_string. */
117 static EMACS_INT readchar_count
;
119 /* This contains the last string skipped with #@. */
120 static char *saved_doc_string
;
121 /* Length of buffer allocated in saved_doc_string. */
122 static ptrdiff_t saved_doc_string_size
;
123 /* Length of actual data in saved_doc_string. */
124 static ptrdiff_t saved_doc_string_length
;
125 /* This is the file position that string came from. */
126 static file_offset saved_doc_string_position
;
128 /* This contains the previous string skipped with #@.
129 We copy it from saved_doc_string when a new string
130 is put in saved_doc_string. */
131 static char *prev_saved_doc_string
;
132 /* Length of buffer allocated in prev_saved_doc_string. */
133 static ptrdiff_t prev_saved_doc_string_size
;
134 /* Length of actual data in prev_saved_doc_string. */
135 static ptrdiff_t prev_saved_doc_string_length
;
136 /* This is the file position that string came from. */
137 static file_offset prev_saved_doc_string_position
;
139 /* Nonzero means inside a new-style backquote
140 with no surrounding parentheses.
141 Fread initializes this to zero, so we need not specbind it
142 or worry about what happens to it when there is an error. */
143 static int new_backquote_flag
;
144 static Lisp_Object Qold_style_backquotes
;
146 /* A list of file names for files being loaded in Fload. Used to
147 check for recursive loads. */
149 static Lisp_Object Vloads_in_progress
;
151 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
154 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
, int,
155 Lisp_Object
, Lisp_Object
,
156 Lisp_Object
, Lisp_Object
);
157 static Lisp_Object
load_unwind (Lisp_Object
);
158 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
160 /* Functions that read one byte from the current source READCHARFUN
161 or unreads one byte. If the integer argument C is -1, it returns
162 one read byte, or -1 when there's no more byte in the source. If C
163 is 0 or positive, it unreads C, and the return value is not
166 static int readbyte_for_lambda (int, Lisp_Object
);
167 static int readbyte_from_file (int, Lisp_Object
);
168 static int readbyte_from_string (int, Lisp_Object
);
170 /* Handle unreading and rereading of characters.
171 Write READCHAR to read a character,
172 UNREAD(c) to unread c to be read again.
174 These macros correctly read/unread multibyte characters. */
176 #define READCHAR readchar (readcharfun, NULL)
177 #define UNREAD(c) unreadchar (readcharfun, c)
179 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
180 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
182 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
183 Qlambda, or a cons, we use this to keep an unread character because
184 a file stream can't handle multibyte-char unreading. The value -1
185 means that there's no unread character. */
186 static int unread_char
;
189 readchar (Lisp_Object readcharfun
, bool *multibyte
)
193 int (*readbyte
) (int, Lisp_Object
);
194 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
196 int emacs_mule_encoding
= 0;
203 if (BUFFERP (readcharfun
))
205 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
207 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
209 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
212 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
214 /* Fetch the character code from the buffer. */
215 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
216 BUF_INC_POS (inbuffer
, pt_byte
);
223 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
224 if (! ASCII_BYTE_P (c
))
225 c
= BYTE8_TO_CHAR (c
);
228 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
232 if (MARKERP (readcharfun
))
234 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
236 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
238 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
241 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
243 /* Fetch the character code from the buffer. */
244 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
245 BUF_INC_POS (inbuffer
, bytepos
);
252 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
253 if (! ASCII_BYTE_P (c
))
254 c
= BYTE8_TO_CHAR (c
);
258 XMARKER (readcharfun
)->bytepos
= bytepos
;
259 XMARKER (readcharfun
)->charpos
++;
264 if (EQ (readcharfun
, Qlambda
))
266 readbyte
= readbyte_for_lambda
;
270 if (EQ (readcharfun
, Qget_file_char
))
272 readbyte
= readbyte_from_file
;
276 if (STRINGP (readcharfun
))
278 if (read_from_string_index
>= read_from_string_limit
)
280 else if (STRING_MULTIBYTE (readcharfun
))
284 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
285 read_from_string_index
,
286 read_from_string_index_byte
);
290 c
= SREF (readcharfun
, read_from_string_index_byte
);
291 read_from_string_index
++;
292 read_from_string_index_byte
++;
297 if (CONSP (readcharfun
))
299 /* This is the case that read_vector is reading from a unibyte
300 string that contains a byte sequence previously skipped
301 because of #@NUMBER. The car part of readcharfun is that
302 string, and the cdr part is a value of readcharfun given to
304 readbyte
= readbyte_from_string
;
305 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
306 emacs_mule_encoding
= 1;
310 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
312 readbyte
= readbyte_from_file
;
313 emacs_mule_encoding
= 1;
317 tem
= call0 (readcharfun
);
324 if (unread_char
>= 0)
330 c
= (*readbyte
) (-1, readcharfun
);
331 if (c
< 0 || load_each_byte
)
335 if (ASCII_BYTE_P (c
))
337 if (emacs_mule_encoding
)
338 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
341 len
= BYTES_BY_CHAR_HEAD (c
);
344 c
= (*readbyte
) (-1, readcharfun
);
345 if (c
< 0 || ! TRAILING_CODE_P (c
))
348 (*readbyte
) (buf
[i
], readcharfun
);
349 return BYTE8_TO_CHAR (buf
[0]);
353 return STRING_CHAR (buf
);
356 /* Unread the character C in the way appropriate for the stream READCHARFUN.
357 If the stream is a user function, call it with the char as argument. */
360 unreadchar (Lisp_Object readcharfun
, int c
)
364 /* Don't back up the pointer if we're unreading the end-of-input mark,
365 since readchar didn't advance it when we read it. */
367 else if (BUFFERP (readcharfun
))
369 struct buffer
*b
= XBUFFER (readcharfun
);
370 ptrdiff_t charpos
= BUF_PT (b
);
371 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
373 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
374 BUF_DEC_POS (b
, bytepos
);
378 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
380 else if (MARKERP (readcharfun
))
382 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
383 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
385 XMARKER (readcharfun
)->charpos
--;
386 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
387 BUF_DEC_POS (b
, bytepos
);
391 XMARKER (readcharfun
)->bytepos
= bytepos
;
393 else if (STRINGP (readcharfun
))
395 read_from_string_index
--;
396 read_from_string_index_byte
397 = string_char_to_byte (readcharfun
, read_from_string_index
);
399 else if (CONSP (readcharfun
))
403 else if (EQ (readcharfun
, Qlambda
))
407 else if (EQ (readcharfun
, Qget_file_char
)
408 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
413 ungetc (c
, instream
);
420 call1 (readcharfun
, make_number (c
));
424 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
426 return read_bytecode_char (c
>= 0);
431 readbyte_from_file (int c
, Lisp_Object readcharfun
)
436 ungetc (c
, instream
);
445 /* Interrupted reads have been observed while reading over the network. */
446 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
458 return (c
== EOF
? -1 : c
);
462 readbyte_from_string (int c
, Lisp_Object readcharfun
)
464 Lisp_Object string
= XCAR (readcharfun
);
468 read_from_string_index
--;
469 read_from_string_index_byte
470 = string_char_to_byte (string
, read_from_string_index
);
473 if (read_from_string_index
>= read_from_string_limit
)
476 FETCH_STRING_CHAR_ADVANCE (c
, string
,
477 read_from_string_index
,
478 read_from_string_index_byte
);
483 /* Read one non-ASCII character from INSTREAM. The character is
484 encoded in `emacs-mule' and the first byte is already read in
488 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
490 /* Emacs-mule coding uses at most 4-byte for one character. */
491 unsigned char buf
[4];
492 int len
= emacs_mule_bytes
[c
];
493 struct charset
*charset
;
498 /* C is not a valid leading-code of `emacs-mule'. */
499 return BYTE8_TO_CHAR (c
);
505 c
= (*readbyte
) (-1, readcharfun
);
509 (*readbyte
) (buf
[i
], readcharfun
);
510 return BYTE8_TO_CHAR (buf
[0]);
517 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
518 code
= buf
[1] & 0x7F;
522 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
523 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
525 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
526 code
= buf
[2] & 0x7F;
530 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
531 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
536 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
537 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
539 c
= DECODE_CHAR (charset
, code
);
541 Fsignal (Qinvalid_read_syntax
,
542 Fcons (build_string ("invalid multibyte form"), Qnil
));
547 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
549 static Lisp_Object
read0 (Lisp_Object
);
550 static Lisp_Object
read1 (Lisp_Object
, int *, int);
552 static Lisp_Object
read_list (int, Lisp_Object
);
553 static Lisp_Object
read_vector (Lisp_Object
, int);
555 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
557 static void substitute_object_in_subtree (Lisp_Object
,
559 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
562 /* Get a character from the tty. */
564 /* Read input events until we get one that's acceptable for our purposes.
566 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
567 until we get a character we like, and then stuffed into
570 If ASCII_REQUIRED is non-zero, we check function key events to see
571 if the unmodified version of the symbol has a Qascii_character
572 property, and use that character, if present.
574 If ERROR_NONASCII is non-zero, we signal an error if the input we
575 get isn't an ASCII character with modifiers. If it's zero but
576 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
579 If INPUT_METHOD is nonzero, we invoke the current input method
580 if the character warrants that.
582 If SECONDS is a number, we wait that many seconds for input, and
583 return Qnil if no input arrives within that time. */
586 read_filtered_event (int no_switch_frame
, int ascii_required
,
587 int error_nonascii
, int input_method
, Lisp_Object seconds
)
589 Lisp_Object val
, delayed_switch_frame
;
592 #ifdef HAVE_WINDOW_SYSTEM
593 if (display_hourglass_p
)
597 delayed_switch_frame
= Qnil
;
599 /* Compute timeout. */
600 if (NUMBERP (seconds
))
602 double duration
= extract_float (seconds
);
603 EMACS_TIME wait_time
= EMACS_TIME_FROM_DOUBLE (duration
);
604 end_time
= add_emacs_time (current_emacs_time (), wait_time
);
607 /* Read until we get an acceptable event. */
610 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
611 NUMBERP (seconds
) ? &end_time
: NULL
);
612 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
617 /* switch-frame events are put off until after the next ASCII
618 character. This is better than signaling an error just because
619 the last characters were typed to a separate minibuffer frame,
620 for example. Eventually, some code which can deal with
621 switch-frame events will read it and process it. */
623 && EVENT_HAS_PARAMETERS (val
)
624 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
626 delayed_switch_frame
= val
;
630 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
632 /* Convert certain symbols to their ASCII equivalents. */
635 Lisp_Object tem
, tem1
;
636 tem
= Fget (val
, Qevent_symbol_element_mask
);
639 tem1
= Fget (Fcar (tem
), Qascii_character
);
640 /* Merge this symbol's modifier bits
641 with the ASCII equivalent of its basic code. */
643 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
647 /* If we don't have a character now, deal with it appropriately. */
652 Vunread_command_events
= Fcons (val
, Qnil
);
653 error ("Non-character input-event");
660 if (! NILP (delayed_switch_frame
))
661 unread_switch_frame
= delayed_switch_frame
;
665 #ifdef HAVE_WINDOW_SYSTEM
666 if (display_hourglass_p
)
675 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
676 doc
: /* Read a character from the command input (keyboard or macro).
677 It is returned as a number.
678 If the character has modifiers, they are resolved and reflected to the
679 character code if possible (e.g. C-SPC -> 0).
681 If the user generates an event which is not a character (i.e. a mouse
682 click or function key event), `read-char' signals an error. As an
683 exception, switch-frame events are put off until non-character events
685 If you want to read non-character events, or ignore them, call
686 `read-event' or `read-char-exclusive' instead.
688 If the optional argument PROMPT is non-nil, display that as a prompt.
689 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
690 input method is turned on in the current buffer, that input method
691 is used for reading a character.
692 If the optional argument SECONDS is non-nil, it should be a number
693 specifying the maximum number of seconds to wait for input. If no
694 input arrives in that time, return nil. SECONDS may be a
695 floating-point value. */)
696 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
701 message_with_string ("%s", prompt
, 0);
702 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
704 return (NILP (val
) ? Qnil
705 : make_number (char_resolve_modifier_mask (XINT (val
))));
708 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
709 doc
: /* Read an event object from the input stream.
710 If the optional argument PROMPT is non-nil, display that as a prompt.
711 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
712 input method is turned on in the current buffer, that input method
713 is used for reading a character.
714 If the optional argument SECONDS is non-nil, it should be a number
715 specifying the maximum number of seconds to wait for input. If no
716 input arrives in that time, return nil. SECONDS may be a
717 floating-point value. */)
718 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
721 message_with_string ("%s", prompt
, 0);
722 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
725 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
726 doc
: /* Read a character from the command input (keyboard or macro).
727 It is returned as a number. Non-character events are ignored.
728 If the character has modifiers, they are resolved and reflected to the
729 character code if possible (e.g. C-SPC -> 0).
731 If the optional argument PROMPT is non-nil, display that as a prompt.
732 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
733 input method is turned on in the current buffer, that input method
734 is used for reading a character.
735 If the optional argument SECONDS is non-nil, it should be a number
736 specifying the maximum number of seconds to wait for input. If no
737 input arrives in that time, return nil. SECONDS may be a
738 floating-point value. */)
739 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
744 message_with_string ("%s", prompt
, 0);
746 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
748 return (NILP (val
) ? Qnil
749 : make_number (char_resolve_modifier_mask (XINT (val
))));
752 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
753 doc
: /* Don't use this yourself. */)
756 register Lisp_Object val
;
758 XSETINT (val
, getc (instream
));
766 /* Return true if the lisp code read using READCHARFUN defines a non-nil
767 `lexical-binding' file variable. After returning, the stream is
768 positioned following the first line, if it is a comment, otherwise
772 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
776 /* The first line isn't a comment, just give up. */
782 /* Look for an appropriate file-variable in the first line. */
786 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
787 } beg_end_state
= NOMINAL
;
788 int in_file_vars
= 0;
790 #define UPDATE_BEG_END_STATE(ch) \
791 if (beg_end_state == NOMINAL) \
792 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
793 else if (beg_end_state == AFTER_FIRST_DASH) \
794 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
795 else if (beg_end_state == AFTER_ASTERIX) \
798 in_file_vars = !in_file_vars; \
799 beg_end_state = NOMINAL; \
802 /* Skip until we get to the file vars, if any. */
806 UPDATE_BEG_END_STATE (ch
);
808 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
812 char var
[100], val
[100];
817 /* Read a variable name. */
818 while (ch
== ' ' || ch
== '\t')
822 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
824 if (i
< sizeof var
- 1)
826 UPDATE_BEG_END_STATE (ch
);
830 /* Stop scanning if no colon was found before end marker. */
831 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
834 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
840 /* Read a variable value. */
843 while (ch
== ' ' || ch
== '\t')
847 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
849 if (i
< sizeof val
- 1)
851 UPDATE_BEG_END_STATE (ch
);
855 /* The value was terminated by an end-marker, which remove. */
857 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
861 if (strcmp (var
, "lexical-binding") == 0)
864 rv
= (strcmp (val
, "nil") != 0);
870 while (ch
!= '\n' && ch
!= EOF
)
877 /* Value is a version number of byte compiled code if the file
878 associated with file descriptor FD is a compiled Lisp file that's
879 safe to load. Only files compiled with Emacs are safe to load.
880 Files compiled with XEmacs can lead to a crash in Fbyte_code
881 because of an incompatible change in the byte compiler. */
884 safe_to_load_p (int fd
)
891 /* Read the first few bytes from the file, and look for a line
892 specifying the byte compiler version used. */
893 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
898 /* Skip to the next newline, skipping over the initial `ELC'
899 with NUL bytes following it, but note the version. */
900 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
905 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
906 buf
+ i
, nbytes
- i
) < 0)
912 lseek (fd
, 0, SEEK_SET
);
917 /* Callback for record_unwind_protect. Restore the old load list OLD,
918 after loading a file successfully. */
921 record_load_unwind (Lisp_Object old
)
923 return Vloads_in_progress
= old
;
926 /* This handler function is used via internal_condition_case_1. */
929 load_error_handler (Lisp_Object data
)
935 load_warn_old_style_backquotes (Lisp_Object file
)
937 if (!NILP (Vold_style_backquotes
))
940 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
947 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
948 doc
: /* Return the suffixes that `load' should try if a suffix is \
950 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
953 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
954 while (CONSP (suffixes
))
956 Lisp_Object exts
= Vload_file_rep_suffixes
;
957 suffix
= XCAR (suffixes
);
958 suffixes
= XCDR (suffixes
);
963 lst
= Fcons (concat2 (suffix
, ext
), lst
);
966 return Fnreverse (lst
);
969 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
970 doc
: /* Execute a file of Lisp code named FILE.
971 First try FILE with `.elc' appended, then try with `.el',
972 then try FILE unmodified (the exact suffixes in the exact order are
973 determined by `load-suffixes'). Environment variable references in
974 FILE are replaced with their values by calling `substitute-in-file-name'.
975 This function searches the directories in `load-path'.
977 If optional second arg NOERROR is non-nil,
978 report no error if FILE doesn't exist.
979 Print messages at start and end of loading unless
980 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
982 If optional fourth arg NOSUFFIX is non-nil, don't try adding
983 suffixes `.elc' or `.el' to the specified name FILE.
984 If optional fifth arg MUST-SUFFIX is non-nil, insist on
985 the suffix `.elc' or `.el'; don't accept just FILE unless
986 it ends in one of those suffixes or includes a directory name.
988 If this function fails to find a file, it may look for different
989 representations of that file before trying another file.
990 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
991 to the file name. Emacs uses this feature mainly to find compressed
992 versions of files when Auto Compression mode is enabled.
994 The exact suffixes that this function tries out, in the exact order,
995 are given by the value of the variable `load-file-rep-suffixes' if
996 NOSUFFIX is non-nil and by the return value of the function
997 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
998 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1001 Loading a file records its definitions, and its `provide' and
1002 `require' calls, in an element of `load-history' whose
1003 car is the file name loaded. See `load-history'.
1005 While the file is in the process of being loaded, the variable
1006 `load-in-progress' is non-nil and the variable `load-file-name'
1007 is bound to the file's name.
1009 Return t if the file exists and loads successfully. */)
1010 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1012 register FILE *stream
;
1013 register int fd
= -1;
1014 ptrdiff_t count
= SPECPDL_INDEX ();
1015 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1016 Lisp_Object found
, efound
, hist_file_name
;
1017 /* 1 means we printed the ".el is newer" message. */
1019 /* 1 means we are loading a compiled file. */
1021 Lisp_Object handler
;
1023 const char *fmode
= "r";
1031 CHECK_STRING (file
);
1033 /* If file name is magic, call the handler. */
1034 /* This shouldn't be necessary any more now that `openp' handles it right.
1035 handler = Ffind_file_name_handler (file, Qload);
1036 if (!NILP (handler))
1037 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1039 /* Do this after the handler to avoid
1040 the need to gcpro noerror, nomessage and nosuffix.
1041 (Below here, we care only whether they are nil or not.)
1042 The presence of this call is the result of a historical accident:
1043 it used to be in every file-operation and when it got removed
1044 everywhere, it accidentally stayed here. Since then, enough people
1045 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1046 that it seemed risky to remove. */
1047 if (! NILP (noerror
))
1049 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1050 Qt
, load_error_handler
);
1055 file
= Fsubstitute_in_file_name (file
);
1058 /* Avoid weird lossage with null string as arg,
1059 since it would try to load a directory as a Lisp file. */
1060 if (SBYTES (file
) > 0)
1062 ptrdiff_t size
= SBYTES (file
);
1065 GCPRO2 (file
, found
);
1067 if (! NILP (must_suffix
))
1069 /* Don't insist on adding a suffix if FILE already ends with one. */
1071 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1074 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1076 /* Don't insist on adding a suffix
1077 if the argument includes a directory name. */
1078 else if (! NILP (Ffile_name_directory (file
)))
1082 fd
= openp (Vload_path
, file
,
1083 (!NILP (nosuffix
) ? Qnil
1084 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1085 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1086 tmp
[1] = Vload_file_rep_suffixes
,
1095 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1099 /* Tell startup.el whether or not we found the user's init file. */
1100 if (EQ (Qt
, Vuser_init_file
))
1101 Vuser_init_file
= found
;
1103 /* If FD is -2, that means openp found a magic file. */
1106 if (NILP (Fequal (found
, file
)))
1107 /* If FOUND is a different file name from FILE,
1108 find its handler even if we have already inhibited
1109 the `load' operation on FILE. */
1110 handler
= Ffind_file_name_handler (found
, Qt
);
1112 handler
= Ffind_file_name_handler (found
, Qload
);
1113 if (! NILP (handler
))
1114 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1116 /* Tramp has to deal with semi-broken packages that prepend
1117 drive letters to remote files. For that reason, Tramp
1118 catches file operations that test for file existence, which
1119 makes openp think X:/foo.elc files are remote. However,
1120 Tramp does not catch `load' operations for such files, so we
1121 end up with a nil as the `load' handler above. If we would
1122 continue with fd = -2, we will behave wrongly, and in
1123 particular try reading a .elc file in the "rt" mode instead
1124 of "rb". See bug #9311 for the results. To work around
1125 this, we try to open the file locally, and go with that if it
1127 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1133 /* Check if we're stuck in a recursive load cycle.
1135 2000-09-21: It's not possible to just check for the file loaded
1136 being a member of Vloads_in_progress. This fails because of the
1137 way the byte compiler currently works; `provide's are not
1138 evaluated, see font-lock.el/jit-lock.el as an example. This
1139 leads to a certain amount of ``normal'' recursion.
1141 Also, just loading a file recursively is not always an error in
1142 the general case; the second load may do something different. */
1146 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1147 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1151 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1153 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1154 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1157 /* All loads are by default dynamic, unless the file itself specifies
1158 otherwise using a file-variable in the first line. This is bound here
1159 so that it takes effect whether or not we use
1160 Vload_source_file_function. */
1161 specbind (Qlexical_binding
, Qnil
);
1163 /* Get the name for load-history. */
1164 hist_file_name
= (! NILP (Vpurify_flag
)
1165 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1166 tmp
[1] = Ffile_name_nondirectory (found
),
1172 /* Check for the presence of old-style quotes and warn about them. */
1173 specbind (Qold_style_backquotes
, Qnil
);
1174 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1176 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1177 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1178 /* Load .elc files directly, but not when they are
1179 remote and have no handler! */
1186 GCPRO3 (file
, found
, hist_file_name
);
1189 && ! (version
= safe_to_load_p (fd
)))
1192 if (!load_dangerous_libraries
)
1196 error ("File `%s' was not compiled in Emacs",
1199 else if (!NILP (nomessage
) && !force_load_messages
)
1200 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1205 efound
= ENCODE_FILE (found
);
1210 result
= stat (SSDATA (efound
), &s1
);
1213 SSET (efound
, SBYTES (efound
) - 1, 0);
1214 result
= stat (SSDATA (efound
), &s2
);
1215 SSET (efound
, SBYTES (efound
) - 1, 'c');
1219 && EMACS_TIME_LT (get_stat_mtime (&s1
), get_stat_mtime (&s2
)))
1221 /* Make the progress messages mention that source is newer. */
1224 /* If we won't print another message, mention this anyway. */
1225 if (!NILP (nomessage
) && !force_load_messages
)
1227 Lisp_Object msg_file
;
1228 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1229 message_with_string ("Source file `%s' newer than byte-compiled file",
1238 /* We are loading a source file (*.el). */
1239 if (!NILP (Vload_source_file_function
))
1245 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1246 NILP (noerror
) ? Qnil
: Qt
,
1247 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1248 return unbind_to (count
, val
);
1252 GCPRO3 (file
, found
, hist_file_name
);
1255 efound
= ENCODE_FILE (found
);
1256 /* If we somehow got here with fd == -2, meaning the file is deemed
1257 to be remote, don't even try to reopen the file locally; just
1258 force a failure instead. */
1262 stream
= fopen (SSDATA (efound
), fmode
);
1266 #else /* not WINDOWSNT */
1267 stream
= fdopen (fd
, fmode
);
1268 #endif /* not WINDOWSNT */
1272 error ("Failure to create stdio stream for %s", SDATA (file
));
1275 if (! NILP (Vpurify_flag
))
1276 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1278 if (NILP (nomessage
) || force_load_messages
)
1281 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1284 message_with_string ("Loading %s (source)...", file
, 1);
1286 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1288 else /* The typical case; compiled file newer than source file. */
1289 message_with_string ("Loading %s...", file
, 1);
1292 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1293 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1294 specbind (Qload_file_name
, found
);
1295 specbind (Qinhibit_file_name_operation
, Qnil
);
1296 load_descriptor_list
1297 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1298 specbind (Qload_in_progress
, Qt
);
1301 if (lisp_file_lexically_bound_p (Qget_file_char
))
1302 Fset (Qlexical_binding
, Qt
);
1304 if (! version
|| version
>= 22)
1305 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1306 0, Qnil
, Qnil
, Qnil
, Qnil
);
1309 /* We can't handle a file which was compiled with
1310 byte-compile-dynamic by older version of Emacs. */
1311 specbind (Qload_force_doc_strings
, Qt
);
1312 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1313 0, Qnil
, Qnil
, Qnil
, Qnil
);
1315 unbind_to (count
, Qnil
);
1317 /* Run any eval-after-load forms for this file. */
1318 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1319 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1323 xfree (saved_doc_string
);
1324 saved_doc_string
= 0;
1325 saved_doc_string_size
= 0;
1327 xfree (prev_saved_doc_string
);
1328 prev_saved_doc_string
= 0;
1329 prev_saved_doc_string_size
= 0;
1331 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1334 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1337 message_with_string ("Loading %s (source)...done", file
, 1);
1339 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1341 else /* The typical case; compiled file newer than source file. */
1342 message_with_string ("Loading %s...done", file
, 1);
1349 load_unwind (Lisp_Object arg
) /* Used as unwind-protect function in load. */
1351 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1362 load_descriptor_unwind (Lisp_Object oldlist
)
1364 load_descriptor_list
= oldlist
;
1368 /* Close all descriptors in use for Floads.
1369 This is used when starting a subprocess. */
1372 close_load_descs (void)
1376 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1377 emacs_close (XFASTINT (XCAR (tail
)));
1382 complete_filename_p (Lisp_Object pathname
)
1384 register const unsigned char *s
= SDATA (pathname
);
1385 return (IS_DIRECTORY_SEP (s
[0])
1386 || (SCHARS (pathname
) > 2
1387 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1390 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1391 doc
: /* Search for FILENAME through PATH.
1392 Returns the file's name in absolute form, or nil if not found.
1393 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1394 file name when searching.
1395 If non-nil, PREDICATE is used instead of `file-readable-p'.
1396 PREDICATE can also be an integer to pass to the access(2) function,
1397 in which case file-name-handlers are ignored.
1398 This function will normally skip directories, so if you want it to find
1399 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1400 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1403 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1404 if (NILP (predicate
) && fd
> 0)
1409 static Lisp_Object Qdir_ok
;
1411 /* Search for a file whose name is STR, looking in directories
1412 in the Lisp list PATH, and trying suffixes from SUFFIX.
1413 On success, returns a file descriptor. On failure, returns -1.
1415 SUFFIXES is a list of strings containing possible suffixes.
1416 The empty suffix is automatically added if the list is empty.
1418 PREDICATE non-nil means don't open the files,
1419 just look for one that satisfies the predicate. In this case,
1420 returns 1 on success. The predicate can be a lisp function or
1421 an integer to pass to `access' (in which case file-name-handlers
1424 If STOREPTR is nonzero, it points to a slot where the name of
1425 the file actually found should be stored as a Lisp string.
1426 nil is stored there on failure.
1428 If the file we find is remote, return -2
1429 but store the found remote file name in *STOREPTR. */
1432 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1435 ptrdiff_t fn_size
= 100;
1437 register char *fn
= buf
;
1439 ptrdiff_t want_length
;
1440 Lisp_Object filename
;
1442 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1443 Lisp_Object string
, tail
, encoded_fn
;
1444 ptrdiff_t max_suffix_len
= 0;
1448 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1450 CHECK_STRING_CAR (tail
);
1451 max_suffix_len
= max (max_suffix_len
,
1452 SBYTES (XCAR (tail
)));
1455 string
= filename
= encoded_fn
= Qnil
;
1456 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1461 if (complete_filename_p (str
))
1464 for (; CONSP (path
); path
= XCDR (path
))
1466 filename
= Fexpand_file_name (str
, XCAR (path
));
1467 if (!complete_filename_p (filename
))
1468 /* If there are non-absolute elts in PATH (eg "."). */
1469 /* Of course, this could conceivably lose if luser sets
1470 default-directory to be something non-absolute... */
1472 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1473 if (!complete_filename_p (filename
))
1474 /* Give up on this path element! */
1478 /* Calculate maximum length of any filename made from
1479 this path element/specified file name and any possible suffix. */
1480 want_length
= max_suffix_len
+ SBYTES (filename
);
1481 if (fn_size
<= want_length
)
1482 fn
= alloca (fn_size
= 100 + want_length
);
1484 /* Loop over suffixes. */
1485 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1486 CONSP (tail
); tail
= XCDR (tail
))
1488 ptrdiff_t fnlen
, lsuffix
= SBYTES (XCAR (tail
));
1489 Lisp_Object handler
;
1492 /* Concatenate path element/specified name with the suffix.
1493 If the directory starts with /:, remove that. */
1494 int prefixlen
= ((SCHARS (filename
) > 2
1495 && SREF (filename
, 0) == '/'
1496 && SREF (filename
, 1) == ':')
1498 fnlen
= SBYTES (filename
) - prefixlen
;
1499 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1500 memcpy (fn
+ fnlen
, SDATA (XCAR (tail
)), lsuffix
+ 1);
1502 /* Check that the file exists and is not a directory. */
1503 /* We used to only check for handlers on non-absolute file names:
1507 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1508 It's not clear why that was the case and it breaks things like
1509 (load "/bar.el") where the file is actually "/bar.el.gz". */
1510 string
= make_string (fn
, fnlen
);
1511 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1512 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1514 if (NILP (predicate
))
1515 exists
= !NILP (Ffile_readable_p (string
));
1518 Lisp_Object tmp
= call1 (predicate
, string
);
1519 exists
= !NILP (tmp
)
1520 && (EQ (tmp
, Qdir_ok
)
1521 || NILP (Ffile_directory_p (string
)));
1526 /* We succeeded; return this descriptor and filename. */
1537 encoded_fn
= ENCODE_FILE (string
);
1538 pfn
= SSDATA (encoded_fn
);
1539 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1542 /* Check that we can access or open it. */
1543 if (NATNUMP (predicate
))
1544 fd
= (((XFASTINT (predicate
) & ~INT_MAX
) == 0
1545 && access (pfn
, XFASTINT (predicate
)) == 0)
1548 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1552 /* We succeeded; return this descriptor and filename. */
1570 /* Merge the list we've accumulated of globals from the current input source
1571 into the load_history variable. The details depend on whether
1572 the source has an associated file name or not.
1574 FILENAME is the file name that we are loading from.
1575 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1578 build_load_history (Lisp_Object filename
, int entire
)
1580 register Lisp_Object tail
, prev
, newelt
;
1581 register Lisp_Object tem
, tem2
;
1582 register int foundit
= 0;
1584 tail
= Vload_history
;
1587 while (CONSP (tail
))
1591 /* Find the feature's previous assoc list... */
1592 if (!NILP (Fequal (filename
, Fcar (tem
))))
1596 /* If we're loading the entire file, remove old data. */
1600 Vload_history
= XCDR (tail
);
1602 Fsetcdr (prev
, XCDR (tail
));
1605 /* Otherwise, cons on new symbols that are not already members. */
1608 tem2
= Vcurrent_load_list
;
1610 while (CONSP (tem2
))
1612 newelt
= XCAR (tem2
);
1614 if (NILP (Fmember (newelt
, tem
)))
1615 Fsetcar (tail
, Fcons (XCAR (tem
),
1616 Fcons (newelt
, XCDR (tem
))));
1629 /* If we're loading an entire file, cons the new assoc onto the
1630 front of load-history, the most-recently-loaded position. Also
1631 do this if we didn't find an existing member for the file. */
1632 if (entire
|| !foundit
)
1633 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1638 readevalloop_1 (Lisp_Object old
)
1640 load_convert_to_unibyte
= ! NILP (old
);
1644 /* Signal an `end-of-file' error, if possible with file name
1647 static _Noreturn
void
1648 end_of_file_error (void)
1650 if (STRINGP (Vload_file_name
))
1651 xsignal1 (Qend_of_file
, Vload_file_name
);
1653 xsignal0 (Qend_of_file
);
1656 /* UNIBYTE specifies how to set load_convert_to_unibyte
1657 for this invocation.
1658 READFUN, if non-nil, is used instead of `read'.
1660 START, END specify region to read in current buffer (from eval-region).
1661 If the input is not from a buffer, they must be nil. */
1664 readevalloop (Lisp_Object readcharfun
,
1666 Lisp_Object sourcename
,
1668 Lisp_Object unibyte
, Lisp_Object readfun
,
1669 Lisp_Object start
, Lisp_Object end
)
1672 register Lisp_Object val
;
1673 ptrdiff_t count
= SPECPDL_INDEX ();
1674 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1675 struct buffer
*b
= 0;
1676 int continue_reading_p
;
1677 Lisp_Object lex_bound
;
1678 /* Nonzero if reading an entire buffer. */
1679 int whole_buffer
= 0;
1680 /* 1 on the first time around. */
1682 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1684 if (NILP (Ffboundp (macroexpand
))
1685 /* Don't macroexpand in .elc files, since it should have been done
1686 already. We actually don't know whether we're in a .elc file or not,
1687 so we use circumstancial evidence: .el files normally go through
1688 Vload_source_file_function -> load-with-code-conversion
1690 || EQ (readcharfun
, Qget_file_char
)
1691 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1694 if (MARKERP (readcharfun
))
1697 start
= readcharfun
;
1700 if (BUFFERP (readcharfun
))
1701 b
= XBUFFER (readcharfun
);
1702 else if (MARKERP (readcharfun
))
1703 b
= XMARKER (readcharfun
)->buffer
;
1705 /* We assume START is nil when input is not from a buffer. */
1706 if (! NILP (start
) && !b
)
1709 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1710 specbind (Qcurrent_load_list
, Qnil
);
1711 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1712 load_convert_to_unibyte
= !NILP (unibyte
);
1714 /* If lexical binding is active (either because it was specified in
1715 the file's header, or via a buffer-local variable), create an empty
1716 lexical environment, otherwise, turn off lexical binding. */
1717 lex_bound
= find_symbol_value (Qlexical_binding
);
1718 specbind (Qinternal_interpreter_environment
,
1719 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1720 ? Qnil
: Fcons (Qt
, Qnil
));
1722 GCPRO4 (sourcename
, readfun
, start
, end
);
1724 /* Try to ensure sourcename is a truename, except whilst preloading. */
1725 if (NILP (Vpurify_flag
)
1726 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1727 && !NILP (Ffboundp (Qfile_truename
)))
1728 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1730 LOADHIST_ATTACH (sourcename
);
1732 continue_reading_p
= 1;
1733 while (continue_reading_p
)
1735 ptrdiff_t count1
= SPECPDL_INDEX ();
1737 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1738 error ("Reading from killed buffer");
1742 /* Switch to the buffer we are reading from. */
1743 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1744 set_buffer_internal (b
);
1746 /* Save point in it. */
1747 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1748 /* Save ZV in it. */
1749 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1750 /* Those get unbound after we read one expression. */
1752 /* Set point and ZV around stuff to be read. */
1755 Fnarrow_to_region (make_number (BEGV
), end
);
1757 /* Just for cleanliness, convert END to a marker
1758 if it is an integer. */
1760 end
= Fpoint_max_marker ();
1763 /* On the first cycle, we can easily test here
1764 whether we are reading the whole buffer. */
1765 if (b
&& first_sexp
)
1766 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1773 while ((c
= READCHAR
) != '\n' && c
!= -1);
1778 unbind_to (count1
, Qnil
);
1782 /* Ignore whitespace here, so we can detect eof. */
1783 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1784 || c
== 0xa0) /* NBSP */
1787 if (!NILP (Vpurify_flag
) && c
== '(')
1789 val
= read_list (0, readcharfun
);
1794 read_objects
= Qnil
;
1795 if (!NILP (readfun
))
1797 val
= call1 (readfun
, readcharfun
);
1799 /* If READCHARFUN has set point to ZV, we should
1800 stop reading, even if the form read sets point
1801 to a different value when evaluated. */
1802 if (BUFFERP (readcharfun
))
1804 struct buffer
*buf
= XBUFFER (readcharfun
);
1805 if (BUF_PT (buf
) == BUF_ZV (buf
))
1806 continue_reading_p
= 0;
1809 else if (! NILP (Vload_read_function
))
1810 val
= call1 (Vload_read_function
, readcharfun
);
1812 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1815 if (!NILP (start
) && continue_reading_p
)
1816 start
= Fpoint_marker ();
1818 /* Restore saved point and BEGV. */
1819 unbind_to (count1
, Qnil
);
1821 /* Now eval what we just read. */
1822 if (!NILP (macroexpand
))
1823 val
= call1 (macroexpand
, val
);
1824 val
= eval_sub (val
);
1828 Vvalues
= Fcons (val
, Vvalues
);
1829 if (EQ (Vstandard_output
, Qt
))
1838 build_load_history (sourcename
,
1839 stream
|| whole_buffer
);
1843 unbind_to (count
, Qnil
);
1846 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1847 doc
: /* Execute the current buffer as Lisp code.
1848 When called from a Lisp program (i.e., not interactively), this
1849 function accepts up to five optional arguments:
1850 BUFFER is the buffer to evaluate (nil means use current buffer).
1851 PRINTFLAG controls printing of output:
1852 A value of nil means discard it; anything else is stream for print.
1853 FILENAME specifies the file name to use for `load-history'.
1854 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1856 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1857 functions should work normally even if PRINTFLAG is nil.
1859 This function preserves the position of point. */)
1860 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1862 ptrdiff_t count
= SPECPDL_INDEX ();
1863 Lisp_Object tem
, buf
;
1866 buf
= Fcurrent_buffer ();
1868 buf
= Fget_buffer (buffer
);
1870 error ("No such buffer");
1872 if (NILP (printflag
) && NILP (do_allow_print
))
1877 if (NILP (filename
))
1878 filename
= BVAR (XBUFFER (buf
), filename
);
1880 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1881 specbind (Qstandard_output
, tem
);
1882 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1883 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1884 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1885 readevalloop (buf
, 0, filename
,
1886 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1887 unbind_to (count
, Qnil
);
1892 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1893 doc
: /* Execute the region as Lisp code.
1894 When called from programs, expects two arguments,
1895 giving starting and ending indices in the current buffer
1896 of the text to be executed.
1897 Programs can pass third argument PRINTFLAG which controls output:
1898 A value of nil means discard it; anything else is stream for printing it.
1899 Also the fourth argument READ-FUNCTION, if non-nil, is used
1900 instead of `read' to read each expression. It gets one argument
1901 which is the input stream for reading characters.
1903 This function does not move point. */)
1904 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1906 /* FIXME: Do the eval-sexp-add-defvars dance! */
1907 ptrdiff_t count
= SPECPDL_INDEX ();
1908 Lisp_Object tem
, cbuf
;
1910 cbuf
= Fcurrent_buffer ();
1912 if (NILP (printflag
))
1916 specbind (Qstandard_output
, tem
);
1917 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1919 /* `readevalloop' calls functions which check the type of start and end. */
1920 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1921 !NILP (printflag
), Qnil
, read_function
,
1924 return unbind_to (count
, Qnil
);
1928 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1929 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1930 If STREAM is nil, use the value of `standard-input' (which see).
1931 STREAM or the value of `standard-input' may be:
1932 a buffer (read from point and advance it)
1933 a marker (read from where it points and advance it)
1934 a function (call it with no arguments for each character,
1935 call it with a char as argument to push a char back)
1936 a string (takes text from string, starting at the beginning)
1937 t (read text line using minibuffer and use it, or read from
1938 standard input in batch mode). */)
1939 (Lisp_Object stream
)
1942 stream
= Vstandard_input
;
1943 if (EQ (stream
, Qt
))
1944 stream
= Qread_char
;
1945 if (EQ (stream
, Qread_char
))
1946 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1948 return read_internal_start (stream
, Qnil
, Qnil
);
1951 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1952 doc
: /* Read one Lisp expression which is represented as text by STRING.
1953 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1954 FINAL-STRING-INDEX is an integer giving the position of the next
1955 remaining character in STRING.
1956 START and END optionally delimit a substring of STRING from which to read;
1957 they default to 0 and (length STRING) respectively. */)
1958 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1961 CHECK_STRING (string
);
1962 /* `read_internal_start' sets `read_from_string_index'. */
1963 ret
= read_internal_start (string
, start
, end
);
1964 return Fcons (ret
, make_number (read_from_string_index
));
1967 /* Function to set up the global context we need in toplevel read
1970 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1971 /* `start', `end' only used when stream is a string. */
1976 new_backquote_flag
= 0;
1977 read_objects
= Qnil
;
1978 if (EQ (Vread_with_symbol_positions
, Qt
)
1979 || EQ (Vread_with_symbol_positions
, stream
))
1980 Vread_symbol_positions_list
= Qnil
;
1982 if (STRINGP (stream
)
1983 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1985 ptrdiff_t startval
, endval
;
1988 if (STRINGP (stream
))
1991 string
= XCAR (stream
);
1994 endval
= SCHARS (string
);
1998 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
1999 args_out_of_range (string
, end
);
2000 endval
= XINT (end
);
2007 CHECK_NUMBER (start
);
2008 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2009 args_out_of_range (string
, start
);
2010 startval
= XINT (start
);
2012 read_from_string_index
= startval
;
2013 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2014 read_from_string_limit
= endval
;
2017 retval
= read0 (stream
);
2018 if (EQ (Vread_with_symbol_positions
, Qt
)
2019 || EQ (Vread_with_symbol_positions
, stream
))
2020 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2025 /* Signal Qinvalid_read_syntax error.
2026 S is error string of length N (if > 0) */
2028 static _Noreturn
void
2029 invalid_syntax (const char *s
)
2031 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2035 /* Use this for recursive reads, in contexts where internal tokens
2039 read0 (Lisp_Object readcharfun
)
2041 register Lisp_Object val
;
2044 val
= read1 (readcharfun
, &c
, 0);
2048 xsignal1 (Qinvalid_read_syntax
,
2049 Fmake_string (make_number (1), make_number (c
)));
2052 static ptrdiff_t read_buffer_size
;
2053 static char *read_buffer
;
2055 /* Read a \-escape sequence, assuming we already read the `\'.
2056 If the escape sequence forces unibyte, return eight-bit char. */
2059 read_escape (Lisp_Object readcharfun
, int stringp
)
2061 register int c
= READCHAR
;
2062 /* \u allows up to four hex digits, \U up to eight. Default to the
2063 behavior for \u, and change this value in the case that \U is seen. */
2064 int unicode_hex_count
= 4;
2069 end_of_file_error ();
2099 error ("Invalid escape character syntax");
2102 c
= read_escape (readcharfun
, 0);
2103 return c
| meta_modifier
;
2108 error ("Invalid escape character syntax");
2111 c
= read_escape (readcharfun
, 0);
2112 return c
| shift_modifier
;
2117 error ("Invalid escape character syntax");
2120 c
= read_escape (readcharfun
, 0);
2121 return c
| hyper_modifier
;
2126 error ("Invalid escape character syntax");
2129 c
= read_escape (readcharfun
, 0);
2130 return c
| alt_modifier
;
2134 if (stringp
|| c
!= '-')
2141 c
= read_escape (readcharfun
, 0);
2142 return c
| super_modifier
;
2147 error ("Invalid escape character syntax");
2151 c
= read_escape (readcharfun
, 0);
2152 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2153 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2154 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2155 return c
| ctrl_modifier
;
2156 /* ASCII control chars are made from letters (both cases),
2157 as well as the non-letters within 0100...0137. */
2158 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2159 return (c
& (037 | ~0177));
2160 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2161 return (c
& (037 | ~0177));
2163 return c
| ctrl_modifier
;
2173 /* An octal escape, as in ANSI C. */
2175 register int i
= c
- '0';
2176 register int count
= 0;
2179 if ((c
= READCHAR
) >= '0' && c
<= '7')
2191 if (i
>= 0x80 && i
< 0x100)
2192 i
= BYTE8_TO_CHAR (i
);
2197 /* A hex escape, as in ANSI C. */
2204 if (c
>= '0' && c
<= '9')
2209 else if ((c
>= 'a' && c
<= 'f')
2210 || (c
>= 'A' && c
<= 'F'))
2213 if (c
>= 'a' && c
<= 'f')
2223 /* Allow hex escapes as large as ?\xfffffff, because some
2224 packages use them to denote characters with modifiers. */
2225 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2226 error ("Hex character out of range: \\x%x...", i
);
2230 if (count
< 3 && i
>= 0x80)
2231 return BYTE8_TO_CHAR (i
);
2236 /* Post-Unicode-2.0: Up to eight hex chars. */
2237 unicode_hex_count
= 8;
2240 /* A Unicode escape. We only permit them in strings and characters,
2241 not arbitrarily in the source code, as in some other languages. */
2246 while (++count
<= unicode_hex_count
)
2249 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2251 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2252 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2253 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2255 error ("Non-hex digit used for Unicode escape");
2258 error ("Non-Unicode character: 0x%x", i
);
2267 /* Return the digit that CHARACTER stands for in the given BASE.
2268 Return -1 if CHARACTER is out of range for BASE,
2269 and -2 if CHARACTER is not valid for any supported BASE. */
2271 digit_to_number (int character
, int base
)
2275 if ('0' <= character
&& character
<= '9')
2276 digit
= character
- '0';
2277 else if ('a' <= character
&& character
<= 'z')
2278 digit
= character
- 'a' + 10;
2279 else if ('A' <= character
&& character
<= 'Z')
2280 digit
= character
- 'A' + 10;
2284 return digit
< base
? digit
: -1;
2287 /* Read an integer in radix RADIX using READCHARFUN to read
2288 characters. RADIX must be in the interval [2..36]; if it isn't, a
2289 read error is signaled . Value is the integer read. Signals an
2290 error if encountering invalid read syntax or if RADIX is out of
2294 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2296 /* Room for sign, leading 0, other digits, trailing null byte.
2297 Also, room for invalid syntax diagnostic. */
2298 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2299 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2301 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2303 if (radix
< 2 || radix
> 36)
2311 if (c
== '-' || c
== '+')
2322 /* Ignore redundant leading zeros, so the buffer doesn't
2323 fill up with them. */
2329 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2336 if (p
< buf
+ sizeof buf
- 1)
2350 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2351 invalid_syntax (buf
);
2354 return string_to_number (buf
, radix
, 0);
2358 /* If the next token is ')' or ']' or '.', we store that character
2359 in *PCH and the return value is not interesting. Else, we store
2360 zero in *PCH and we read and return one lisp object.
2362 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2365 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2368 bool uninterned_symbol
= 0;
2376 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2378 end_of_file_error ();
2383 return read_list (0, readcharfun
);
2386 return read_vector (readcharfun
, 0);
2402 /* Accept extended format for hashtables (extensible to
2404 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2405 Lisp_Object tmp
= read_list (0, readcharfun
);
2406 Lisp_Object head
= CAR_SAFE (tmp
);
2407 Lisp_Object data
= Qnil
;
2408 Lisp_Object val
= Qnil
;
2409 /* The size is 2 * number of allowed keywords to
2411 Lisp_Object params
[10];
2413 Lisp_Object key
= Qnil
;
2414 int param_count
= 0;
2416 if (!EQ (head
, Qhash_table
))
2417 error ("Invalid extended read marker at head of #s list "
2418 "(only hash-table allowed)");
2420 tmp
= CDR_SAFE (tmp
);
2422 /* This is repetitive but fast and simple. */
2423 params
[param_count
] = QCsize
;
2424 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2425 if (!NILP (params
[param_count
+ 1]))
2428 params
[param_count
] = QCtest
;
2429 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2430 if (!NILP (params
[param_count
+ 1]))
2433 params
[param_count
] = QCweakness
;
2434 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2435 if (!NILP (params
[param_count
+ 1]))
2438 params
[param_count
] = QCrehash_size
;
2439 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2440 if (!NILP (params
[param_count
+ 1]))
2443 params
[param_count
] = QCrehash_threshold
;
2444 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2445 if (!NILP (params
[param_count
+ 1]))
2448 /* This is the hashtable data. */
2449 data
= Fplist_get (tmp
, Qdata
);
2451 /* Now use params to make a new hashtable and fill it. */
2452 ht
= Fmake_hash_table (param_count
, params
);
2454 while (CONSP (data
))
2459 error ("Odd number of elements in hashtable data");
2462 Fputhash (key
, val
, ht
);
2468 invalid_syntax ("#");
2476 tmp
= read_vector (readcharfun
, 0);
2477 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2478 error ("Invalid size char-table");
2479 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2491 tmp
= read_vector (readcharfun
, 0);
2494 error ("Invalid size char-table");
2495 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2496 error ("Invalid depth in char-table");
2497 depth
= XINT (AREF (tmp
, 0));
2498 if (chartab_size
[depth
] != size
- 2)
2499 error ("Invalid size char-table");
2500 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2503 invalid_syntax ("#^^");
2505 invalid_syntax ("#^");
2510 length
= read1 (readcharfun
, pch
, first_in_list
);
2514 Lisp_Object tmp
, val
;
2515 EMACS_INT size_in_chars
2516 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2517 / BOOL_VECTOR_BITS_PER_CHAR
);
2520 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2521 if (STRING_MULTIBYTE (tmp
)
2522 || (size_in_chars
!= SCHARS (tmp
)
2523 /* We used to print 1 char too many
2524 when the number of bits was a multiple of 8.
2525 Accept such input in case it came from an old
2527 && ! (XFASTINT (length
)
2528 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2529 invalid_syntax ("#&...");
2531 val
= Fmake_bool_vector (length
, Qnil
);
2532 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2533 /* Clear the extraneous bits in the last byte. */
2534 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2535 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2536 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2539 invalid_syntax ("#&...");
2543 /* Accept compiled functions at read-time so that we don't have to
2544 build them using function calls. */
2546 tmp
= read_vector (readcharfun
, 1);
2547 make_byte_code (XVECTOR (tmp
));
2553 struct gcpro gcpro1
;
2556 /* Read the string itself. */
2557 tmp
= read1 (readcharfun
, &ch
, 0);
2558 if (ch
!= 0 || !STRINGP (tmp
))
2559 invalid_syntax ("#");
2561 /* Read the intervals and their properties. */
2564 Lisp_Object beg
, end
, plist
;
2566 beg
= read1 (readcharfun
, &ch
, 0);
2571 end
= read1 (readcharfun
, &ch
, 0);
2573 plist
= read1 (readcharfun
, &ch
, 0);
2575 invalid_syntax ("Invalid string property list");
2576 Fset_text_properties (beg
, end
, plist
, tmp
);
2582 /* #@NUMBER is used to skip NUMBER following characters.
2583 That's used in .elc files to skip over doc strings
2584 and function definitions. */
2587 enum { extra
= 100 };
2588 ptrdiff_t i
, nskip
= 0;
2591 /* Read a decimal integer. */
2592 while ((c
= READCHAR
) >= 0
2593 && c
>= '0' && c
<= '9')
2595 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2602 if (load_force_doc_strings
2603 && (EQ (readcharfun
, Qget_file_char
)
2604 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2606 /* If we are supposed to force doc strings into core right now,
2607 record the last string that we skipped,
2608 and record where in the file it comes from. */
2610 /* But first exchange saved_doc_string
2611 with prev_saved_doc_string, so we save two strings. */
2613 char *temp
= saved_doc_string
;
2614 ptrdiff_t temp_size
= saved_doc_string_size
;
2615 file_offset temp_pos
= saved_doc_string_position
;
2616 ptrdiff_t temp_len
= saved_doc_string_length
;
2618 saved_doc_string
= prev_saved_doc_string
;
2619 saved_doc_string_size
= prev_saved_doc_string_size
;
2620 saved_doc_string_position
= prev_saved_doc_string_position
;
2621 saved_doc_string_length
= prev_saved_doc_string_length
;
2623 prev_saved_doc_string
= temp
;
2624 prev_saved_doc_string_size
= temp_size
;
2625 prev_saved_doc_string_position
= temp_pos
;
2626 prev_saved_doc_string_length
= temp_len
;
2629 if (saved_doc_string_size
== 0)
2631 saved_doc_string
= xmalloc (nskip
+ extra
);
2632 saved_doc_string_size
= nskip
+ extra
;
2634 if (nskip
> saved_doc_string_size
)
2636 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2637 saved_doc_string_size
= nskip
+ extra
;
2640 saved_doc_string_position
= file_tell (instream
);
2642 /* Copy that many characters into saved_doc_string. */
2643 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2644 saved_doc_string
[i
] = c
= READCHAR
;
2646 saved_doc_string_length
= i
;
2650 /* Skip that many characters. */
2651 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2660 /* #! appears at the beginning of an executable file.
2661 Skip the first line. */
2662 while (c
!= '\n' && c
>= 0)
2667 return Vload_file_name
;
2669 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2670 /* #:foo is the uninterned symbol named foo. */
2673 uninterned_symbol
= 1;
2676 && c
!= 0xa0 /* NBSP */
2678 || strchr ("\"';()[]#`,", c
) == NULL
)))
2680 /* No symbol character follows, this is the empty
2683 return Fmake_symbol (empty_unibyte_string
);
2687 /* ## is the empty symbol. */
2689 return Fintern (empty_unibyte_string
, Qnil
);
2690 /* Reader forms that can reuse previously read objects. */
2691 if (c
>= '0' && c
<= '9')
2696 /* Read a non-negative integer. */
2697 while (c
>= '0' && c
<= '9')
2699 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2700 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2701 n
= MOST_POSITIVE_FIXNUM
+ 1;
2703 n
= n
* 10 + c
- '0';
2707 if (n
<= MOST_POSITIVE_FIXNUM
)
2709 if (c
== 'r' || c
== 'R')
2710 return read_integer (readcharfun
, n
);
2712 if (! NILP (Vread_circle
))
2714 /* #n=object returns object, but associates it with
2718 /* Make a placeholder for #n# to use temporarily. */
2719 Lisp_Object placeholder
;
2722 placeholder
= Fcons (Qnil
, Qnil
);
2723 cell
= Fcons (make_number (n
), placeholder
);
2724 read_objects
= Fcons (cell
, read_objects
);
2726 /* Read the object itself. */
2727 tem
= read0 (readcharfun
);
2729 /* Now put it everywhere the placeholder was... */
2730 substitute_object_in_subtree (tem
, placeholder
);
2732 /* ...and #n# will use the real value from now on. */
2733 Fsetcdr (cell
, tem
);
2738 /* #n# returns a previously read object. */
2741 tem
= Fassq (make_number (n
), read_objects
);
2747 /* Fall through to error message. */
2749 else if (c
== 'x' || c
== 'X')
2750 return read_integer (readcharfun
, 16);
2751 else if (c
== 'o' || c
== 'O')
2752 return read_integer (readcharfun
, 8);
2753 else if (c
== 'b' || c
== 'B')
2754 return read_integer (readcharfun
, 2);
2757 invalid_syntax ("#");
2760 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2765 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2770 int next_char
= READCHAR
;
2772 /* Transition from old-style to new-style:
2773 If we see "(`" it used to mean old-style, which usually works
2774 fine because ` should almost never appear in such a position
2775 for new-style. But occasionally we need "(`" to mean new
2776 style, so we try to distinguish the two by the fact that we
2777 can either write "( `foo" or "(` foo", where the first
2778 intends to use new-style whereas the second intends to use
2779 old-style. For Emacs-25, we should completely remove this
2780 first_in_list exception (old-style can still be obtained via
2782 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2784 Vold_style_backquotes
= Qt
;
2791 new_backquote_flag
++;
2792 value
= read0 (readcharfun
);
2793 new_backquote_flag
--;
2795 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2800 int next_char
= READCHAR
;
2802 /* Transition from old-style to new-style:
2803 It used to be impossible to have a new-style , other than within
2804 a new-style `. This is sufficient when ` and , are used in the
2805 normal way, but ` and , can also appear in args to macros that
2806 will not interpret them in the usual way, in which case , may be
2807 used without any ` anywhere near.
2808 So we now use the same heuristic as for backquote: old-style
2809 unquotes are only recognized when first on a list, and when
2810 followed by a space.
2811 Because it's more difficult to peek 2 chars ahead, a new-style
2812 ,@ can still not be used outside of a `, unless it's in the middle
2814 if (new_backquote_flag
2816 || (next_char
!= ' ' && next_char
!= '@'))
2818 Lisp_Object comma_type
= Qnil
;
2823 comma_type
= Qcomma_at
;
2825 comma_type
= Qcomma_dot
;
2828 if (ch
>= 0) UNREAD (ch
);
2829 comma_type
= Qcomma
;
2832 value
= read0 (readcharfun
);
2833 return Fcons (comma_type
, Fcons (value
, Qnil
));
2837 Vold_style_backquotes
= Qt
;
2849 end_of_file_error ();
2851 /* Accept `single space' syntax like (list ? x) where the
2852 whitespace character is SPC or TAB.
2853 Other literal whitespace like NL, CR, and FF are not accepted,
2854 as there are well-established escape sequences for these. */
2855 if (c
== ' ' || c
== '\t')
2856 return make_number (c
);
2859 c
= read_escape (readcharfun
, 0);
2860 modifiers
= c
& CHAR_MODIFIER_MASK
;
2861 c
&= ~CHAR_MODIFIER_MASK
;
2862 if (CHAR_BYTE8_P (c
))
2863 c
= CHAR_TO_BYTE8 (c
);
2866 next_char
= READCHAR
;
2867 ok
= (next_char
<= 040
2868 || (next_char
< 0200
2869 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2872 return make_number (c
);
2874 invalid_syntax ("?");
2879 char *p
= read_buffer
;
2880 char *end
= read_buffer
+ read_buffer_size
;
2882 /* Nonzero if we saw an escape sequence specifying
2883 a multibyte character. */
2884 int force_multibyte
= 0;
2885 /* Nonzero if we saw an escape sequence specifying
2886 a single-byte character. */
2887 int force_singlebyte
= 0;
2889 ptrdiff_t nchars
= 0;
2891 while ((ch
= READCHAR
) >= 0
2894 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2896 ptrdiff_t offset
= p
- read_buffer
;
2897 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2898 memory_full (SIZE_MAX
);
2899 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
2900 read_buffer_size
*= 2;
2901 p
= read_buffer
+ offset
;
2902 end
= read_buffer
+ read_buffer_size
;
2909 ch
= read_escape (readcharfun
, 1);
2911 /* CH is -1 if \ newline has just been seen. */
2914 if (p
== read_buffer
)
2919 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2920 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2922 if (CHAR_BYTE8_P (ch
))
2923 force_singlebyte
= 1;
2924 else if (! ASCII_CHAR_P (ch
))
2925 force_multibyte
= 1;
2926 else /* I.e. ASCII_CHAR_P (ch). */
2928 /* Allow `\C- ' and `\C-?'. */
2929 if (modifiers
== CHAR_CTL
)
2932 ch
= 0, modifiers
= 0;
2934 ch
= 127, modifiers
= 0;
2936 if (modifiers
& CHAR_SHIFT
)
2938 /* Shift modifier is valid only with [A-Za-z]. */
2939 if (ch
>= 'A' && ch
<= 'Z')
2940 modifiers
&= ~CHAR_SHIFT
;
2941 else if (ch
>= 'a' && ch
<= 'z')
2942 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2945 if (modifiers
& CHAR_META
)
2947 /* Move the meta bit to the right place for a
2949 modifiers
&= ~CHAR_META
;
2950 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2951 force_singlebyte
= 1;
2955 /* Any modifiers remaining are invalid. */
2957 error ("Invalid modifier in string");
2958 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2962 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2963 if (CHAR_BYTE8_P (ch
))
2964 force_singlebyte
= 1;
2965 else if (! ASCII_CHAR_P (ch
))
2966 force_multibyte
= 1;
2972 end_of_file_error ();
2974 /* If purifying, and string starts with \ newline,
2975 return zero instead. This is for doc strings
2976 that we are really going to find in etc/DOC.nn.nn. */
2977 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2978 return make_number (0);
2980 if (! force_multibyte
&& force_singlebyte
)
2982 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
2983 forms. Convert it to unibyte. */
2984 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
2986 p
= read_buffer
+ nchars
;
2989 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2991 || (p
- read_buffer
!= nchars
)));
2996 int next_char
= READCHAR
;
2999 if (next_char
<= 040
3000 || (next_char
< 0200
3001 && strchr ("\"';([#?`,", next_char
) != NULL
))
3007 /* Otherwise, we fall through! Note that the atom-reading loop
3008 below will now loop at least once, assuring that we will not
3009 try to UNREAD two characters in a row. */
3013 if (c
<= 040) goto retry
;
3014 if (c
== 0xa0) /* NBSP */
3019 char *p
= read_buffer
;
3021 EMACS_INT start_position
= readchar_count
- 1;
3024 char *end
= read_buffer
+ read_buffer_size
;
3028 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3030 ptrdiff_t offset
= p
- read_buffer
;
3031 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3032 memory_full (SIZE_MAX
);
3033 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3034 read_buffer_size
*= 2;
3035 p
= read_buffer
+ offset
;
3036 end
= read_buffer
+ read_buffer_size
;
3043 end_of_file_error ();
3048 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3054 && c
!= 0xa0 /* NBSP */
3056 || strchr ("\"';()[]#`,", c
) == NULL
));
3060 ptrdiff_t offset
= p
- read_buffer
;
3061 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3062 memory_full (SIZE_MAX
);
3063 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3064 read_buffer_size
*= 2;
3065 p
= read_buffer
+ offset
;
3066 end
= read_buffer
+ read_buffer_size
;
3072 if (!quoted
&& !uninterned_symbol
)
3074 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3075 if (! NILP (result
))
3079 Lisp_Object name
, result
;
3080 ptrdiff_t nbytes
= p
- read_buffer
;
3083 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3087 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3088 ? make_pure_string
: make_specified_string
)
3089 (read_buffer
, nchars
, nbytes
, multibyte
));
3090 result
= (uninterned_symbol
? Fmake_symbol (name
)
3091 : Fintern (name
, Qnil
));
3093 if (EQ (Vread_with_symbol_positions
, Qt
)
3094 || EQ (Vread_with_symbol_positions
, readcharfun
))
3095 Vread_symbol_positions_list
3096 = Fcons (Fcons (result
, make_number (start_position
)),
3097 Vread_symbol_positions_list
);
3105 /* List of nodes we've seen during substitute_object_in_subtree. */
3106 static Lisp_Object seen_list
;
3109 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3111 Lisp_Object check_object
;
3113 /* We haven't seen any objects when we start. */
3116 /* Make all the substitutions. */
3118 = substitute_object_recurse (object
, placeholder
, object
);
3120 /* Clear seen_list because we're done with it. */
3123 /* The returned object here is expected to always eq the
3125 if (!EQ (check_object
, object
))
3126 error ("Unexpected mutation error in reader");
3129 /* Feval doesn't get called from here, so no gc protection is needed. */
3130 #define SUBSTITUTE(get_val, set_val) \
3132 Lisp_Object old_value = get_val; \
3133 Lisp_Object true_value \
3134 = substitute_object_recurse (object, placeholder, \
3137 if (!EQ (old_value, true_value)) \
3144 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3146 /* If we find the placeholder, return the target object. */
3147 if (EQ (placeholder
, subtree
))
3150 /* If we've been to this node before, don't explore it again. */
3151 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3154 /* If this node can be the entry point to a cycle, remember that
3155 we've seen it. It can only be such an entry point if it was made
3156 by #n=, which means that we can find it as a value in
3158 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3159 seen_list
= Fcons (subtree
, seen_list
);
3161 /* Recurse according to subtree's type.
3162 Every branch must return a Lisp_Object. */
3163 switch (XTYPE (subtree
))
3165 case Lisp_Vectorlike
:
3167 ptrdiff_t i
, length
= 0;
3168 if (BOOL_VECTOR_P (subtree
))
3169 return subtree
; /* No sub-objects anyway. */
3170 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3171 || COMPILEDP (subtree
))
3172 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3173 else if (VECTORP (subtree
))
3174 length
= ASIZE (subtree
);
3176 /* An unknown pseudovector may contain non-Lisp fields, so we
3177 can't just blindly traverse all its fields. We used to call
3178 `Flength' which signaled `sequencep', so I just preserved this
3180 wrong_type_argument (Qsequencep
, subtree
);
3182 for (i
= 0; i
< length
; i
++)
3183 SUBSTITUTE (AREF (subtree
, i
),
3184 ASET (subtree
, i
, true_value
));
3190 SUBSTITUTE (XCAR (subtree
),
3191 XSETCAR (subtree
, true_value
));
3192 SUBSTITUTE (XCDR (subtree
),
3193 XSETCDR (subtree
, true_value
));
3199 /* Check for text properties in each interval.
3200 substitute_in_interval contains part of the logic. */
3202 INTERVAL root_interval
= string_intervals (subtree
);
3203 Lisp_Object arg
= Fcons (object
, placeholder
);
3205 traverse_intervals_noorder (root_interval
,
3206 &substitute_in_interval
, arg
);
3211 /* Other types don't recurse any further. */
3217 /* Helper function for substitute_object_recurse. */
3219 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3221 Lisp_Object object
= Fcar (arg
);
3222 Lisp_Object placeholder
= Fcdr (arg
);
3224 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3234 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3235 integer syntax and fits in a fixnum, else return the nearest float if CP has
3236 either floating point or integer syntax and BASE is 10, else return nil. If
3237 IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
3238 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3239 number has integer syntax but does not fit. */
3242 string_to_number (char const *string
, int base
, int ignore_trailing
)
3245 char const *cp
= string
;
3247 int float_syntax
= 0;
3250 /* Compute NaN and infinities using a variable, to cope with compilers that
3251 think they are smarter than we are. */
3254 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3255 IEEE floating point hosts, and works around a formerly-common bug where
3256 atof ("-0.0") drops the sign. */
3257 int negative
= *cp
== '-';
3259 int signedp
= negative
|| *cp
== '+';
3264 leading_digit
= digit_to_number (*cp
, base
);
3265 if (0 <= leading_digit
)
3270 while (0 <= digit_to_number (*cp
, base
));
3280 if ('0' <= *cp
&& *cp
<= '9')
3285 while ('0' <= *cp
&& *cp
<= '9');
3287 if (*cp
== 'e' || *cp
== 'E')
3289 char const *ecp
= cp
;
3291 if (*cp
== '+' || *cp
== '-')
3293 if ('0' <= *cp
&& *cp
<= '9')
3298 while ('0' <= *cp
&& *cp
<= '9');
3300 else if (cp
[-1] == '+'
3301 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3307 else if (cp
[-1] == '+'
3308 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3312 value
= zero
/ zero
;
3314 /* If that made a "negative" NaN, negate it. */
3317 union { double d
; char c
[sizeof (double)]; }
3318 u_data
, u_minus_zero
;
3320 u_minus_zero
.d
= -0.0;
3321 for (i
= 0; i
< sizeof (double); i
++)
3322 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3328 /* Now VALUE is a positive NaN. */
3334 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3335 || state
== (LEAD_INT
|E_EXP
));
3338 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3339 any prefix that matches. Otherwise, the entire string must match. */
3340 if (! (ignore_trailing
3341 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3342 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3345 /* If the number uses integer and not float syntax, and is in C-language
3346 range, use its value, preferably as a fixnum. */
3347 if (0 <= leading_digit
&& ! float_syntax
)
3351 /* Fast special case for single-digit integers. This also avoids a
3352 glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
3353 case some versions of strtoumax accept numbers like "0x1" that Emacs
3355 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3356 return make_number (negative
? -leading_digit
: leading_digit
);
3359 n
= strtoumax (string
+ signedp
, NULL
, base
);
3360 if (errno
== ERANGE
)
3362 /* Unfortunately there's no simple and accurate way to convert
3363 non-base-10 numbers that are out of C-language range. */
3365 xsignal1 (Qoverflow_error
, build_string (string
));
3367 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3369 EMACS_INT signed_n
= n
;
3370 return make_number (negative
? -signed_n
: signed_n
);
3376 /* Either the number uses float syntax, or it does not fit into a fixnum.
3377 Convert it from string to floating point, unless the value is already
3378 known because it is an infinity, a NAN, or its absolute value fits in
3381 value
= atof (string
+ signedp
);
3383 return make_float (negative
? -value
: value
);
3388 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3391 register Lisp_Object
*ptr
;
3392 register Lisp_Object tem
, item
, vector
;
3393 register struct Lisp_Cons
*otem
;
3396 tem
= read_list (1, readcharfun
);
3397 len
= Flength (tem
);
3398 vector
= Fmake_vector (len
, Qnil
);
3400 size
= ASIZE (vector
);
3401 ptr
= XVECTOR (vector
)->contents
;
3402 for (i
= 0; i
< size
; i
++)
3405 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3406 bytecode object, the docstring containing the bytecode and
3407 constants values must be treated as unibyte and passed to
3408 Fread, to get the actual bytecode string and constants vector. */
3409 if (bytecodeflag
&& load_force_doc_strings
)
3411 if (i
== COMPILED_BYTECODE
)
3413 if (!STRINGP (item
))
3414 error ("Invalid byte code");
3416 /* Delay handling the bytecode slot until we know whether
3417 it is lazily-loaded (we can tell by whether the
3418 constants slot is nil). */
3419 ASET (vector
, COMPILED_CONSTANTS
, item
);
3422 else if (i
== COMPILED_CONSTANTS
)
3424 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3428 /* Coerce string to unibyte (like string-as-unibyte,
3429 but without generating extra garbage and
3430 guaranteeing no change in the contents). */
3431 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3432 STRING_SET_UNIBYTE (bytestr
);
3434 item
= Fread (Fcons (bytestr
, readcharfun
));
3436 error ("Invalid byte code");
3438 otem
= XCONS (item
);
3439 bytestr
= XCAR (item
);
3444 /* Now handle the bytecode slot. */
3445 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3447 else if (i
== COMPILED_DOC_STRING
3449 && ! STRING_MULTIBYTE (item
))
3451 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3452 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3454 item
= Fstring_as_multibyte (item
);
3457 ASET (vector
, i
, item
);
3465 /* FLAG = 1 means check for ] to terminate rather than ) and . */
3468 read_list (int flag
, register Lisp_Object readcharfun
)
3470 Lisp_Object val
, tail
;
3471 register Lisp_Object elt
, tem
;
3472 struct gcpro gcpro1
, gcpro2
;
3473 /* 0 is the normal case.
3474 1 means this list is a doc reference; replace it with the number 0.
3475 2 means this list is a doc reference; replace it with the doc string. */
3476 int doc_reference
= 0;
3478 /* Initialize this to 1 if we are reading a list. */
3479 int first_in_list
= flag
<= 0;
3488 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3493 /* While building, if the list starts with #$, treat it specially. */
3494 if (EQ (elt
, Vload_file_name
)
3496 && !NILP (Vpurify_flag
))
3498 if (NILP (Vdoc_file_name
))
3499 /* We have not yet called Snarf-documentation, so assume
3500 this file is described in the DOC-MM.NN file
3501 and Snarf-documentation will fill in the right value later.
3502 For now, replace the whole list with 0. */
3505 /* We have already called Snarf-documentation, so make a relative
3506 file name for this file, so it can be found properly
3507 in the installed Lisp directory.
3508 We don't use Fexpand_file_name because that would make
3509 the directory absolute now. */
3510 elt
= concat2 (build_string ("../lisp/"),
3511 Ffile_name_nondirectory (elt
));
3513 else if (EQ (elt
, Vload_file_name
)
3515 && load_force_doc_strings
)
3524 invalid_syntax (") or . in a vector");
3532 XSETCDR (tail
, read0 (readcharfun
));
3534 val
= read0 (readcharfun
);
3535 read1 (readcharfun
, &ch
, 0);
3539 if (doc_reference
== 1)
3540 return make_number (0);
3541 if (doc_reference
== 2)
3543 /* Get a doc string from the file we are loading.
3544 If it's in saved_doc_string, get it from there.
3546 Here, we don't know if the string is a
3547 bytecode string or a doc string. As a
3548 bytecode string must be unibyte, we always
3549 return a unibyte string. If it is actually a
3550 doc string, caller must make it
3553 EMACS_INT pos
= XINT (XCDR (val
));
3554 /* Position is negative for user variables. */
3555 if (pos
< 0) pos
= -pos
;
3556 if (pos
>= saved_doc_string_position
3557 && pos
< (saved_doc_string_position
3558 + saved_doc_string_length
))
3560 ptrdiff_t start
= pos
- saved_doc_string_position
;
3563 /* Process quoting with ^A,
3564 and find the end of the string,
3565 which is marked with ^_ (037). */
3566 for (from
= start
, to
= start
;
3567 saved_doc_string
[from
] != 037;)
3569 int c
= saved_doc_string
[from
++];
3572 c
= saved_doc_string
[from
++];
3574 saved_doc_string
[to
++] = c
;
3576 saved_doc_string
[to
++] = 0;
3578 saved_doc_string
[to
++] = 037;
3581 saved_doc_string
[to
++] = c
;
3584 return make_unibyte_string (saved_doc_string
+ start
,
3587 /* Look in prev_saved_doc_string the same way. */
3588 else if (pos
>= prev_saved_doc_string_position
3589 && pos
< (prev_saved_doc_string_position
3590 + prev_saved_doc_string_length
))
3593 pos
- prev_saved_doc_string_position
;
3596 /* Process quoting with ^A,
3597 and find the end of the string,
3598 which is marked with ^_ (037). */
3599 for (from
= start
, to
= start
;
3600 prev_saved_doc_string
[from
] != 037;)
3602 int c
= prev_saved_doc_string
[from
++];
3605 c
= prev_saved_doc_string
[from
++];
3607 prev_saved_doc_string
[to
++] = c
;
3609 prev_saved_doc_string
[to
++] = 0;
3611 prev_saved_doc_string
[to
++] = 037;
3614 prev_saved_doc_string
[to
++] = c
;
3617 return make_unibyte_string (prev_saved_doc_string
3622 return get_doc_string (val
, 1, 0);
3627 invalid_syntax (". in wrong context");
3629 invalid_syntax ("] in a list");
3631 tem
= Fcons (elt
, Qnil
);
3633 XSETCDR (tail
, tem
);
3640 static Lisp_Object initial_obarray
;
3642 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3644 static size_t oblookup_last_bucket_number
;
3646 /* Get an error if OBARRAY is not an obarray.
3647 If it is one, return it. */
3650 check_obarray (Lisp_Object obarray
)
3652 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3654 /* If Vobarray is now invalid, force it to be valid. */
3655 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3656 wrong_type_argument (Qvectorp
, obarray
);
3661 /* Intern the C string STR: return a symbol with that name,
3662 interned in the current obarray. */
3665 intern_1 (const char *str
, ptrdiff_t len
)
3667 Lisp_Object obarray
= check_obarray (Vobarray
);
3668 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3670 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3674 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3676 Lisp_Object obarray
= check_obarray (Vobarray
);
3677 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3682 if (NILP (Vpurify_flag
))
3683 /* Creating a non-pure string from a string literal not
3684 implemented yet. We could just use make_string here and live
3685 with the extra copy. */
3688 return Fintern (make_pure_c_string (str
, len
), obarray
);
3691 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3692 doc
: /* Return the canonical symbol whose name is STRING.
3693 If there is none, one is created by this function and returned.
3694 A second optional argument specifies the obarray to use;
3695 it defaults to the value of `obarray'. */)
3696 (Lisp_Object string
, Lisp_Object obarray
)
3698 register Lisp_Object tem
, sym
, *ptr
;
3700 if (NILP (obarray
)) obarray
= Vobarray
;
3701 obarray
= check_obarray (obarray
);
3703 CHECK_STRING (string
);
3705 tem
= oblookup (obarray
, SSDATA (string
),
3708 if (!INTEGERP (tem
))
3711 if (!NILP (Vpurify_flag
))
3712 string
= Fpurecopy (string
);
3713 sym
= Fmake_symbol (string
);
3715 if (EQ (obarray
, initial_obarray
))
3716 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3718 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3720 if ((SREF (string
, 0) == ':')
3721 && EQ (obarray
, initial_obarray
))
3723 XSYMBOL (sym
)->constant
= 1;
3724 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3725 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3728 ptr
= aref_addr (obarray
, XINT(tem
));
3730 set_symbol_next (sym
, XSYMBOL (*ptr
));
3732 set_symbol_next (sym
, NULL
);
3737 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3738 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3739 NAME may be a string or a symbol. If it is a symbol, that exact
3740 symbol is searched for.
3741 A second optional argument specifies the obarray to use;
3742 it defaults to the value of `obarray'. */)
3743 (Lisp_Object name
, Lisp_Object obarray
)
3745 register Lisp_Object tem
, string
;
3747 if (NILP (obarray
)) obarray
= Vobarray
;
3748 obarray
= check_obarray (obarray
);
3750 if (!SYMBOLP (name
))
3752 CHECK_STRING (name
);
3756 string
= SYMBOL_NAME (name
);
3758 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3759 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3765 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3766 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3767 The value is t if a symbol was found and deleted, nil otherwise.
3768 NAME may be a string or a symbol. If it is a symbol, that symbol
3769 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3770 OBARRAY defaults to the value of the variable `obarray'. */)
3771 (Lisp_Object name
, Lisp_Object obarray
)
3773 register Lisp_Object string
, tem
;
3776 if (NILP (obarray
)) obarray
= Vobarray
;
3777 obarray
= check_obarray (obarray
);
3780 string
= SYMBOL_NAME (name
);
3783 CHECK_STRING (name
);
3787 tem
= oblookup (obarray
, SSDATA (string
),
3792 /* If arg was a symbol, don't delete anything but that symbol itself. */
3793 if (SYMBOLP (name
) && !EQ (name
, tem
))
3796 /* There are plenty of other symbols which will screw up the Emacs
3797 session if we unintern them, as well as even more ways to use
3798 `setq' or `fset' or whatnot to make the Emacs session
3799 unusable. Let's not go down this silly road. --Stef */
3800 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3801 error ("Attempt to unintern t or nil"); */
3803 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3805 hash
= oblookup_last_bucket_number
;
3807 if (EQ (AREF (obarray
, hash
), tem
))
3809 if (XSYMBOL (tem
)->next
)
3812 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3813 ASET (obarray
, hash
, sym
);
3816 ASET (obarray
, hash
, make_number (0));
3820 Lisp_Object tail
, following
;
3822 for (tail
= AREF (obarray
, hash
);
3823 XSYMBOL (tail
)->next
;
3826 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3827 if (EQ (following
, tem
))
3829 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3838 /* Return the symbol in OBARRAY whose names matches the string
3839 of SIZE characters (SIZE_BYTE bytes) at PTR.
3840 If there is no such symbol in OBARRAY, return nil.
3842 Also store the bucket number in oblookup_last_bucket_number. */
3845 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3849 register Lisp_Object tail
;
3850 Lisp_Object bucket
, tem
;
3852 obarray
= check_obarray (obarray
);
3853 obsize
= ASIZE (obarray
);
3855 /* This is sometimes needed in the middle of GC. */
3856 obsize
&= ~ARRAY_MARK_FLAG
;
3857 hash
= hash_string (ptr
, size_byte
) % obsize
;
3858 bucket
= AREF (obarray
, hash
);
3859 oblookup_last_bucket_number
= hash
;
3860 if (EQ (bucket
, make_number (0)))
3862 else if (!SYMBOLP (bucket
))
3863 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3865 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3867 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3868 && SCHARS (SYMBOL_NAME (tail
)) == size
3869 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3871 else if (XSYMBOL (tail
)->next
== 0)
3874 XSETINT (tem
, hash
);
3879 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3882 register Lisp_Object tail
;
3883 CHECK_VECTOR (obarray
);
3884 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3886 tail
= AREF (obarray
, i
);
3891 if (XSYMBOL (tail
)->next
== 0)
3893 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3899 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3901 call1 (function
, sym
);
3904 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3905 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3906 OBARRAY defaults to the value of `obarray'. */)
3907 (Lisp_Object function
, Lisp_Object obarray
)
3909 if (NILP (obarray
)) obarray
= Vobarray
;
3910 obarray
= check_obarray (obarray
);
3912 map_obarray (obarray
, mapatoms_1
, function
);
3916 #define OBARRAY_SIZE 1511
3921 Lisp_Object oblength
;
3922 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3924 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3926 Vobarray
= Fmake_vector (oblength
, make_number (0));
3927 initial_obarray
= Vobarray
;
3928 staticpro (&initial_obarray
);
3930 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
3931 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3932 NILP (Vpurify_flag) check in intern_c_string. */
3933 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3934 Qnil
= intern_c_string ("nil");
3936 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3937 so those two need to be fixed manually. */
3938 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3939 set_symbol_function (Qunbound
, Qunbound
);
3940 set_symbol_plist (Qunbound
, Qnil
);
3941 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3942 XSYMBOL (Qnil
)->constant
= 1;
3943 XSYMBOL (Qnil
)->declared_special
= 1;
3944 set_symbol_plist (Qnil
, Qnil
);
3946 Qt
= intern_c_string ("t");
3947 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3948 XSYMBOL (Qnil
)->declared_special
= 1;
3949 XSYMBOL (Qt
)->constant
= 1;
3951 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3954 DEFSYM (Qvariable_documentation
, "variable-documentation");
3956 read_buffer
= xmalloc (size
);
3957 read_buffer_size
= size
;
3961 defsubr (struct Lisp_Subr
*sname
)
3963 Lisp_Object sym
, tem
;
3964 sym
= intern_c_string (sname
->symbol_name
);
3965 XSETTYPED_PVECTYPE (sname
, size
, PVEC_SUBR
);
3966 XSETSUBR (tem
, sname
);
3967 set_symbol_function (sym
, tem
);
3970 #ifdef NOTDEF /* Use fset in subr.el now! */
3972 defalias (struct Lisp_Subr
*sname
, char *string
)
3975 sym
= intern (string
);
3976 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3980 /* Define an "integer variable"; a symbol whose value is forwarded to a
3981 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
3982 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3984 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3985 const char *namestring
, EMACS_INT
*address
)
3988 sym
= intern_c_string (namestring
);
3989 i_fwd
->type
= Lisp_Fwd_Int
;
3990 i_fwd
->intvar
= address
;
3991 XSYMBOL (sym
)->declared_special
= 1;
3992 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3993 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
3996 /* Similar but define a variable whose value is t if address contains 1,
3997 nil if address contains 0. */
3999 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4000 const char *namestring
, bool *address
)
4003 sym
= intern_c_string (namestring
);
4004 b_fwd
->type
= Lisp_Fwd_Bool
;
4005 b_fwd
->boolvar
= address
;
4006 XSYMBOL (sym
)->declared_special
= 1;
4007 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4008 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4009 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4012 /* Similar but define a variable whose value is the Lisp Object stored
4013 at address. Two versions: with and without gc-marking of the C
4014 variable. The nopro version is used when that variable will be
4015 gc-marked for some other reason, since marking the same slot twice
4016 can cause trouble with strings. */
4018 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4019 const char *namestring
, Lisp_Object
*address
)
4022 sym
= intern_c_string (namestring
);
4023 o_fwd
->type
= Lisp_Fwd_Obj
;
4024 o_fwd
->objvar
= address
;
4025 XSYMBOL (sym
)->declared_special
= 1;
4026 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4027 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4031 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4032 const char *namestring
, Lisp_Object
*address
)
4034 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4035 staticpro (address
);
4038 /* Similar but define a variable whose value is the Lisp Object stored
4039 at a particular offset in the current kboard object. */
4042 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4043 const char *namestring
, int offset
)
4046 sym
= intern_c_string (namestring
);
4047 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4048 ko_fwd
->offset
= offset
;
4049 XSYMBOL (sym
)->declared_special
= 1;
4050 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4051 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4054 /* Check that the elements of Vload_path exist. */
4057 load_path_check (void)
4059 Lisp_Object path_tail
;
4061 /* The only elements that might not exist are those from
4062 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4064 for (path_tail
= Vload_path
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4066 Lisp_Object dirfile
;
4067 dirfile
= Fcar (path_tail
);
4068 if (STRINGP (dirfile
))
4070 dirfile
= Fdirectory_file_name (dirfile
);
4071 if (access (SSDATA (dirfile
), 0) < 0)
4072 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4078 /* Record the value of load-path used at the start of dumping
4079 so we can see if the site changed it later during dumping. */
4080 static Lisp_Object dump_path
;
4082 /* Compute the default Vload_path, with the following logic:
4084 use EMACSLOADPATH env-var if set; otherwise use PATH_LOADSEARCH,
4085 prepending PATH_SITELOADSEARCH unless --no-site-lisp.
4086 The remainder is what happens when dumping works:
4087 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4088 Otherwise use EMACSLOADPATH if set, else PATH_LOADSEARCH.
4090 If !initialized, then just set both Vload_path and dump_path.
4091 If initialized, then if Vload_path != dump_path, do nothing.
4092 (Presumably the load-path has already been changed by something.
4093 This can only be from a site-load file during dumping,
4094 or because EMACSLOADPATH is set.)
4095 If Vinstallation_directory is not nil (ie, running uninstalled):
4096 If installation-dir/lisp exists and not already a member,
4097 we must be running uninstalled. Reset the load-path
4098 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4099 refers to the eventual installation directories. Since we
4100 are not yet installed, we should not use them, even if they exist.)
4101 If installation-dir/lisp does not exist, just add dump_path at the
4103 Add installation-dir/leim (if exists and not already a member) at the front.
4104 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4105 and not already a member) at the front.
4106 If installation-dir != source-dir (ie running an uninstalled,
4107 out-of-tree build) AND install-dir/src/Makefile exists BUT
4108 install-dir/src/Makefile.in does NOT exist (this is a sanity
4109 check), then repeat the above steps for source-dir/lisp,
4111 Finally, add the site-lisp directories at the front (if !no_site_lisp).
4121 const char *loadpath
= ns_load_path ();
4124 normal
= PATH_LOADSEARCH
;
4126 Vload_path
= decode_env_path ("EMACSLOADPATH", loadpath
? loadpath
: normal
);
4128 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4133 /* FIXME CANNOT_DUMP platforms should get source-dir/lisp etc added
4134 to their load-path too, AFAICS. I don't think we can tell the
4135 difference between initialized and !initialized in this case,
4136 so we'll have to do it unconditionally when Vinstallation_directory
4138 if (!no_site_lisp
&& !egetenv ("EMACSLOADPATH"))
4140 Lisp_Object sitelisp
;
4141 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4142 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4144 #else /* !CANNOT_DUMP */
4145 if (NILP (Vpurify_flag
))
4147 normal
= PATH_LOADSEARCH
;
4148 /* If the EMACSLOADPATH environment variable is set, use its value.
4149 This doesn't apply if we're dumping. */
4150 if (egetenv ("EMACSLOADPATH"))
4151 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4154 normal
= PATH_DUMPLOADSEARCH
;
4156 /* In a dumped Emacs, we normally reset the value of Vload_path using
4157 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4158 the source directory, instead of the path of the installed elisp
4159 libraries. However, if it appears that Vload_path has already been
4160 changed from the default that was saved before dumping, don't
4161 change it further. Changes can only be due to EMACSLOADPATH, or
4162 site-lisp files that were processed during dumping. */
4165 if (NILP (Fequal (dump_path
, Vload_path
)))
4167 /* Do not make any changes, just check the elements exist. */
4168 /* Note: --no-site-lisp is ignored.
4169 I don't know what to do about this. */
4175 const char *loadpath
= ns_load_path ();
4176 Vload_path
= decode_env_path (0, loadpath
? loadpath
: normal
);
4178 Vload_path
= decode_env_path (0, normal
);
4180 if (!NILP (Vinstallation_directory
))
4182 Lisp_Object tem
, tem1
;
4184 /* Add to the path the lisp subdir of the installation
4185 dir, if it exists. Note: in out-of-tree builds,
4186 this directory is empty save for Makefile. */
4187 tem
= Fexpand_file_name (build_string ("lisp"),
4188 Vinstallation_directory
);
4189 tem1
= Ffile_exists_p (tem
);
4192 if (NILP (Fmember (tem
, Vload_path
)))
4194 /* We are running uninstalled. The default load-path
4195 points to the eventual installed lisp, leim
4196 directories. We should not use those now, even
4197 if they exist, so start over from a clean slate. */
4198 Vload_path
= Fcons (tem
, Qnil
);
4202 /* That dir doesn't exist, so add the build-time
4203 Lisp dirs instead. */
4204 Vload_path
= nconc2 (Vload_path
, dump_path
);
4206 /* Add leim under the installation dir, if it exists. */
4207 tem
= Fexpand_file_name (build_string ("leim"),
4208 Vinstallation_directory
);
4209 tem1
= Ffile_exists_p (tem
);
4212 if (NILP (Fmember (tem
, Vload_path
)))
4213 Vload_path
= Fcons (tem
, Vload_path
);
4216 /* Add site-lisp under the installation dir, if it exists. */
4219 tem
= Fexpand_file_name (build_string ("site-lisp"),
4220 Vinstallation_directory
);
4221 tem1
= Ffile_exists_p (tem
);
4224 if (NILP (Fmember (tem
, Vload_path
)))
4225 Vload_path
= Fcons (tem
, Vload_path
);
4229 /* If Emacs was not built in the source directory,
4230 and it is run from where it was built, add to load-path
4231 the lisp, leim and site-lisp dirs under that directory. */
4233 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4237 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4238 Vinstallation_directory
);
4239 tem1
= Ffile_exists_p (tem
);
4241 /* Don't be fooled if they moved the entire source tree
4242 AFTER dumping Emacs. If the build directory is indeed
4243 different from the source dir, src/Makefile.in and
4244 src/Makefile will not be found together. */
4245 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4246 Vinstallation_directory
);
4247 tem2
= Ffile_exists_p (tem
);
4248 if (!NILP (tem1
) && NILP (tem2
))
4250 tem
= Fexpand_file_name (build_string ("lisp"),
4253 if (NILP (Fmember (tem
, Vload_path
)))
4254 Vload_path
= Fcons (tem
, Vload_path
);
4256 tem
= Fexpand_file_name (build_string ("leim"),
4259 if (NILP (Fmember (tem
, Vload_path
)))
4260 Vload_path
= Fcons (tem
, Vload_path
);
4264 tem
= Fexpand_file_name (build_string ("site-lisp"),
4266 tem1
= Ffile_exists_p (tem
);
4269 if (NILP (Fmember (tem
, Vload_path
)))
4270 Vload_path
= Fcons (tem
, Vload_path
);
4274 } /* Vinstallation_directory != Vsource_directory */
4276 } /* if Vinstallation_directory */
4278 /* Check before adding the site-lisp directories.
4279 The install should have created them, but they are not
4280 required, so no need to warn if they are absent.
4281 Or we might be running before installation. */
4284 /* Add the site-lisp directories at the front. */
4287 Lisp_Object sitelisp
;
4288 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4289 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4291 } /* if dump_path == Vload_path */
4293 else /* !initialized */
4295 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4296 source directory. We used to add ../lisp (ie the lisp dir in
4297 the build directory) at the front here, but that caused trouble
4298 because it was copied from dump_path into Vload_path, above,
4299 when Vinstallation_directory was non-nil. It should not be
4300 necessary, since in out of tree builds lisp/ is empty, save
4302 Vload_path
= decode_env_path (0, normal
);
4303 dump_path
= Vload_path
;
4304 /* No point calling load_path_check; load-path only contains essential
4305 elements from the source directory at this point. They cannot
4306 be missing unless something went extremely (and improbably)
4307 wrong, in which case the build will fail in obvious ways. */
4309 #endif /* !CANNOT_DUMP */
4313 load_in_progress
= 0;
4314 Vload_file_name
= Qnil
;
4316 load_descriptor_list
= Qnil
;
4318 Vstandard_input
= Qt
;
4319 Vloads_in_progress
= Qnil
;
4322 /* Print a warning, using format string FORMAT, that directory DIRNAME
4323 does not exist. Print it on stderr and put it in *Messages*. */
4326 dir_warning (const char *format
, Lisp_Object dirname
)
4328 fprintf (stderr
, format
, SDATA (dirname
));
4330 /* Don't log the warning before we've initialized!! */
4334 char *buffer
= SAFE_ALLOCA (SBYTES (dirname
)
4335 + strlen (format
) - (sizeof "%s" - 1) + 1);
4336 ptrdiff_t message_len
= esprintf (buffer
, format
, SDATA (dirname
));
4337 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4343 syms_of_lread (void)
4346 defsubr (&Sread_from_string
);
4348 defsubr (&Sintern_soft
);
4349 defsubr (&Sunintern
);
4350 defsubr (&Sget_load_suffixes
);
4352 defsubr (&Seval_buffer
);
4353 defsubr (&Seval_region
);
4354 defsubr (&Sread_char
);
4355 defsubr (&Sread_char_exclusive
);
4356 defsubr (&Sread_event
);
4357 defsubr (&Sget_file_char
);
4358 defsubr (&Smapatoms
);
4359 defsubr (&Slocate_file_internal
);
4361 DEFVAR_LISP ("obarray", Vobarray
,
4362 doc
: /* Symbol table for use by `intern' and `read'.
4363 It is a vector whose length ought to be prime for best results.
4364 The vector's contents don't make sense if examined from Lisp programs;
4365 to find all the symbols in an obarray, use `mapatoms'. */);
4367 DEFVAR_LISP ("values", Vvalues
,
4368 doc
: /* List of values of all expressions which were read, evaluated and printed.
4369 Order is reverse chronological. */);
4370 XSYMBOL (intern ("values"))->declared_special
= 0;
4372 DEFVAR_LISP ("standard-input", Vstandard_input
,
4373 doc
: /* Stream for read to get input from.
4374 See documentation of `read' for possible values. */);
4375 Vstandard_input
= Qt
;
4377 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4378 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4380 If this variable is a buffer, then only forms read from that buffer
4381 will be added to `read-symbol-positions-list'.
4382 If this variable is t, then all read forms will be added.
4383 The effect of all other values other than nil are not currently
4384 defined, although they may be in the future.
4386 The positions are relative to the last call to `read' or
4387 `read-from-string'. It is probably a bad idea to set this variable at
4388 the toplevel; bind it instead. */);
4389 Vread_with_symbol_positions
= Qnil
;
4391 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4392 doc
: /* A list mapping read symbols to their positions.
4393 This variable is modified during calls to `read' or
4394 `read-from-string', but only when `read-with-symbol-positions' is
4397 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4398 CHAR-POSITION is an integer giving the offset of that occurrence of the
4399 symbol from the position where `read' or `read-from-string' started.
4401 Note that a symbol will appear multiple times in this list, if it was
4402 read multiple times. The list is in the same order as the symbols
4404 Vread_symbol_positions_list
= Qnil
;
4406 DEFVAR_LISP ("read-circle", Vread_circle
,
4407 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4410 DEFVAR_LISP ("load-path", Vload_path
,
4411 doc
: /* List of directories to search for files to load.
4412 Each element is a string (directory name) or nil (try default directory).
4413 Initialized based on EMACSLOADPATH environment variable, if any,
4414 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4416 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4417 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4418 This list should not include the empty string.
4419 `load' and related functions try to append these suffixes, in order,
4420 to the specified file name if a Lisp suffix is allowed or required. */);
4421 Vload_suffixes
= Fcons (build_pure_c_string (".elc"),
4422 Fcons (build_pure_c_string (".el"), Qnil
));
4423 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4424 doc
: /* List of suffixes that indicate representations of \
4426 This list should normally start with the empty string.
4428 Enabling Auto Compression mode appends the suffixes in
4429 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4430 mode removes them again. `load' and related functions use this list to
4431 determine whether they should look for compressed versions of a file
4432 and, if so, which suffixes they should try to append to the file name
4433 in order to do so. However, if you want to customize which suffixes
4434 the loading functions recognize as compression suffixes, you should
4435 customize `jka-compr-load-suffixes' rather than the present variable. */);
4436 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4438 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4439 doc
: /* Non-nil if inside of `load'. */);
4440 DEFSYM (Qload_in_progress
, "load-in-progress");
4442 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4443 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4444 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4446 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4447 a symbol \(a feature name).
4449 When `load' is run and the file-name argument matches an element's
4450 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4451 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4453 An error in FORMS does not undo the load, but does prevent execution of
4454 the rest of the FORMS. */);
4455 Vafter_load_alist
= Qnil
;
4457 DEFVAR_LISP ("load-history", Vload_history
,
4458 doc
: /* Alist mapping loaded file names to symbols and features.
4459 Each alist element should be a list (FILE-NAME ENTRIES...), where
4460 FILE-NAME is the name of a file that has been loaded into Emacs.
4461 The file name is absolute and true (i.e. it doesn't contain symlinks).
4462 As an exception, one of the alist elements may have FILE-NAME nil,
4463 for symbols and features not associated with any file.
4465 The remaining ENTRIES in the alist element describe the functions and
4466 variables defined in that file, the features provided, and the
4467 features required. Each entry has the form `(provide . FEATURE)',
4468 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4469 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4470 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4471 autoload before this file redefined it as a function. In addition,
4472 entries may also be single symbols, which means that SYMBOL was
4473 defined by `defvar' or `defconst'.
4475 During preloading, the file name recorded is relative to the main Lisp
4476 directory. These file names are converted to absolute at startup. */);
4477 Vload_history
= Qnil
;
4479 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4480 doc
: /* Full name of file being loaded by `load'. */);
4481 Vload_file_name
= Qnil
;
4483 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4484 doc
: /* File name, including directory, of user's initialization file.
4485 If the file loaded had extension `.elc', and the corresponding source file
4486 exists, this variable contains the name of source file, suitable for use
4487 by functions like `custom-save-all' which edit the init file.
4488 While Emacs loads and evaluates the init file, value is the real name
4489 of the file, regardless of whether or not it has the `.elc' extension. */);
4490 Vuser_init_file
= Qnil
;
4492 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4493 doc
: /* Used for internal purposes by `load'. */);
4494 Vcurrent_load_list
= Qnil
;
4496 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4497 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4498 The default is nil, which means use the function `read'. */);
4499 Vload_read_function
= Qnil
;
4501 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4502 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4503 This function is for doing code conversion before reading the source file.
4504 If nil, loading is done without any code conversion.
4505 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4506 FULLNAME is the full name of FILE.
4507 See `load' for the meaning of the remaining arguments. */);
4508 Vload_source_file_function
= Qnil
;
4510 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4511 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4512 This is useful when the file being loaded is a temporary copy. */);
4513 load_force_doc_strings
= 0;
4515 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4516 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4517 This is normally bound by `load' and `eval-buffer' to control `read',
4518 and is not meant for users to change. */);
4519 load_convert_to_unibyte
= 0;
4521 DEFVAR_LISP ("source-directory", Vsource_directory
,
4522 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4523 You cannot count on them to still be there! */);
4525 = Fexpand_file_name (build_string ("../"),
4526 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4528 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4529 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4530 Vpreloaded_file_list
= Qnil
;
4532 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4533 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4534 Vbyte_boolean_vars
= Qnil
;
4536 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4537 doc
: /* Non-nil means load dangerous compiled Lisp files.
4538 Some versions of XEmacs use different byte codes than Emacs. These
4539 incompatible byte codes can make Emacs crash when it tries to execute
4541 load_dangerous_libraries
= 0;
4543 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4544 doc
: /* Non-nil means force printing messages when loading Lisp files.
4545 This overrides the value of the NOMESSAGE argument to `load'. */);
4546 force_load_messages
= 0;
4548 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4549 doc
: /* Regular expression matching safe to load compiled Lisp files.
4550 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4551 from the file, and matches them against this regular expression.
4552 When the regular expression matches, the file is considered to be safe
4553 to load. See also `load-dangerous-libraries'. */);
4554 Vbytecomp_version_regexp
4555 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4557 DEFSYM (Qlexical_binding
, "lexical-binding");
4558 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4559 doc
: /* Whether to use lexical binding when evaluating code.
4560 Non-nil means that the code in the current buffer should be evaluated
4561 with lexical binding.
4562 This variable is automatically set from the file variables of an
4563 interpreted Lisp file read using `load'. Unlike other file local
4564 variables, this must be set in the first line of a file. */);
4565 Vlexical_binding
= Qnil
;
4566 Fmake_variable_buffer_local (Qlexical_binding
);
4568 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4569 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4570 Veval_buffer_list
= Qnil
;
4572 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4573 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4574 Vold_style_backquotes
= Qnil
;
4575 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4577 /* Vsource_directory was initialized in init_lread. */
4579 load_descriptor_list
= Qnil
;
4580 staticpro (&load_descriptor_list
);
4582 DEFSYM (Qcurrent_load_list
, "current-load-list");
4583 DEFSYM (Qstandard_input
, "standard-input");
4584 DEFSYM (Qread_char
, "read-char");
4585 DEFSYM (Qget_file_char
, "get-file-char");
4586 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4587 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4589 DEFSYM (Qbackquote
, "`");
4590 DEFSYM (Qcomma
, ",");
4591 DEFSYM (Qcomma_at
, ",@");
4592 DEFSYM (Qcomma_dot
, ",.");
4594 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4595 DEFSYM (Qascii_character
, "ascii-character");
4596 DEFSYM (Qfunction
, "function");
4597 DEFSYM (Qload
, "load");
4598 DEFSYM (Qload_file_name
, "load-file-name");
4599 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4600 DEFSYM (Qfile_truename
, "file-truename");
4601 DEFSYM (Qdir_ok
, "dir-ok");
4602 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4604 staticpro (&dump_path
);
4606 staticpro (&read_objects
);
4607 read_objects
= Qnil
;
4608 staticpro (&seen_list
);
4611 Vloads_in_progress
= Qnil
;
4612 staticpro (&Vloads_in_progress
);
4614 DEFSYM (Qhash_table
, "hash-table");
4615 DEFSYM (Qdata
, "data");
4616 DEFSYM (Qtest
, "test");
4617 DEFSYM (Qsize
, "size");
4618 DEFSYM (Qweakness
, "weakness");
4619 DEFSYM (Qrehash_size
, "rehash-size");
4620 DEFSYM (Qrehash_threshold
, "rehash-threshold");