1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2012 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
27 #include <limits.h> /* For CHAR_BIT. */
29 #include <stat-time.h>
31 #include "intervals.h"
32 #include "character.h"
40 #include "termhooks.h"
42 #include "blockinput.h"
57 #endif /* HAVE_SETLOCALE */
62 #define file_offset off_t
63 #define file_tell ftello
65 #define file_offset long
66 #define file_tell ftell
69 /* Hash table read constants. */
70 static Lisp_Object Qhash_table
, Qdata
;
71 static Lisp_Object Qtest
, Qsize
;
72 static Lisp_Object Qweakness
;
73 static Lisp_Object Qrehash_size
;
74 static Lisp_Object Qrehash_threshold
;
76 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
77 Lisp_Object Qstandard_input
;
78 Lisp_Object Qvariable_documentation
;
79 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
80 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
81 static Lisp_Object Qinhibit_file_name_operation
;
82 static Lisp_Object Qeval_buffer_list
;
83 Lisp_Object Qlexical_binding
;
84 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
86 /* Used instead of Qget_file_char while loading *.elc files compiled
87 by Emacs 21 or older. */
88 static Lisp_Object Qget_emacs_mule_file_char
;
90 static Lisp_Object Qload_force_doc_strings
;
92 static Lisp_Object Qload_in_progress
;
94 /* The association list of objects read with the #n=object form.
95 Each member of the list has the form (n . object), and is used to
96 look up the object for the corresponding #n# construct.
97 It must be set to nil before all top-level calls to read0. */
98 static Lisp_Object read_objects
;
100 /* Nonzero means READCHAR should read bytes one by one (not character)
101 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
102 This is set to 1 by read1 temporarily while handling #@NUMBER. */
103 static int load_each_byte
;
105 /* List of descriptors now open for Fload. */
106 static Lisp_Object load_descriptor_list
;
108 /* File for get_file_char to read from. Use by load. */
109 static FILE *instream
;
111 /* For use within read-from-string (this reader is non-reentrant!!) */
112 static ptrdiff_t read_from_string_index
;
113 static ptrdiff_t read_from_string_index_byte
;
114 static ptrdiff_t read_from_string_limit
;
116 /* Number of characters read in the current call to Fread or
117 Fread_from_string. */
118 static EMACS_INT readchar_count
;
120 /* This contains the last string skipped with #@. */
121 static char *saved_doc_string
;
122 /* Length of buffer allocated in saved_doc_string. */
123 static ptrdiff_t saved_doc_string_size
;
124 /* Length of actual data in saved_doc_string. */
125 static ptrdiff_t saved_doc_string_length
;
126 /* This is the file position that string came from. */
127 static file_offset saved_doc_string_position
;
129 /* This contains the previous string skipped with #@.
130 We copy it from saved_doc_string when a new string
131 is put in saved_doc_string. */
132 static char *prev_saved_doc_string
;
133 /* Length of buffer allocated in prev_saved_doc_string. */
134 static ptrdiff_t prev_saved_doc_string_size
;
135 /* Length of actual data in prev_saved_doc_string. */
136 static ptrdiff_t prev_saved_doc_string_length
;
137 /* This is the file position that string came from. */
138 static file_offset prev_saved_doc_string_position
;
140 /* Nonzero means inside a new-style backquote
141 with no surrounding parentheses.
142 Fread initializes this to zero, so we need not specbind it
143 or worry about what happens to it when there is an error. */
144 static int new_backquote_flag
;
145 static Lisp_Object Qold_style_backquotes
;
147 /* A list of file names for files being loaded in Fload. Used to
148 check for recursive loads. */
150 static Lisp_Object Vloads_in_progress
;
152 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
155 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
, int,
156 Lisp_Object
, Lisp_Object
,
157 Lisp_Object
, Lisp_Object
);
158 static Lisp_Object
load_unwind (Lisp_Object
);
159 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
161 /* Functions that read one byte from the current source READCHARFUN
162 or unreads one byte. If the integer argument C is -1, it returns
163 one read byte, or -1 when there's no more byte in the source. If C
164 is 0 or positive, it unreads C, and the return value is not
167 static int readbyte_for_lambda (int, Lisp_Object
);
168 static int readbyte_from_file (int, Lisp_Object
);
169 static int readbyte_from_string (int, Lisp_Object
);
171 /* Handle unreading and rereading of characters.
172 Write READCHAR to read a character,
173 UNREAD(c) to unread c to be read again.
175 These macros correctly read/unread multibyte characters. */
177 #define READCHAR readchar (readcharfun, NULL)
178 #define UNREAD(c) unreadchar (readcharfun, c)
180 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
181 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
183 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
184 Qlambda, or a cons, we use this to keep an unread character because
185 a file stream can't handle multibyte-char unreading. The value -1
186 means that there's no unread character. */
187 static int unread_char
;
190 readchar (Lisp_Object readcharfun
, bool *multibyte
)
194 int (*readbyte
) (int, Lisp_Object
);
195 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
197 int emacs_mule_encoding
= 0;
204 if (BUFFERP (readcharfun
))
206 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
208 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
210 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
213 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
215 /* Fetch the character code from the buffer. */
216 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
217 BUF_INC_POS (inbuffer
, pt_byte
);
224 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
225 if (! ASCII_BYTE_P (c
))
226 c
= BYTE8_TO_CHAR (c
);
229 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
233 if (MARKERP (readcharfun
))
235 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
237 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
239 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
242 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
244 /* Fetch the character code from the buffer. */
245 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
246 BUF_INC_POS (inbuffer
, bytepos
);
253 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
254 if (! ASCII_BYTE_P (c
))
255 c
= BYTE8_TO_CHAR (c
);
259 XMARKER (readcharfun
)->bytepos
= bytepos
;
260 XMARKER (readcharfun
)->charpos
++;
265 if (EQ (readcharfun
, Qlambda
))
267 readbyte
= readbyte_for_lambda
;
271 if (EQ (readcharfun
, Qget_file_char
))
273 readbyte
= readbyte_from_file
;
277 if (STRINGP (readcharfun
))
279 if (read_from_string_index
>= read_from_string_limit
)
281 else if (STRING_MULTIBYTE (readcharfun
))
285 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
286 read_from_string_index
,
287 read_from_string_index_byte
);
291 c
= SREF (readcharfun
, read_from_string_index_byte
);
292 read_from_string_index
++;
293 read_from_string_index_byte
++;
298 if (CONSP (readcharfun
))
300 /* This is the case that read_vector is reading from a unibyte
301 string that contains a byte sequence previously skipped
302 because of #@NUMBER. The car part of readcharfun is that
303 string, and the cdr part is a value of readcharfun given to
305 readbyte
= readbyte_from_string
;
306 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
307 emacs_mule_encoding
= 1;
311 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
313 readbyte
= readbyte_from_file
;
314 emacs_mule_encoding
= 1;
318 tem
= call0 (readcharfun
);
325 if (unread_char
>= 0)
331 c
= (*readbyte
) (-1, readcharfun
);
332 if (c
< 0 || load_each_byte
)
336 if (ASCII_BYTE_P (c
))
338 if (emacs_mule_encoding
)
339 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
342 len
= BYTES_BY_CHAR_HEAD (c
);
345 c
= (*readbyte
) (-1, readcharfun
);
346 if (c
< 0 || ! TRAILING_CODE_P (c
))
349 (*readbyte
) (buf
[i
], readcharfun
);
350 return BYTE8_TO_CHAR (buf
[0]);
354 return STRING_CHAR (buf
);
357 /* Unread the character C in the way appropriate for the stream READCHARFUN.
358 If the stream is a user function, call it with the char as argument. */
361 unreadchar (Lisp_Object readcharfun
, int c
)
365 /* Don't back up the pointer if we're unreading the end-of-input mark,
366 since readchar didn't advance it when we read it. */
368 else if (BUFFERP (readcharfun
))
370 struct buffer
*b
= XBUFFER (readcharfun
);
371 ptrdiff_t charpos
= BUF_PT (b
);
372 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
374 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
375 BUF_DEC_POS (b
, bytepos
);
379 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
381 else if (MARKERP (readcharfun
))
383 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
384 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
386 XMARKER (readcharfun
)->charpos
--;
387 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
388 BUF_DEC_POS (b
, bytepos
);
392 XMARKER (readcharfun
)->bytepos
= bytepos
;
394 else if (STRINGP (readcharfun
))
396 read_from_string_index
--;
397 read_from_string_index_byte
398 = string_char_to_byte (readcharfun
, read_from_string_index
);
400 else if (CONSP (readcharfun
))
404 else if (EQ (readcharfun
, Qlambda
))
408 else if (EQ (readcharfun
, Qget_file_char
)
409 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
414 ungetc (c
, instream
);
421 call1 (readcharfun
, make_number (c
));
425 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
427 return read_bytecode_char (c
>= 0);
432 readbyte_from_file (int c
, Lisp_Object readcharfun
)
437 ungetc (c
, instream
);
446 /* Interrupted reads have been observed while reading over the network. */
447 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
459 return (c
== EOF
? -1 : c
);
463 readbyte_from_string (int c
, Lisp_Object readcharfun
)
465 Lisp_Object string
= XCAR (readcharfun
);
469 read_from_string_index
--;
470 read_from_string_index_byte
471 = string_char_to_byte (string
, read_from_string_index
);
474 if (read_from_string_index
>= read_from_string_limit
)
477 FETCH_STRING_CHAR_ADVANCE (c
, string
,
478 read_from_string_index
,
479 read_from_string_index_byte
);
484 /* Read one non-ASCII character from INSTREAM. The character is
485 encoded in `emacs-mule' and the first byte is already read in
489 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
491 /* Emacs-mule coding uses at most 4-byte for one character. */
492 unsigned char buf
[4];
493 int len
= emacs_mule_bytes
[c
];
494 struct charset
*charset
;
499 /* C is not a valid leading-code of `emacs-mule'. */
500 return BYTE8_TO_CHAR (c
);
506 c
= (*readbyte
) (-1, readcharfun
);
510 (*readbyte
) (buf
[i
], readcharfun
);
511 return BYTE8_TO_CHAR (buf
[0]);
518 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
519 code
= buf
[1] & 0x7F;
523 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
524 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
526 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
527 code
= buf
[2] & 0x7F;
531 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
532 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
537 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
538 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
540 c
= DECODE_CHAR (charset
, code
);
542 Fsignal (Qinvalid_read_syntax
,
543 Fcons (build_string ("invalid multibyte form"), Qnil
));
548 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
550 static Lisp_Object
read0 (Lisp_Object
);
551 static Lisp_Object
read1 (Lisp_Object
, int *, int);
553 static Lisp_Object
read_list (int, Lisp_Object
);
554 static Lisp_Object
read_vector (Lisp_Object
, int);
556 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
558 static void substitute_object_in_subtree (Lisp_Object
,
560 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
563 /* Get a character from the tty. */
565 /* Read input events until we get one that's acceptable for our purposes.
567 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
568 until we get a character we like, and then stuffed into
571 If ASCII_REQUIRED is non-zero, we check function key events to see
572 if the unmodified version of the symbol has a Qascii_character
573 property, and use that character, if present.
575 If ERROR_NONASCII is non-zero, we signal an error if the input we
576 get isn't an ASCII character with modifiers. If it's zero but
577 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
580 If INPUT_METHOD is nonzero, we invoke the current input method
581 if the character warrants that.
583 If SECONDS is a number, we wait that many seconds for input, and
584 return Qnil if no input arrives within that time. */
587 read_filtered_event (int no_switch_frame
, int ascii_required
,
588 int error_nonascii
, int input_method
, Lisp_Object seconds
)
590 Lisp_Object val
, delayed_switch_frame
;
593 #ifdef HAVE_WINDOW_SYSTEM
594 if (display_hourglass_p
)
598 delayed_switch_frame
= Qnil
;
600 /* Compute timeout. */
601 if (NUMBERP (seconds
))
603 double duration
= extract_float (seconds
);
604 EMACS_TIME wait_time
= EMACS_TIME_FROM_DOUBLE (duration
);
605 end_time
= add_emacs_time (current_emacs_time (), wait_time
);
608 /* Read until we get an acceptable event. */
611 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
612 NUMBERP (seconds
) ? &end_time
: NULL
);
613 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
618 /* switch-frame events are put off until after the next ASCII
619 character. This is better than signaling an error just because
620 the last characters were typed to a separate minibuffer frame,
621 for example. Eventually, some code which can deal with
622 switch-frame events will read it and process it. */
624 && EVENT_HAS_PARAMETERS (val
)
625 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
627 delayed_switch_frame
= val
;
631 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
633 /* Convert certain symbols to their ASCII equivalents. */
636 Lisp_Object tem
, tem1
;
637 tem
= Fget (val
, Qevent_symbol_element_mask
);
640 tem1
= Fget (Fcar (tem
), Qascii_character
);
641 /* Merge this symbol's modifier bits
642 with the ASCII equivalent of its basic code. */
644 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
648 /* If we don't have a character now, deal with it appropriately. */
653 Vunread_command_events
= Fcons (val
, Qnil
);
654 error ("Non-character input-event");
661 if (! NILP (delayed_switch_frame
))
662 unread_switch_frame
= delayed_switch_frame
;
666 #ifdef HAVE_WINDOW_SYSTEM
667 if (display_hourglass_p
)
676 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
677 doc
: /* Read a character from the command input (keyboard or macro).
678 It is returned as a number.
679 If the character has modifiers, they are resolved and reflected to the
680 character code if possible (e.g. C-SPC -> 0).
682 If the user generates an event which is not a character (i.e. a mouse
683 click or function key event), `read-char' signals an error. As an
684 exception, switch-frame events are put off until non-character events
686 If you want to read non-character events, or ignore them, call
687 `read-event' or `read-char-exclusive' instead.
689 If the optional argument PROMPT is non-nil, display that as a prompt.
690 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
691 input method is turned on in the current buffer, that input method
692 is used for reading a character.
693 If the optional argument SECONDS is non-nil, it should be a number
694 specifying the maximum number of seconds to wait for input. If no
695 input arrives in that time, return nil. SECONDS may be a
696 floating-point value. */)
697 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
702 message_with_string ("%s", prompt
, 0);
703 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
705 return (NILP (val
) ? Qnil
706 : make_number (char_resolve_modifier_mask (XINT (val
))));
709 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
710 doc
: /* Read an event object from the input stream.
711 If the optional argument PROMPT is non-nil, display that as a prompt.
712 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
713 input method is turned on in the current buffer, that input method
714 is used for reading a character.
715 If the optional argument SECONDS is non-nil, it should be a number
716 specifying the maximum number of seconds to wait for input. If no
717 input arrives in that time, return nil. SECONDS may be a
718 floating-point value. */)
719 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
722 message_with_string ("%s", prompt
, 0);
723 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
726 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
727 doc
: /* Read a character from the command input (keyboard or macro).
728 It is returned as a number. Non-character events are ignored.
729 If the character has modifiers, they are resolved and reflected to the
730 character code if possible (e.g. C-SPC -> 0).
732 If the optional argument PROMPT is non-nil, display that as a prompt.
733 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
734 input method is turned on in the current buffer, that input method
735 is used for reading a character.
736 If the optional argument SECONDS is non-nil, it should be a number
737 specifying the maximum number of seconds to wait for input. If no
738 input arrives in that time, return nil. SECONDS may be a
739 floating-point value. */)
740 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
745 message_with_string ("%s", prompt
, 0);
747 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
749 return (NILP (val
) ? Qnil
750 : make_number (char_resolve_modifier_mask (XINT (val
))));
753 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
754 doc
: /* Don't use this yourself. */)
757 register Lisp_Object val
;
759 XSETINT (val
, getc (instream
));
767 /* Return true if the lisp code read using READCHARFUN defines a non-nil
768 `lexical-binding' file variable. After returning, the stream is
769 positioned following the first line, if it is a comment, otherwise
773 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
777 /* The first line isn't a comment, just give up. */
783 /* Look for an appropriate file-variable in the first line. */
787 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
788 } beg_end_state
= NOMINAL
;
789 int in_file_vars
= 0;
791 #define UPDATE_BEG_END_STATE(ch) \
792 if (beg_end_state == NOMINAL) \
793 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
794 else if (beg_end_state == AFTER_FIRST_DASH) \
795 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
796 else if (beg_end_state == AFTER_ASTERIX) \
799 in_file_vars = !in_file_vars; \
800 beg_end_state = NOMINAL; \
803 /* Skip until we get to the file vars, if any. */
807 UPDATE_BEG_END_STATE (ch
);
809 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
813 char var
[100], val
[100];
818 /* Read a variable name. */
819 while (ch
== ' ' || ch
== '\t')
823 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
825 if (i
< sizeof var
- 1)
827 UPDATE_BEG_END_STATE (ch
);
831 /* Stop scanning if no colon was found before end marker. */
832 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
835 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
841 /* Read a variable value. */
844 while (ch
== ' ' || ch
== '\t')
848 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
850 if (i
< sizeof val
- 1)
852 UPDATE_BEG_END_STATE (ch
);
856 /* The value was terminated by an end-marker, which remove. */
858 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
862 if (strcmp (var
, "lexical-binding") == 0)
865 rv
= (strcmp (val
, "nil") != 0);
871 while (ch
!= '\n' && ch
!= EOF
)
878 /* Value is a version number of byte compiled code if the file
879 associated with file descriptor FD is a compiled Lisp file that's
880 safe to load. Only files compiled with Emacs are safe to load.
881 Files compiled with XEmacs can lead to a crash in Fbyte_code
882 because of an incompatible change in the byte compiler. */
885 safe_to_load_p (int fd
)
892 /* Read the first few bytes from the file, and look for a line
893 specifying the byte compiler version used. */
894 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
899 /* Skip to the next newline, skipping over the initial `ELC'
900 with NUL bytes following it, but note the version. */
901 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
906 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
907 buf
+ i
, nbytes
- i
) < 0)
913 lseek (fd
, 0, SEEK_SET
);
918 /* Callback for record_unwind_protect. Restore the old load list OLD,
919 after loading a file successfully. */
922 record_load_unwind (Lisp_Object old
)
924 return Vloads_in_progress
= old
;
927 /* This handler function is used via internal_condition_case_1. */
930 load_error_handler (Lisp_Object data
)
936 load_warn_old_style_backquotes (Lisp_Object file
)
938 if (!NILP (Vold_style_backquotes
))
941 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
948 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
949 doc
: /* Return the suffixes that `load' should try if a suffix is \
951 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
954 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
955 while (CONSP (suffixes
))
957 Lisp_Object exts
= Vload_file_rep_suffixes
;
958 suffix
= XCAR (suffixes
);
959 suffixes
= XCDR (suffixes
);
964 lst
= Fcons (concat2 (suffix
, ext
), lst
);
967 return Fnreverse (lst
);
970 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
971 doc
: /* Execute a file of Lisp code named FILE.
972 First try FILE with `.elc' appended, then try with `.el',
973 then try FILE unmodified (the exact suffixes in the exact order are
974 determined by `load-suffixes'). Environment variable references in
975 FILE are replaced with their values by calling `substitute-in-file-name'.
976 This function searches the directories in `load-path'.
978 If optional second arg NOERROR is non-nil,
979 report no error if FILE doesn't exist.
980 Print messages at start and end of loading unless
981 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
983 If optional fourth arg NOSUFFIX is non-nil, don't try adding
984 suffixes `.elc' or `.el' to the specified name FILE.
985 If optional fifth arg MUST-SUFFIX is non-nil, insist on
986 the suffix `.elc' or `.el'; don't accept just FILE unless
987 it ends in one of those suffixes or includes a directory name.
989 If this function fails to find a file, it may look for different
990 representations of that file before trying another file.
991 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
992 to the file name. Emacs uses this feature mainly to find compressed
993 versions of files when Auto Compression mode is enabled.
995 The exact suffixes that this function tries out, in the exact order,
996 are given by the value of the variable `load-file-rep-suffixes' if
997 NOSUFFIX is non-nil and by the return value of the function
998 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
999 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1000 and then the former.
1002 Loading a file records its definitions, and its `provide' and
1003 `require' calls, in an element of `load-history' whose
1004 car is the file name loaded. See `load-history'.
1006 While the file is in the process of being loaded, the variable
1007 `load-in-progress' is non-nil and the variable `load-file-name'
1008 is bound to the file's name.
1010 Return t if the file exists and loads successfully. */)
1011 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1013 register FILE *stream
;
1014 register int fd
= -1;
1015 ptrdiff_t count
= SPECPDL_INDEX ();
1016 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1017 Lisp_Object found
, efound
, hist_file_name
;
1018 /* 1 means we printed the ".el is newer" message. */
1020 /* 1 means we are loading a compiled file. */
1022 Lisp_Object handler
;
1024 const char *fmode
= "r";
1032 CHECK_STRING (file
);
1034 /* If file name is magic, call the handler. */
1035 /* This shouldn't be necessary any more now that `openp' handles it right.
1036 handler = Ffind_file_name_handler (file, Qload);
1037 if (!NILP (handler))
1038 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1040 /* Do this after the handler to avoid
1041 the need to gcpro noerror, nomessage and nosuffix.
1042 (Below here, we care only whether they are nil or not.)
1043 The presence of this call is the result of a historical accident:
1044 it used to be in every file-operation and when it got removed
1045 everywhere, it accidentally stayed here. Since then, enough people
1046 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1047 that it seemed risky to remove. */
1048 if (! NILP (noerror
))
1050 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1051 Qt
, load_error_handler
);
1056 file
= Fsubstitute_in_file_name (file
);
1059 /* Avoid weird lossage with null string as arg,
1060 since it would try to load a directory as a Lisp file. */
1061 if (SBYTES (file
) > 0)
1063 ptrdiff_t size
= SBYTES (file
);
1066 GCPRO2 (file
, found
);
1068 if (! NILP (must_suffix
))
1070 /* Don't insist on adding a suffix if FILE already ends with one. */
1072 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1075 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1077 /* Don't insist on adding a suffix
1078 if the argument includes a directory name. */
1079 else if (! NILP (Ffile_name_directory (file
)))
1083 fd
= openp (Vload_path
, file
,
1084 (!NILP (nosuffix
) ? Qnil
1085 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1086 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1087 tmp
[1] = Vload_file_rep_suffixes
,
1096 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1100 /* Tell startup.el whether or not we found the user's init file. */
1101 if (EQ (Qt
, Vuser_init_file
))
1102 Vuser_init_file
= found
;
1104 /* If FD is -2, that means openp found a magic file. */
1107 if (NILP (Fequal (found
, file
)))
1108 /* If FOUND is a different file name from FILE,
1109 find its handler even if we have already inhibited
1110 the `load' operation on FILE. */
1111 handler
= Ffind_file_name_handler (found
, Qt
);
1113 handler
= Ffind_file_name_handler (found
, Qload
);
1114 if (! NILP (handler
))
1115 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1117 /* Tramp has to deal with semi-broken packages that prepend
1118 drive letters to remote files. For that reason, Tramp
1119 catches file operations that test for file existence, which
1120 makes openp think X:/foo.elc files are remote. However,
1121 Tramp does not catch `load' operations for such files, so we
1122 end up with a nil as the `load' handler above. If we would
1123 continue with fd = -2, we will behave wrongly, and in
1124 particular try reading a .elc file in the "rt" mode instead
1125 of "rb". See bug #9311 for the results. To work around
1126 this, we try to open the file locally, and go with that if it
1128 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1134 /* Check if we're stuck in a recursive load cycle.
1136 2000-09-21: It's not possible to just check for the file loaded
1137 being a member of Vloads_in_progress. This fails because of the
1138 way the byte compiler currently works; `provide's are not
1139 evaluated, see font-lock.el/jit-lock.el as an example. This
1140 leads to a certain amount of ``normal'' recursion.
1142 Also, just loading a file recursively is not always an error in
1143 the general case; the second load may do something different. */
1147 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1148 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1152 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1154 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1155 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1158 /* All loads are by default dynamic, unless the file itself specifies
1159 otherwise using a file-variable in the first line. This is bound here
1160 so that it takes effect whether or not we use
1161 Vload_source_file_function. */
1162 specbind (Qlexical_binding
, Qnil
);
1164 /* Get the name for load-history. */
1165 hist_file_name
= (! NILP (Vpurify_flag
)
1166 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1167 tmp
[1] = Ffile_name_nondirectory (found
),
1173 /* Check for the presence of old-style quotes and warn about them. */
1174 specbind (Qold_style_backquotes
, Qnil
);
1175 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1177 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1178 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1179 /* Load .elc files directly, but not when they are
1180 remote and have no handler! */
1187 GCPRO3 (file
, found
, hist_file_name
);
1190 && ! (version
= safe_to_load_p (fd
)))
1193 if (!load_dangerous_libraries
)
1197 error ("File `%s' was not compiled in Emacs",
1200 else if (!NILP (nomessage
) && !force_load_messages
)
1201 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1206 efound
= ENCODE_FILE (found
);
1211 result
= stat (SSDATA (efound
), &s1
);
1214 SSET (efound
, SBYTES (efound
) - 1, 0);
1215 result
= stat (SSDATA (efound
), &s2
);
1216 SSET (efound
, SBYTES (efound
) - 1, 'c');
1220 && EMACS_TIME_LT (get_stat_mtime (&s1
), get_stat_mtime (&s2
)))
1222 /* Make the progress messages mention that source is newer. */
1225 /* If we won't print another message, mention this anyway. */
1226 if (!NILP (nomessage
) && !force_load_messages
)
1228 Lisp_Object msg_file
;
1229 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1230 message_with_string ("Source file `%s' newer than byte-compiled file",
1239 /* We are loading a source file (*.el). */
1240 if (!NILP (Vload_source_file_function
))
1246 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1247 NILP (noerror
) ? Qnil
: Qt
,
1248 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1249 return unbind_to (count
, val
);
1253 GCPRO3 (file
, found
, hist_file_name
);
1256 efound
= ENCODE_FILE (found
);
1257 /* If we somehow got here with fd == -2, meaning the file is deemed
1258 to be remote, don't even try to reopen the file locally; just
1259 force a failure instead. */
1263 stream
= fopen (SSDATA (efound
), fmode
);
1267 #else /* not WINDOWSNT */
1268 stream
= fdopen (fd
, fmode
);
1269 #endif /* not WINDOWSNT */
1273 error ("Failure to create stdio stream for %s", SDATA (file
));
1276 if (! NILP (Vpurify_flag
))
1277 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1279 if (NILP (nomessage
) || force_load_messages
)
1282 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1285 message_with_string ("Loading %s (source)...", file
, 1);
1287 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1289 else /* The typical case; compiled file newer than source file. */
1290 message_with_string ("Loading %s...", file
, 1);
1293 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1294 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1295 specbind (Qload_file_name
, found
);
1296 specbind (Qinhibit_file_name_operation
, Qnil
);
1297 load_descriptor_list
1298 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1299 specbind (Qload_in_progress
, Qt
);
1302 if (lisp_file_lexically_bound_p (Qget_file_char
))
1303 Fset (Qlexical_binding
, Qt
);
1305 if (! version
|| version
>= 22)
1306 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1307 0, Qnil
, Qnil
, Qnil
, Qnil
);
1310 /* We can't handle a file which was compiled with
1311 byte-compile-dynamic by older version of Emacs. */
1312 specbind (Qload_force_doc_strings
, Qt
);
1313 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1314 0, Qnil
, Qnil
, Qnil
, Qnil
);
1316 unbind_to (count
, Qnil
);
1318 /* Run any eval-after-load forms for this file. */
1319 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1320 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1324 xfree (saved_doc_string
);
1325 saved_doc_string
= 0;
1326 saved_doc_string_size
= 0;
1328 xfree (prev_saved_doc_string
);
1329 prev_saved_doc_string
= 0;
1330 prev_saved_doc_string_size
= 0;
1332 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1335 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1338 message_with_string ("Loading %s (source)...done", file
, 1);
1340 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1342 else /* The typical case; compiled file newer than source file. */
1343 message_with_string ("Loading %s...done", file
, 1);
1350 load_unwind (Lisp_Object arg
) /* Used as unwind-protect function in load. */
1352 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1363 load_descriptor_unwind (Lisp_Object oldlist
)
1365 load_descriptor_list
= oldlist
;
1369 /* Close all descriptors in use for Floads.
1370 This is used when starting a subprocess. */
1373 close_load_descs (void)
1377 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1378 emacs_close (XFASTINT (XCAR (tail
)));
1383 complete_filename_p (Lisp_Object pathname
)
1385 register const unsigned char *s
= SDATA (pathname
);
1386 return (IS_DIRECTORY_SEP (s
[0])
1387 || (SCHARS (pathname
) > 2
1388 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1391 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1392 doc
: /* Search for FILENAME through PATH.
1393 Returns the file's name in absolute form, or nil if not found.
1394 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1395 file name when searching.
1396 If non-nil, PREDICATE is used instead of `file-readable-p'.
1397 PREDICATE can also be an integer to pass to the access(2) function,
1398 in which case file-name-handlers are ignored.
1399 This function will normally skip directories, so if you want it to find
1400 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1401 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1404 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1405 if (NILP (predicate
) && fd
> 0)
1410 static Lisp_Object Qdir_ok
;
1412 /* Search for a file whose name is STR, looking in directories
1413 in the Lisp list PATH, and trying suffixes from SUFFIX.
1414 On success, returns a file descriptor. On failure, returns -1.
1416 SUFFIXES is a list of strings containing possible suffixes.
1417 The empty suffix is automatically added if the list is empty.
1419 PREDICATE non-nil means don't open the files,
1420 just look for one that satisfies the predicate. In this case,
1421 returns 1 on success. The predicate can be a lisp function or
1422 an integer to pass to `access' (in which case file-name-handlers
1425 If STOREPTR is nonzero, it points to a slot where the name of
1426 the file actually found should be stored as a Lisp string.
1427 nil is stored there on failure.
1429 If the file we find is remote, return -2
1430 but store the found remote file name in *STOREPTR. */
1433 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1436 ptrdiff_t fn_size
= 100;
1438 register char *fn
= buf
;
1440 ptrdiff_t want_length
;
1441 Lisp_Object filename
;
1443 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1444 Lisp_Object string
, tail
, encoded_fn
;
1445 ptrdiff_t max_suffix_len
= 0;
1449 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1451 CHECK_STRING_CAR (tail
);
1452 max_suffix_len
= max (max_suffix_len
,
1453 SBYTES (XCAR (tail
)));
1456 string
= filename
= encoded_fn
= Qnil
;
1457 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1462 if (complete_filename_p (str
))
1465 for (; CONSP (path
); path
= XCDR (path
))
1467 filename
= Fexpand_file_name (str
, XCAR (path
));
1468 if (!complete_filename_p (filename
))
1469 /* If there are non-absolute elts in PATH (eg "."). */
1470 /* Of course, this could conceivably lose if luser sets
1471 default-directory to be something non-absolute... */
1473 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1474 if (!complete_filename_p (filename
))
1475 /* Give up on this path element! */
1479 /* Calculate maximum length of any filename made from
1480 this path element/specified file name and any possible suffix. */
1481 want_length
= max_suffix_len
+ SBYTES (filename
);
1482 if (fn_size
<= want_length
)
1483 fn
= alloca (fn_size
= 100 + want_length
);
1485 /* Loop over suffixes. */
1486 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1487 CONSP (tail
); tail
= XCDR (tail
))
1489 ptrdiff_t fnlen
, lsuffix
= SBYTES (XCAR (tail
));
1490 Lisp_Object handler
;
1493 /* Concatenate path element/specified name with the suffix.
1494 If the directory starts with /:, remove that. */
1495 int prefixlen
= ((SCHARS (filename
) > 2
1496 && SREF (filename
, 0) == '/'
1497 && SREF (filename
, 1) == ':')
1499 fnlen
= SBYTES (filename
) - prefixlen
;
1500 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1501 memcpy (fn
+ fnlen
, SDATA (XCAR (tail
)), lsuffix
+ 1);
1503 /* Check that the file exists and is not a directory. */
1504 /* We used to only check for handlers on non-absolute file names:
1508 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1509 It's not clear why that was the case and it breaks things like
1510 (load "/bar.el") where the file is actually "/bar.el.gz". */
1511 string
= make_string (fn
, fnlen
);
1512 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1513 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1515 if (NILP (predicate
))
1516 exists
= !NILP (Ffile_readable_p (string
));
1519 Lisp_Object tmp
= call1 (predicate
, string
);
1520 exists
= !NILP (tmp
)
1521 && (EQ (tmp
, Qdir_ok
)
1522 || NILP (Ffile_directory_p (string
)));
1527 /* We succeeded; return this descriptor and filename. */
1538 encoded_fn
= ENCODE_FILE (string
);
1539 pfn
= SSDATA (encoded_fn
);
1540 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1543 /* Check that we can access or open it. */
1544 if (NATNUMP (predicate
))
1545 fd
= (((XFASTINT (predicate
) & ~INT_MAX
) == 0
1546 && access (pfn
, XFASTINT (predicate
)) == 0)
1549 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1553 /* We succeeded; return this descriptor and filename. */
1571 /* Merge the list we've accumulated of globals from the current input source
1572 into the load_history variable. The details depend on whether
1573 the source has an associated file name or not.
1575 FILENAME is the file name that we are loading from.
1576 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1579 build_load_history (Lisp_Object filename
, int entire
)
1581 register Lisp_Object tail
, prev
, newelt
;
1582 register Lisp_Object tem
, tem2
;
1583 register int foundit
= 0;
1585 tail
= Vload_history
;
1588 while (CONSP (tail
))
1592 /* Find the feature's previous assoc list... */
1593 if (!NILP (Fequal (filename
, Fcar (tem
))))
1597 /* If we're loading the entire file, remove old data. */
1601 Vload_history
= XCDR (tail
);
1603 Fsetcdr (prev
, XCDR (tail
));
1606 /* Otherwise, cons on new symbols that are not already members. */
1609 tem2
= Vcurrent_load_list
;
1611 while (CONSP (tem2
))
1613 newelt
= XCAR (tem2
);
1615 if (NILP (Fmember (newelt
, tem
)))
1616 Fsetcar (tail
, Fcons (XCAR (tem
),
1617 Fcons (newelt
, XCDR (tem
))));
1630 /* If we're loading an entire file, cons the new assoc onto the
1631 front of load-history, the most-recently-loaded position. Also
1632 do this if we didn't find an existing member for the file. */
1633 if (entire
|| !foundit
)
1634 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1639 readevalloop_1 (Lisp_Object old
)
1641 load_convert_to_unibyte
= ! NILP (old
);
1645 /* Signal an `end-of-file' error, if possible with file name
1648 static _Noreturn
void
1649 end_of_file_error (void)
1651 if (STRINGP (Vload_file_name
))
1652 xsignal1 (Qend_of_file
, Vload_file_name
);
1654 xsignal0 (Qend_of_file
);
1657 /* UNIBYTE specifies how to set load_convert_to_unibyte
1658 for this invocation.
1659 READFUN, if non-nil, is used instead of `read'.
1661 START, END specify region to read in current buffer (from eval-region).
1662 If the input is not from a buffer, they must be nil. */
1665 readevalloop (Lisp_Object readcharfun
,
1667 Lisp_Object sourcename
,
1669 Lisp_Object unibyte
, Lisp_Object readfun
,
1670 Lisp_Object start
, Lisp_Object end
)
1673 register Lisp_Object val
;
1674 ptrdiff_t count
= SPECPDL_INDEX ();
1675 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1676 struct buffer
*b
= 0;
1677 int continue_reading_p
;
1678 Lisp_Object lex_bound
;
1679 /* Nonzero if reading an entire buffer. */
1680 int whole_buffer
= 0;
1681 /* 1 on the first time around. */
1683 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1685 if (NILP (Ffboundp (macroexpand
))
1686 /* Don't macroexpand in .elc files, since it should have been done
1687 already. We actually don't know whether we're in a .elc file or not,
1688 so we use circumstancial evidence: .el files normally go through
1689 Vload_source_file_function -> load-with-code-conversion
1691 || EQ (readcharfun
, Qget_file_char
)
1692 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1695 if (MARKERP (readcharfun
))
1698 start
= readcharfun
;
1701 if (BUFFERP (readcharfun
))
1702 b
= XBUFFER (readcharfun
);
1703 else if (MARKERP (readcharfun
))
1704 b
= XMARKER (readcharfun
)->buffer
;
1706 /* We assume START is nil when input is not from a buffer. */
1707 if (! NILP (start
) && !b
)
1710 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1711 specbind (Qcurrent_load_list
, Qnil
);
1712 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1713 load_convert_to_unibyte
= !NILP (unibyte
);
1715 /* If lexical binding is active (either because it was specified in
1716 the file's header, or via a buffer-local variable), create an empty
1717 lexical environment, otherwise, turn off lexical binding. */
1718 lex_bound
= find_symbol_value (Qlexical_binding
);
1719 specbind (Qinternal_interpreter_environment
,
1720 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1721 ? Qnil
: Fcons (Qt
, Qnil
));
1723 GCPRO4 (sourcename
, readfun
, start
, end
);
1725 /* Try to ensure sourcename is a truename, except whilst preloading. */
1726 if (NILP (Vpurify_flag
)
1727 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1728 && !NILP (Ffboundp (Qfile_truename
)))
1729 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1731 LOADHIST_ATTACH (sourcename
);
1733 continue_reading_p
= 1;
1734 while (continue_reading_p
)
1736 ptrdiff_t count1
= SPECPDL_INDEX ();
1738 if (b
!= 0 && NILP (BVAR (b
, name
)))
1739 error ("Reading from killed buffer");
1743 /* Switch to the buffer we are reading from. */
1744 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1745 set_buffer_internal (b
);
1747 /* Save point in it. */
1748 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1749 /* Save ZV in it. */
1750 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1751 /* Those get unbound after we read one expression. */
1753 /* Set point and ZV around stuff to be read. */
1756 Fnarrow_to_region (make_number (BEGV
), end
);
1758 /* Just for cleanliness, convert END to a marker
1759 if it is an integer. */
1761 end
= Fpoint_max_marker ();
1764 /* On the first cycle, we can easily test here
1765 whether we are reading the whole buffer. */
1766 if (b
&& first_sexp
)
1767 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1774 while ((c
= READCHAR
) != '\n' && c
!= -1);
1779 unbind_to (count1
, Qnil
);
1783 /* Ignore whitespace here, so we can detect eof. */
1784 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1785 || c
== 0xa0) /* NBSP */
1788 if (!NILP (Vpurify_flag
) && c
== '(')
1790 val
= read_list (0, readcharfun
);
1795 read_objects
= Qnil
;
1796 if (!NILP (readfun
))
1798 val
= call1 (readfun
, readcharfun
);
1800 /* If READCHARFUN has set point to ZV, we should
1801 stop reading, even if the form read sets point
1802 to a different value when evaluated. */
1803 if (BUFFERP (readcharfun
))
1805 struct buffer
*buf
= XBUFFER (readcharfun
);
1806 if (BUF_PT (buf
) == BUF_ZV (buf
))
1807 continue_reading_p
= 0;
1810 else if (! NILP (Vload_read_function
))
1811 val
= call1 (Vload_read_function
, readcharfun
);
1813 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1816 if (!NILP (start
) && continue_reading_p
)
1817 start
= Fpoint_marker ();
1819 /* Restore saved point and BEGV. */
1820 unbind_to (count1
, Qnil
);
1822 /* Now eval what we just read. */
1823 if (!NILP (macroexpand
))
1824 val
= call1 (macroexpand
, val
);
1825 val
= eval_sub (val
);
1829 Vvalues
= Fcons (val
, Vvalues
);
1830 if (EQ (Vstandard_output
, Qt
))
1839 build_load_history (sourcename
,
1840 stream
|| whole_buffer
);
1844 unbind_to (count
, Qnil
);
1847 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1848 doc
: /* Execute the current buffer as Lisp code.
1849 When called from a Lisp program (i.e., not interactively), this
1850 function accepts up to five optional arguments:
1851 BUFFER is the buffer to evaluate (nil means use current buffer).
1852 PRINTFLAG controls printing of output:
1853 A value of nil means discard it; anything else is stream for print.
1854 FILENAME specifies the file name to use for `load-history'.
1855 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1857 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1858 functions should work normally even if PRINTFLAG is nil.
1860 This function preserves the position of point. */)
1861 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1863 ptrdiff_t count
= SPECPDL_INDEX ();
1864 Lisp_Object tem
, buf
;
1867 buf
= Fcurrent_buffer ();
1869 buf
= Fget_buffer (buffer
);
1871 error ("No such buffer");
1873 if (NILP (printflag
) && NILP (do_allow_print
))
1878 if (NILP (filename
))
1879 filename
= BVAR (XBUFFER (buf
), filename
);
1881 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1882 specbind (Qstandard_output
, tem
);
1883 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1884 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1885 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1886 readevalloop (buf
, 0, filename
,
1887 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1888 unbind_to (count
, Qnil
);
1893 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1894 doc
: /* Execute the region as Lisp code.
1895 When called from programs, expects two arguments,
1896 giving starting and ending indices in the current buffer
1897 of the text to be executed.
1898 Programs can pass third argument PRINTFLAG which controls output:
1899 A value of nil means discard it; anything else is stream for printing it.
1900 Also the fourth argument READ-FUNCTION, if non-nil, is used
1901 instead of `read' to read each expression. It gets one argument
1902 which is the input stream for reading characters.
1904 This function does not move point. */)
1905 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1907 /* FIXME: Do the eval-sexp-add-defvars dance! */
1908 ptrdiff_t count
= SPECPDL_INDEX ();
1909 Lisp_Object tem
, cbuf
;
1911 cbuf
= Fcurrent_buffer ();
1913 if (NILP (printflag
))
1917 specbind (Qstandard_output
, tem
);
1918 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1920 /* `readevalloop' calls functions which check the type of start and end. */
1921 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1922 !NILP (printflag
), Qnil
, read_function
,
1925 return unbind_to (count
, Qnil
);
1929 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1930 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1931 If STREAM is nil, use the value of `standard-input' (which see).
1932 STREAM or the value of `standard-input' may be:
1933 a buffer (read from point and advance it)
1934 a marker (read from where it points and advance it)
1935 a function (call it with no arguments for each character,
1936 call it with a char as argument to push a char back)
1937 a string (takes text from string, starting at the beginning)
1938 t (read text line using minibuffer and use it, or read from
1939 standard input in batch mode). */)
1940 (Lisp_Object stream
)
1943 stream
= Vstandard_input
;
1944 if (EQ (stream
, Qt
))
1945 stream
= Qread_char
;
1946 if (EQ (stream
, Qread_char
))
1947 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1949 return read_internal_start (stream
, Qnil
, Qnil
);
1952 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1953 doc
: /* Read one Lisp expression which is represented as text by STRING.
1954 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1955 FINAL-STRING-INDEX is an integer giving the position of the next
1956 remaining character in STRING.
1957 START and END optionally delimit a substring of STRING from which to read;
1958 they default to 0 and (length STRING) respectively. */)
1959 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1962 CHECK_STRING (string
);
1963 /* `read_internal_start' sets `read_from_string_index'. */
1964 ret
= read_internal_start (string
, start
, end
);
1965 return Fcons (ret
, make_number (read_from_string_index
));
1968 /* Function to set up the global context we need in toplevel read
1971 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1972 /* `start', `end' only used when stream is a string. */
1977 new_backquote_flag
= 0;
1978 read_objects
= Qnil
;
1979 if (EQ (Vread_with_symbol_positions
, Qt
)
1980 || EQ (Vread_with_symbol_positions
, stream
))
1981 Vread_symbol_positions_list
= Qnil
;
1983 if (STRINGP (stream
)
1984 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1986 ptrdiff_t startval
, endval
;
1989 if (STRINGP (stream
))
1992 string
= XCAR (stream
);
1995 endval
= SCHARS (string
);
1999 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2000 args_out_of_range (string
, end
);
2001 endval
= XINT (end
);
2008 CHECK_NUMBER (start
);
2009 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2010 args_out_of_range (string
, start
);
2011 startval
= XINT (start
);
2013 read_from_string_index
= startval
;
2014 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2015 read_from_string_limit
= endval
;
2018 retval
= read0 (stream
);
2019 if (EQ (Vread_with_symbol_positions
, Qt
)
2020 || EQ (Vread_with_symbol_positions
, stream
))
2021 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2026 /* Signal Qinvalid_read_syntax error.
2027 S is error string of length N (if > 0) */
2029 static _Noreturn
void
2030 invalid_syntax (const char *s
)
2032 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2036 /* Use this for recursive reads, in contexts where internal tokens
2040 read0 (Lisp_Object readcharfun
)
2042 register Lisp_Object val
;
2045 val
= read1 (readcharfun
, &c
, 0);
2049 xsignal1 (Qinvalid_read_syntax
,
2050 Fmake_string (make_number (1), make_number (c
)));
2053 static ptrdiff_t read_buffer_size
;
2054 static char *read_buffer
;
2056 /* Read a \-escape sequence, assuming we already read the `\'.
2057 If the escape sequence forces unibyte, return eight-bit char. */
2060 read_escape (Lisp_Object readcharfun
, int stringp
)
2062 register int c
= READCHAR
;
2063 /* \u allows up to four hex digits, \U up to eight. Default to the
2064 behavior for \u, and change this value in the case that \U is seen. */
2065 int unicode_hex_count
= 4;
2070 end_of_file_error ();
2100 error ("Invalid escape character syntax");
2103 c
= read_escape (readcharfun
, 0);
2104 return c
| meta_modifier
;
2109 error ("Invalid escape character syntax");
2112 c
= read_escape (readcharfun
, 0);
2113 return c
| shift_modifier
;
2118 error ("Invalid escape character syntax");
2121 c
= read_escape (readcharfun
, 0);
2122 return c
| hyper_modifier
;
2127 error ("Invalid escape character syntax");
2130 c
= read_escape (readcharfun
, 0);
2131 return c
| alt_modifier
;
2135 if (stringp
|| c
!= '-')
2142 c
= read_escape (readcharfun
, 0);
2143 return c
| super_modifier
;
2148 error ("Invalid escape character syntax");
2152 c
= read_escape (readcharfun
, 0);
2153 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2154 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2155 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2156 return c
| ctrl_modifier
;
2157 /* ASCII control chars are made from letters (both cases),
2158 as well as the non-letters within 0100...0137. */
2159 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2160 return (c
& (037 | ~0177));
2161 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2162 return (c
& (037 | ~0177));
2164 return c
| ctrl_modifier
;
2174 /* An octal escape, as in ANSI C. */
2176 register int i
= c
- '0';
2177 register int count
= 0;
2180 if ((c
= READCHAR
) >= '0' && c
<= '7')
2192 if (i
>= 0x80 && i
< 0x100)
2193 i
= BYTE8_TO_CHAR (i
);
2198 /* A hex escape, as in ANSI C. */
2205 if (c
>= '0' && c
<= '9')
2210 else if ((c
>= 'a' && c
<= 'f')
2211 || (c
>= 'A' && c
<= 'F'))
2214 if (c
>= 'a' && c
<= 'f')
2224 /* Allow hex escapes as large as ?\xfffffff, because some
2225 packages use them to denote characters with modifiers. */
2226 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2227 error ("Hex character out of range: \\x%x...", i
);
2231 if (count
< 3 && i
>= 0x80)
2232 return BYTE8_TO_CHAR (i
);
2237 /* Post-Unicode-2.0: Up to eight hex chars. */
2238 unicode_hex_count
= 8;
2241 /* A Unicode escape. We only permit them in strings and characters,
2242 not arbitrarily in the source code, as in some other languages. */
2247 while (++count
<= unicode_hex_count
)
2250 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2252 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2253 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2254 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2256 error ("Non-hex digit used for Unicode escape");
2259 error ("Non-Unicode character: 0x%x", i
);
2268 /* Return the digit that CHARACTER stands for in the given BASE.
2269 Return -1 if CHARACTER is out of range for BASE,
2270 and -2 if CHARACTER is not valid for any supported BASE. */
2272 digit_to_number (int character
, int base
)
2276 if ('0' <= character
&& character
<= '9')
2277 digit
= character
- '0';
2278 else if ('a' <= character
&& character
<= 'z')
2279 digit
= character
- 'a' + 10;
2280 else if ('A' <= character
&& character
<= 'Z')
2281 digit
= character
- 'A' + 10;
2285 return digit
< base
? digit
: -1;
2288 /* Read an integer in radix RADIX using READCHARFUN to read
2289 characters. RADIX must be in the interval [2..36]; if it isn't, a
2290 read error is signaled . Value is the integer read. Signals an
2291 error if encountering invalid read syntax or if RADIX is out of
2295 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2297 /* Room for sign, leading 0, other digits, trailing null byte.
2298 Also, room for invalid syntax diagnostic. */
2299 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2300 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2302 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2304 if (radix
< 2 || radix
> 36)
2312 if (c
== '-' || c
== '+')
2323 /* Ignore redundant leading zeros, so the buffer doesn't
2324 fill up with them. */
2330 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2337 if (p
< buf
+ sizeof buf
- 1)
2351 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2352 invalid_syntax (buf
);
2355 return string_to_number (buf
, radix
, 0);
2359 /* If the next token is ')' or ']' or '.', we store that character
2360 in *PCH and the return value is not interesting. Else, we store
2361 zero in *PCH and we read and return one lisp object.
2363 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2366 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2369 bool uninterned_symbol
= 0;
2377 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2379 end_of_file_error ();
2384 return read_list (0, readcharfun
);
2387 return read_vector (readcharfun
, 0);
2403 /* Accept extended format for hashtables (extensible to
2405 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2406 Lisp_Object tmp
= read_list (0, readcharfun
);
2407 Lisp_Object head
= CAR_SAFE (tmp
);
2408 Lisp_Object data
= Qnil
;
2409 Lisp_Object val
= Qnil
;
2410 /* The size is 2 * number of allowed keywords to
2412 Lisp_Object params
[10];
2414 Lisp_Object key
= Qnil
;
2415 int param_count
= 0;
2417 if (!EQ (head
, Qhash_table
))
2418 error ("Invalid extended read marker at head of #s list "
2419 "(only hash-table allowed)");
2421 tmp
= CDR_SAFE (tmp
);
2423 /* This is repetitive but fast and simple. */
2424 params
[param_count
] = QCsize
;
2425 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2426 if (!NILP (params
[param_count
+ 1]))
2429 params
[param_count
] = QCtest
;
2430 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2431 if (!NILP (params
[param_count
+ 1]))
2434 params
[param_count
] = QCweakness
;
2435 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2436 if (!NILP (params
[param_count
+ 1]))
2439 params
[param_count
] = QCrehash_size
;
2440 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2441 if (!NILP (params
[param_count
+ 1]))
2444 params
[param_count
] = QCrehash_threshold
;
2445 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2446 if (!NILP (params
[param_count
+ 1]))
2449 /* This is the hashtable data. */
2450 data
= Fplist_get (tmp
, Qdata
);
2452 /* Now use params to make a new hashtable and fill it. */
2453 ht
= Fmake_hash_table (param_count
, params
);
2455 while (CONSP (data
))
2460 error ("Odd number of elements in hashtable data");
2463 Fputhash (key
, val
, ht
);
2469 invalid_syntax ("#");
2477 tmp
= read_vector (readcharfun
, 0);
2478 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2479 error ("Invalid size char-table");
2480 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2492 tmp
= read_vector (readcharfun
, 0);
2495 error ("Invalid size char-table");
2496 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2497 error ("Invalid depth in char-table");
2498 depth
= XINT (AREF (tmp
, 0));
2499 if (chartab_size
[depth
] != size
- 2)
2500 error ("Invalid size char-table");
2501 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2504 invalid_syntax ("#^^");
2506 invalid_syntax ("#^");
2511 length
= read1 (readcharfun
, pch
, first_in_list
);
2515 Lisp_Object tmp
, val
;
2516 EMACS_INT size_in_chars
2517 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2518 / BOOL_VECTOR_BITS_PER_CHAR
);
2521 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2522 if (STRING_MULTIBYTE (tmp
)
2523 || (size_in_chars
!= SCHARS (tmp
)
2524 /* We used to print 1 char too many
2525 when the number of bits was a multiple of 8.
2526 Accept such input in case it came from an old
2528 && ! (XFASTINT (length
)
2529 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2530 invalid_syntax ("#&...");
2532 val
= Fmake_bool_vector (length
, Qnil
);
2533 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2534 /* Clear the extraneous bits in the last byte. */
2535 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2536 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2537 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2540 invalid_syntax ("#&...");
2544 /* Accept compiled functions at read-time so that we don't have to
2545 build them using function calls. */
2547 tmp
= read_vector (readcharfun
, 1);
2548 make_byte_code (XVECTOR (tmp
));
2554 struct gcpro gcpro1
;
2557 /* Read the string itself. */
2558 tmp
= read1 (readcharfun
, &ch
, 0);
2559 if (ch
!= 0 || !STRINGP (tmp
))
2560 invalid_syntax ("#");
2562 /* Read the intervals and their properties. */
2565 Lisp_Object beg
, end
, plist
;
2567 beg
= read1 (readcharfun
, &ch
, 0);
2572 end
= read1 (readcharfun
, &ch
, 0);
2574 plist
= read1 (readcharfun
, &ch
, 0);
2576 invalid_syntax ("Invalid string property list");
2577 Fset_text_properties (beg
, end
, plist
, tmp
);
2583 /* #@NUMBER is used to skip NUMBER following characters.
2584 That's used in .elc files to skip over doc strings
2585 and function definitions. */
2588 enum { extra
= 100 };
2589 ptrdiff_t i
, nskip
= 0;
2592 /* Read a decimal integer. */
2593 while ((c
= READCHAR
) >= 0
2594 && c
>= '0' && c
<= '9')
2596 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2603 if (load_force_doc_strings
2604 && (EQ (readcharfun
, Qget_file_char
)
2605 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2607 /* If we are supposed to force doc strings into core right now,
2608 record the last string that we skipped,
2609 and record where in the file it comes from. */
2611 /* But first exchange saved_doc_string
2612 with prev_saved_doc_string, so we save two strings. */
2614 char *temp
= saved_doc_string
;
2615 ptrdiff_t temp_size
= saved_doc_string_size
;
2616 file_offset temp_pos
= saved_doc_string_position
;
2617 ptrdiff_t temp_len
= saved_doc_string_length
;
2619 saved_doc_string
= prev_saved_doc_string
;
2620 saved_doc_string_size
= prev_saved_doc_string_size
;
2621 saved_doc_string_position
= prev_saved_doc_string_position
;
2622 saved_doc_string_length
= prev_saved_doc_string_length
;
2624 prev_saved_doc_string
= temp
;
2625 prev_saved_doc_string_size
= temp_size
;
2626 prev_saved_doc_string_position
= temp_pos
;
2627 prev_saved_doc_string_length
= temp_len
;
2630 if (saved_doc_string_size
== 0)
2632 saved_doc_string
= xmalloc (nskip
+ extra
);
2633 saved_doc_string_size
= nskip
+ extra
;
2635 if (nskip
> saved_doc_string_size
)
2637 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2638 saved_doc_string_size
= nskip
+ extra
;
2641 saved_doc_string_position
= file_tell (instream
);
2643 /* Copy that many characters into saved_doc_string. */
2644 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2645 saved_doc_string
[i
] = c
= READCHAR
;
2647 saved_doc_string_length
= i
;
2651 /* Skip that many characters. */
2652 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2661 /* #! appears at the beginning of an executable file.
2662 Skip the first line. */
2663 while (c
!= '\n' && c
>= 0)
2668 return Vload_file_name
;
2670 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2671 /* #:foo is the uninterned symbol named foo. */
2674 uninterned_symbol
= 1;
2677 && c
!= 0xa0 /* NBSP */
2679 || strchr ("\"';()[]#`,", c
) == NULL
)))
2681 /* No symbol character follows, this is the empty
2684 return Fmake_symbol (empty_unibyte_string
);
2688 /* ## is the empty symbol. */
2690 return Fintern (empty_unibyte_string
, Qnil
);
2691 /* Reader forms that can reuse previously read objects. */
2692 if (c
>= '0' && c
<= '9')
2697 /* Read a non-negative integer. */
2698 while (c
>= '0' && c
<= '9')
2700 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2701 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2702 n
= MOST_POSITIVE_FIXNUM
+ 1;
2704 n
= n
* 10 + c
- '0';
2708 if (n
<= MOST_POSITIVE_FIXNUM
)
2710 if (c
== 'r' || c
== 'R')
2711 return read_integer (readcharfun
, n
);
2713 if (! NILP (Vread_circle
))
2715 /* #n=object returns object, but associates it with
2719 /* Make a placeholder for #n# to use temporarily. */
2720 Lisp_Object placeholder
;
2723 placeholder
= Fcons (Qnil
, Qnil
);
2724 cell
= Fcons (make_number (n
), placeholder
);
2725 read_objects
= Fcons (cell
, read_objects
);
2727 /* Read the object itself. */
2728 tem
= read0 (readcharfun
);
2730 /* Now put it everywhere the placeholder was... */
2731 substitute_object_in_subtree (tem
, placeholder
);
2733 /* ...and #n# will use the real value from now on. */
2734 Fsetcdr (cell
, tem
);
2739 /* #n# returns a previously read object. */
2742 tem
= Fassq (make_number (n
), read_objects
);
2748 /* Fall through to error message. */
2750 else if (c
== 'x' || c
== 'X')
2751 return read_integer (readcharfun
, 16);
2752 else if (c
== 'o' || c
== 'O')
2753 return read_integer (readcharfun
, 8);
2754 else if (c
== 'b' || c
== 'B')
2755 return read_integer (readcharfun
, 2);
2758 invalid_syntax ("#");
2761 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2766 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2771 int next_char
= READCHAR
;
2773 /* Transition from old-style to new-style:
2774 If we see "(`" it used to mean old-style, which usually works
2775 fine because ` should almost never appear in such a position
2776 for new-style. But occasionally we need "(`" to mean new
2777 style, so we try to distinguish the two by the fact that we
2778 can either write "( `foo" or "(` foo", where the first
2779 intends to use new-style whereas the second intends to use
2780 old-style. For Emacs-25, we should completely remove this
2781 first_in_list exception (old-style can still be obtained via
2783 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2785 Vold_style_backquotes
= Qt
;
2792 new_backquote_flag
++;
2793 value
= read0 (readcharfun
);
2794 new_backquote_flag
--;
2796 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2801 int next_char
= READCHAR
;
2803 /* Transition from old-style to new-style:
2804 It used to be impossible to have a new-style , other than within
2805 a new-style `. This is sufficient when ` and , are used in the
2806 normal way, but ` and , can also appear in args to macros that
2807 will not interpret them in the usual way, in which case , may be
2808 used without any ` anywhere near.
2809 So we now use the same heuristic as for backquote: old-style
2810 unquotes are only recognized when first on a list, and when
2811 followed by a space.
2812 Because it's more difficult to peek 2 chars ahead, a new-style
2813 ,@ can still not be used outside of a `, unless it's in the middle
2815 if (new_backquote_flag
2817 || (next_char
!= ' ' && next_char
!= '@'))
2819 Lisp_Object comma_type
= Qnil
;
2824 comma_type
= Qcomma_at
;
2826 comma_type
= Qcomma_dot
;
2829 if (ch
>= 0) UNREAD (ch
);
2830 comma_type
= Qcomma
;
2833 value
= read0 (readcharfun
);
2834 return Fcons (comma_type
, Fcons (value
, Qnil
));
2838 Vold_style_backquotes
= Qt
;
2850 end_of_file_error ();
2852 /* Accept `single space' syntax like (list ? x) where the
2853 whitespace character is SPC or TAB.
2854 Other literal whitespace like NL, CR, and FF are not accepted,
2855 as there are well-established escape sequences for these. */
2856 if (c
== ' ' || c
== '\t')
2857 return make_number (c
);
2860 c
= read_escape (readcharfun
, 0);
2861 modifiers
= c
& CHAR_MODIFIER_MASK
;
2862 c
&= ~CHAR_MODIFIER_MASK
;
2863 if (CHAR_BYTE8_P (c
))
2864 c
= CHAR_TO_BYTE8 (c
);
2867 next_char
= READCHAR
;
2868 ok
= (next_char
<= 040
2869 || (next_char
< 0200
2870 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2873 return make_number (c
);
2875 invalid_syntax ("?");
2880 char *p
= read_buffer
;
2881 char *end
= read_buffer
+ read_buffer_size
;
2883 /* Nonzero if we saw an escape sequence specifying
2884 a multibyte character. */
2885 int force_multibyte
= 0;
2886 /* Nonzero if we saw an escape sequence specifying
2887 a single-byte character. */
2888 int force_singlebyte
= 0;
2890 ptrdiff_t nchars
= 0;
2892 while ((ch
= READCHAR
) >= 0
2895 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2897 ptrdiff_t offset
= p
- read_buffer
;
2898 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2899 memory_full (SIZE_MAX
);
2900 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
2901 read_buffer_size
*= 2;
2902 p
= read_buffer
+ offset
;
2903 end
= read_buffer
+ read_buffer_size
;
2910 ch
= read_escape (readcharfun
, 1);
2912 /* CH is -1 if \ newline has just been seen. */
2915 if (p
== read_buffer
)
2920 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2921 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2923 if (CHAR_BYTE8_P (ch
))
2924 force_singlebyte
= 1;
2925 else if (! ASCII_CHAR_P (ch
))
2926 force_multibyte
= 1;
2927 else /* I.e. ASCII_CHAR_P (ch). */
2929 /* Allow `\C- ' and `\C-?'. */
2930 if (modifiers
== CHAR_CTL
)
2933 ch
= 0, modifiers
= 0;
2935 ch
= 127, modifiers
= 0;
2937 if (modifiers
& CHAR_SHIFT
)
2939 /* Shift modifier is valid only with [A-Za-z]. */
2940 if (ch
>= 'A' && ch
<= 'Z')
2941 modifiers
&= ~CHAR_SHIFT
;
2942 else if (ch
>= 'a' && ch
<= 'z')
2943 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2946 if (modifiers
& CHAR_META
)
2948 /* Move the meta bit to the right place for a
2950 modifiers
&= ~CHAR_META
;
2951 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2952 force_singlebyte
= 1;
2956 /* Any modifiers remaining are invalid. */
2958 error ("Invalid modifier in string");
2959 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2963 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2964 if (CHAR_BYTE8_P (ch
))
2965 force_singlebyte
= 1;
2966 else if (! ASCII_CHAR_P (ch
))
2967 force_multibyte
= 1;
2973 end_of_file_error ();
2975 /* If purifying, and string starts with \ newline,
2976 return zero instead. This is for doc strings
2977 that we are really going to find in etc/DOC.nn.nn. */
2978 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2979 return make_number (0);
2981 if (! force_multibyte
&& force_singlebyte
)
2983 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
2984 forms. Convert it to unibyte. */
2985 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
2987 p
= read_buffer
+ nchars
;
2990 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2992 || (p
- read_buffer
!= nchars
)));
2997 int next_char
= READCHAR
;
3000 if (next_char
<= 040
3001 || (next_char
< 0200
3002 && strchr ("\"';([#?`,", next_char
) != NULL
))
3008 /* Otherwise, we fall through! Note that the atom-reading loop
3009 below will now loop at least once, assuring that we will not
3010 try to UNREAD two characters in a row. */
3014 if (c
<= 040) goto retry
;
3015 if (c
== 0xa0) /* NBSP */
3020 char *p
= read_buffer
;
3022 EMACS_INT start_position
= readchar_count
- 1;
3025 char *end
= read_buffer
+ read_buffer_size
;
3029 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3031 ptrdiff_t offset
= p
- read_buffer
;
3032 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3033 memory_full (SIZE_MAX
);
3034 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3035 read_buffer_size
*= 2;
3036 p
= read_buffer
+ offset
;
3037 end
= read_buffer
+ read_buffer_size
;
3044 end_of_file_error ();
3049 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3055 && c
!= 0xa0 /* NBSP */
3057 || strchr ("\"';()[]#`,", c
) == NULL
));
3061 ptrdiff_t offset
= p
- read_buffer
;
3062 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3063 memory_full (SIZE_MAX
);
3064 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3065 read_buffer_size
*= 2;
3066 p
= read_buffer
+ offset
;
3067 end
= read_buffer
+ read_buffer_size
;
3073 if (!quoted
&& !uninterned_symbol
)
3075 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3076 if (! NILP (result
))
3080 Lisp_Object name
, result
;
3081 ptrdiff_t nbytes
= p
- read_buffer
;
3084 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3088 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3089 ? make_pure_string
: make_specified_string
)
3090 (read_buffer
, nchars
, nbytes
, multibyte
));
3091 result
= (uninterned_symbol
? Fmake_symbol (name
)
3092 : Fintern (name
, Qnil
));
3094 if (EQ (Vread_with_symbol_positions
, Qt
)
3095 || EQ (Vread_with_symbol_positions
, readcharfun
))
3096 Vread_symbol_positions_list
3097 = Fcons (Fcons (result
, make_number (start_position
)),
3098 Vread_symbol_positions_list
);
3106 /* List of nodes we've seen during substitute_object_in_subtree. */
3107 static Lisp_Object seen_list
;
3110 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3112 Lisp_Object check_object
;
3114 /* We haven't seen any objects when we start. */
3117 /* Make all the substitutions. */
3119 = substitute_object_recurse (object
, placeholder
, object
);
3121 /* Clear seen_list because we're done with it. */
3124 /* The returned object here is expected to always eq the
3126 if (!EQ (check_object
, object
))
3127 error ("Unexpected mutation error in reader");
3130 /* Feval doesn't get called from here, so no gc protection is needed. */
3131 #define SUBSTITUTE(get_val, set_val) \
3133 Lisp_Object old_value = get_val; \
3134 Lisp_Object true_value \
3135 = substitute_object_recurse (object, placeholder, \
3138 if (!EQ (old_value, true_value)) \
3145 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3147 /* If we find the placeholder, return the target object. */
3148 if (EQ (placeholder
, subtree
))
3151 /* If we've been to this node before, don't explore it again. */
3152 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3155 /* If this node can be the entry point to a cycle, remember that
3156 we've seen it. It can only be such an entry point if it was made
3157 by #n=, which means that we can find it as a value in
3159 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3160 seen_list
= Fcons (subtree
, seen_list
);
3162 /* Recurse according to subtree's type.
3163 Every branch must return a Lisp_Object. */
3164 switch (XTYPE (subtree
))
3166 case Lisp_Vectorlike
:
3168 ptrdiff_t i
, length
= 0;
3169 if (BOOL_VECTOR_P (subtree
))
3170 return subtree
; /* No sub-objects anyway. */
3171 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3172 || COMPILEDP (subtree
))
3173 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3174 else if (VECTORP (subtree
))
3175 length
= ASIZE (subtree
);
3177 /* An unknown pseudovector may contain non-Lisp fields, so we
3178 can't just blindly traverse all its fields. We used to call
3179 `Flength' which signaled `sequencep', so I just preserved this
3181 wrong_type_argument (Qsequencep
, subtree
);
3183 for (i
= 0; i
< length
; i
++)
3184 SUBSTITUTE (AREF (subtree
, i
),
3185 ASET (subtree
, i
, true_value
));
3191 SUBSTITUTE (XCAR (subtree
),
3192 XSETCAR (subtree
, true_value
));
3193 SUBSTITUTE (XCDR (subtree
),
3194 XSETCDR (subtree
, true_value
));
3200 /* Check for text properties in each interval.
3201 substitute_in_interval contains part of the logic. */
3203 INTERVAL root_interval
= string_intervals (subtree
);
3204 Lisp_Object arg
= Fcons (object
, placeholder
);
3206 traverse_intervals_noorder (root_interval
,
3207 &substitute_in_interval
, arg
);
3212 /* Other types don't recurse any further. */
3218 /* Helper function for substitute_object_recurse. */
3220 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3222 Lisp_Object object
= Fcar (arg
);
3223 Lisp_Object placeholder
= Fcdr (arg
);
3225 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3235 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3236 integer syntax and fits in a fixnum, else return the nearest float if CP has
3237 either floating point or integer syntax and BASE is 10, else return nil. If
3238 IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
3239 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3240 number has integer syntax but does not fit. */
3243 string_to_number (char const *string
, int base
, int ignore_trailing
)
3246 char const *cp
= string
;
3248 int float_syntax
= 0;
3251 /* Compute NaN and infinities using a variable, to cope with compilers that
3252 think they are smarter than we are. */
3255 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3256 IEEE floating point hosts, and works around a formerly-common bug where
3257 atof ("-0.0") drops the sign. */
3258 int negative
= *cp
== '-';
3260 int signedp
= negative
|| *cp
== '+';
3265 leading_digit
= digit_to_number (*cp
, base
);
3266 if (0 <= leading_digit
)
3271 while (0 <= digit_to_number (*cp
, base
));
3281 if ('0' <= *cp
&& *cp
<= '9')
3286 while ('0' <= *cp
&& *cp
<= '9');
3288 if (*cp
== 'e' || *cp
== 'E')
3290 char const *ecp
= cp
;
3292 if (*cp
== '+' || *cp
== '-')
3294 if ('0' <= *cp
&& *cp
<= '9')
3299 while ('0' <= *cp
&& *cp
<= '9');
3301 else if (cp
[-1] == '+'
3302 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3308 else if (cp
[-1] == '+'
3309 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3313 value
= zero
/ zero
;
3315 /* If that made a "negative" NaN, negate it. */
3318 union { double d
; char c
[sizeof (double)]; }
3319 u_data
, u_minus_zero
;
3321 u_minus_zero
.d
= -0.0;
3322 for (i
= 0; i
< sizeof (double); i
++)
3323 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3329 /* Now VALUE is a positive NaN. */
3335 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3336 || state
== (LEAD_INT
|E_EXP
));
3339 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3340 any prefix that matches. Otherwise, the entire string must match. */
3341 if (! (ignore_trailing
3342 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3343 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3346 /* If the number uses integer and not float syntax, and is in C-language
3347 range, use its value, preferably as a fixnum. */
3348 if (0 <= leading_digit
&& ! float_syntax
)
3352 /* Fast special case for single-digit integers. This also avoids a
3353 glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
3354 case some versions of strtoumax accept numbers like "0x1" that Emacs
3356 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3357 return make_number (negative
? -leading_digit
: leading_digit
);
3360 n
= strtoumax (string
+ signedp
, NULL
, base
);
3361 if (errno
== ERANGE
)
3363 /* Unfortunately there's no simple and accurate way to convert
3364 non-base-10 numbers that are out of C-language range. */
3366 xsignal1 (Qoverflow_error
, build_string (string
));
3368 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3370 EMACS_INT signed_n
= n
;
3371 return make_number (negative
? -signed_n
: signed_n
);
3377 /* Either the number uses float syntax, or it does not fit into a fixnum.
3378 Convert it from string to floating point, unless the value is already
3379 known because it is an infinity, a NAN, or its absolute value fits in
3382 value
= atof (string
+ signedp
);
3384 return make_float (negative
? -value
: value
);
3389 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3392 register Lisp_Object
*ptr
;
3393 register Lisp_Object tem
, item
, vector
;
3394 register struct Lisp_Cons
*otem
;
3397 tem
= read_list (1, readcharfun
);
3398 len
= Flength (tem
);
3399 vector
= Fmake_vector (len
, Qnil
);
3401 size
= ASIZE (vector
);
3402 ptr
= XVECTOR (vector
)->contents
;
3403 for (i
= 0; i
< size
; i
++)
3406 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3407 bytecode object, the docstring containing the bytecode and
3408 constants values must be treated as unibyte and passed to
3409 Fread, to get the actual bytecode string and constants vector. */
3410 if (bytecodeflag
&& load_force_doc_strings
)
3412 if (i
== COMPILED_BYTECODE
)
3414 if (!STRINGP (item
))
3415 error ("Invalid byte code");
3417 /* Delay handling the bytecode slot until we know whether
3418 it is lazily-loaded (we can tell by whether the
3419 constants slot is nil). */
3420 ASET (vector
, COMPILED_CONSTANTS
, item
);
3423 else if (i
== COMPILED_CONSTANTS
)
3425 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3429 /* Coerce string to unibyte (like string-as-unibyte,
3430 but without generating extra garbage and
3431 guaranteeing no change in the contents). */
3432 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3433 STRING_SET_UNIBYTE (bytestr
);
3435 item
= Fread (Fcons (bytestr
, readcharfun
));
3437 error ("Invalid byte code");
3439 otem
= XCONS (item
);
3440 bytestr
= XCAR (item
);
3445 /* Now handle the bytecode slot. */
3446 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3448 else if (i
== COMPILED_DOC_STRING
3450 && ! STRING_MULTIBYTE (item
))
3452 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3453 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3455 item
= Fstring_as_multibyte (item
);
3458 ASET (vector
, i
, item
);
3466 /* FLAG = 1 means check for ] to terminate rather than ) and . */
3469 read_list (int flag
, register Lisp_Object readcharfun
)
3471 Lisp_Object val
, tail
;
3472 register Lisp_Object elt
, tem
;
3473 struct gcpro gcpro1
, gcpro2
;
3474 /* 0 is the normal case.
3475 1 means this list is a doc reference; replace it with the number 0.
3476 2 means this list is a doc reference; replace it with the doc string. */
3477 int doc_reference
= 0;
3479 /* Initialize this to 1 if we are reading a list. */
3480 int first_in_list
= flag
<= 0;
3489 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3494 /* While building, if the list starts with #$, treat it specially. */
3495 if (EQ (elt
, Vload_file_name
)
3497 && !NILP (Vpurify_flag
))
3499 if (NILP (Vdoc_file_name
))
3500 /* We have not yet called Snarf-documentation, so assume
3501 this file is described in the DOC-MM.NN file
3502 and Snarf-documentation will fill in the right value later.
3503 For now, replace the whole list with 0. */
3506 /* We have already called Snarf-documentation, so make a relative
3507 file name for this file, so it can be found properly
3508 in the installed Lisp directory.
3509 We don't use Fexpand_file_name because that would make
3510 the directory absolute now. */
3511 elt
= concat2 (build_string ("../lisp/"),
3512 Ffile_name_nondirectory (elt
));
3514 else if (EQ (elt
, Vload_file_name
)
3516 && load_force_doc_strings
)
3525 invalid_syntax (") or . in a vector");
3533 XSETCDR (tail
, read0 (readcharfun
));
3535 val
= read0 (readcharfun
);
3536 read1 (readcharfun
, &ch
, 0);
3540 if (doc_reference
== 1)
3541 return make_number (0);
3542 if (doc_reference
== 2)
3544 /* Get a doc string from the file we are loading.
3545 If it's in saved_doc_string, get it from there.
3547 Here, we don't know if the string is a
3548 bytecode string or a doc string. As a
3549 bytecode string must be unibyte, we always
3550 return a unibyte string. If it is actually a
3551 doc string, caller must make it
3554 EMACS_INT pos
= XINT (XCDR (val
));
3555 /* Position is negative for user variables. */
3556 if (pos
< 0) pos
= -pos
;
3557 if (pos
>= saved_doc_string_position
3558 && pos
< (saved_doc_string_position
3559 + saved_doc_string_length
))
3561 ptrdiff_t start
= pos
- saved_doc_string_position
;
3564 /* Process quoting with ^A,
3565 and find the end of the string,
3566 which is marked with ^_ (037). */
3567 for (from
= start
, to
= start
;
3568 saved_doc_string
[from
] != 037;)
3570 int c
= saved_doc_string
[from
++];
3573 c
= saved_doc_string
[from
++];
3575 saved_doc_string
[to
++] = c
;
3577 saved_doc_string
[to
++] = 0;
3579 saved_doc_string
[to
++] = 037;
3582 saved_doc_string
[to
++] = c
;
3585 return make_unibyte_string (saved_doc_string
+ start
,
3588 /* Look in prev_saved_doc_string the same way. */
3589 else if (pos
>= prev_saved_doc_string_position
3590 && pos
< (prev_saved_doc_string_position
3591 + prev_saved_doc_string_length
))
3594 pos
- prev_saved_doc_string_position
;
3597 /* Process quoting with ^A,
3598 and find the end of the string,
3599 which is marked with ^_ (037). */
3600 for (from
= start
, to
= start
;
3601 prev_saved_doc_string
[from
] != 037;)
3603 int c
= prev_saved_doc_string
[from
++];
3606 c
= prev_saved_doc_string
[from
++];
3608 prev_saved_doc_string
[to
++] = c
;
3610 prev_saved_doc_string
[to
++] = 0;
3612 prev_saved_doc_string
[to
++] = 037;
3615 prev_saved_doc_string
[to
++] = c
;
3618 return make_unibyte_string (prev_saved_doc_string
3623 return get_doc_string (val
, 1, 0);
3628 invalid_syntax (". in wrong context");
3630 invalid_syntax ("] in a list");
3632 tem
= Fcons (elt
, Qnil
);
3634 XSETCDR (tail
, tem
);
3641 static Lisp_Object initial_obarray
;
3643 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3645 static size_t oblookup_last_bucket_number
;
3647 /* Get an error if OBARRAY is not an obarray.
3648 If it is one, return it. */
3651 check_obarray (Lisp_Object obarray
)
3653 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3655 /* If Vobarray is now invalid, force it to be valid. */
3656 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3657 wrong_type_argument (Qvectorp
, obarray
);
3662 /* Intern the C string STR: return a symbol with that name,
3663 interned in the current obarray. */
3666 intern_1 (const char *str
, ptrdiff_t len
)
3668 Lisp_Object obarray
= check_obarray (Vobarray
);
3669 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3671 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3675 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3677 Lisp_Object obarray
= check_obarray (Vobarray
);
3678 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3683 if (NILP (Vpurify_flag
))
3684 /* Creating a non-pure string from a string literal not
3685 implemented yet. We could just use make_string here and live
3686 with the extra copy. */
3689 return Fintern (make_pure_c_string (str
, len
), obarray
);
3692 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3693 doc
: /* Return the canonical symbol whose name is STRING.
3694 If there is none, one is created by this function and returned.
3695 A second optional argument specifies the obarray to use;
3696 it defaults to the value of `obarray'. */)
3697 (Lisp_Object string
, Lisp_Object obarray
)
3699 register Lisp_Object tem
, sym
, *ptr
;
3701 if (NILP (obarray
)) obarray
= Vobarray
;
3702 obarray
= check_obarray (obarray
);
3704 CHECK_STRING (string
);
3706 tem
= oblookup (obarray
, SSDATA (string
),
3709 if (!INTEGERP (tem
))
3712 if (!NILP (Vpurify_flag
))
3713 string
= Fpurecopy (string
);
3714 sym
= Fmake_symbol (string
);
3716 if (EQ (obarray
, initial_obarray
))
3717 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3719 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3721 if ((SREF (string
, 0) == ':')
3722 && EQ (obarray
, initial_obarray
))
3724 XSYMBOL (sym
)->constant
= 1;
3725 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3726 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3729 ptr
= aref_addr (obarray
, XINT(tem
));
3731 set_symbol_next (sym
, XSYMBOL (*ptr
));
3733 set_symbol_next (sym
, NULL
);
3738 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3739 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3740 NAME may be a string or a symbol. If it is a symbol, that exact
3741 symbol is searched for.
3742 A second optional argument specifies the obarray to use;
3743 it defaults to the value of `obarray'. */)
3744 (Lisp_Object name
, Lisp_Object obarray
)
3746 register Lisp_Object tem
, string
;
3748 if (NILP (obarray
)) obarray
= Vobarray
;
3749 obarray
= check_obarray (obarray
);
3751 if (!SYMBOLP (name
))
3753 CHECK_STRING (name
);
3757 string
= SYMBOL_NAME (name
);
3759 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3760 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3766 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3767 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3768 The value is t if a symbol was found and deleted, nil otherwise.
3769 NAME may be a string or a symbol. If it is a symbol, that symbol
3770 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3771 OBARRAY defaults to the value of the variable `obarray'. */)
3772 (Lisp_Object name
, Lisp_Object obarray
)
3774 register Lisp_Object string
, tem
;
3777 if (NILP (obarray
)) obarray
= Vobarray
;
3778 obarray
= check_obarray (obarray
);
3781 string
= SYMBOL_NAME (name
);
3784 CHECK_STRING (name
);
3788 tem
= oblookup (obarray
, SSDATA (string
),
3793 /* If arg was a symbol, don't delete anything but that symbol itself. */
3794 if (SYMBOLP (name
) && !EQ (name
, tem
))
3797 /* There are plenty of other symbols which will screw up the Emacs
3798 session if we unintern them, as well as even more ways to use
3799 `setq' or `fset' or whatnot to make the Emacs session
3800 unusable. Let's not go down this silly road. --Stef */
3801 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3802 error ("Attempt to unintern t or nil"); */
3804 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3806 hash
= oblookup_last_bucket_number
;
3808 if (EQ (AREF (obarray
, hash
), tem
))
3810 if (XSYMBOL (tem
)->next
)
3813 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3814 ASET (obarray
, hash
, sym
);
3817 ASET (obarray
, hash
, make_number (0));
3821 Lisp_Object tail
, following
;
3823 for (tail
= AREF (obarray
, hash
);
3824 XSYMBOL (tail
)->next
;
3827 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3828 if (EQ (following
, tem
))
3830 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3839 /* Return the symbol in OBARRAY whose names matches the string
3840 of SIZE characters (SIZE_BYTE bytes) at PTR.
3841 If there is no such symbol in OBARRAY, return nil.
3843 Also store the bucket number in oblookup_last_bucket_number. */
3846 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3850 register Lisp_Object tail
;
3851 Lisp_Object bucket
, tem
;
3853 obarray
= check_obarray (obarray
);
3854 obsize
= ASIZE (obarray
);
3856 /* This is sometimes needed in the middle of GC. */
3857 obsize
&= ~ARRAY_MARK_FLAG
;
3858 hash
= hash_string (ptr
, size_byte
) % obsize
;
3859 bucket
= AREF (obarray
, hash
);
3860 oblookup_last_bucket_number
= hash
;
3861 if (EQ (bucket
, make_number (0)))
3863 else if (!SYMBOLP (bucket
))
3864 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3866 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3868 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3869 && SCHARS (SYMBOL_NAME (tail
)) == size
3870 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3872 else if (XSYMBOL (tail
)->next
== 0)
3875 XSETINT (tem
, hash
);
3880 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3883 register Lisp_Object tail
;
3884 CHECK_VECTOR (obarray
);
3885 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3887 tail
= AREF (obarray
, i
);
3892 if (XSYMBOL (tail
)->next
== 0)
3894 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3900 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3902 call1 (function
, sym
);
3905 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3906 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3907 OBARRAY defaults to the value of `obarray'. */)
3908 (Lisp_Object function
, Lisp_Object obarray
)
3910 if (NILP (obarray
)) obarray
= Vobarray
;
3911 obarray
= check_obarray (obarray
);
3913 map_obarray (obarray
, mapatoms_1
, function
);
3917 #define OBARRAY_SIZE 1511
3922 Lisp_Object oblength
;
3923 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3925 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3927 Vobarray
= Fmake_vector (oblength
, make_number (0));
3928 initial_obarray
= Vobarray
;
3929 staticpro (&initial_obarray
);
3931 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
3932 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3933 NILP (Vpurify_flag) check in intern_c_string. */
3934 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3935 Qnil
= intern_c_string ("nil");
3937 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3938 so those two need to be fixed manually. */
3939 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3940 set_symbol_function (Qunbound
, Qunbound
);
3941 set_symbol_plist (Qunbound
, Qnil
);
3942 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3943 XSYMBOL (Qnil
)->constant
= 1;
3944 XSYMBOL (Qnil
)->declared_special
= 1;
3945 set_symbol_plist (Qnil
, Qnil
);
3947 Qt
= intern_c_string ("t");
3948 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3949 XSYMBOL (Qnil
)->declared_special
= 1;
3950 XSYMBOL (Qt
)->constant
= 1;
3952 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3955 DEFSYM (Qvariable_documentation
, "variable-documentation");
3957 read_buffer
= xmalloc (size
);
3958 read_buffer_size
= size
;
3962 defsubr (struct Lisp_Subr
*sname
)
3964 Lisp_Object sym
, tem
;
3965 sym
= intern_c_string (sname
->symbol_name
);
3966 XSETTYPED_PVECTYPE (sname
, size
, PVEC_SUBR
);
3967 XSETSUBR (tem
, sname
);
3968 set_symbol_function (sym
, tem
);
3971 #ifdef NOTDEF /* Use fset in subr.el now! */
3973 defalias (struct Lisp_Subr
*sname
, char *string
)
3976 sym
= intern (string
);
3977 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3981 /* Define an "integer variable"; a symbol whose value is forwarded to a
3982 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
3983 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3985 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3986 const char *namestring
, EMACS_INT
*address
)
3989 sym
= intern_c_string (namestring
);
3990 i_fwd
->type
= Lisp_Fwd_Int
;
3991 i_fwd
->intvar
= address
;
3992 XSYMBOL (sym
)->declared_special
= 1;
3993 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3994 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
3997 /* Similar but define a variable whose value is t if address contains 1,
3998 nil if address contains 0. */
4000 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4001 const char *namestring
, bool *address
)
4004 sym
= intern_c_string (namestring
);
4005 b_fwd
->type
= Lisp_Fwd_Bool
;
4006 b_fwd
->boolvar
= address
;
4007 XSYMBOL (sym
)->declared_special
= 1;
4008 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4009 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4010 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4013 /* Similar but define a variable whose value is the Lisp Object stored
4014 at address. Two versions: with and without gc-marking of the C
4015 variable. The nopro version is used when that variable will be
4016 gc-marked for some other reason, since marking the same slot twice
4017 can cause trouble with strings. */
4019 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4020 const char *namestring
, Lisp_Object
*address
)
4023 sym
= intern_c_string (namestring
);
4024 o_fwd
->type
= Lisp_Fwd_Obj
;
4025 o_fwd
->objvar
= address
;
4026 XSYMBOL (sym
)->declared_special
= 1;
4027 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4028 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4032 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4033 const char *namestring
, Lisp_Object
*address
)
4035 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4036 staticpro (address
);
4039 /* Similar but define a variable whose value is the Lisp Object stored
4040 at a particular offset in the current kboard object. */
4043 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4044 const char *namestring
, int offset
)
4047 sym
= intern_c_string (namestring
);
4048 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4049 ko_fwd
->offset
= offset
;
4050 XSYMBOL (sym
)->declared_special
= 1;
4051 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4052 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4055 /* Check that the elements of Vload_path exist. */
4058 load_path_check (void)
4060 Lisp_Object path_tail
;
4062 /* The only elements that might not exist are those from
4063 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4065 for (path_tail
= Vload_path
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4067 Lisp_Object dirfile
;
4068 dirfile
= Fcar (path_tail
);
4069 if (STRINGP (dirfile
))
4071 dirfile
= Fdirectory_file_name (dirfile
);
4072 if (access (SSDATA (dirfile
), 0) < 0)
4073 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4079 /* Record the value of load-path used at the start of dumping
4080 so we can see if the site changed it later during dumping. */
4081 static Lisp_Object dump_path
;
4083 /* Compute the default Vload_path, with the following logic:
4085 use EMACSLOADPATH env-var if set; otherwise use PATH_LOADSEARCH,
4086 prepending PATH_SITELOADSEARCH unless --no-site-lisp.
4087 The remainder is what happens when dumping works:
4088 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4089 Otherwise use EMACSLOADPATH if set, else PATH_LOADSEARCH.
4091 If !initialized, then just set both Vload_path and dump_path.
4092 If initialized, then if Vload_path != dump_path, do nothing.
4093 (Presumably the load-path has already been changed by something.
4094 This can only be from a site-load file during dumping,
4095 or because EMACSLOADPATH is set.)
4096 If Vinstallation_directory is not nil (ie, running uninstalled):
4097 If installation-dir/lisp exists and not already a member,
4098 we must be running uninstalled. Reset the load-path
4099 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4100 refers to the eventual installation directories. Since we
4101 are not yet installed, we should not use them, even if they exist.)
4102 If installation-dir/lisp does not exist, just add dump_path at the
4104 Add installation-dir/leim (if exists and not already a member) at the front.
4105 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4106 and not already a member) at the front.
4107 If installation-dir != source-dir (ie running an uninstalled,
4108 out-of-tree build) AND install-dir/src/Makefile exists BUT
4109 install-dir/src/Makefile.in does NOT exist (this is a sanity
4110 check), then repeat the above steps for source-dir/lisp,
4112 Finally, add the site-lisp directories at the front (if !no_site_lisp).
4122 const char *loadpath
= ns_load_path ();
4125 normal
= PATH_LOADSEARCH
;
4127 Vload_path
= decode_env_path ("EMACSLOADPATH", loadpath
? loadpath
: normal
);
4129 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4134 /* FIXME CANNOT_DUMP platforms should get source-dir/lisp etc added
4135 to their load-path too, AFAICS. I don't think we can tell the
4136 difference between initialized and !initialized in this case,
4137 so we'll have to do it unconditionally when Vinstallation_directory
4139 if (!no_site_lisp
&& !egetenv ("EMACSLOADPATH"))
4141 Lisp_Object sitelisp
;
4142 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4143 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4145 #else /* !CANNOT_DUMP */
4146 if (NILP (Vpurify_flag
))
4148 normal
= PATH_LOADSEARCH
;
4149 /* If the EMACSLOADPATH environment variable is set, use its value.
4150 This doesn't apply if we're dumping. */
4151 if (egetenv ("EMACSLOADPATH"))
4152 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4155 normal
= PATH_DUMPLOADSEARCH
;
4157 /* In a dumped Emacs, we normally reset the value of Vload_path using
4158 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4159 the source directory, instead of the path of the installed elisp
4160 libraries. However, if it appears that Vload_path has already been
4161 changed from the default that was saved before dumping, don't
4162 change it further. Changes can only be due to EMACSLOADPATH, or
4163 site-lisp files that were processed during dumping. */
4166 if (NILP (Fequal (dump_path
, Vload_path
)))
4168 /* Do not make any changes, just check the elements exist. */
4169 /* Note: --no-site-lisp is ignored.
4170 I don't know what to do about this. */
4176 const char *loadpath
= ns_load_path ();
4177 Vload_path
= decode_env_path (0, loadpath
? loadpath
: normal
);
4179 Vload_path
= decode_env_path (0, normal
);
4181 if (!NILP (Vinstallation_directory
))
4183 Lisp_Object tem
, tem1
;
4185 /* Add to the path the lisp subdir of the installation
4186 dir, if it exists. Note: in out-of-tree builds,
4187 this directory is empty save for Makefile. */
4188 tem
= Fexpand_file_name (build_string ("lisp"),
4189 Vinstallation_directory
);
4190 tem1
= Ffile_exists_p (tem
);
4193 if (NILP (Fmember (tem
, Vload_path
)))
4195 /* We are running uninstalled. The default load-path
4196 points to the eventual installed lisp, leim
4197 directories. We should not use those now, even
4198 if they exist, so start over from a clean slate. */
4199 Vload_path
= Fcons (tem
, Qnil
);
4203 /* That dir doesn't exist, so add the build-time
4204 Lisp dirs instead. */
4205 Vload_path
= nconc2 (Vload_path
, dump_path
);
4207 /* Add leim under the installation dir, if it exists. */
4208 tem
= Fexpand_file_name (build_string ("leim"),
4209 Vinstallation_directory
);
4210 tem1
= Ffile_exists_p (tem
);
4213 if (NILP (Fmember (tem
, Vload_path
)))
4214 Vload_path
= Fcons (tem
, Vload_path
);
4217 /* Add site-lisp under the installation dir, if it exists. */
4220 tem
= Fexpand_file_name (build_string ("site-lisp"),
4221 Vinstallation_directory
);
4222 tem1
= Ffile_exists_p (tem
);
4225 if (NILP (Fmember (tem
, Vload_path
)))
4226 Vload_path
= Fcons (tem
, Vload_path
);
4230 /* If Emacs was not built in the source directory,
4231 and it is run from where it was built, add to load-path
4232 the lisp, leim and site-lisp dirs under that directory. */
4234 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4238 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4239 Vinstallation_directory
);
4240 tem1
= Ffile_exists_p (tem
);
4242 /* Don't be fooled if they moved the entire source tree
4243 AFTER dumping Emacs. If the build directory is indeed
4244 different from the source dir, src/Makefile.in and
4245 src/Makefile will not be found together. */
4246 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4247 Vinstallation_directory
);
4248 tem2
= Ffile_exists_p (tem
);
4249 if (!NILP (tem1
) && NILP (tem2
))
4251 tem
= Fexpand_file_name (build_string ("lisp"),
4254 if (NILP (Fmember (tem
, Vload_path
)))
4255 Vload_path
= Fcons (tem
, Vload_path
);
4257 tem
= Fexpand_file_name (build_string ("leim"),
4260 if (NILP (Fmember (tem
, Vload_path
)))
4261 Vload_path
= Fcons (tem
, Vload_path
);
4265 tem
= Fexpand_file_name (build_string ("site-lisp"),
4267 tem1
= Ffile_exists_p (tem
);
4270 if (NILP (Fmember (tem
, Vload_path
)))
4271 Vload_path
= Fcons (tem
, Vload_path
);
4275 } /* Vinstallation_directory != Vsource_directory */
4277 } /* if Vinstallation_directory */
4279 /* Check before adding the site-lisp directories.
4280 The install should have created them, but they are not
4281 required, so no need to warn if they are absent.
4282 Or we might be running before installation. */
4285 /* Add the site-lisp directories at the front. */
4288 Lisp_Object sitelisp
;
4289 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4290 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4292 } /* if dump_path == Vload_path */
4294 else /* !initialized */
4296 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4297 source directory. We used to add ../lisp (ie the lisp dir in
4298 the build directory) at the front here, but that caused trouble
4299 because it was copied from dump_path into Vload_path, above,
4300 when Vinstallation_directory was non-nil. It should not be
4301 necessary, since in out of tree builds lisp/ is empty, save
4303 Vload_path
= decode_env_path (0, normal
);
4304 dump_path
= Vload_path
;
4305 /* No point calling load_path_check; load-path only contains essential
4306 elements from the source directory at this point. They cannot
4307 be missing unless something went extremely (and improbably)
4308 wrong, in which case the build will fail in obvious ways. */
4310 #endif /* !CANNOT_DUMP */
4314 load_in_progress
= 0;
4315 Vload_file_name
= Qnil
;
4317 load_descriptor_list
= Qnil
;
4319 Vstandard_input
= Qt
;
4320 Vloads_in_progress
= Qnil
;
4323 /* Print a warning, using format string FORMAT, that directory DIRNAME
4324 does not exist. Print it on stderr and put it in *Messages*. */
4327 dir_warning (const char *format
, Lisp_Object dirname
)
4329 fprintf (stderr
, format
, SDATA (dirname
));
4331 /* Don't log the warning before we've initialized!! */
4335 char *buffer
= SAFE_ALLOCA (SBYTES (dirname
)
4336 + strlen (format
) - (sizeof "%s" - 1) + 1);
4337 ptrdiff_t message_len
= esprintf (buffer
, format
, SDATA (dirname
));
4338 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4344 syms_of_lread (void)
4347 defsubr (&Sread_from_string
);
4349 defsubr (&Sintern_soft
);
4350 defsubr (&Sunintern
);
4351 defsubr (&Sget_load_suffixes
);
4353 defsubr (&Seval_buffer
);
4354 defsubr (&Seval_region
);
4355 defsubr (&Sread_char
);
4356 defsubr (&Sread_char_exclusive
);
4357 defsubr (&Sread_event
);
4358 defsubr (&Sget_file_char
);
4359 defsubr (&Smapatoms
);
4360 defsubr (&Slocate_file_internal
);
4362 DEFVAR_LISP ("obarray", Vobarray
,
4363 doc
: /* Symbol table for use by `intern' and `read'.
4364 It is a vector whose length ought to be prime for best results.
4365 The vector's contents don't make sense if examined from Lisp programs;
4366 to find all the symbols in an obarray, use `mapatoms'. */);
4368 DEFVAR_LISP ("values", Vvalues
,
4369 doc
: /* List of values of all expressions which were read, evaluated and printed.
4370 Order is reverse chronological. */);
4371 XSYMBOL (intern ("values"))->declared_special
= 0;
4373 DEFVAR_LISP ("standard-input", Vstandard_input
,
4374 doc
: /* Stream for read to get input from.
4375 See documentation of `read' for possible values. */);
4376 Vstandard_input
= Qt
;
4378 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4379 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4381 If this variable is a buffer, then only forms read from that buffer
4382 will be added to `read-symbol-positions-list'.
4383 If this variable is t, then all read forms will be added.
4384 The effect of all other values other than nil are not currently
4385 defined, although they may be in the future.
4387 The positions are relative to the last call to `read' or
4388 `read-from-string'. It is probably a bad idea to set this variable at
4389 the toplevel; bind it instead. */);
4390 Vread_with_symbol_positions
= Qnil
;
4392 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4393 doc
: /* A list mapping read symbols to their positions.
4394 This variable is modified during calls to `read' or
4395 `read-from-string', but only when `read-with-symbol-positions' is
4398 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4399 CHAR-POSITION is an integer giving the offset of that occurrence of the
4400 symbol from the position where `read' or `read-from-string' started.
4402 Note that a symbol will appear multiple times in this list, if it was
4403 read multiple times. The list is in the same order as the symbols
4405 Vread_symbol_positions_list
= Qnil
;
4407 DEFVAR_LISP ("read-circle", Vread_circle
,
4408 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4411 DEFVAR_LISP ("load-path", Vload_path
,
4412 doc
: /* List of directories to search for files to load.
4413 Each element is a string (directory name) or nil (try default directory).
4414 Initialized based on EMACSLOADPATH environment variable, if any,
4415 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4417 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4418 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4419 This list should not include the empty string.
4420 `load' and related functions try to append these suffixes, in order,
4421 to the specified file name if a Lisp suffix is allowed or required. */);
4422 Vload_suffixes
= Fcons (build_pure_c_string (".elc"),
4423 Fcons (build_pure_c_string (".el"), Qnil
));
4424 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4425 doc
: /* List of suffixes that indicate representations of \
4427 This list should normally start with the empty string.
4429 Enabling Auto Compression mode appends the suffixes in
4430 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4431 mode removes them again. `load' and related functions use this list to
4432 determine whether they should look for compressed versions of a file
4433 and, if so, which suffixes they should try to append to the file name
4434 in order to do so. However, if you want to customize which suffixes
4435 the loading functions recognize as compression suffixes, you should
4436 customize `jka-compr-load-suffixes' rather than the present variable. */);
4437 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4439 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4440 doc
: /* Non-nil if inside of `load'. */);
4441 DEFSYM (Qload_in_progress
, "load-in-progress");
4443 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4444 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4445 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4447 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4448 a symbol \(a feature name).
4450 When `load' is run and the file-name argument matches an element's
4451 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4452 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4454 An error in FORMS does not undo the load, but does prevent execution of
4455 the rest of the FORMS. */);
4456 Vafter_load_alist
= Qnil
;
4458 DEFVAR_LISP ("load-history", Vload_history
,
4459 doc
: /* Alist mapping loaded file names to symbols and features.
4460 Each alist element should be a list (FILE-NAME ENTRIES...), where
4461 FILE-NAME is the name of a file that has been loaded into Emacs.
4462 The file name is absolute and true (i.e. it doesn't contain symlinks).
4463 As an exception, one of the alist elements may have FILE-NAME nil,
4464 for symbols and features not associated with any file.
4466 The remaining ENTRIES in the alist element describe the functions and
4467 variables defined in that file, the features provided, and the
4468 features required. Each entry has the form `(provide . FEATURE)',
4469 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4470 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4471 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4472 autoload before this file redefined it as a function. In addition,
4473 entries may also be single symbols, which means that SYMBOL was
4474 defined by `defvar' or `defconst'.
4476 During preloading, the file name recorded is relative to the main Lisp
4477 directory. These file names are converted to absolute at startup. */);
4478 Vload_history
= Qnil
;
4480 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4481 doc
: /* Full name of file being loaded by `load'. */);
4482 Vload_file_name
= Qnil
;
4484 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4485 doc
: /* File name, including directory, of user's initialization file.
4486 If the file loaded had extension `.elc', and the corresponding source file
4487 exists, this variable contains the name of source file, suitable for use
4488 by functions like `custom-save-all' which edit the init file.
4489 While Emacs loads and evaluates the init file, value is the real name
4490 of the file, regardless of whether or not it has the `.elc' extension. */);
4491 Vuser_init_file
= Qnil
;
4493 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4494 doc
: /* Used for internal purposes by `load'. */);
4495 Vcurrent_load_list
= Qnil
;
4497 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4498 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4499 The default is nil, which means use the function `read'. */);
4500 Vload_read_function
= Qnil
;
4502 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4503 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4504 This function is for doing code conversion before reading the source file.
4505 If nil, loading is done without any code conversion.
4506 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4507 FULLNAME is the full name of FILE.
4508 See `load' for the meaning of the remaining arguments. */);
4509 Vload_source_file_function
= Qnil
;
4511 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4512 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4513 This is useful when the file being loaded is a temporary copy. */);
4514 load_force_doc_strings
= 0;
4516 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4517 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4518 This is normally bound by `load' and `eval-buffer' to control `read',
4519 and is not meant for users to change. */);
4520 load_convert_to_unibyte
= 0;
4522 DEFVAR_LISP ("source-directory", Vsource_directory
,
4523 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4524 You cannot count on them to still be there! */);
4526 = Fexpand_file_name (build_string ("../"),
4527 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4529 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4530 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4531 Vpreloaded_file_list
= Qnil
;
4533 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4534 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4535 Vbyte_boolean_vars
= Qnil
;
4537 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4538 doc
: /* Non-nil means load dangerous compiled Lisp files.
4539 Some versions of XEmacs use different byte codes than Emacs. These
4540 incompatible byte codes can make Emacs crash when it tries to execute
4542 load_dangerous_libraries
= 0;
4544 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4545 doc
: /* Non-nil means force printing messages when loading Lisp files.
4546 This overrides the value of the NOMESSAGE argument to `load'. */);
4547 force_load_messages
= 0;
4549 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4550 doc
: /* Regular expression matching safe to load compiled Lisp files.
4551 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4552 from the file, and matches them against this regular expression.
4553 When the regular expression matches, the file is considered to be safe
4554 to load. See also `load-dangerous-libraries'. */);
4555 Vbytecomp_version_regexp
4556 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4558 DEFSYM (Qlexical_binding
, "lexical-binding");
4559 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4560 doc
: /* Whether to use lexical binding when evaluating code.
4561 Non-nil means that the code in the current buffer should be evaluated
4562 with lexical binding.
4563 This variable is automatically set from the file variables of an
4564 interpreted Lisp file read using `load'. Unlike other file local
4565 variables, this must be set in the first line of a file. */);
4566 Vlexical_binding
= Qnil
;
4567 Fmake_variable_buffer_local (Qlexical_binding
);
4569 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4570 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4571 Veval_buffer_list
= Qnil
;
4573 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4574 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4575 Vold_style_backquotes
= Qnil
;
4576 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4578 /* Vsource_directory was initialized in init_lread. */
4580 load_descriptor_list
= Qnil
;
4581 staticpro (&load_descriptor_list
);
4583 DEFSYM (Qcurrent_load_list
, "current-load-list");
4584 DEFSYM (Qstandard_input
, "standard-input");
4585 DEFSYM (Qread_char
, "read-char");
4586 DEFSYM (Qget_file_char
, "get-file-char");
4587 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4588 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4590 DEFSYM (Qbackquote
, "`");
4591 DEFSYM (Qcomma
, ",");
4592 DEFSYM (Qcomma_at
, ",@");
4593 DEFSYM (Qcomma_dot
, ",.");
4595 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4596 DEFSYM (Qascii_character
, "ascii-character");
4597 DEFSYM (Qfunction
, "function");
4598 DEFSYM (Qload
, "load");
4599 DEFSYM (Qload_file_name
, "load-file-name");
4600 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4601 DEFSYM (Qfile_truename
, "file-truename");
4602 DEFSYM (Qdir_ok
, "dir-ok");
4603 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4605 staticpro (&dump_path
);
4607 staticpro (&read_objects
);
4608 read_objects
= Qnil
;
4609 staticpro (&seen_list
);
4612 Vloads_in_progress
= Qnil
;
4613 staticpro (&Vloads_in_progress
);
4615 DEFSYM (Qhash_table
, "hash-table");
4616 DEFSYM (Qdata
, "data");
4617 DEFSYM (Qtest
, "test");
4618 DEFSYM (Qsize
, "size");
4619 DEFSYM (Qweakness
, "weakness");
4620 DEFSYM (Qrehash_size
, "rehash-size");
4621 DEFSYM (Qrehash_threshold
, "rehash-threshold");