1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2013 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
28 #include <limits.h> /* For CHAR_BIT. */
29 #include <stat-time.h>
31 #include "intervals.h"
32 #include "character.h"
40 #include "termhooks.h"
41 #include "blockinput.h"
55 #endif /* HAVE_SETLOCALE */
60 #define file_offset off_t
61 #define file_tell ftello
63 #define file_offset long
64 #define file_tell ftell
67 /* Hash table read constants. */
68 static Lisp_Object Qhash_table
, Qdata
;
69 static Lisp_Object Qtest
, Qsize
;
70 static Lisp_Object Qweakness
;
71 static Lisp_Object Qrehash_size
;
72 static Lisp_Object Qrehash_threshold
;
74 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
75 Lisp_Object Qstandard_input
;
76 Lisp_Object Qvariable_documentation
;
77 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
78 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
79 static Lisp_Object Qinhibit_file_name_operation
;
80 static Lisp_Object Qeval_buffer_list
;
81 Lisp_Object Qlexical_binding
;
82 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
84 /* Used instead of Qget_file_char while loading *.elc files compiled
85 by Emacs 21 or older. */
86 static Lisp_Object Qget_emacs_mule_file_char
;
88 static Lisp_Object Qload_force_doc_strings
;
90 static Lisp_Object Qload_in_progress
;
92 /* The association list of objects read with the #n=object form.
93 Each member of the list has the form (n . object), and is used to
94 look up the object for the corresponding #n# construct.
95 It must be set to nil before all top-level calls to read0. */
96 static Lisp_Object read_objects
;
98 /* File for get_file_char to read from. Use by load. */
99 static FILE *instream
;
101 /* For use within read-from-string (this reader is non-reentrant!!) */
102 static ptrdiff_t read_from_string_index
;
103 static ptrdiff_t read_from_string_index_byte
;
104 static ptrdiff_t read_from_string_limit
;
106 /* Number of characters read in the current call to Fread or
107 Fread_from_string. */
108 static EMACS_INT readchar_count
;
110 /* This contains the last string skipped with #@. */
111 static char *saved_doc_string
;
112 /* Length of buffer allocated in saved_doc_string. */
113 static ptrdiff_t saved_doc_string_size
;
114 /* Length of actual data in saved_doc_string. */
115 static ptrdiff_t saved_doc_string_length
;
116 /* This is the file position that string came from. */
117 static file_offset saved_doc_string_position
;
119 /* This contains the previous string skipped with #@.
120 We copy it from saved_doc_string when a new string
121 is put in saved_doc_string. */
122 static char *prev_saved_doc_string
;
123 /* Length of buffer allocated in prev_saved_doc_string. */
124 static ptrdiff_t prev_saved_doc_string_size
;
125 /* Length of actual data in prev_saved_doc_string. */
126 static ptrdiff_t prev_saved_doc_string_length
;
127 /* This is the file position that string came from. */
128 static file_offset prev_saved_doc_string_position
;
130 /* True means inside a new-style backquote
131 with no surrounding parentheses.
132 Fread initializes this to false, so we need not specbind it
133 or worry about what happens to it when there is an error. */
134 static bool new_backquote_flag
;
135 static Lisp_Object Qold_style_backquotes
;
137 /* A list of file names for files being loaded in Fload. Used to
138 check for recursive loads. */
140 static Lisp_Object Vloads_in_progress
;
142 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
145 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
146 Lisp_Object
, Lisp_Object
,
147 Lisp_Object
, Lisp_Object
);
148 static Lisp_Object
load_unwind (Lisp_Object
);
150 /* Functions that read one byte from the current source READCHARFUN
151 or unreads one byte. If the integer argument C is -1, it returns
152 one read byte, or -1 when there's no more byte in the source. If C
153 is 0 or positive, it unreads C, and the return value is not
156 static int readbyte_for_lambda (int, Lisp_Object
);
157 static int readbyte_from_file (int, Lisp_Object
);
158 static int readbyte_from_string (int, Lisp_Object
);
160 /* Handle unreading and rereading of characters.
161 Write READCHAR to read a character,
162 UNREAD(c) to unread c to be read again.
164 These macros correctly read/unread multibyte characters. */
166 #define READCHAR readchar (readcharfun, NULL)
167 #define UNREAD(c) unreadchar (readcharfun, c)
169 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
170 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
172 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
173 Qlambda, or a cons, we use this to keep an unread character because
174 a file stream can't handle multibyte-char unreading. The value -1
175 means that there's no unread character. */
176 static int unread_char
;
179 readchar (Lisp_Object readcharfun
, bool *multibyte
)
183 int (*readbyte
) (int, Lisp_Object
);
184 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
186 bool emacs_mule_encoding
= 0;
193 if (BUFFERP (readcharfun
))
195 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
197 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
199 if (! BUFFER_LIVE_P (inbuffer
))
202 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
205 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
207 /* Fetch the character code from the buffer. */
208 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
209 BUF_INC_POS (inbuffer
, pt_byte
);
216 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
217 if (! ASCII_BYTE_P (c
))
218 c
= BYTE8_TO_CHAR (c
);
221 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
225 if (MARKERP (readcharfun
))
227 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
229 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
231 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
234 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
236 /* Fetch the character code from the buffer. */
237 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
238 BUF_INC_POS (inbuffer
, bytepos
);
245 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
246 if (! ASCII_BYTE_P (c
))
247 c
= BYTE8_TO_CHAR (c
);
251 XMARKER (readcharfun
)->bytepos
= bytepos
;
252 XMARKER (readcharfun
)->charpos
++;
257 if (EQ (readcharfun
, Qlambda
))
259 readbyte
= readbyte_for_lambda
;
263 if (EQ (readcharfun
, Qget_file_char
))
265 readbyte
= readbyte_from_file
;
269 if (STRINGP (readcharfun
))
271 if (read_from_string_index
>= read_from_string_limit
)
273 else if (STRING_MULTIBYTE (readcharfun
))
277 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
278 read_from_string_index
,
279 read_from_string_index_byte
);
283 c
= SREF (readcharfun
, read_from_string_index_byte
);
284 read_from_string_index
++;
285 read_from_string_index_byte
++;
290 if (CONSP (readcharfun
))
292 /* This is the case that read_vector is reading from a unibyte
293 string that contains a byte sequence previously skipped
294 because of #@NUMBER. The car part of readcharfun is that
295 string, and the cdr part is a value of readcharfun given to
297 readbyte
= readbyte_from_string
;
298 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
299 emacs_mule_encoding
= 1;
303 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
305 readbyte
= readbyte_from_file
;
306 emacs_mule_encoding
= 1;
310 tem
= call0 (readcharfun
);
317 if (unread_char
>= 0)
323 c
= (*readbyte
) (-1, readcharfun
);
328 if (ASCII_BYTE_P (c
))
330 if (emacs_mule_encoding
)
331 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
334 len
= BYTES_BY_CHAR_HEAD (c
);
337 c
= (*readbyte
) (-1, readcharfun
);
338 if (c
< 0 || ! TRAILING_CODE_P (c
))
341 (*readbyte
) (buf
[i
], readcharfun
);
342 return BYTE8_TO_CHAR (buf
[0]);
346 return STRING_CHAR (buf
);
349 #define FROM_FILE_P(readcharfun) \
350 (EQ (readcharfun, Qget_file_char) \
351 || EQ (readcharfun, Qget_emacs_mule_file_char))
354 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
356 if (FROM_FILE_P (readcharfun
))
358 block_input (); /* FIXME: Not sure if it's needed. */
359 fseek (instream
, n
, SEEK_CUR
);
363 { /* We're not reading directly from a file. In that case, it's difficult
364 to reliably count bytes, since these are usually meant for the file's
365 encoding, whereas we're now typically in the internal encoding.
366 But luckily, skip_dyn_bytes is used to skip over a single
367 dynamic-docstring (or dynamic byte-code) which is always quoted such
368 that \037 is the final char. */
372 } while (c
>= 0 && c
!= '\037');
377 skip_dyn_eof (Lisp_Object readcharfun
)
379 if (FROM_FILE_P (readcharfun
))
381 block_input (); /* FIXME: Not sure if it's needed. */
382 fseek (instream
, 0, SEEK_END
);
386 while (READCHAR
>= 0);
389 /* Unread the character C in the way appropriate for the stream READCHARFUN.
390 If the stream is a user function, call it with the char as argument. */
393 unreadchar (Lisp_Object readcharfun
, int c
)
397 /* Don't back up the pointer if we're unreading the end-of-input mark,
398 since readchar didn't advance it when we read it. */
400 else if (BUFFERP (readcharfun
))
402 struct buffer
*b
= XBUFFER (readcharfun
);
403 ptrdiff_t charpos
= BUF_PT (b
);
404 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
406 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
407 BUF_DEC_POS (b
, bytepos
);
411 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
413 else if (MARKERP (readcharfun
))
415 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
416 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
418 XMARKER (readcharfun
)->charpos
--;
419 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
420 BUF_DEC_POS (b
, bytepos
);
424 XMARKER (readcharfun
)->bytepos
= bytepos
;
426 else if (STRINGP (readcharfun
))
428 read_from_string_index
--;
429 read_from_string_index_byte
430 = string_char_to_byte (readcharfun
, read_from_string_index
);
432 else if (CONSP (readcharfun
))
436 else if (EQ (readcharfun
, Qlambda
))
440 else if (FROM_FILE_P (readcharfun
))
445 call1 (readcharfun
, make_number (c
));
449 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
451 return read_bytecode_char (c
>= 0);
456 readbyte_from_file (int c
, Lisp_Object readcharfun
)
461 ungetc (c
, instream
);
469 /* Interrupted reads have been observed while reading over the network. */
470 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
481 return (c
== EOF
? -1 : c
);
485 readbyte_from_string (int c
, Lisp_Object readcharfun
)
487 Lisp_Object string
= XCAR (readcharfun
);
491 read_from_string_index
--;
492 read_from_string_index_byte
493 = string_char_to_byte (string
, read_from_string_index
);
496 if (read_from_string_index
>= read_from_string_limit
)
499 FETCH_STRING_CHAR_ADVANCE (c
, string
,
500 read_from_string_index
,
501 read_from_string_index_byte
);
506 /* Read one non-ASCII character from INSTREAM. The character is
507 encoded in `emacs-mule' and the first byte is already read in
511 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
513 /* Emacs-mule coding uses at most 4-byte for one character. */
514 unsigned char buf
[4];
515 int len
= emacs_mule_bytes
[c
];
516 struct charset
*charset
;
521 /* C is not a valid leading-code of `emacs-mule'. */
522 return BYTE8_TO_CHAR (c
);
528 c
= (*readbyte
) (-1, readcharfun
);
532 (*readbyte
) (buf
[i
], readcharfun
);
533 return BYTE8_TO_CHAR (buf
[0]);
540 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
541 code
= buf
[1] & 0x7F;
545 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
546 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
548 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
549 code
= buf
[2] & 0x7F;
553 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
554 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
559 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
560 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
562 c
= DECODE_CHAR (charset
, code
);
564 Fsignal (Qinvalid_read_syntax
,
565 list1 (build_string ("invalid multibyte form")));
570 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
572 static Lisp_Object
read0 (Lisp_Object
);
573 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
575 static Lisp_Object
read_list (bool, Lisp_Object
);
576 static Lisp_Object
read_vector (Lisp_Object
, bool);
578 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
580 static void substitute_object_in_subtree (Lisp_Object
,
582 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
585 /* Get a character from the tty. */
587 /* Read input events until we get one that's acceptable for our purposes.
589 If NO_SWITCH_FRAME, switch-frame events are stashed
590 until we get a character we like, and then stuffed into
593 If ASCII_REQUIRED, check function key events to see
594 if the unmodified version of the symbol has a Qascii_character
595 property, and use that character, if present.
597 If ERROR_NONASCII, signal an error if the input we
598 get isn't an ASCII character with modifiers. If it's false but
599 ASCII_REQUIRED is true, just re-read until we get an ASCII
602 If INPUT_METHOD, invoke the current input method
603 if the character warrants that.
605 If SECONDS is a number, wait that many seconds for input, and
606 return Qnil if no input arrives within that time. */
609 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
610 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
612 Lisp_Object val
, delayed_switch_frame
;
615 #ifdef HAVE_WINDOW_SYSTEM
616 if (display_hourglass_p
)
620 delayed_switch_frame
= Qnil
;
622 /* Compute timeout. */
623 if (NUMBERP (seconds
))
625 double duration
= extract_float (seconds
);
626 EMACS_TIME wait_time
= EMACS_TIME_FROM_DOUBLE (duration
);
627 end_time
= add_emacs_time (current_emacs_time (), wait_time
);
630 /* Read until we get an acceptable event. */
633 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
634 NUMBERP (seconds
) ? &end_time
: NULL
);
635 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
640 /* `switch-frame' events are put off until after the next ASCII
641 character. This is better than signaling an error just because
642 the last characters were typed to a separate minibuffer frame,
643 for example. Eventually, some code which can deal with
644 switch-frame events will read it and process it. */
646 && EVENT_HAS_PARAMETERS (val
)
647 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
649 delayed_switch_frame
= val
;
653 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
655 /* Convert certain symbols to their ASCII equivalents. */
658 Lisp_Object tem
, tem1
;
659 tem
= Fget (val
, Qevent_symbol_element_mask
);
662 tem1
= Fget (Fcar (tem
), Qascii_character
);
663 /* Merge this symbol's modifier bits
664 with the ASCII equivalent of its basic code. */
666 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
670 /* If we don't have a character now, deal with it appropriately. */
675 Vunread_command_events
= list1 (val
);
676 error ("Non-character input-event");
683 if (! NILP (delayed_switch_frame
))
684 unread_switch_frame
= delayed_switch_frame
;
688 #ifdef HAVE_WINDOW_SYSTEM
689 if (display_hourglass_p
)
698 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
699 doc
: /* Read a character from the command input (keyboard or macro).
700 It is returned as a number.
701 If the character has modifiers, they are resolved and reflected to the
702 character code if possible (e.g. C-SPC -> 0).
704 If the user generates an event which is not a character (i.e. a mouse
705 click or function key event), `read-char' signals an error. As an
706 exception, switch-frame events are put off until non-character events
708 If you want to read non-character events, or ignore them, call
709 `read-event' or `read-char-exclusive' instead.
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
)
724 message_with_string ("%s", prompt
, 0);
725 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
727 return (NILP (val
) ? Qnil
728 : make_number (char_resolve_modifier_mask (XINT (val
))));
731 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
732 doc
: /* Read an event object from the input stream.
733 If the optional argument PROMPT is non-nil, display that as a prompt.
734 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
735 input method is turned on in the current buffer, that input method
736 is used for reading a character.
737 If the optional argument SECONDS is non-nil, it should be a number
738 specifying the maximum number of seconds to wait for input. If no
739 input arrives in that time, return nil. SECONDS may be a
740 floating-point value. */)
741 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
744 message_with_string ("%s", prompt
, 0);
745 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
748 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
749 doc
: /* Read a character from the command input (keyboard or macro).
750 It is returned as a number. Non-character events are ignored.
751 If the character has modifiers, they are resolved and reflected to the
752 character code if possible (e.g. C-SPC -> 0).
754 If the optional argument PROMPT is non-nil, display that as a prompt.
755 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
756 input method is turned on in the current buffer, that input method
757 is used for reading a character.
758 If the optional argument SECONDS is non-nil, it should be a number
759 specifying the maximum number of seconds to wait for input. If no
760 input arrives in that time, return nil. SECONDS may be a
761 floating-point value. */)
762 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
767 message_with_string ("%s", prompt
, 0);
769 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
771 return (NILP (val
) ? Qnil
772 : make_number (char_resolve_modifier_mask (XINT (val
))));
775 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
776 doc
: /* Don't use this yourself. */)
779 register Lisp_Object val
;
781 XSETINT (val
, getc (instream
));
789 /* Return true if the lisp code read using READCHARFUN defines a non-nil
790 `lexical-binding' file variable. After returning, the stream is
791 positioned following the first line, if it is a comment or #! line,
792 otherwise nothing is read. */
795 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
808 while (ch
!= '\n' && ch
!= EOF
)
810 if (ch
== '\n') ch
= READCHAR
;
811 /* It is OK to leave the position after a #! line, since
812 that is what read1 does. */
816 /* The first line isn't a comment, just give up. */
822 /* Look for an appropriate file-variable in the first line. */
826 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
827 } beg_end_state
= NOMINAL
;
828 bool in_file_vars
= 0;
830 #define UPDATE_BEG_END_STATE(ch) \
831 if (beg_end_state == NOMINAL) \
832 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
833 else if (beg_end_state == AFTER_FIRST_DASH) \
834 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
835 else if (beg_end_state == AFTER_ASTERIX) \
838 in_file_vars = !in_file_vars; \
839 beg_end_state = NOMINAL; \
842 /* Skip until we get to the file vars, if any. */
846 UPDATE_BEG_END_STATE (ch
);
848 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
852 char var
[100], val
[100];
857 /* Read a variable name. */
858 while (ch
== ' ' || ch
== '\t')
862 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
864 if (i
< sizeof var
- 1)
866 UPDATE_BEG_END_STATE (ch
);
870 /* Stop scanning if no colon was found before end marker. */
871 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
874 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
880 /* Read a variable value. */
883 while (ch
== ' ' || ch
== '\t')
887 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
889 if (i
< sizeof val
- 1)
891 UPDATE_BEG_END_STATE (ch
);
895 /* The value was terminated by an end-marker, which remove. */
897 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
901 if (strcmp (var
, "lexical-binding") == 0)
904 rv
= (strcmp (val
, "nil") != 0);
910 while (ch
!= '\n' && ch
!= EOF
)
917 /* Value is a version number of byte compiled code if the file
918 associated with file descriptor FD is a compiled Lisp file that's
919 safe to load. Only files compiled with Emacs are safe to load.
920 Files compiled with XEmacs can lead to a crash in Fbyte_code
921 because of an incompatible change in the byte compiler. */
924 safe_to_load_version (int fd
)
930 /* Read the first few bytes from the file, and look for a line
931 specifying the byte compiler version used. */
932 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
935 /* Skip to the next newline, skipping over the initial `ELC'
936 with NUL bytes following it, but note the version. */
937 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
942 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
943 buf
+ i
, nbytes
- i
) < 0)
947 lseek (fd
, 0, SEEK_SET
);
952 /* Callback for record_unwind_protect. Restore the old load list OLD,
953 after loading a file successfully. */
956 record_load_unwind (Lisp_Object old
)
958 return Vloads_in_progress
= old
;
961 /* This handler function is used via internal_condition_case_1. */
964 load_error_handler (Lisp_Object data
)
970 load_warn_old_style_backquotes (Lisp_Object file
)
972 if (!NILP (Vold_style_backquotes
))
975 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
982 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
983 doc
: /* Return the suffixes that `load' should try if a suffix is \
985 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
988 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
989 while (CONSP (suffixes
))
991 Lisp_Object exts
= Vload_file_rep_suffixes
;
992 suffix
= XCAR (suffixes
);
993 suffixes
= XCDR (suffixes
);
998 lst
= Fcons (concat2 (suffix
, ext
), lst
);
1001 return Fnreverse (lst
);
1004 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1005 doc
: /* Execute a file of Lisp code named FILE.
1006 First try FILE with `.elc' appended, then try with `.el',
1007 then try FILE unmodified (the exact suffixes in the exact order are
1008 determined by `load-suffixes'). Environment variable references in
1009 FILE are replaced with their values by calling `substitute-in-file-name'.
1010 This function searches the directories in `load-path'.
1012 If optional second arg NOERROR is non-nil,
1013 report no error if FILE doesn't exist.
1014 Print messages at start and end of loading unless
1015 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1017 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1018 suffixes `.elc' or `.el' to the specified name FILE.
1019 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1020 the suffix `.elc' or `.el'; don't accept just FILE unless
1021 it ends in one of those suffixes or includes a directory name.
1023 If NOSUFFIX is nil, then if a file could not be found, try looking for
1024 a different representation of the file by adding non-empty suffixes to
1025 its name, before trying another file. Emacs uses this feature to find
1026 compressed versions of files when Auto Compression mode is enabled.
1027 If NOSUFFIX is non-nil, disable this feature.
1029 The suffixes that this function tries out, when NOSUFFIX is nil, are
1030 given by the return value of `get-load-suffixes' and the values listed
1031 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1032 return value of `get-load-suffixes' is used, i.e. the file name is
1033 required to have a non-empty suffix.
1035 Loading a file records its definitions, and its `provide' and
1036 `require' calls, in an element of `load-history' whose
1037 car is the file name loaded. See `load-history'.
1039 While the file is in the process of being loaded, the variable
1040 `load-in-progress' is non-nil and the variable `load-file-name'
1041 is bound to the file's name.
1043 Return t if the file exists and loads successfully. */)
1044 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1046 register FILE *stream
;
1047 register int fd
= -1;
1048 ptrdiff_t count
= SPECPDL_INDEX ();
1049 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1050 Lisp_Object found
, efound
, hist_file_name
;
1051 /* True means we printed the ".el is newer" message. */
1053 /* True means we are loading a compiled file. */
1055 Lisp_Object handler
;
1057 const char *fmode
= "r";
1065 CHECK_STRING (file
);
1067 /* If file name is magic, call the handler. */
1068 /* This shouldn't be necessary any more now that `openp' handles it right.
1069 handler = Ffind_file_name_handler (file, Qload);
1070 if (!NILP (handler))
1071 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1073 /* Do this after the handler to avoid
1074 the need to gcpro noerror, nomessage and nosuffix.
1075 (Below here, we care only whether they are nil or not.)
1076 The presence of this call is the result of a historical accident:
1077 it used to be in every file-operation and when it got removed
1078 everywhere, it accidentally stayed here. Since then, enough people
1079 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1080 that it seemed risky to remove. */
1081 if (! NILP (noerror
))
1083 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1084 Qt
, load_error_handler
);
1089 file
= Fsubstitute_in_file_name (file
);
1092 /* Avoid weird lossage with null string as arg,
1093 since it would try to load a directory as a Lisp file. */
1094 if (SBYTES (file
) > 0)
1096 ptrdiff_t size
= SBYTES (file
);
1099 GCPRO2 (file
, found
);
1101 if (! NILP (must_suffix
))
1103 /* Don't insist on adding a suffix if FILE already ends with one. */
1105 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1108 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1110 /* Don't insist on adding a suffix
1111 if the argument includes a directory name. */
1112 else if (! NILP (Ffile_name_directory (file
)))
1116 fd
= openp (Vload_path
, file
,
1117 (!NILP (nosuffix
) ? Qnil
1118 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1119 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1120 tmp
[1] = Vload_file_rep_suffixes
,
1129 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1133 /* Tell startup.el whether or not we found the user's init file. */
1134 if (EQ (Qt
, Vuser_init_file
))
1135 Vuser_init_file
= found
;
1137 /* If FD is -2, that means openp found a magic file. */
1140 if (NILP (Fequal (found
, file
)))
1141 /* If FOUND is a different file name from FILE,
1142 find its handler even if we have already inhibited
1143 the `load' operation on FILE. */
1144 handler
= Ffind_file_name_handler (found
, Qt
);
1146 handler
= Ffind_file_name_handler (found
, Qload
);
1147 if (! NILP (handler
))
1148 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1150 /* Tramp has to deal with semi-broken packages that prepend
1151 drive letters to remote files. For that reason, Tramp
1152 catches file operations that test for file existence, which
1153 makes openp think X:/foo.elc files are remote. However,
1154 Tramp does not catch `load' operations for such files, so we
1155 end up with a nil as the `load' handler above. If we would
1156 continue with fd = -2, we will behave wrongly, and in
1157 particular try reading a .elc file in the "rt" mode instead
1158 of "rb". See bug #9311 for the results. To work around
1159 this, we try to open the file locally, and go with that if it
1161 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1167 /* Check if we're stuck in a recursive load cycle.
1169 2000-09-21: It's not possible to just check for the file loaded
1170 being a member of Vloads_in_progress. This fails because of the
1171 way the byte compiler currently works; `provide's are not
1172 evaluated, see font-lock.el/jit-lock.el as an example. This
1173 leads to a certain amount of ``normal'' recursion.
1175 Also, just loading a file recursively is not always an error in
1176 the general case; the second load may do something different. */
1180 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1181 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1185 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1187 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1188 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1191 /* All loads are by default dynamic, unless the file itself specifies
1192 otherwise using a file-variable in the first line. This is bound here
1193 so that it takes effect whether or not we use
1194 Vload_source_file_function. */
1195 specbind (Qlexical_binding
, Qnil
);
1197 /* Get the name for load-history. */
1198 hist_file_name
= (! NILP (Vpurify_flag
)
1199 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1200 tmp
[1] = Ffile_name_nondirectory (found
),
1206 /* Check for the presence of old-style quotes and warn about them. */
1207 specbind (Qold_style_backquotes
, Qnil
);
1208 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1210 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1211 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1212 /* Load .elc files directly, but not when they are
1213 remote and have no handler! */
1220 GCPRO3 (file
, found
, hist_file_name
);
1223 && ! (version
= safe_to_load_version (fd
)))
1226 if (!load_dangerous_libraries
)
1230 error ("File `%s' was not compiled in Emacs",
1233 else if (!NILP (nomessage
) && !force_load_messages
)
1234 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1239 efound
= ENCODE_FILE (found
);
1244 result
= stat (SSDATA (efound
), &s1
);
1247 SSET (efound
, SBYTES (efound
) - 1, 0);
1248 result
= stat (SSDATA (efound
), &s2
);
1249 SSET (efound
, SBYTES (efound
) - 1, 'c');
1253 && EMACS_TIME_LT (get_stat_mtime (&s1
), get_stat_mtime (&s2
)))
1255 /* Make the progress messages mention that source is newer. */
1258 /* If we won't print another message, mention this anyway. */
1259 if (!NILP (nomessage
) && !force_load_messages
)
1261 Lisp_Object msg_file
;
1262 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1263 message_with_string ("Source file `%s' newer than byte-compiled file",
1272 /* We are loading a source file (*.el). */
1273 if (!NILP (Vload_source_file_function
))
1279 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1280 NILP (noerror
) ? Qnil
: Qt
,
1281 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1282 return unbind_to (count
, val
);
1286 GCPRO3 (file
, found
, hist_file_name
);
1289 efound
= ENCODE_FILE (found
);
1290 /* If we somehow got here with fd == -2, meaning the file is deemed
1291 to be remote, don't even try to reopen the file locally; just
1292 force a failure instead. */
1296 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1300 #else /* not WINDOWSNT */
1301 stream
= fdopen (fd
, fmode
);
1302 #endif /* not WINDOWSNT */
1306 error ("Failure to create stdio stream for %s", SDATA (file
));
1309 if (! NILP (Vpurify_flag
))
1310 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1312 if (NILP (nomessage
) || force_load_messages
)
1315 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1318 message_with_string ("Loading %s (source)...", file
, 1);
1320 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1322 else /* The typical case; compiled file newer than source file. */
1323 message_with_string ("Loading %s...", file
, 1);
1326 record_unwind_protect (load_unwind
, make_save_pointer (stream
));
1327 specbind (Qload_file_name
, found
);
1328 specbind (Qinhibit_file_name_operation
, Qnil
);
1329 specbind (Qload_in_progress
, Qt
);
1332 if (lisp_file_lexically_bound_p (Qget_file_char
))
1333 Fset (Qlexical_binding
, Qt
);
1335 if (! version
|| version
>= 22)
1336 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1337 0, Qnil
, Qnil
, Qnil
, Qnil
);
1340 /* We can't handle a file which was compiled with
1341 byte-compile-dynamic by older version of Emacs. */
1342 specbind (Qload_force_doc_strings
, Qt
);
1343 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1344 0, Qnil
, Qnil
, Qnil
, Qnil
);
1346 unbind_to (count
, Qnil
);
1348 /* Run any eval-after-load forms for this file. */
1349 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1350 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1354 xfree (saved_doc_string
);
1355 saved_doc_string
= 0;
1356 saved_doc_string_size
= 0;
1358 xfree (prev_saved_doc_string
);
1359 prev_saved_doc_string
= 0;
1360 prev_saved_doc_string_size
= 0;
1362 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1365 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1368 message_with_string ("Loading %s (source)...done", file
, 1);
1370 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1372 else /* The typical case; compiled file newer than source file. */
1373 message_with_string ("Loading %s...done", file
, 1);
1380 load_unwind (Lisp_Object arg
) /* Used as unwind-protect function in load. */
1382 FILE *stream
= XSAVE_POINTER (arg
, 0);
1393 complete_filename_p (Lisp_Object pathname
)
1395 const unsigned char *s
= SDATA (pathname
);
1396 return (IS_DIRECTORY_SEP (s
[0])
1397 || (SCHARS (pathname
) > 2
1398 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1401 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1402 doc
: /* Search for FILENAME through PATH.
1403 Returns the file's name in absolute form, or nil if not found.
1404 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1405 file name when searching.
1406 If non-nil, PREDICATE is used instead of `file-readable-p'.
1407 PREDICATE can also be an integer to pass to the faccessat(2) function,
1408 in which case file-name-handlers are ignored.
1409 This function will normally skip directories, so if you want it to find
1410 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1411 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1414 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1415 if (NILP (predicate
) && fd
>= 0)
1420 static Lisp_Object Qdir_ok
;
1422 /* Search for a file whose name is STR, looking in directories
1423 in the Lisp list PATH, and trying suffixes from SUFFIX.
1424 On success, return a file descriptor (or 1 or -2 as described below).
1425 On failure, return -1 and set errno.
1427 SUFFIXES is a list of strings containing possible suffixes.
1428 The empty suffix is automatically added if the list is empty.
1430 PREDICATE non-nil means don't open the files,
1431 just look for one that satisfies the predicate. In this case,
1432 return 1 on success. The predicate can be a lisp function or
1433 an integer to pass to `access' (in which case file-name-handlers
1436 If STOREPTR is nonzero, it points to a slot where the name of
1437 the file actually found should be stored as a Lisp string.
1438 nil is stored there on failure.
1440 If the file we find is remote, return -2
1441 but store the found remote file name in *STOREPTR. */
1444 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1445 Lisp_Object
*storeptr
, Lisp_Object predicate
)
1447 ptrdiff_t fn_size
= 100;
1451 ptrdiff_t want_length
;
1452 Lisp_Object filename
;
1453 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1454 Lisp_Object string
, tail
, encoded_fn
;
1455 ptrdiff_t max_suffix_len
= 0;
1456 int last_errno
= ENOENT
;
1460 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1462 CHECK_STRING_CAR (tail
);
1463 max_suffix_len
= max (max_suffix_len
,
1464 SBYTES (XCAR (tail
)));
1467 string
= filename
= encoded_fn
= Qnil
;
1468 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1473 if (complete_filename_p (str
))
1476 for (; CONSP (path
); path
= XCDR (path
))
1478 filename
= Fexpand_file_name (str
, XCAR (path
));
1479 if (!complete_filename_p (filename
))
1480 /* If there are non-absolute elts in PATH (eg "."). */
1481 /* Of course, this could conceivably lose if luser sets
1482 default-directory to be something non-absolute... */
1484 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1485 if (!complete_filename_p (filename
))
1486 /* Give up on this path element! */
1490 /* Calculate maximum length of any filename made from
1491 this path element/specified file name and any possible suffix. */
1492 want_length
= max_suffix_len
+ SBYTES (filename
);
1493 if (fn_size
<= want_length
)
1494 fn
= alloca (fn_size
= 100 + want_length
);
1496 /* Loop over suffixes. */
1497 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1498 CONSP (tail
); tail
= XCDR (tail
))
1500 ptrdiff_t fnlen
, lsuffix
= SBYTES (XCAR (tail
));
1501 Lisp_Object handler
;
1503 /* Concatenate path element/specified name with the suffix.
1504 If the directory starts with /:, remove that. */
1505 int prefixlen
= ((SCHARS (filename
) > 2
1506 && SREF (filename
, 0) == '/'
1507 && SREF (filename
, 1) == ':')
1509 fnlen
= SBYTES (filename
) - prefixlen
;
1510 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1511 memcpy (fn
+ fnlen
, SDATA (XCAR (tail
)), lsuffix
+ 1);
1513 /* Check that the file exists and is not a directory. */
1514 /* We used to only check for handlers on non-absolute file names:
1518 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1519 It's not clear why that was the case and it breaks things like
1520 (load "/bar.el") where the file is actually "/bar.el.gz". */
1521 string
= make_string (fn
, fnlen
);
1522 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1523 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1526 last_errno
= ENOENT
;
1527 if (NILP (predicate
))
1528 exists
= !NILP (Ffile_readable_p (string
));
1531 Lisp_Object tmp
= call1 (predicate
, string
);
1534 else if (EQ (tmp
, Qdir_ok
)
1535 || NILP (Ffile_directory_p (string
)))
1540 last_errno
= EISDIR
;
1546 /* We succeeded; return this descriptor and filename. */
1558 encoded_fn
= ENCODE_FILE (string
);
1559 pfn
= SSDATA (encoded_fn
);
1561 /* Check that we can access or open it. */
1562 if (NATNUMP (predicate
))
1565 if (INT_MAX
< XFASTINT (predicate
))
1566 last_errno
= EINVAL
;
1567 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1571 if (file_directory_p (pfn
))
1572 last_errno
= EISDIR
;
1579 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1585 int err
= (fstat (fd
, &st
) != 0 ? errno
1586 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1598 /* We succeeded; return this descriptor and filename. */
1616 /* Merge the list we've accumulated of globals from the current input source
1617 into the load_history variable. The details depend on whether
1618 the source has an associated file name or not.
1620 FILENAME is the file name that we are loading from.
1622 ENTIRE is true if loading that entire file, false if evaluating
1626 build_load_history (Lisp_Object filename
, bool entire
)
1628 Lisp_Object tail
, prev
, newelt
;
1629 Lisp_Object tem
, tem2
;
1632 tail
= Vload_history
;
1635 while (CONSP (tail
))
1639 /* Find the feature's previous assoc list... */
1640 if (!NILP (Fequal (filename
, Fcar (tem
))))
1644 /* If we're loading the entire file, remove old data. */
1648 Vload_history
= XCDR (tail
);
1650 Fsetcdr (prev
, XCDR (tail
));
1653 /* Otherwise, cons on new symbols that are not already members. */
1656 tem2
= Vcurrent_load_list
;
1658 while (CONSP (tem2
))
1660 newelt
= XCAR (tem2
);
1662 if (NILP (Fmember (newelt
, tem
)))
1663 Fsetcar (tail
, Fcons (XCAR (tem
),
1664 Fcons (newelt
, XCDR (tem
))));
1677 /* If we're loading an entire file, cons the new assoc onto the
1678 front of load-history, the most-recently-loaded position. Also
1679 do this if we didn't find an existing member for the file. */
1680 if (entire
|| !foundit
)
1681 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1686 readevalloop_1 (Lisp_Object old
)
1688 load_convert_to_unibyte
= ! NILP (old
);
1692 /* Signal an `end-of-file' error, if possible with file name
1695 static _Noreturn
void
1696 end_of_file_error (void)
1698 if (STRINGP (Vload_file_name
))
1699 xsignal1 (Qend_of_file
, Vload_file_name
);
1701 xsignal0 (Qend_of_file
);
1704 /* UNIBYTE specifies how to set load_convert_to_unibyte
1705 for this invocation.
1706 READFUN, if non-nil, is used instead of `read'.
1708 START, END specify region to read in current buffer (from eval-region).
1709 If the input is not from a buffer, they must be nil. */
1712 readevalloop (Lisp_Object readcharfun
,
1714 Lisp_Object sourcename
,
1716 Lisp_Object unibyte
, Lisp_Object readfun
,
1717 Lisp_Object start
, Lisp_Object end
)
1720 register Lisp_Object val
;
1721 ptrdiff_t count
= SPECPDL_INDEX ();
1722 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1723 struct buffer
*b
= 0;
1724 bool continue_reading_p
;
1725 Lisp_Object lex_bound
;
1726 /* True if reading an entire buffer. */
1727 bool whole_buffer
= 0;
1728 /* True on the first time around. */
1729 bool first_sexp
= 1;
1730 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1732 if (NILP (Ffboundp (macroexpand
))
1733 /* Don't macroexpand in .elc files, since it should have been done
1734 already. We actually don't know whether we're in a .elc file or not,
1735 so we use circumstantial evidence: .el files normally go through
1736 Vload_source_file_function -> load-with-code-conversion
1738 || EQ (readcharfun
, Qget_file_char
)
1739 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1742 if (MARKERP (readcharfun
))
1745 start
= readcharfun
;
1748 if (BUFFERP (readcharfun
))
1749 b
= XBUFFER (readcharfun
);
1750 else if (MARKERP (readcharfun
))
1751 b
= XMARKER (readcharfun
)->buffer
;
1753 /* We assume START is nil when input is not from a buffer. */
1754 if (! NILP (start
) && !b
)
1757 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1758 specbind (Qcurrent_load_list
, Qnil
);
1759 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1760 load_convert_to_unibyte
= !NILP (unibyte
);
1762 /* If lexical binding is active (either because it was specified in
1763 the file's header, or via a buffer-local variable), create an empty
1764 lexical environment, otherwise, turn off lexical binding. */
1765 lex_bound
= find_symbol_value (Qlexical_binding
);
1766 specbind (Qinternal_interpreter_environment
,
1767 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1768 ? Qnil
: list1 (Qt
)));
1770 GCPRO4 (sourcename
, readfun
, start
, end
);
1772 /* Try to ensure sourcename is a truename, except whilst preloading. */
1773 if (NILP (Vpurify_flag
)
1774 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1775 && !NILP (Ffboundp (Qfile_truename
)))
1776 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1778 LOADHIST_ATTACH (sourcename
);
1780 continue_reading_p
= 1;
1781 while (continue_reading_p
)
1783 ptrdiff_t count1
= SPECPDL_INDEX ();
1785 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1786 error ("Reading from killed buffer");
1790 /* Switch to the buffer we are reading from. */
1791 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1792 set_buffer_internal (b
);
1794 /* Save point in it. */
1795 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1796 /* Save ZV in it. */
1797 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1798 /* Those get unbound after we read one expression. */
1800 /* Set point and ZV around stuff to be read. */
1803 Fnarrow_to_region (make_number (BEGV
), end
);
1805 /* Just for cleanliness, convert END to a marker
1806 if it is an integer. */
1808 end
= Fpoint_max_marker ();
1811 /* On the first cycle, we can easily test here
1812 whether we are reading the whole buffer. */
1813 if (b
&& first_sexp
)
1814 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1821 while ((c
= READCHAR
) != '\n' && c
!= -1);
1826 unbind_to (count1
, Qnil
);
1830 /* Ignore whitespace here, so we can detect eof. */
1831 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1832 || c
== 0xa0) /* NBSP */
1835 if (!NILP (Vpurify_flag
) && c
== '(')
1837 val
= read_list (0, readcharfun
);
1842 read_objects
= Qnil
;
1843 if (!NILP (readfun
))
1845 val
= call1 (readfun
, readcharfun
);
1847 /* If READCHARFUN has set point to ZV, we should
1848 stop reading, even if the form read sets point
1849 to a different value when evaluated. */
1850 if (BUFFERP (readcharfun
))
1852 struct buffer
*buf
= XBUFFER (readcharfun
);
1853 if (BUF_PT (buf
) == BUF_ZV (buf
))
1854 continue_reading_p
= 0;
1857 else if (! NILP (Vload_read_function
))
1858 val
= call1 (Vload_read_function
, readcharfun
);
1860 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1863 if (!NILP (start
) && continue_reading_p
)
1864 start
= Fpoint_marker ();
1866 /* Restore saved point and BEGV. */
1867 unbind_to (count1
, Qnil
);
1869 /* Now eval what we just read. */
1870 if (!NILP (macroexpand
))
1871 val
= call1 (macroexpand
, val
);
1872 val
= eval_sub (val
);
1876 Vvalues
= Fcons (val
, Vvalues
);
1877 if (EQ (Vstandard_output
, Qt
))
1886 build_load_history (sourcename
,
1887 stream
|| whole_buffer
);
1891 unbind_to (count
, Qnil
);
1894 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1895 doc
: /* Execute the current buffer as Lisp code.
1896 When called from a Lisp program (i.e., not interactively), this
1897 function accepts up to five optional arguments:
1898 BUFFER is the buffer to evaluate (nil means use current buffer).
1899 PRINTFLAG controls printing of output:
1900 A value of nil means discard it; anything else is stream for print.
1901 FILENAME specifies the file name to use for `load-history'.
1902 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1904 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1905 functions should work normally even if PRINTFLAG is nil.
1907 This function preserves the position of point. */)
1908 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1910 ptrdiff_t count
= SPECPDL_INDEX ();
1911 Lisp_Object tem
, buf
;
1914 buf
= Fcurrent_buffer ();
1916 buf
= Fget_buffer (buffer
);
1918 error ("No such buffer");
1920 if (NILP (printflag
) && NILP (do_allow_print
))
1925 if (NILP (filename
))
1926 filename
= BVAR (XBUFFER (buf
), filename
);
1928 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1929 specbind (Qstandard_output
, tem
);
1930 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1931 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1932 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1933 readevalloop (buf
, 0, filename
,
1934 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1935 unbind_to (count
, Qnil
);
1940 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1941 doc
: /* Execute the region as Lisp code.
1942 When called from programs, expects two arguments,
1943 giving starting and ending indices in the current buffer
1944 of the text to be executed.
1945 Programs can pass third argument PRINTFLAG which controls output:
1946 A value of nil means discard it; anything else is stream for printing it.
1947 Also the fourth argument READ-FUNCTION, if non-nil, is used
1948 instead of `read' to read each expression. It gets one argument
1949 which is the input stream for reading characters.
1951 This function does not move point. */)
1952 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1954 /* FIXME: Do the eval-sexp-add-defvars dance! */
1955 ptrdiff_t count
= SPECPDL_INDEX ();
1956 Lisp_Object tem
, cbuf
;
1958 cbuf
= Fcurrent_buffer ();
1960 if (NILP (printflag
))
1964 specbind (Qstandard_output
, tem
);
1965 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1967 /* `readevalloop' calls functions which check the type of start and end. */
1968 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1969 !NILP (printflag
), Qnil
, read_function
,
1972 return unbind_to (count
, Qnil
);
1976 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1977 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1978 If STREAM is nil, use the value of `standard-input' (which see).
1979 STREAM or the value of `standard-input' may be:
1980 a buffer (read from point and advance it)
1981 a marker (read from where it points and advance it)
1982 a function (call it with no arguments for each character,
1983 call it with a char as argument to push a char back)
1984 a string (takes text from string, starting at the beginning)
1985 t (read text line using minibuffer and use it, or read from
1986 standard input in batch mode). */)
1987 (Lisp_Object stream
)
1990 stream
= Vstandard_input
;
1991 if (EQ (stream
, Qt
))
1992 stream
= Qread_char
;
1993 if (EQ (stream
, Qread_char
))
1994 /* FIXME: ¿¡ When is this used !? */
1995 return call1 (intern ("read-minibuffer"),
1996 build_string ("Lisp expression: "));
1998 return read_internal_start (stream
, Qnil
, Qnil
);
2001 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2002 doc
: /* Read one Lisp expression which is represented as text by STRING.
2003 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2004 FINAL-STRING-INDEX is an integer giving the position of the next
2005 remaining character in STRING.
2006 START and END optionally delimit a substring of STRING from which to read;
2007 they default to 0 and (length STRING) respectively. */)
2008 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2011 CHECK_STRING (string
);
2012 /* `read_internal_start' sets `read_from_string_index'. */
2013 ret
= read_internal_start (string
, start
, end
);
2014 return Fcons (ret
, make_number (read_from_string_index
));
2017 /* Function to set up the global context we need in toplevel read
2020 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2021 /* `start', `end' only used when stream is a string. */
2026 new_backquote_flag
= 0;
2027 read_objects
= Qnil
;
2028 if (EQ (Vread_with_symbol_positions
, Qt
)
2029 || EQ (Vread_with_symbol_positions
, stream
))
2030 Vread_symbol_positions_list
= Qnil
;
2032 if (STRINGP (stream
)
2033 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2035 ptrdiff_t startval
, endval
;
2038 if (STRINGP (stream
))
2041 string
= XCAR (stream
);
2044 endval
= SCHARS (string
);
2048 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2049 args_out_of_range (string
, end
);
2050 endval
= XINT (end
);
2057 CHECK_NUMBER (start
);
2058 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2059 args_out_of_range (string
, start
);
2060 startval
= XINT (start
);
2062 read_from_string_index
= startval
;
2063 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2064 read_from_string_limit
= endval
;
2067 retval
= read0 (stream
);
2068 if (EQ (Vread_with_symbol_positions
, Qt
)
2069 || EQ (Vread_with_symbol_positions
, stream
))
2070 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2075 /* Signal Qinvalid_read_syntax error.
2076 S is error string of length N (if > 0) */
2078 static _Noreturn
void
2079 invalid_syntax (const char *s
)
2081 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2085 /* Use this for recursive reads, in contexts where internal tokens
2089 read0 (Lisp_Object readcharfun
)
2091 register Lisp_Object val
;
2094 val
= read1 (readcharfun
, &c
, 0);
2098 xsignal1 (Qinvalid_read_syntax
,
2099 Fmake_string (make_number (1), make_number (c
)));
2102 static ptrdiff_t read_buffer_size
;
2103 static char *read_buffer
;
2105 /* Read a \-escape sequence, assuming we already read the `\'.
2106 If the escape sequence forces unibyte, return eight-bit char. */
2109 read_escape (Lisp_Object readcharfun
, bool stringp
)
2112 /* \u allows up to four hex digits, \U up to eight. Default to the
2113 behavior for \u, and change this value in the case that \U is seen. */
2114 int unicode_hex_count
= 4;
2119 end_of_file_error ();
2149 error ("Invalid escape character syntax");
2152 c
= read_escape (readcharfun
, 0);
2153 return c
| meta_modifier
;
2158 error ("Invalid escape character syntax");
2161 c
= read_escape (readcharfun
, 0);
2162 return c
| shift_modifier
;
2167 error ("Invalid escape character syntax");
2170 c
= read_escape (readcharfun
, 0);
2171 return c
| hyper_modifier
;
2176 error ("Invalid escape character syntax");
2179 c
= read_escape (readcharfun
, 0);
2180 return c
| alt_modifier
;
2184 if (stringp
|| c
!= '-')
2191 c
= read_escape (readcharfun
, 0);
2192 return c
| super_modifier
;
2197 error ("Invalid escape character syntax");
2201 c
= read_escape (readcharfun
, 0);
2202 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2203 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2204 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2205 return c
| ctrl_modifier
;
2206 /* ASCII control chars are made from letters (both cases),
2207 as well as the non-letters within 0100...0137. */
2208 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2209 return (c
& (037 | ~0177));
2210 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2211 return (c
& (037 | ~0177));
2213 return c
| ctrl_modifier
;
2223 /* An octal escape, as in ANSI C. */
2225 register int i
= c
- '0';
2226 register int count
= 0;
2229 if ((c
= READCHAR
) >= '0' && c
<= '7')
2241 if (i
>= 0x80 && i
< 0x100)
2242 i
= BYTE8_TO_CHAR (i
);
2247 /* A hex escape, as in ANSI C. */
2254 if (c
>= '0' && c
<= '9')
2259 else if ((c
>= 'a' && c
<= 'f')
2260 || (c
>= 'A' && c
<= 'F'))
2263 if (c
>= 'a' && c
<= 'f')
2273 /* Allow hex escapes as large as ?\xfffffff, because some
2274 packages use them to denote characters with modifiers. */
2275 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2276 error ("Hex character out of range: \\x%x...", i
);
2280 if (count
< 3 && i
>= 0x80)
2281 return BYTE8_TO_CHAR (i
);
2286 /* Post-Unicode-2.0: Up to eight hex chars. */
2287 unicode_hex_count
= 8;
2290 /* A Unicode escape. We only permit them in strings and characters,
2291 not arbitrarily in the source code, as in some other languages. */
2296 while (++count
<= unicode_hex_count
)
2299 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2301 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2302 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2303 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2305 error ("Non-hex digit used for Unicode escape");
2308 error ("Non-Unicode character: 0x%x", i
);
2317 /* Return the digit that CHARACTER stands for in the given BASE.
2318 Return -1 if CHARACTER is out of range for BASE,
2319 and -2 if CHARACTER is not valid for any supported BASE. */
2321 digit_to_number (int character
, int base
)
2325 if ('0' <= character
&& character
<= '9')
2326 digit
= character
- '0';
2327 else if ('a' <= character
&& character
<= 'z')
2328 digit
= character
- 'a' + 10;
2329 else if ('A' <= character
&& character
<= 'Z')
2330 digit
= character
- 'A' + 10;
2334 return digit
< base
? digit
: -1;
2337 /* Read an integer in radix RADIX using READCHARFUN to read
2338 characters. RADIX must be in the interval [2..36]; if it isn't, a
2339 read error is signaled . Value is the integer read. Signals an
2340 error if encountering invalid read syntax or if RADIX is out of
2344 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2346 /* Room for sign, leading 0, other digits, trailing null byte.
2347 Also, room for invalid syntax diagnostic. */
2348 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2349 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2351 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2353 if (radix
< 2 || radix
> 36)
2361 if (c
== '-' || c
== '+')
2372 /* Ignore redundant leading zeros, so the buffer doesn't
2373 fill up with them. */
2379 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2386 if (p
< buf
+ sizeof buf
- 1)
2400 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2401 invalid_syntax (buf
);
2404 return string_to_number (buf
, radix
, 0);
2408 /* If the next token is ')' or ']' or '.', we store that character
2409 in *PCH and the return value is not interesting. Else, we store
2410 zero in *PCH and we read and return one lisp object.
2412 FIRST_IN_LIST is true if this is the first element of a list. */
2415 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2418 bool uninterned_symbol
= 0;
2425 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2427 end_of_file_error ();
2432 return read_list (0, readcharfun
);
2435 return read_vector (readcharfun
, 0);
2451 /* Accept extended format for hashtables (extensible to
2453 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2454 Lisp_Object tmp
= read_list (0, readcharfun
);
2455 Lisp_Object head
= CAR_SAFE (tmp
);
2456 Lisp_Object data
= Qnil
;
2457 Lisp_Object val
= Qnil
;
2458 /* The size is 2 * number of allowed keywords to
2460 Lisp_Object params
[10];
2462 Lisp_Object key
= Qnil
;
2463 int param_count
= 0;
2465 if (!EQ (head
, Qhash_table
))
2466 error ("Invalid extended read marker at head of #s list "
2467 "(only hash-table allowed)");
2469 tmp
= CDR_SAFE (tmp
);
2471 /* This is repetitive but fast and simple. */
2472 params
[param_count
] = QCsize
;
2473 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2474 if (!NILP (params
[param_count
+ 1]))
2477 params
[param_count
] = QCtest
;
2478 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2479 if (!NILP (params
[param_count
+ 1]))
2482 params
[param_count
] = QCweakness
;
2483 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2484 if (!NILP (params
[param_count
+ 1]))
2487 params
[param_count
] = QCrehash_size
;
2488 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2489 if (!NILP (params
[param_count
+ 1]))
2492 params
[param_count
] = QCrehash_threshold
;
2493 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2494 if (!NILP (params
[param_count
+ 1]))
2497 /* This is the hashtable data. */
2498 data
= Fplist_get (tmp
, Qdata
);
2500 /* Now use params to make a new hashtable and fill it. */
2501 ht
= Fmake_hash_table (param_count
, params
);
2503 while (CONSP (data
))
2508 error ("Odd number of elements in hashtable data");
2511 Fputhash (key
, val
, ht
);
2517 invalid_syntax ("#");
2525 tmp
= read_vector (readcharfun
, 0);
2526 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2527 error ("Invalid size char-table");
2528 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2540 tmp
= read_vector (readcharfun
, 0);
2543 error ("Invalid size char-table");
2544 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2545 error ("Invalid depth in char-table");
2546 depth
= XINT (AREF (tmp
, 0));
2547 if (chartab_size
[depth
] != size
- 2)
2548 error ("Invalid size char-table");
2549 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2552 invalid_syntax ("#^^");
2554 invalid_syntax ("#^");
2559 length
= read1 (readcharfun
, pch
, first_in_list
);
2563 Lisp_Object tmp
, val
;
2564 EMACS_INT size_in_chars
2565 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2566 / BOOL_VECTOR_BITS_PER_CHAR
);
2569 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2570 if (STRING_MULTIBYTE (tmp
)
2571 || (size_in_chars
!= SCHARS (tmp
)
2572 /* We used to print 1 char too many
2573 when the number of bits was a multiple of 8.
2574 Accept such input in case it came from an old
2576 && ! (XFASTINT (length
)
2577 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2578 invalid_syntax ("#&...");
2580 val
= Fmake_bool_vector (length
, Qnil
);
2581 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2582 /* Clear the extraneous bits in the last byte. */
2583 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2584 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2585 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2588 invalid_syntax ("#&...");
2592 /* Accept compiled functions at read-time so that we don't have to
2593 build them using function calls. */
2595 tmp
= read_vector (readcharfun
, 1);
2596 make_byte_code (XVECTOR (tmp
));
2602 struct gcpro gcpro1
;
2605 /* Read the string itself. */
2606 tmp
= read1 (readcharfun
, &ch
, 0);
2607 if (ch
!= 0 || !STRINGP (tmp
))
2608 invalid_syntax ("#");
2610 /* Read the intervals and their properties. */
2613 Lisp_Object beg
, end
, plist
;
2615 beg
= read1 (readcharfun
, &ch
, 0);
2620 end
= read1 (readcharfun
, &ch
, 0);
2622 plist
= read1 (readcharfun
, &ch
, 0);
2624 invalid_syntax ("Invalid string property list");
2625 Fset_text_properties (beg
, end
, plist
, tmp
);
2631 /* #@NUMBER is used to skip NUMBER following bytes.
2632 That's used in .elc files to skip over doc strings
2633 and function definitions. */
2636 enum { extra
= 100 };
2637 ptrdiff_t i
, nskip
= 0, digits
= 0;
2639 /* Read a decimal integer. */
2640 while ((c
= READCHAR
) >= 0
2641 && c
>= '0' && c
<= '9')
2643 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2648 if (digits
== 2 && nskip
== 0)
2649 { /* We've just seen #@00, which means "skip to end". */
2650 skip_dyn_eof (readcharfun
);
2655 /* We can't use UNREAD here, because in the code below we side-step
2656 READCHAR. Instead, assume the first char after #@NNN occupies
2657 a single byte, which is the case normally since it's just
2663 if (load_force_doc_strings
2664 && (FROM_FILE_P (readcharfun
)))
2666 /* If we are supposed to force doc strings into core right now,
2667 record the last string that we skipped,
2668 and record where in the file it comes from. */
2670 /* But first exchange saved_doc_string
2671 with prev_saved_doc_string, so we save two strings. */
2673 char *temp
= saved_doc_string
;
2674 ptrdiff_t temp_size
= saved_doc_string_size
;
2675 file_offset temp_pos
= saved_doc_string_position
;
2676 ptrdiff_t temp_len
= saved_doc_string_length
;
2678 saved_doc_string
= prev_saved_doc_string
;
2679 saved_doc_string_size
= prev_saved_doc_string_size
;
2680 saved_doc_string_position
= prev_saved_doc_string_position
;
2681 saved_doc_string_length
= prev_saved_doc_string_length
;
2683 prev_saved_doc_string
= temp
;
2684 prev_saved_doc_string_size
= temp_size
;
2685 prev_saved_doc_string_position
= temp_pos
;
2686 prev_saved_doc_string_length
= temp_len
;
2689 if (saved_doc_string_size
== 0)
2691 saved_doc_string
= xmalloc (nskip
+ extra
);
2692 saved_doc_string_size
= nskip
+ extra
;
2694 if (nskip
> saved_doc_string_size
)
2696 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2697 saved_doc_string_size
= nskip
+ extra
;
2700 saved_doc_string_position
= file_tell (instream
);
2702 /* Copy that many characters into saved_doc_string. */
2704 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2705 saved_doc_string
[i
] = c
= getc (instream
);
2708 saved_doc_string_length
= i
;
2711 /* Skip that many bytes. */
2712 skip_dyn_bytes (readcharfun
, nskip
);
2718 /* #! appears at the beginning of an executable file.
2719 Skip the first line. */
2720 while (c
!= '\n' && c
>= 0)
2725 return Vload_file_name
;
2727 return list2 (Qfunction
, read0 (readcharfun
));
2728 /* #:foo is the uninterned symbol named foo. */
2731 uninterned_symbol
= 1;
2734 && c
!= 0xa0 /* NBSP */
2736 || strchr ("\"';()[]#`,", c
) == NULL
)))
2738 /* No symbol character follows, this is the empty
2741 return Fmake_symbol (empty_unibyte_string
);
2745 /* ## is the empty symbol. */
2747 return Fintern (empty_unibyte_string
, Qnil
);
2748 /* Reader forms that can reuse previously read objects. */
2749 if (c
>= '0' && c
<= '9')
2754 /* Read a non-negative integer. */
2755 while (c
>= '0' && c
<= '9')
2757 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2758 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2759 n
= MOST_POSITIVE_FIXNUM
+ 1;
2761 n
= n
* 10 + c
- '0';
2765 if (n
<= MOST_POSITIVE_FIXNUM
)
2767 if (c
== 'r' || c
== 'R')
2768 return read_integer (readcharfun
, n
);
2770 if (! NILP (Vread_circle
))
2772 /* #n=object returns object, but associates it with
2776 /* Make a placeholder for #n# to use temporarily. */
2777 Lisp_Object placeholder
;
2780 placeholder
= Fcons (Qnil
, Qnil
);
2781 cell
= Fcons (make_number (n
), placeholder
);
2782 read_objects
= Fcons (cell
, read_objects
);
2784 /* Read the object itself. */
2785 tem
= read0 (readcharfun
);
2787 /* Now put it everywhere the placeholder was... */
2788 substitute_object_in_subtree (tem
, placeholder
);
2790 /* ...and #n# will use the real value from now on. */
2791 Fsetcdr (cell
, tem
);
2796 /* #n# returns a previously read object. */
2799 tem
= Fassq (make_number (n
), read_objects
);
2805 /* Fall through to error message. */
2807 else if (c
== 'x' || c
== 'X')
2808 return read_integer (readcharfun
, 16);
2809 else if (c
== 'o' || c
== 'O')
2810 return read_integer (readcharfun
, 8);
2811 else if (c
== 'b' || c
== 'B')
2812 return read_integer (readcharfun
, 2);
2815 invalid_syntax ("#");
2818 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2822 return list2 (Qquote
, read0 (readcharfun
));
2826 int next_char
= READCHAR
;
2828 /* Transition from old-style to new-style:
2829 If we see "(`" it used to mean old-style, which usually works
2830 fine because ` should almost never appear in such a position
2831 for new-style. But occasionally we need "(`" to mean new
2832 style, so we try to distinguish the two by the fact that we
2833 can either write "( `foo" or "(` foo", where the first
2834 intends to use new-style whereas the second intends to use
2835 old-style. For Emacs-25, we should completely remove this
2836 first_in_list exception (old-style can still be obtained via
2838 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2840 Vold_style_backquotes
= Qt
;
2846 bool saved_new_backquote_flag
= new_backquote_flag
;
2848 new_backquote_flag
= 1;
2849 value
= read0 (readcharfun
);
2850 new_backquote_flag
= saved_new_backquote_flag
;
2852 return list2 (Qbackquote
, value
);
2857 int next_char
= READCHAR
;
2859 /* Transition from old-style to new-style:
2860 It used to be impossible to have a new-style , other than within
2861 a new-style `. This is sufficient when ` and , are used in the
2862 normal way, but ` and , can also appear in args to macros that
2863 will not interpret them in the usual way, in which case , may be
2864 used without any ` anywhere near.
2865 So we now use the same heuristic as for backquote: old-style
2866 unquotes are only recognized when first on a list, and when
2867 followed by a space.
2868 Because it's more difficult to peek 2 chars ahead, a new-style
2869 ,@ can still not be used outside of a `, unless it's in the middle
2871 if (new_backquote_flag
2873 || (next_char
!= ' ' && next_char
!= '@'))
2875 Lisp_Object comma_type
= Qnil
;
2880 comma_type
= Qcomma_at
;
2882 comma_type
= Qcomma_dot
;
2885 if (ch
>= 0) UNREAD (ch
);
2886 comma_type
= Qcomma
;
2889 value
= read0 (readcharfun
);
2890 return list2 (comma_type
, value
);
2894 Vold_style_backquotes
= Qt
;
2906 end_of_file_error ();
2908 /* Accept `single space' syntax like (list ? x) where the
2909 whitespace character is SPC or TAB.
2910 Other literal whitespace like NL, CR, and FF are not accepted,
2911 as there are well-established escape sequences for these. */
2912 if (c
== ' ' || c
== '\t')
2913 return make_number (c
);
2916 c
= read_escape (readcharfun
, 0);
2917 modifiers
= c
& CHAR_MODIFIER_MASK
;
2918 c
&= ~CHAR_MODIFIER_MASK
;
2919 if (CHAR_BYTE8_P (c
))
2920 c
= CHAR_TO_BYTE8 (c
);
2923 next_char
= READCHAR
;
2924 ok
= (next_char
<= 040
2925 || (next_char
< 0200
2926 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2929 return make_number (c
);
2931 invalid_syntax ("?");
2936 char *p
= read_buffer
;
2937 char *end
= read_buffer
+ read_buffer_size
;
2939 /* True if we saw an escape sequence specifying
2940 a multibyte character. */
2941 bool force_multibyte
= 0;
2942 /* True if we saw an escape sequence specifying
2943 a single-byte character. */
2944 bool force_singlebyte
= 0;
2946 ptrdiff_t nchars
= 0;
2948 while ((ch
= READCHAR
) >= 0
2951 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2953 ptrdiff_t offset
= p
- read_buffer
;
2954 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2955 memory_full (SIZE_MAX
);
2956 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
2957 read_buffer_size
*= 2;
2958 p
= read_buffer
+ offset
;
2959 end
= read_buffer
+ read_buffer_size
;
2966 ch
= read_escape (readcharfun
, 1);
2968 /* CH is -1 if \ newline has just been seen. */
2971 if (p
== read_buffer
)
2976 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2977 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2979 if (CHAR_BYTE8_P (ch
))
2980 force_singlebyte
= 1;
2981 else if (! ASCII_CHAR_P (ch
))
2982 force_multibyte
= 1;
2983 else /* I.e. ASCII_CHAR_P (ch). */
2985 /* Allow `\C- ' and `\C-?'. */
2986 if (modifiers
== CHAR_CTL
)
2989 ch
= 0, modifiers
= 0;
2991 ch
= 127, modifiers
= 0;
2993 if (modifiers
& CHAR_SHIFT
)
2995 /* Shift modifier is valid only with [A-Za-z]. */
2996 if (ch
>= 'A' && ch
<= 'Z')
2997 modifiers
&= ~CHAR_SHIFT
;
2998 else if (ch
>= 'a' && ch
<= 'z')
2999 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3002 if (modifiers
& CHAR_META
)
3004 /* Move the meta bit to the right place for a
3006 modifiers
&= ~CHAR_META
;
3007 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3008 force_singlebyte
= 1;
3012 /* Any modifiers remaining are invalid. */
3014 error ("Invalid modifier in string");
3015 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3019 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3020 if (CHAR_BYTE8_P (ch
))
3021 force_singlebyte
= 1;
3022 else if (! ASCII_CHAR_P (ch
))
3023 force_multibyte
= 1;
3029 end_of_file_error ();
3031 /* If purifying, and string starts with \ newline,
3032 return zero instead. This is for doc strings
3033 that we are really going to find in etc/DOC.nn.nn. */
3034 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3035 return make_number (0);
3037 if (! force_multibyte
&& force_singlebyte
)
3039 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3040 forms. Convert it to unibyte. */
3041 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3043 p
= read_buffer
+ nchars
;
3046 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3048 || (p
- read_buffer
!= nchars
)));
3053 int next_char
= READCHAR
;
3056 if (next_char
<= 040
3057 || (next_char
< 0200
3058 && strchr ("\"';([#?`,", next_char
) != NULL
))
3064 /* Otherwise, we fall through! Note that the atom-reading loop
3065 below will now loop at least once, assuring that we will not
3066 try to UNREAD two characters in a row. */
3070 if (c
<= 040) goto retry
;
3071 if (c
== 0xa0) /* NBSP */
3076 char *p
= read_buffer
;
3078 EMACS_INT start_position
= readchar_count
- 1;
3081 char *end
= read_buffer
+ read_buffer_size
;
3085 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3087 ptrdiff_t offset
= p
- read_buffer
;
3088 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3089 memory_full (SIZE_MAX
);
3090 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3091 read_buffer_size
*= 2;
3092 p
= read_buffer
+ offset
;
3093 end
= read_buffer
+ read_buffer_size
;
3100 end_of_file_error ();
3105 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3111 && c
!= 0xa0 /* NBSP */
3113 || strchr ("\"';()[]#`,", c
) == NULL
));
3117 ptrdiff_t offset
= p
- read_buffer
;
3118 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3119 memory_full (SIZE_MAX
);
3120 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3121 read_buffer_size
*= 2;
3122 p
= read_buffer
+ offset
;
3123 end
= read_buffer
+ read_buffer_size
;
3129 if (!quoted
&& !uninterned_symbol
)
3131 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3132 if (! NILP (result
))
3136 Lisp_Object name
, result
;
3137 ptrdiff_t nbytes
= p
- read_buffer
;
3140 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3144 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3145 ? make_pure_string
: make_specified_string
)
3146 (read_buffer
, nchars
, nbytes
, multibyte
));
3147 result
= (uninterned_symbol
? Fmake_symbol (name
)
3148 : Fintern (name
, Qnil
));
3150 if (EQ (Vread_with_symbol_positions
, Qt
)
3151 || EQ (Vread_with_symbol_positions
, readcharfun
))
3152 Vread_symbol_positions_list
3153 = Fcons (Fcons (result
, make_number (start_position
)),
3154 Vread_symbol_positions_list
);
3162 /* List of nodes we've seen during substitute_object_in_subtree. */
3163 static Lisp_Object seen_list
;
3166 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3168 Lisp_Object check_object
;
3170 /* We haven't seen any objects when we start. */
3173 /* Make all the substitutions. */
3175 = substitute_object_recurse (object
, placeholder
, object
);
3177 /* Clear seen_list because we're done with it. */
3180 /* The returned object here is expected to always eq the
3182 if (!EQ (check_object
, object
))
3183 error ("Unexpected mutation error in reader");
3186 /* Feval doesn't get called from here, so no gc protection is needed. */
3187 #define SUBSTITUTE(get_val, set_val) \
3189 Lisp_Object old_value = get_val; \
3190 Lisp_Object true_value \
3191 = substitute_object_recurse (object, placeholder, \
3194 if (!EQ (old_value, true_value)) \
3201 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3203 /* If we find the placeholder, return the target object. */
3204 if (EQ (placeholder
, subtree
))
3207 /* If we've been to this node before, don't explore it again. */
3208 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3211 /* If this node can be the entry point to a cycle, remember that
3212 we've seen it. It can only be such an entry point if it was made
3213 by #n=, which means that we can find it as a value in
3215 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3216 seen_list
= Fcons (subtree
, seen_list
);
3218 /* Recurse according to subtree's type.
3219 Every branch must return a Lisp_Object. */
3220 switch (XTYPE (subtree
))
3222 case Lisp_Vectorlike
:
3224 ptrdiff_t i
, length
= 0;
3225 if (BOOL_VECTOR_P (subtree
))
3226 return subtree
; /* No sub-objects anyway. */
3227 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3228 || COMPILEDP (subtree
))
3229 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3230 else if (VECTORP (subtree
))
3231 length
= ASIZE (subtree
);
3233 /* An unknown pseudovector may contain non-Lisp fields, so we
3234 can't just blindly traverse all its fields. We used to call
3235 `Flength' which signaled `sequencep', so I just preserved this
3237 wrong_type_argument (Qsequencep
, subtree
);
3239 for (i
= 0; i
< length
; i
++)
3240 SUBSTITUTE (AREF (subtree
, i
),
3241 ASET (subtree
, i
, true_value
));
3247 SUBSTITUTE (XCAR (subtree
),
3248 XSETCAR (subtree
, true_value
));
3249 SUBSTITUTE (XCDR (subtree
),
3250 XSETCDR (subtree
, true_value
));
3256 /* Check for text properties in each interval.
3257 substitute_in_interval contains part of the logic. */
3259 INTERVAL root_interval
= string_intervals (subtree
);
3260 Lisp_Object arg
= Fcons (object
, placeholder
);
3262 traverse_intervals_noorder (root_interval
,
3263 &substitute_in_interval
, arg
);
3268 /* Other types don't recurse any further. */
3274 /* Helper function for substitute_object_recurse. */
3276 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3278 Lisp_Object object
= Fcar (arg
);
3279 Lisp_Object placeholder
= Fcdr (arg
);
3281 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3291 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3292 integer syntax and fits in a fixnum, else return the nearest float if CP has
3293 either floating point or integer syntax and BASE is 10, else return nil. If
3294 IGNORE_TRAILING, consider just the longest prefix of CP that has
3295 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3296 number has integer syntax but does not fit. */
3299 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3302 char const *cp
= string
;
3304 bool float_syntax
= 0;
3307 /* Compute NaN and infinities using a variable, to cope with compilers that
3308 think they are smarter than we are. */
3311 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3312 IEEE floating point hosts, and works around a formerly-common bug where
3313 atof ("-0.0") drops the sign. */
3314 bool negative
= *cp
== '-';
3316 bool signedp
= negative
|| *cp
== '+';
3321 leading_digit
= digit_to_number (*cp
, base
);
3322 if (leading_digit
>= 0)
3327 while (digit_to_number (*cp
, base
) >= 0);
3337 if ('0' <= *cp
&& *cp
<= '9')
3342 while ('0' <= *cp
&& *cp
<= '9');
3344 if (*cp
== 'e' || *cp
== 'E')
3346 char const *ecp
= cp
;
3348 if (*cp
== '+' || *cp
== '-')
3350 if ('0' <= *cp
&& *cp
<= '9')
3355 while ('0' <= *cp
&& *cp
<= '9');
3357 else if (cp
[-1] == '+'
3358 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3364 else if (cp
[-1] == '+'
3365 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3369 value
= zero
/ zero
;
3371 /* If that made a "negative" NaN, negate it. */
3374 union { double d
; char c
[sizeof (double)]; }
3375 u_data
, u_minus_zero
;
3377 u_minus_zero
.d
= -0.0;
3378 for (i
= 0; i
< sizeof (double); i
++)
3379 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3385 /* Now VALUE is a positive NaN. */
3391 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3392 || state
== (LEAD_INT
|E_EXP
));
3395 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3396 any prefix that matches. Otherwise, the entire string must match. */
3397 if (! (ignore_trailing
3398 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3399 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3402 /* If the number uses integer and not float syntax, and is in C-language
3403 range, use its value, preferably as a fixnum. */
3404 if (leading_digit
>= 0 && ! float_syntax
)
3408 /* Fast special case for single-digit integers. This also avoids a
3409 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3410 case some versions of strtoumax accept numbers like "0x1" that Emacs
3412 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3413 return make_number (negative
? -leading_digit
: leading_digit
);
3416 n
= strtoumax (string
+ signedp
, NULL
, base
);
3417 if (errno
== ERANGE
)
3419 /* Unfortunately there's no simple and accurate way to convert
3420 non-base-10 numbers that are out of C-language range. */
3422 xsignal1 (Qoverflow_error
, build_string (string
));
3424 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3426 EMACS_INT signed_n
= n
;
3427 return make_number (negative
? -signed_n
: signed_n
);
3433 /* Either the number uses float syntax, or it does not fit into a fixnum.
3434 Convert it from string to floating point, unless the value is already
3435 known because it is an infinity, a NAN, or its absolute value fits in
3438 value
= atof (string
+ signedp
);
3440 return make_float (negative
? -value
: value
);
3445 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3449 Lisp_Object tem
, item
, vector
;
3450 struct Lisp_Cons
*otem
;
3453 tem
= read_list (1, readcharfun
);
3454 len
= Flength (tem
);
3455 vector
= Fmake_vector (len
, Qnil
);
3457 size
= ASIZE (vector
);
3458 ptr
= XVECTOR (vector
)->contents
;
3459 for (i
= 0; i
< size
; i
++)
3462 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3463 bytecode object, the docstring containing the bytecode and
3464 constants values must be treated as unibyte and passed to
3465 Fread, to get the actual bytecode string and constants vector. */
3466 if (bytecodeflag
&& load_force_doc_strings
)
3468 if (i
== COMPILED_BYTECODE
)
3470 if (!STRINGP (item
))
3471 error ("Invalid byte code");
3473 /* Delay handling the bytecode slot until we know whether
3474 it is lazily-loaded (we can tell by whether the
3475 constants slot is nil). */
3476 ASET (vector
, COMPILED_CONSTANTS
, item
);
3479 else if (i
== COMPILED_CONSTANTS
)
3481 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3485 /* Coerce string to unibyte (like string-as-unibyte,
3486 but without generating extra garbage and
3487 guaranteeing no change in the contents). */
3488 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3489 STRING_SET_UNIBYTE (bytestr
);
3491 item
= Fread (Fcons (bytestr
, readcharfun
));
3493 error ("Invalid byte code");
3495 otem
= XCONS (item
);
3496 bytestr
= XCAR (item
);
3501 /* Now handle the bytecode slot. */
3502 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3504 else if (i
== COMPILED_DOC_STRING
3506 && ! STRING_MULTIBYTE (item
))
3508 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3509 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3511 item
= Fstring_as_multibyte (item
);
3514 ASET (vector
, i
, item
);
3522 /* FLAG means check for ] to terminate rather than ) and . */
3525 read_list (bool flag
, Lisp_Object readcharfun
)
3527 Lisp_Object val
, tail
;
3528 Lisp_Object elt
, tem
;
3529 struct gcpro gcpro1
, gcpro2
;
3530 /* 0 is the normal case.
3531 1 means this list is a doc reference; replace it with the number 0.
3532 2 means this list is a doc reference; replace it with the doc string. */
3533 int doc_reference
= 0;
3535 /* Initialize this to 1 if we are reading a list. */
3536 bool first_in_list
= flag
<= 0;
3545 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3550 /* While building, if the list starts with #$, treat it specially. */
3551 if (EQ (elt
, Vload_file_name
)
3553 && !NILP (Vpurify_flag
))
3555 if (NILP (Vdoc_file_name
))
3556 /* We have not yet called Snarf-documentation, so assume
3557 this file is described in the DOC file
3558 and Snarf-documentation will fill in the right value later.
3559 For now, replace the whole list with 0. */
3562 /* We have already called Snarf-documentation, so make a relative
3563 file name for this file, so it can be found properly
3564 in the installed Lisp directory.
3565 We don't use Fexpand_file_name because that would make
3566 the directory absolute now. */
3567 elt
= concat2 (build_string ("../lisp/"),
3568 Ffile_name_nondirectory (elt
));
3570 else if (EQ (elt
, Vload_file_name
)
3572 && load_force_doc_strings
)
3581 invalid_syntax (") or . in a vector");
3589 XSETCDR (tail
, read0 (readcharfun
));
3591 val
= read0 (readcharfun
);
3592 read1 (readcharfun
, &ch
, 0);
3596 if (doc_reference
== 1)
3597 return make_number (0);
3598 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3601 file_offset saved_position
;
3602 /* Get a doc string from the file we are loading.
3603 If it's in saved_doc_string, get it from there.
3605 Here, we don't know if the string is a
3606 bytecode string or a doc string. As a
3607 bytecode string must be unibyte, we always
3608 return a unibyte string. If it is actually a
3609 doc string, caller must make it
3612 /* Position is negative for user variables. */
3613 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3614 if (pos
>= saved_doc_string_position
3615 && pos
< (saved_doc_string_position
3616 + saved_doc_string_length
))
3618 saved
= saved_doc_string
;
3619 saved_position
= saved_doc_string_position
;
3621 /* Look in prev_saved_doc_string the same way. */
3622 else if (pos
>= prev_saved_doc_string_position
3623 && pos
< (prev_saved_doc_string_position
3624 + prev_saved_doc_string_length
))
3626 saved
= prev_saved_doc_string
;
3627 saved_position
= prev_saved_doc_string_position
;
3631 ptrdiff_t start
= pos
- saved_position
;
3634 /* Process quoting with ^A,
3635 and find the end of the string,
3636 which is marked with ^_ (037). */
3637 for (from
= start
, to
= start
;
3638 saved
[from
] != 037;)
3640 int c
= saved
[from
++];
3644 saved
[to
++] = (c
== 1 ? c
3653 return make_unibyte_string (saved
+ start
,
3657 return get_doc_string (val
, 1, 0);
3662 invalid_syntax (". in wrong context");
3664 invalid_syntax ("] in a list");
3668 XSETCDR (tail
, tem
);
3675 static Lisp_Object initial_obarray
;
3677 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3679 static size_t oblookup_last_bucket_number
;
3681 /* Get an error if OBARRAY is not an obarray.
3682 If it is one, return it. */
3685 check_obarray (Lisp_Object obarray
)
3687 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3689 /* If Vobarray is now invalid, force it to be valid. */
3690 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3691 wrong_type_argument (Qvectorp
, obarray
);
3696 /* Intern the C string STR: return a symbol with that name,
3697 interned in the current obarray. */
3700 intern_1 (const char *str
, ptrdiff_t len
)
3702 Lisp_Object obarray
= check_obarray (Vobarray
);
3703 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3705 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3709 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3711 Lisp_Object obarray
= check_obarray (Vobarray
);
3712 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3717 if (NILP (Vpurify_flag
))
3718 /* Creating a non-pure string from a string literal not
3719 implemented yet. We could just use make_string here and live
3720 with the extra copy. */
3723 return Fintern (make_pure_c_string (str
, len
), obarray
);
3726 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3727 doc
: /* Return the canonical symbol whose name is STRING.
3728 If there is none, one is created by this function and returned.
3729 A second optional argument specifies the obarray to use;
3730 it defaults to the value of `obarray'. */)
3731 (Lisp_Object string
, Lisp_Object obarray
)
3733 register Lisp_Object tem
, sym
, *ptr
;
3735 if (NILP (obarray
)) obarray
= Vobarray
;
3736 obarray
= check_obarray (obarray
);
3738 CHECK_STRING (string
);
3740 tem
= oblookup (obarray
, SSDATA (string
),
3743 if (!INTEGERP (tem
))
3746 if (!NILP (Vpurify_flag
))
3747 string
= Fpurecopy (string
);
3748 sym
= Fmake_symbol (string
);
3750 if (EQ (obarray
, initial_obarray
))
3751 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3753 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3755 if ((SREF (string
, 0) == ':')
3756 && EQ (obarray
, initial_obarray
))
3758 XSYMBOL (sym
)->constant
= 1;
3759 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3760 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3763 ptr
= aref_addr (obarray
, XINT(tem
));
3765 set_symbol_next (sym
, XSYMBOL (*ptr
));
3767 set_symbol_next (sym
, NULL
);
3772 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3773 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3774 NAME may be a string or a symbol. If it is a symbol, that exact
3775 symbol is searched for.
3776 A second optional argument specifies the obarray to use;
3777 it defaults to the value of `obarray'. */)
3778 (Lisp_Object name
, Lisp_Object obarray
)
3780 register Lisp_Object tem
, string
;
3782 if (NILP (obarray
)) obarray
= Vobarray
;
3783 obarray
= check_obarray (obarray
);
3785 if (!SYMBOLP (name
))
3787 CHECK_STRING (name
);
3791 string
= SYMBOL_NAME (name
);
3793 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3794 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3800 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3801 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3802 The value is t if a symbol was found and deleted, nil otherwise.
3803 NAME may be a string or a symbol. If it is a symbol, that symbol
3804 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3805 OBARRAY defaults to the value of the variable `obarray'. */)
3806 (Lisp_Object name
, Lisp_Object obarray
)
3808 register Lisp_Object string
, tem
;
3811 if (NILP (obarray
)) obarray
= Vobarray
;
3812 obarray
= check_obarray (obarray
);
3815 string
= SYMBOL_NAME (name
);
3818 CHECK_STRING (name
);
3822 tem
= oblookup (obarray
, SSDATA (string
),
3827 /* If arg was a symbol, don't delete anything but that symbol itself. */
3828 if (SYMBOLP (name
) && !EQ (name
, tem
))
3831 /* There are plenty of other symbols which will screw up the Emacs
3832 session if we unintern them, as well as even more ways to use
3833 `setq' or `fset' or whatnot to make the Emacs session
3834 unusable. Let's not go down this silly road. --Stef */
3835 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3836 error ("Attempt to unintern t or nil"); */
3838 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3840 hash
= oblookup_last_bucket_number
;
3842 if (EQ (AREF (obarray
, hash
), tem
))
3844 if (XSYMBOL (tem
)->next
)
3847 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3848 ASET (obarray
, hash
, sym
);
3851 ASET (obarray
, hash
, make_number (0));
3855 Lisp_Object tail
, following
;
3857 for (tail
= AREF (obarray
, hash
);
3858 XSYMBOL (tail
)->next
;
3861 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3862 if (EQ (following
, tem
))
3864 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3873 /* Return the symbol in OBARRAY whose names matches the string
3874 of SIZE characters (SIZE_BYTE bytes) at PTR.
3875 If there is no such symbol in OBARRAY, return nil.
3877 Also store the bucket number in oblookup_last_bucket_number. */
3880 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3884 register Lisp_Object tail
;
3885 Lisp_Object bucket
, tem
;
3887 obarray
= check_obarray (obarray
);
3888 obsize
= ASIZE (obarray
);
3890 /* This is sometimes needed in the middle of GC. */
3891 obsize
&= ~ARRAY_MARK_FLAG
;
3892 hash
= hash_string (ptr
, size_byte
) % obsize
;
3893 bucket
= AREF (obarray
, hash
);
3894 oblookup_last_bucket_number
= hash
;
3895 if (EQ (bucket
, make_number (0)))
3897 else if (!SYMBOLP (bucket
))
3898 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3900 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3902 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3903 && SCHARS (SYMBOL_NAME (tail
)) == size
3904 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3906 else if (XSYMBOL (tail
)->next
== 0)
3909 XSETINT (tem
, hash
);
3914 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3917 register Lisp_Object tail
;
3918 CHECK_VECTOR (obarray
);
3919 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3921 tail
= AREF (obarray
, i
);
3926 if (XSYMBOL (tail
)->next
== 0)
3928 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3934 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3936 call1 (function
, sym
);
3939 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3940 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3941 OBARRAY defaults to the value of `obarray'. */)
3942 (Lisp_Object function
, Lisp_Object obarray
)
3944 if (NILP (obarray
)) obarray
= Vobarray
;
3945 obarray
= check_obarray (obarray
);
3947 map_obarray (obarray
, mapatoms_1
, function
);
3951 #define OBARRAY_SIZE 1511
3956 Lisp_Object oblength
;
3957 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3959 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3961 Vobarray
= Fmake_vector (oblength
, make_number (0));
3962 initial_obarray
= Vobarray
;
3963 staticpro (&initial_obarray
);
3965 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
3966 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3967 NILP (Vpurify_flag) check in intern_c_string. */
3968 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3969 Qnil
= intern_c_string ("nil");
3971 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3972 so those two need to be fixed manually. */
3973 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3974 set_symbol_function (Qunbound
, Qnil
);
3975 set_symbol_plist (Qunbound
, Qnil
);
3976 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3977 XSYMBOL (Qnil
)->constant
= 1;
3978 XSYMBOL (Qnil
)->declared_special
= 1;
3979 set_symbol_plist (Qnil
, Qnil
);
3980 set_symbol_function (Qnil
, Qnil
);
3982 Qt
= intern_c_string ("t");
3983 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3984 XSYMBOL (Qnil
)->declared_special
= 1;
3985 XSYMBOL (Qt
)->constant
= 1;
3987 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3990 DEFSYM (Qvariable_documentation
, "variable-documentation");
3992 read_buffer
= xmalloc (size
);
3993 read_buffer_size
= size
;
3997 defsubr (struct Lisp_Subr
*sname
)
3999 Lisp_Object sym
, tem
;
4000 sym
= intern_c_string (sname
->symbol_name
);
4001 XSETPVECTYPE (sname
, PVEC_SUBR
);
4002 XSETSUBR (tem
, sname
);
4003 set_symbol_function (sym
, tem
);
4006 #ifdef NOTDEF /* Use fset in subr.el now! */
4008 defalias (struct Lisp_Subr
*sname
, char *string
)
4011 sym
= intern (string
);
4012 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4016 /* Define an "integer variable"; a symbol whose value is forwarded to a
4017 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4018 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4020 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4021 const char *namestring
, EMACS_INT
*address
)
4024 sym
= intern_c_string (namestring
);
4025 i_fwd
->type
= Lisp_Fwd_Int
;
4026 i_fwd
->intvar
= address
;
4027 XSYMBOL (sym
)->declared_special
= 1;
4028 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4029 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4032 /* Similar but define a variable whose value is t if address contains 1,
4033 nil if address contains 0. */
4035 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4036 const char *namestring
, bool *address
)
4039 sym
= intern_c_string (namestring
);
4040 b_fwd
->type
= Lisp_Fwd_Bool
;
4041 b_fwd
->boolvar
= address
;
4042 XSYMBOL (sym
)->declared_special
= 1;
4043 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4044 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4045 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4048 /* Similar but define a variable whose value is the Lisp Object stored
4049 at address. Two versions: with and without gc-marking of the C
4050 variable. The nopro version is used when that variable will be
4051 gc-marked for some other reason, since marking the same slot twice
4052 can cause trouble with strings. */
4054 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4055 const char *namestring
, Lisp_Object
*address
)
4058 sym
= intern_c_string (namestring
);
4059 o_fwd
->type
= Lisp_Fwd_Obj
;
4060 o_fwd
->objvar
= address
;
4061 XSYMBOL (sym
)->declared_special
= 1;
4062 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4063 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4067 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4068 const char *namestring
, Lisp_Object
*address
)
4070 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4071 staticpro (address
);
4074 /* Similar but define a variable whose value is the Lisp Object stored
4075 at a particular offset in the current kboard object. */
4078 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4079 const char *namestring
, int offset
)
4082 sym
= intern_c_string (namestring
);
4083 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4084 ko_fwd
->offset
= offset
;
4085 XSYMBOL (sym
)->declared_special
= 1;
4086 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4087 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4090 /* Check that the elements of Vload_path exist. */
4093 load_path_check (void)
4095 Lisp_Object path_tail
;
4097 /* The only elements that might not exist are those from
4098 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4100 for (path_tail
= Vload_path
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4102 Lisp_Object dirfile
;
4103 dirfile
= Fcar (path_tail
);
4104 if (STRINGP (dirfile
))
4106 dirfile
= Fdirectory_file_name (dirfile
);
4107 if (! file_accessible_directory_p (SSDATA (dirfile
)))
4108 dir_warning ("Lisp directory", XCAR (path_tail
));
4113 /* Record the value of load-path used at the start of dumping
4114 so we can see if the site changed it later during dumping. */
4115 static Lisp_Object dump_path
;
4117 /* Compute the default Vload_path, with the following logic:
4119 use EMACSLOADPATH env-var if set; otherwise use PATH_LOADSEARCH,
4120 prepending PATH_SITELOADSEARCH unless --no-site-lisp.
4121 The remainder is what happens when dumping works:
4122 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4123 Otherwise use EMACSLOADPATH if set, else PATH_LOADSEARCH.
4125 If !initialized, then just set both Vload_path and dump_path.
4126 If initialized, then if Vload_path != dump_path, do nothing.
4127 (Presumably the load-path has already been changed by something.
4128 This can only be from a site-load file during dumping,
4129 or because EMACSLOADPATH is set.)
4130 If Vinstallation_directory is not nil (ie, running uninstalled):
4131 If installation-dir/lisp exists and not already a member,
4132 we must be running uninstalled. Reset the load-path
4133 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4134 refers to the eventual installation directories. Since we
4135 are not yet installed, we should not use them, even if they exist.)
4136 If installation-dir/lisp does not exist, just add dump_path at the
4138 Add installation-dir/leim (if exists and not already a member) at the front.
4139 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4140 and not already a member) at the front.
4141 If installation-dir != source-dir (ie running an uninstalled,
4142 out-of-tree build) AND install-dir/src/Makefile exists BUT
4143 install-dir/src/Makefile.in does NOT exist (this is a sanity
4144 check), then repeat the above steps for source-dir/lisp,
4146 Finally, add the site-lisp directories at the front (if !no_site_lisp).
4156 const char *loadpath
= ns_load_path ();
4159 normal
= PATH_LOADSEARCH
;
4161 Vload_path
= decode_env_path ("EMACSLOADPATH", loadpath
? loadpath
: normal
);
4163 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4168 /* FIXME CANNOT_DUMP platforms should get source-dir/lisp etc added
4169 to their load-path too, AFAICS. I don't think we can tell the
4170 difference between initialized and !initialized in this case,
4171 so we'll have to do it unconditionally when Vinstallation_directory
4173 if (!no_site_lisp
&& !egetenv ("EMACSLOADPATH"))
4175 Lisp_Object sitelisp
;
4176 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4177 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4179 #else /* !CANNOT_DUMP */
4180 if (NILP (Vpurify_flag
))
4182 normal
= PATH_LOADSEARCH
;
4183 /* If the EMACSLOADPATH environment variable is set, use its value.
4184 This doesn't apply if we're dumping. */
4185 if (egetenv ("EMACSLOADPATH"))
4186 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4189 normal
= PATH_DUMPLOADSEARCH
;
4191 /* In a dumped Emacs, we normally reset the value of Vload_path using
4192 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4193 the source directory, instead of the path of the installed elisp
4194 libraries. However, if it appears that Vload_path has already been
4195 changed from the default that was saved before dumping, don't
4196 change it further. Changes can only be due to EMACSLOADPATH, or
4197 site-lisp files that were processed during dumping. */
4200 if (NILP (Fequal (dump_path
, Vload_path
)))
4202 /* Do not make any changes, just check the elements exist. */
4203 /* Note: --no-site-lisp is ignored.
4204 I don't know what to do about this. */
4210 const char *loadpath
= ns_load_path ();
4211 Vload_path
= decode_env_path (0, loadpath
? loadpath
: normal
);
4213 Vload_path
= decode_env_path (0, normal
);
4215 if (!NILP (Vinstallation_directory
))
4217 Lisp_Object tem
, tem1
;
4219 /* Add to the path the lisp subdir of the installation
4220 dir, if it is accessible. Note: in out-of-tree builds,
4221 this directory is empty save for Makefile. */
4222 tem
= Fexpand_file_name (build_string ("lisp"),
4223 Vinstallation_directory
);
4224 tem1
= Ffile_accessible_directory_p (tem
);
4227 if (NILP (Fmember (tem
, Vload_path
)))
4229 /* We are running uninstalled. The default load-path
4230 points to the eventual installed lisp, leim
4231 directories. We should not use those now, even
4232 if they exist, so start over from a clean slate. */
4233 Vload_path
= list1 (tem
);
4237 /* That dir doesn't exist, so add the build-time
4238 Lisp dirs instead. */
4239 Vload_path
= nconc2 (Vload_path
, dump_path
);
4241 /* Add leim under the installation dir, if it is accessible. */
4242 tem
= Fexpand_file_name (build_string ("leim"),
4243 Vinstallation_directory
);
4244 tem1
= Ffile_accessible_directory_p (tem
);
4247 if (NILP (Fmember (tem
, Vload_path
)))
4248 Vload_path
= Fcons (tem
, Vload_path
);
4251 /* Add site-lisp under the installation dir, if it exists. */
4254 tem
= Fexpand_file_name (build_string ("site-lisp"),
4255 Vinstallation_directory
);
4256 tem1
= Ffile_accessible_directory_p (tem
);
4259 if (NILP (Fmember (tem
, Vload_path
)))
4260 Vload_path
= Fcons (tem
, Vload_path
);
4264 /* If Emacs was not built in the source directory,
4265 and it is run from where it was built, add to load-path
4266 the lisp, leim and site-lisp dirs under that directory. */
4268 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4272 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4273 Vinstallation_directory
);
4274 tem1
= Ffile_exists_p (tem
);
4276 /* Don't be fooled if they moved the entire source tree
4277 AFTER dumping Emacs. If the build directory is indeed
4278 different from the source dir, src/Makefile.in and
4279 src/Makefile will not be found together. */
4280 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4281 Vinstallation_directory
);
4282 tem2
= Ffile_exists_p (tem
);
4283 if (!NILP (tem1
) && NILP (tem2
))
4285 tem
= Fexpand_file_name (build_string ("lisp"),
4288 if (NILP (Fmember (tem
, Vload_path
)))
4289 Vload_path
= Fcons (tem
, Vload_path
);
4291 tem
= Fexpand_file_name (build_string ("leim"),
4294 if (NILP (Fmember (tem
, Vload_path
)))
4295 Vload_path
= Fcons (tem
, Vload_path
);
4299 tem
= Fexpand_file_name (build_string ("site-lisp"),
4301 tem1
= Ffile_accessible_directory_p (tem
);
4304 if (NILP (Fmember (tem
, Vload_path
)))
4305 Vload_path
= Fcons (tem
, Vload_path
);
4309 } /* Vinstallation_directory != Vsource_directory */
4311 } /* if Vinstallation_directory */
4313 /* Check before adding the site-lisp directories.
4314 The install should have created them, but they are not
4315 required, so no need to warn if they are absent.
4316 Or we might be running before installation. */
4319 /* Add the site-lisp directories at the front. */
4322 Lisp_Object sitelisp
;
4323 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4324 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4326 } /* if dump_path == Vload_path */
4328 else /* !initialized */
4330 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4331 source directory. We used to add ../lisp (ie the lisp dir in
4332 the build directory) at the front here, but that caused trouble
4333 because it was copied from dump_path into Vload_path, above,
4334 when Vinstallation_directory was non-nil. It should not be
4335 necessary, since in out of tree builds lisp/ is empty, save
4337 Vload_path
= decode_env_path (0, normal
);
4338 dump_path
= Vload_path
;
4339 /* No point calling load_path_check; load-path only contains essential
4340 elements from the source directory at this point. They cannot
4341 be missing unless something went extremely (and improbably)
4342 wrong, in which case the build will fail in obvious ways. */
4344 #endif /* !CANNOT_DUMP */
4348 load_in_progress
= 0;
4349 Vload_file_name
= Qnil
;
4350 Vstandard_input
= Qt
;
4351 Vloads_in_progress
= Qnil
;
4354 /* Print a warning that directory intended for use USE and with name
4355 DIRNAME cannot be accessed. On entry, errno should correspond to
4356 the access failure. Print the warning on stderr and put it in
4360 dir_warning (char const *use
, Lisp_Object dirname
)
4362 static char const format
[] = "Warning: %s `%s': %s\n";
4363 int access_errno
= errno
;
4364 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4366 /* Don't log the warning before we've initialized!! */
4369 char const *diagnostic
= emacs_strerror (access_errno
);
4371 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4372 + strlen (use
) + SBYTES (dirname
)
4373 + strlen (diagnostic
));
4374 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4376 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4382 syms_of_lread (void)
4385 defsubr (&Sread_from_string
);
4387 defsubr (&Sintern_soft
);
4388 defsubr (&Sunintern
);
4389 defsubr (&Sget_load_suffixes
);
4391 defsubr (&Seval_buffer
);
4392 defsubr (&Seval_region
);
4393 defsubr (&Sread_char
);
4394 defsubr (&Sread_char_exclusive
);
4395 defsubr (&Sread_event
);
4396 defsubr (&Sget_file_char
);
4397 defsubr (&Smapatoms
);
4398 defsubr (&Slocate_file_internal
);
4400 DEFVAR_LISP ("obarray", Vobarray
,
4401 doc
: /* Symbol table for use by `intern' and `read'.
4402 It is a vector whose length ought to be prime for best results.
4403 The vector's contents don't make sense if examined from Lisp programs;
4404 to find all the symbols in an obarray, use `mapatoms'. */);
4406 DEFVAR_LISP ("values", Vvalues
,
4407 doc
: /* List of values of all expressions which were read, evaluated and printed.
4408 Order is reverse chronological. */);
4409 XSYMBOL (intern ("values"))->declared_special
= 0;
4411 DEFVAR_LISP ("standard-input", Vstandard_input
,
4412 doc
: /* Stream for read to get input from.
4413 See documentation of `read' for possible values. */);
4414 Vstandard_input
= Qt
;
4416 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4417 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4419 If this variable is a buffer, then only forms read from that buffer
4420 will be added to `read-symbol-positions-list'.
4421 If this variable is t, then all read forms will be added.
4422 The effect of all other values other than nil are not currently
4423 defined, although they may be in the future.
4425 The positions are relative to the last call to `read' or
4426 `read-from-string'. It is probably a bad idea to set this variable at
4427 the toplevel; bind it instead. */);
4428 Vread_with_symbol_positions
= Qnil
;
4430 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4431 doc
: /* A list mapping read symbols to their positions.
4432 This variable is modified during calls to `read' or
4433 `read-from-string', but only when `read-with-symbol-positions' is
4436 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4437 CHAR-POSITION is an integer giving the offset of that occurrence of the
4438 symbol from the position where `read' or `read-from-string' started.
4440 Note that a symbol will appear multiple times in this list, if it was
4441 read multiple times. The list is in the same order as the symbols
4443 Vread_symbol_positions_list
= Qnil
;
4445 DEFVAR_LISP ("read-circle", Vread_circle
,
4446 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4449 DEFVAR_LISP ("load-path", Vload_path
,
4450 doc
: /* List of directories to search for files to load.
4451 Each element is a string (directory name) or nil (try default directory).
4452 Initialized based on EMACSLOADPATH environment variable, if any,
4453 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4455 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4456 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4457 This list should not include the empty string.
4458 `load' and related functions try to append these suffixes, in order,
4459 to the specified file name if a Lisp suffix is allowed or required. */);
4460 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4461 build_pure_c_string (".el"));
4462 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4463 doc
: /* List of suffixes that indicate representations of \
4465 This list should normally start with the empty string.
4467 Enabling Auto Compression mode appends the suffixes in
4468 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4469 mode removes them again. `load' and related functions use this list to
4470 determine whether they should look for compressed versions of a file
4471 and, if so, which suffixes they should try to append to the file name
4472 in order to do so. However, if you want to customize which suffixes
4473 the loading functions recognize as compression suffixes, you should
4474 customize `jka-compr-load-suffixes' rather than the present variable. */);
4475 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4477 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4478 doc
: /* Non-nil if inside of `load'. */);
4479 DEFSYM (Qload_in_progress
, "load-in-progress");
4481 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4482 doc
: /* An alist of functions to be evalled when particular files are loaded.
4483 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4485 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4486 a symbol \(a feature name).
4488 When `load' is run and the file-name argument matches an element's
4489 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4490 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4492 An error in FORMS does not undo the load, but does prevent execution of
4493 the rest of the FORMS. */);
4494 Vafter_load_alist
= Qnil
;
4496 DEFVAR_LISP ("load-history", Vload_history
,
4497 doc
: /* Alist mapping loaded file names to symbols and features.
4498 Each alist element should be a list (FILE-NAME ENTRIES...), where
4499 FILE-NAME is the name of a file that has been loaded into Emacs.
4500 The file name is absolute and true (i.e. it doesn't contain symlinks).
4501 As an exception, one of the alist elements may have FILE-NAME nil,
4502 for symbols and features not associated with any file.
4504 The remaining ENTRIES in the alist element describe the functions and
4505 variables defined in that file, the features provided, and the
4506 features required. Each entry has the form `(provide . FEATURE)',
4507 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4508 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4509 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4510 autoload before this file redefined it as a function. In addition,
4511 entries may also be single symbols, which means that SYMBOL was
4512 defined by `defvar' or `defconst'.
4514 During preloading, the file name recorded is relative to the main Lisp
4515 directory. These file names are converted to absolute at startup. */);
4516 Vload_history
= Qnil
;
4518 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4519 doc
: /* Full name of file being loaded by `load'. */);
4520 Vload_file_name
= Qnil
;
4522 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4523 doc
: /* File name, including directory, of user's initialization file.
4524 If the file loaded had extension `.elc', and the corresponding source file
4525 exists, this variable contains the name of source file, suitable for use
4526 by functions like `custom-save-all' which edit the init file.
4527 While Emacs loads and evaluates the init file, value is the real name
4528 of the file, regardless of whether or not it has the `.elc' extension. */);
4529 Vuser_init_file
= Qnil
;
4531 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4532 doc
: /* Used for internal purposes by `load'. */);
4533 Vcurrent_load_list
= Qnil
;
4535 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4536 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4537 The default is nil, which means use the function `read'. */);
4538 Vload_read_function
= Qnil
;
4540 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4541 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4542 The value should be a function for doing code conversion before
4543 reading a source file. It can also be nil, in which case loading is
4544 done without any code conversion.
4546 If the value is a function, it is called with four arguments,
4547 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4548 the file to load, FILE is the non-absolute name (for messages etc.),
4549 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4550 `load'. The function should return t if the file was loaded. */);
4551 Vload_source_file_function
= Qnil
;
4553 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4554 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4555 This is useful when the file being loaded is a temporary copy. */);
4556 load_force_doc_strings
= 0;
4558 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4559 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4560 This is normally bound by `load' and `eval-buffer' to control `read',
4561 and is not meant for users to change. */);
4562 load_convert_to_unibyte
= 0;
4564 DEFVAR_LISP ("source-directory", Vsource_directory
,
4565 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4566 You cannot count on them to still be there! */);
4568 = Fexpand_file_name (build_string ("../"),
4569 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4571 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4572 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4573 Vpreloaded_file_list
= Qnil
;
4575 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4576 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4577 Vbyte_boolean_vars
= Qnil
;
4579 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4580 doc
: /* Non-nil means load dangerous compiled Lisp files.
4581 Some versions of XEmacs use different byte codes than Emacs. These
4582 incompatible byte codes can make Emacs crash when it tries to execute
4584 load_dangerous_libraries
= 0;
4586 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4587 doc
: /* Non-nil means force printing messages when loading Lisp files.
4588 This overrides the value of the NOMESSAGE argument to `load'. */);
4589 force_load_messages
= 0;
4591 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4592 doc
: /* Regular expression matching safe to load compiled Lisp files.
4593 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4594 from the file, and matches them against this regular expression.
4595 When the regular expression matches, the file is considered to be safe
4596 to load. See also `load-dangerous-libraries'. */);
4597 Vbytecomp_version_regexp
4598 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4600 DEFSYM (Qlexical_binding
, "lexical-binding");
4601 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4602 doc
: /* Whether to use lexical binding when evaluating code.
4603 Non-nil means that the code in the current buffer should be evaluated
4604 with lexical binding.
4605 This variable is automatically set from the file variables of an
4606 interpreted Lisp file read using `load'. Unlike other file local
4607 variables, this must be set in the first line of a file. */);
4608 Vlexical_binding
= Qnil
;
4609 Fmake_variable_buffer_local (Qlexical_binding
);
4611 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4612 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4613 Veval_buffer_list
= Qnil
;
4615 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4616 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4617 Vold_style_backquotes
= Qnil
;
4618 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4620 /* Vsource_directory was initialized in init_lread. */
4622 DEFSYM (Qcurrent_load_list
, "current-load-list");
4623 DEFSYM (Qstandard_input
, "standard-input");
4624 DEFSYM (Qread_char
, "read-char");
4625 DEFSYM (Qget_file_char
, "get-file-char");
4626 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4627 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4629 DEFSYM (Qbackquote
, "`");
4630 DEFSYM (Qcomma
, ",");
4631 DEFSYM (Qcomma_at
, ",@");
4632 DEFSYM (Qcomma_dot
, ",.");
4634 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4635 DEFSYM (Qascii_character
, "ascii-character");
4636 DEFSYM (Qfunction
, "function");
4637 DEFSYM (Qload
, "load");
4638 DEFSYM (Qload_file_name
, "load-file-name");
4639 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4640 DEFSYM (Qfile_truename
, "file-truename");
4641 DEFSYM (Qdir_ok
, "dir-ok");
4642 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4644 staticpro (&dump_path
);
4646 staticpro (&read_objects
);
4647 read_objects
= Qnil
;
4648 staticpro (&seen_list
);
4651 Vloads_in_progress
= Qnil
;
4652 staticpro (&Vloads_in_progress
);
4654 DEFSYM (Qhash_table
, "hash-table");
4655 DEFSYM (Qdata
, "data");
4656 DEFSYM (Qtest
, "test");
4657 DEFSYM (Qsize
, "size");
4658 DEFSYM (Qweakness
, "weakness");
4659 DEFSYM (Qrehash_size
, "rehash-size");
4660 DEFSYM (Qrehash_threshold
, "rehash-threshold");