1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2014 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
);
149 /* Functions that read one byte from the current source READCHARFUN
150 or unreads one byte. If the integer argument C is -1, it returns
151 one read byte, or -1 when there's no more byte in the source. If C
152 is 0 or positive, it unreads C, and the return value is not
155 static int readbyte_for_lambda (int, Lisp_Object
);
156 static int readbyte_from_file (int, Lisp_Object
);
157 static int readbyte_from_string (int, Lisp_Object
);
159 /* Handle unreading and rereading of characters.
160 Write READCHAR to read a character,
161 UNREAD(c) to unread c to be read again.
163 These macros correctly read/unread multibyte characters. */
165 #define READCHAR readchar (readcharfun, NULL)
166 #define UNREAD(c) unreadchar (readcharfun, c)
168 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
169 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
171 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
172 Qlambda, or a cons, we use this to keep an unread character because
173 a file stream can't handle multibyte-char unreading. The value -1
174 means that there's no unread character. */
175 static int unread_char
;
178 readchar (Lisp_Object readcharfun
, bool *multibyte
)
182 int (*readbyte
) (int, Lisp_Object
);
183 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
185 bool emacs_mule_encoding
= 0;
192 if (BUFFERP (readcharfun
))
194 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
196 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
198 if (! BUFFER_LIVE_P (inbuffer
))
201 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
204 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
206 /* Fetch the character code from the buffer. */
207 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
208 BUF_INC_POS (inbuffer
, pt_byte
);
215 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
216 if (! ASCII_BYTE_P (c
))
217 c
= BYTE8_TO_CHAR (c
);
220 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
224 if (MARKERP (readcharfun
))
226 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
228 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
230 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
233 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
235 /* Fetch the character code from the buffer. */
236 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
237 BUF_INC_POS (inbuffer
, bytepos
);
244 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
245 if (! ASCII_BYTE_P (c
))
246 c
= BYTE8_TO_CHAR (c
);
250 XMARKER (readcharfun
)->bytepos
= bytepos
;
251 XMARKER (readcharfun
)->charpos
++;
256 if (EQ (readcharfun
, Qlambda
))
258 readbyte
= readbyte_for_lambda
;
262 if (EQ (readcharfun
, Qget_file_char
))
264 readbyte
= readbyte_from_file
;
268 if (STRINGP (readcharfun
))
270 if (read_from_string_index
>= read_from_string_limit
)
272 else if (STRING_MULTIBYTE (readcharfun
))
276 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
277 read_from_string_index
,
278 read_from_string_index_byte
);
282 c
= SREF (readcharfun
, read_from_string_index_byte
);
283 read_from_string_index
++;
284 read_from_string_index_byte
++;
289 if (CONSP (readcharfun
))
291 /* This is the case that read_vector is reading from a unibyte
292 string that contains a byte sequence previously skipped
293 because of #@NUMBER. The car part of readcharfun is that
294 string, and the cdr part is a value of readcharfun given to
296 readbyte
= readbyte_from_string
;
297 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
298 emacs_mule_encoding
= 1;
302 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
304 readbyte
= readbyte_from_file
;
305 emacs_mule_encoding
= 1;
309 tem
= call0 (readcharfun
);
316 if (unread_char
>= 0)
322 c
= (*readbyte
) (-1, readcharfun
);
327 if (ASCII_BYTE_P (c
))
329 if (emacs_mule_encoding
)
330 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
333 len
= BYTES_BY_CHAR_HEAD (c
);
336 c
= (*readbyte
) (-1, readcharfun
);
337 if (c
< 0 || ! TRAILING_CODE_P (c
))
340 (*readbyte
) (buf
[i
], readcharfun
);
341 return BYTE8_TO_CHAR (buf
[0]);
345 return STRING_CHAR (buf
);
348 #define FROM_FILE_P(readcharfun) \
349 (EQ (readcharfun, Qget_file_char) \
350 || EQ (readcharfun, Qget_emacs_mule_file_char))
353 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
355 if (FROM_FILE_P (readcharfun
))
357 block_input (); /* FIXME: Not sure if it's needed. */
358 fseek (instream
, n
, SEEK_CUR
);
362 { /* We're not reading directly from a file. In that case, it's difficult
363 to reliably count bytes, since these are usually meant for the file's
364 encoding, whereas we're now typically in the internal encoding.
365 But luckily, skip_dyn_bytes is used to skip over a single
366 dynamic-docstring (or dynamic byte-code) which is always quoted such
367 that \037 is the final char. */
371 } while (c
>= 0 && c
!= '\037');
376 skip_dyn_eof (Lisp_Object readcharfun
)
378 if (FROM_FILE_P (readcharfun
))
380 block_input (); /* FIXME: Not sure if it's needed. */
381 fseek (instream
, 0, SEEK_END
);
385 while (READCHAR
>= 0);
388 /* Unread the character C in the way appropriate for the stream READCHARFUN.
389 If the stream is a user function, call it with the char as argument. */
392 unreadchar (Lisp_Object readcharfun
, int c
)
396 /* Don't back up the pointer if we're unreading the end-of-input mark,
397 since readchar didn't advance it when we read it. */
399 else if (BUFFERP (readcharfun
))
401 struct buffer
*b
= XBUFFER (readcharfun
);
402 ptrdiff_t charpos
= BUF_PT (b
);
403 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
405 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
406 BUF_DEC_POS (b
, bytepos
);
410 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
412 else if (MARKERP (readcharfun
))
414 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
415 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
417 XMARKER (readcharfun
)->charpos
--;
418 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
419 BUF_DEC_POS (b
, bytepos
);
423 XMARKER (readcharfun
)->bytepos
= bytepos
;
425 else if (STRINGP (readcharfun
))
427 read_from_string_index
--;
428 read_from_string_index_byte
429 = string_char_to_byte (readcharfun
, read_from_string_index
);
431 else if (CONSP (readcharfun
))
435 else if (EQ (readcharfun
, Qlambda
))
439 else if (FROM_FILE_P (readcharfun
))
444 call1 (readcharfun
, make_number (c
));
448 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
450 return read_bytecode_char (c
>= 0);
455 readbyte_from_file (int c
, Lisp_Object readcharfun
)
460 ungetc (c
, instream
);
468 /* Interrupted reads have been observed while reading over the network. */
469 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
480 return (c
== EOF
? -1 : c
);
484 readbyte_from_string (int c
, Lisp_Object readcharfun
)
486 Lisp_Object string
= XCAR (readcharfun
);
490 read_from_string_index
--;
491 read_from_string_index_byte
492 = string_char_to_byte (string
, read_from_string_index
);
495 if (read_from_string_index
>= read_from_string_limit
)
498 FETCH_STRING_CHAR_ADVANCE (c
, string
,
499 read_from_string_index
,
500 read_from_string_index_byte
);
505 /* Read one non-ASCII character from INSTREAM. The character is
506 encoded in `emacs-mule' and the first byte is already read in
510 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
512 /* Emacs-mule coding uses at most 4-byte for one character. */
513 unsigned char buf
[4];
514 int len
= emacs_mule_bytes
[c
];
515 struct charset
*charset
;
520 /* C is not a valid leading-code of `emacs-mule'. */
521 return BYTE8_TO_CHAR (c
);
527 c
= (*readbyte
) (-1, readcharfun
);
531 (*readbyte
) (buf
[i
], readcharfun
);
532 return BYTE8_TO_CHAR (buf
[0]);
539 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
540 code
= buf
[1] & 0x7F;
544 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
545 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
547 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
548 code
= buf
[2] & 0x7F;
552 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
553 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
558 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
559 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
561 c
= DECODE_CHAR (charset
, code
);
563 Fsignal (Qinvalid_read_syntax
,
564 list1 (build_string ("invalid multibyte form")));
569 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
571 static Lisp_Object
read0 (Lisp_Object
);
572 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
574 static Lisp_Object
read_list (bool, Lisp_Object
);
575 static Lisp_Object
read_vector (Lisp_Object
, bool);
577 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
579 static void substitute_object_in_subtree (Lisp_Object
,
581 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
584 /* Get a character from the tty. */
586 /* Read input events until we get one that's acceptable for our purposes.
588 If NO_SWITCH_FRAME, switch-frame events are stashed
589 until we get a character we like, and then stuffed into
592 If ASCII_REQUIRED, check function key events to see
593 if the unmodified version of the symbol has a Qascii_character
594 property, and use that character, if present.
596 If ERROR_NONASCII, signal an error if the input we
597 get isn't an ASCII character with modifiers. If it's false but
598 ASCII_REQUIRED is true, just re-read until we get an ASCII
601 If INPUT_METHOD, invoke the current input method
602 if the character warrants that.
604 If SECONDS is a number, wait that many seconds for input, and
605 return Qnil if no input arrives within that time. */
608 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
609 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
611 Lisp_Object val
, delayed_switch_frame
;
612 struct timespec end_time
;
614 #ifdef HAVE_WINDOW_SYSTEM
615 if (display_hourglass_p
)
619 delayed_switch_frame
= Qnil
;
621 /* Compute timeout. */
622 if (NUMBERP (seconds
))
624 double duration
= extract_float (seconds
);
625 struct timespec wait_time
= dtotimespec (duration
);
626 end_time
= timespec_add (current_timespec (), wait_time
);
629 /* Read until we get an acceptable event. */
632 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
633 NUMBERP (seconds
) ? &end_time
: NULL
);
634 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
639 /* `switch-frame' events are put off until after the next ASCII
640 character. This is better than signaling an error just because
641 the last characters were typed to a separate minibuffer frame,
642 for example. Eventually, some code which can deal with
643 switch-frame events will read it and process it. */
645 && EVENT_HAS_PARAMETERS (val
)
646 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
648 delayed_switch_frame
= val
;
652 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
654 /* Convert certain symbols to their ASCII equivalents. */
657 Lisp_Object tem
, tem1
;
658 tem
= Fget (val
, Qevent_symbol_element_mask
);
661 tem1
= Fget (Fcar (tem
), Qascii_character
);
662 /* Merge this symbol's modifier bits
663 with the ASCII equivalent of its basic code. */
665 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
669 /* If we don't have a character now, deal with it appropriately. */
674 Vunread_command_events
= list1 (val
);
675 error ("Non-character input-event");
682 if (! NILP (delayed_switch_frame
))
683 unread_switch_frame
= delayed_switch_frame
;
687 #ifdef HAVE_WINDOW_SYSTEM
688 if (display_hourglass_p
)
697 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
698 doc
: /* Read a character from the command input (keyboard or macro).
699 It is returned as a number.
700 If the character has modifiers, they are resolved and reflected to the
701 character code if possible (e.g. C-SPC -> 0).
703 If the user generates an event which is not a character (i.e. a mouse
704 click or function key event), `read-char' signals an error. As an
705 exception, switch-frame events are put off until non-character events
707 If you want to read non-character events, or ignore them, call
708 `read-event' or `read-char-exclusive' instead.
710 If the optional argument PROMPT is non-nil, display that as a prompt.
711 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
712 input method is turned on in the current buffer, that input method
713 is used for reading a character.
714 If the optional argument SECONDS is non-nil, it should be a number
715 specifying the maximum number of seconds to wait for input. If no
716 input arrives in that time, return nil. SECONDS may be a
717 floating-point value. */)
718 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
723 message_with_string ("%s", prompt
, 0);
724 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
726 return (NILP (val
) ? Qnil
727 : make_number (char_resolve_modifier_mask (XINT (val
))));
730 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
731 doc
: /* Read an event object from the input stream.
732 If the optional argument PROMPT is non-nil, display that as a prompt.
733 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
734 input method is turned on in the current buffer, that input method
735 is used for reading a character.
736 If the optional argument SECONDS is non-nil, it should be a number
737 specifying the maximum number of seconds to wait for input. If no
738 input arrives in that time, return nil. SECONDS may be a
739 floating-point value. */)
740 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
743 message_with_string ("%s", prompt
, 0);
744 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
747 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
748 doc
: /* Read a character from the command input (keyboard or macro).
749 It is returned as a number. Non-character events are ignored.
750 If the character has modifiers, they are resolved and reflected to the
751 character code if possible (e.g. C-SPC -> 0).
753 If the optional argument PROMPT is non-nil, display that as a prompt.
754 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
755 input method is turned on in the current buffer, that input method
756 is used for reading a character.
757 If the optional argument SECONDS is non-nil, it should be a number
758 specifying the maximum number of seconds to wait for input. If no
759 input arrives in that time, return nil. SECONDS may be a
760 floating-point value. */)
761 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
766 message_with_string ("%s", prompt
, 0);
768 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
770 return (NILP (val
) ? Qnil
771 : make_number (char_resolve_modifier_mask (XINT (val
))));
774 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
775 doc
: /* Don't use this yourself. */)
778 register Lisp_Object val
;
780 XSETINT (val
, getc (instream
));
788 /* Return true if the lisp code read using READCHARFUN defines a non-nil
789 `lexical-binding' file variable. After returning, the stream is
790 positioned following the first line, if it is a comment or #! line,
791 otherwise nothing is read. */
794 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
807 while (ch
!= '\n' && ch
!= EOF
)
809 if (ch
== '\n') ch
= READCHAR
;
810 /* It is OK to leave the position after a #! line, since
811 that is what read1 does. */
815 /* The first line isn't a comment, just give up. */
821 /* Look for an appropriate file-variable in the first line. */
825 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
826 } beg_end_state
= NOMINAL
;
827 bool in_file_vars
= 0;
829 #define UPDATE_BEG_END_STATE(ch) \
830 if (beg_end_state == NOMINAL) \
831 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
832 else if (beg_end_state == AFTER_FIRST_DASH) \
833 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
834 else if (beg_end_state == AFTER_ASTERIX) \
837 in_file_vars = !in_file_vars; \
838 beg_end_state = NOMINAL; \
841 /* Skip until we get to the file vars, if any. */
845 UPDATE_BEG_END_STATE (ch
);
847 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
851 char var
[100], val
[100];
856 /* Read a variable name. */
857 while (ch
== ' ' || ch
== '\t')
861 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
863 if (i
< sizeof var
- 1)
865 UPDATE_BEG_END_STATE (ch
);
869 /* Stop scanning if no colon was found before end marker. */
870 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
873 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
879 /* Read a variable value. */
882 while (ch
== ' ' || ch
== '\t')
886 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
888 if (i
< sizeof val
- 1)
890 UPDATE_BEG_END_STATE (ch
);
894 /* The value was terminated by an end-marker, which remove. */
896 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
900 if (strcmp (var
, "lexical-binding") == 0)
903 rv
= (strcmp (val
, "nil") != 0);
909 while (ch
!= '\n' && ch
!= EOF
)
916 /* Value is a version number of byte compiled code if the file
917 associated with file descriptor FD is a compiled Lisp file that's
918 safe to load. Only files compiled with Emacs are safe to load.
919 Files compiled with XEmacs can lead to a crash in Fbyte_code
920 because of an incompatible change in the byte compiler. */
923 safe_to_load_version (int fd
)
929 /* Read the first few bytes from the file, and look for a line
930 specifying the byte compiler version used. */
931 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
934 /* Skip to the next newline, skipping over the initial `ELC'
935 with NUL bytes following it, but note the version. */
936 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
941 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
942 buf
+ i
, nbytes
- i
) < 0)
946 lseek (fd
, 0, SEEK_SET
);
951 /* Callback for record_unwind_protect. Restore the old load list OLD,
952 after loading a file successfully. */
955 record_load_unwind (Lisp_Object old
)
957 Vloads_in_progress
= old
;
960 /* This handler function is used via internal_condition_case_1. */
963 load_error_handler (Lisp_Object data
)
969 load_warn_old_style_backquotes (Lisp_Object file
)
971 if (!NILP (Vold_style_backquotes
))
974 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
980 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
981 doc
: /* Return the suffixes that `load' should try if a suffix is \
983 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
986 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
987 while (CONSP (suffixes
))
989 Lisp_Object exts
= Vload_file_rep_suffixes
;
990 suffix
= XCAR (suffixes
);
991 suffixes
= XCDR (suffixes
);
996 lst
= Fcons (concat2 (suffix
, ext
), lst
);
999 return Fnreverse (lst
);
1002 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1003 doc
: /* Execute a file of Lisp code named FILE.
1004 First try FILE with `.elc' appended, then try with `.el',
1005 then try FILE unmodified (the exact suffixes in the exact order are
1006 determined by `load-suffixes'). Environment variable references in
1007 FILE are replaced with their values by calling `substitute-in-file-name'.
1008 This function searches the directories in `load-path'.
1010 If optional second arg NOERROR is non-nil,
1011 report no error if FILE doesn't exist.
1012 Print messages at start and end of loading unless
1013 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1015 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1016 suffixes `.elc' or `.el' to the specified name FILE.
1017 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1018 the suffix `.elc' or `.el'; don't accept just FILE unless
1019 it ends in one of those suffixes or includes a directory name.
1021 If NOSUFFIX is nil, then if a file could not be found, try looking for
1022 a different representation of the file by adding non-empty suffixes to
1023 its name, before trying another file. Emacs uses this feature to find
1024 compressed versions of files when Auto Compression mode is enabled.
1025 If NOSUFFIX is non-nil, disable this feature.
1027 The suffixes that this function tries out, when NOSUFFIX is nil, are
1028 given by the return value of `get-load-suffixes' and the values listed
1029 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1030 return value of `get-load-suffixes' is used, i.e. the file name is
1031 required to have a non-empty suffix.
1033 When searching suffixes, this function normally stops at the first
1034 one that exists. If the option `load-prefer-newer' is non-nil,
1035 however, it tries all suffixes, and uses whichever file is the newest.
1037 Loading a file records its definitions, and its `provide' and
1038 `require' calls, in an element of `load-history' whose
1039 car is the file name loaded. See `load-history'.
1041 While the file is in the process of being loaded, the variable
1042 `load-in-progress' is non-nil and the variable `load-file-name'
1043 is bound to the file's name.
1045 Return t if the file exists and loads successfully. */)
1046 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1047 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1052 ptrdiff_t count
= SPECPDL_INDEX ();
1053 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1054 Lisp_Object found
, efound
, hist_file_name
;
1055 /* True means we printed the ".el is newer" message. */
1057 /* True means we are loading a compiled file. */
1059 Lisp_Object handler
;
1061 const char *fmode
= "r";
1068 CHECK_STRING (file
);
1070 /* If file name is magic, call the handler. */
1071 /* This shouldn't be necessary any more now that `openp' handles it right.
1072 handler = Ffind_file_name_handler (file, Qload);
1073 if (!NILP (handler))
1074 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1076 /* Do this after the handler to avoid
1077 the need to gcpro noerror, nomessage and nosuffix.
1078 (Below here, we care only whether they are nil or not.)
1079 The presence of this call is the result of a historical accident:
1080 it used to be in every file-operation and when it got removed
1081 everywhere, it accidentally stayed here. Since then, enough people
1082 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1083 that it seemed risky to remove. */
1084 if (! NILP (noerror
))
1086 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1087 Qt
, load_error_handler
);
1092 file
= Fsubstitute_in_file_name (file
);
1094 /* Avoid weird lossage with null string as arg,
1095 since it would try to load a directory as a Lisp file. */
1096 if (SCHARS (file
) == 0)
1103 Lisp_Object suffixes
;
1105 GCPRO2 (file
, found
);
1107 if (! NILP (must_suffix
))
1109 /* Don't insist on adding a suffix if FILE already ends with one. */
1110 ptrdiff_t size
= SBYTES (file
);
1112 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1115 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1117 /* Don't insist on adding a suffix
1118 if the argument includes a directory name. */
1119 else if (! NILP (Ffile_name_directory (file
)))
1123 if (!NILP (nosuffix
))
1127 suffixes
= Fget_load_suffixes ();
1128 if (NILP (must_suffix
))
1132 arg
[1] = Vload_file_rep_suffixes
;
1133 suffixes
= Fappend (2, arg
);
1137 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1144 report_file_error ("Cannot open load file", file
);
1148 /* Tell startup.el whether or not we found the user's init file. */
1149 if (EQ (Qt
, Vuser_init_file
))
1150 Vuser_init_file
= found
;
1152 /* If FD is -2, that means openp found a magic file. */
1155 if (NILP (Fequal (found
, file
)))
1156 /* If FOUND is a different file name from FILE,
1157 find its handler even if we have already inhibited
1158 the `load' operation on FILE. */
1159 handler
= Ffind_file_name_handler (found
, Qt
);
1161 handler
= Ffind_file_name_handler (found
, Qload
);
1162 if (! NILP (handler
))
1163 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1165 /* Tramp has to deal with semi-broken packages that prepend
1166 drive letters to remote files. For that reason, Tramp
1167 catches file operations that test for file existence, which
1168 makes openp think X:/foo.elc files are remote. However,
1169 Tramp does not catch `load' operations for such files, so we
1170 end up with a nil as the `load' handler above. If we would
1171 continue with fd = -2, we will behave wrongly, and in
1172 particular try reading a .elc file in the "rt" mode instead
1173 of "rb". See bug #9311 for the results. To work around
1174 this, we try to open the file locally, and go with that if it
1176 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1184 /* Pacify older GCC with --enable-gcc-warnings. */
1185 IF_LINT (fd_index
= 0);
1189 fd_index
= SPECPDL_INDEX ();
1190 record_unwind_protect_int (close_file_unwind
, fd
);
1193 /* Check if we're stuck in a recursive load cycle.
1195 2000-09-21: It's not possible to just check for the file loaded
1196 being a member of Vloads_in_progress. This fails because of the
1197 way the byte compiler currently works; `provide's are not
1198 evaluated, see font-lock.el/jit-lock.el as an example. This
1199 leads to a certain amount of ``normal'' recursion.
1201 Also, just loading a file recursively is not always an error in
1202 the general case; the second load may do something different. */
1206 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1207 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1208 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1209 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1210 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1213 /* All loads are by default dynamic, unless the file itself specifies
1214 otherwise using a file-variable in the first line. This is bound here
1215 so that it takes effect whether or not we use
1216 Vload_source_file_function. */
1217 specbind (Qlexical_binding
, Qnil
);
1219 /* Get the name for load-history. */
1220 hist_file_name
= (! NILP (Vpurify_flag
)
1221 ? concat2 (Ffile_name_directory (file
),
1222 Ffile_name_nondirectory (found
))
1227 /* Check for the presence of old-style quotes and warn about them. */
1228 specbind (Qold_style_backquotes
, Qnil
);
1229 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1231 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1232 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1233 /* Load .elc files directly, but not when they are
1234 remote and have no handler! */
1241 GCPRO3 (file
, found
, hist_file_name
);
1244 && ! (version
= safe_to_load_version (fd
)))
1247 if (!load_dangerous_libraries
)
1248 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1249 else if (!NILP (nomessage
) && !force_load_messages
)
1250 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1255 efound
= ENCODE_FILE (found
);
1261 /* openp already checked for newness, no point doing it again.
1262 FIXME would be nice to get a message when openp
1263 ignores suffix order due to load_prefer_newer. */
1264 if (!load_prefer_newer
)
1266 result
= stat (SSDATA (efound
), &s1
);
1269 SSET (efound
, SBYTES (efound
) - 1, 0);
1270 result
= stat (SSDATA (efound
), &s2
);
1271 SSET (efound
, SBYTES (efound
) - 1, 'c');
1275 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1277 /* Make the progress messages mention that source is newer. */
1280 /* If we won't print another message, mention this anyway. */
1281 if (!NILP (nomessage
) && !force_load_messages
)
1283 Lisp_Object msg_file
;
1284 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1285 message_with_string ("Source file `%s' newer than byte-compiled file",
1289 } /* !load_prefer_newer */
1295 /* We are loading a source file (*.el). */
1296 if (!NILP (Vload_source_file_function
))
1303 clear_unwind_protect (fd_index
);
1305 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1306 NILP (noerror
) ? Qnil
: Qt
,
1307 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1308 return unbind_to (count
, val
);
1312 GCPRO3 (file
, found
, hist_file_name
);
1316 /* We somehow got here with fd == -2, meaning the file is deemed
1317 to be remote. Don't even try to reopen the file locally;
1318 just force a failure. */
1326 clear_unwind_protect (fd_index
);
1327 efound
= ENCODE_FILE (found
);
1328 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1330 stream
= fdopen (fd
, fmode
);
1334 report_file_error ("Opening stdio stream", file
);
1335 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1337 if (! NILP (Vpurify_flag
))
1338 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1340 if (NILP (nomessage
) || force_load_messages
)
1343 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1346 message_with_string ("Loading %s (source)...", file
, 1);
1348 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1350 else /* The typical case; compiled file newer than source file. */
1351 message_with_string ("Loading %s...", file
, 1);
1354 specbind (Qload_file_name
, found
);
1355 specbind (Qinhibit_file_name_operation
, Qnil
);
1356 specbind (Qload_in_progress
, Qt
);
1359 if (lisp_file_lexically_bound_p (Qget_file_char
))
1360 Fset (Qlexical_binding
, Qt
);
1362 if (! version
|| version
>= 22)
1363 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1364 0, Qnil
, Qnil
, Qnil
, Qnil
);
1367 /* We can't handle a file which was compiled with
1368 byte-compile-dynamic by older version of Emacs. */
1369 specbind (Qload_force_doc_strings
, Qt
);
1370 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1371 0, Qnil
, Qnil
, Qnil
, Qnil
);
1373 unbind_to (count
, Qnil
);
1375 /* Run any eval-after-load forms for this file. */
1376 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1377 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1381 xfree (saved_doc_string
);
1382 saved_doc_string
= 0;
1383 saved_doc_string_size
= 0;
1385 xfree (prev_saved_doc_string
);
1386 prev_saved_doc_string
= 0;
1387 prev_saved_doc_string_size
= 0;
1389 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1392 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1395 message_with_string ("Loading %s (source)...done", file
, 1);
1397 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1399 else /* The typical case; compiled file newer than source file. */
1400 message_with_string ("Loading %s...done", file
, 1);
1407 complete_filename_p (Lisp_Object pathname
)
1409 const unsigned char *s
= SDATA (pathname
);
1410 return (IS_DIRECTORY_SEP (s
[0])
1411 || (SCHARS (pathname
) > 2
1412 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1415 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1416 doc
: /* Search for FILENAME through PATH.
1417 Returns the file's name in absolute form, or nil if not found.
1418 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1419 file name when searching.
1420 If non-nil, PREDICATE is used instead of `file-readable-p'.
1421 PREDICATE can also be an integer to pass to the faccessat(2) function,
1422 in which case file-name-handlers are ignored.
1423 This function will normally skip directories, so if you want it to find
1424 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1425 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1428 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1429 if (NILP (predicate
) && fd
>= 0)
1434 static Lisp_Object Qdir_ok
;
1436 /* Search for a file whose name is STR, looking in directories
1437 in the Lisp list PATH, and trying suffixes from SUFFIX.
1438 On success, return a file descriptor (or 1 or -2 as described below).
1439 On failure, return -1 and set errno.
1441 SUFFIXES is a list of strings containing possible suffixes.
1442 The empty suffix is automatically added if the list is empty.
1444 PREDICATE non-nil means don't open the files,
1445 just look for one that satisfies the predicate. In this case,
1446 return 1 on success. The predicate can be a lisp function or
1447 an integer to pass to `access' (in which case file-name-handlers
1450 If STOREPTR is nonzero, it points to a slot where the name of
1451 the file actually found should be stored as a Lisp string.
1452 nil is stored there on failure.
1454 If the file we find is remote, return -2
1455 but store the found remote file name in *STOREPTR.
1457 If NEWER is true, try all SUFFIXes and return the result for the
1458 newest file that exists. Does not apply to remote files,
1459 or if PREDICATE is specified. */
1462 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1463 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1465 ptrdiff_t fn_size
= 100;
1469 ptrdiff_t want_length
;
1470 Lisp_Object filename
;
1471 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
, gcpro7
;
1472 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1473 ptrdiff_t max_suffix_len
= 0;
1474 int last_errno
= ENOENT
;
1477 /* The last-modified time of the newest matching file found.
1478 Initialize it to something less than all valid timestamps. */
1479 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1483 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1485 CHECK_STRING_CAR (tail
);
1486 max_suffix_len
= max (max_suffix_len
,
1487 SBYTES (XCAR (tail
)));
1490 string
= filename
= encoded_fn
= save_string
= Qnil
;
1491 GCPRO7 (str
, string
, save_string
, filename
, path
, suffixes
, encoded_fn
);
1496 absolute
= complete_filename_p (str
);
1498 for (; CONSP (path
); path
= XCDR (path
))
1500 filename
= Fexpand_file_name (str
, XCAR (path
));
1501 if (!complete_filename_p (filename
))
1502 /* If there are non-absolute elts in PATH (eg "."). */
1503 /* Of course, this could conceivably lose if luser sets
1504 default-directory to be something non-absolute... */
1506 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1507 if (!complete_filename_p (filename
))
1508 /* Give up on this path element! */
1512 /* Calculate maximum length of any filename made from
1513 this path element/specified file name and any possible suffix. */
1514 want_length
= max_suffix_len
+ SBYTES (filename
);
1515 if (fn_size
<= want_length
)
1516 fn
= alloca (fn_size
= 100 + want_length
);
1518 /* Loop over suffixes. */
1519 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1520 CONSP (tail
); tail
= XCDR (tail
))
1522 Lisp_Object suffix
= XCAR (tail
);
1523 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1524 Lisp_Object handler
;
1526 /* Concatenate path element/specified name with the suffix.
1527 If the directory starts with /:, remove that. */
1528 int prefixlen
= ((SCHARS (filename
) > 2
1529 && SREF (filename
, 0) == '/'
1530 && SREF (filename
, 1) == ':')
1532 fnlen
= SBYTES (filename
) - prefixlen
;
1533 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1534 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1536 /* Check that the file exists and is not a directory. */
1537 /* We used to only check for handlers on non-absolute file names:
1541 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1542 It's not clear why that was the case and it breaks things like
1543 (load "/bar.el") where the file is actually "/bar.el.gz". */
1544 /* make_string has its own ideas on when to return a unibyte
1545 string and when a multibyte string, but we know better.
1546 We must have a unibyte string when dumping, since
1547 file-name encoding is shaky at best at that time, and in
1548 particular default-file-name-coding-system is reset
1549 several times during loadup. We therefore don't want to
1550 encode the file before passing it to file I/O library
1552 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1553 string
= make_unibyte_string (fn
, fnlen
);
1555 string
= make_string (fn
, fnlen
);
1556 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1557 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1560 if (NILP (predicate
))
1561 exists
= !NILP (Ffile_readable_p (string
));
1564 Lisp_Object tmp
= call1 (predicate
, string
);
1567 else if (EQ (tmp
, Qdir_ok
)
1568 || NILP (Ffile_directory_p (string
)))
1573 last_errno
= EISDIR
;
1579 /* We succeeded; return this descriptor and filename. */
1592 encoded_fn
= ENCODE_FILE (string
);
1593 pfn
= SSDATA (encoded_fn
);
1595 /* Check that we can access or open it. */
1596 if (NATNUMP (predicate
))
1599 if (INT_MAX
< XFASTINT (predicate
))
1600 last_errno
= EINVAL
;
1601 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1605 if (file_directory_p (pfn
))
1606 last_errno
= EISDIR
;
1613 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1616 if (errno
!= ENOENT
)
1621 int err
= (fstat (fd
, &st
) != 0 ? errno
1622 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1634 if (newer
&& !NATNUMP (predicate
))
1636 struct timespec mtime
= get_stat_mtime (&st
);
1638 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1643 emacs_close (save_fd
);
1646 save_string
= string
;
1651 /* We succeeded; return this descriptor and filename. */
1659 /* No more suffixes. Return the newest. */
1660 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1663 *storeptr
= save_string
;
1679 /* Merge the list we've accumulated of globals from the current input source
1680 into the load_history variable. The details depend on whether
1681 the source has an associated file name or not.
1683 FILENAME is the file name that we are loading from.
1685 ENTIRE is true if loading that entire file, false if evaluating
1689 build_load_history (Lisp_Object filename
, bool entire
)
1691 Lisp_Object tail
, prev
, newelt
;
1692 Lisp_Object tem
, tem2
;
1695 tail
= Vload_history
;
1698 while (CONSP (tail
))
1702 /* Find the feature's previous assoc list... */
1703 if (!NILP (Fequal (filename
, Fcar (tem
))))
1707 /* If we're loading the entire file, remove old data. */
1711 Vload_history
= XCDR (tail
);
1713 Fsetcdr (prev
, XCDR (tail
));
1716 /* Otherwise, cons on new symbols that are not already members. */
1719 tem2
= Vcurrent_load_list
;
1721 while (CONSP (tem2
))
1723 newelt
= XCAR (tem2
);
1725 if (NILP (Fmember (newelt
, tem
)))
1726 Fsetcar (tail
, Fcons (XCAR (tem
),
1727 Fcons (newelt
, XCDR (tem
))));
1740 /* If we're loading an entire file, cons the new assoc onto the
1741 front of load-history, the most-recently-loaded position. Also
1742 do this if we didn't find an existing member for the file. */
1743 if (entire
|| !foundit
)
1744 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1749 readevalloop_1 (int old
)
1751 load_convert_to_unibyte
= old
;
1754 /* Signal an `end-of-file' error, if possible with file name
1757 static _Noreturn
void
1758 end_of_file_error (void)
1760 if (STRINGP (Vload_file_name
))
1761 xsignal1 (Qend_of_file
, Vload_file_name
);
1763 xsignal0 (Qend_of_file
);
1767 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1769 /* If we macroexpand the toplevel form non-recursively and it ends
1770 up being a `progn' (or if it was a progn to start), treat each
1771 form in the progn as a top-level form. This way, if one form in
1772 the progn defines a macro, that macro is in effect when we expand
1773 the remaining forms. See similar code in bytecomp.el. */
1774 val
= call2 (macroexpand
, val
, Qnil
);
1775 if (EQ (CAR_SAFE (val
), Qprogn
))
1777 Lisp_Object subforms
= XCDR (val
);
1779 for (; CONSP (subforms
); subforms
= XCDR (subforms
))
1780 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1784 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1789 /* UNIBYTE specifies how to set load_convert_to_unibyte
1790 for this invocation.
1791 READFUN, if non-nil, is used instead of `read'.
1793 START, END specify region to read in current buffer (from eval-region).
1794 If the input is not from a buffer, they must be nil. */
1797 readevalloop (Lisp_Object readcharfun
,
1799 Lisp_Object sourcename
,
1801 Lisp_Object unibyte
, Lisp_Object readfun
,
1802 Lisp_Object start
, Lisp_Object end
)
1805 register Lisp_Object val
;
1806 ptrdiff_t count
= SPECPDL_INDEX ();
1807 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1808 struct buffer
*b
= 0;
1809 bool continue_reading_p
;
1810 Lisp_Object lex_bound
;
1811 /* True if reading an entire buffer. */
1812 bool whole_buffer
= 0;
1813 /* True on the first time around. */
1814 bool first_sexp
= 1;
1815 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1817 if (NILP (Ffboundp (macroexpand
))
1818 /* Don't macroexpand in .elc files, since it should have been done
1819 already. We actually don't know whether we're in a .elc file or not,
1820 so we use circumstantial evidence: .el files normally go through
1821 Vload_source_file_function -> load-with-code-conversion
1823 || EQ (readcharfun
, Qget_file_char
)
1824 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1827 if (MARKERP (readcharfun
))
1830 start
= readcharfun
;
1833 if (BUFFERP (readcharfun
))
1834 b
= XBUFFER (readcharfun
);
1835 else if (MARKERP (readcharfun
))
1836 b
= XMARKER (readcharfun
)->buffer
;
1838 /* We assume START is nil when input is not from a buffer. */
1839 if (! NILP (start
) && !b
)
1842 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1843 specbind (Qcurrent_load_list
, Qnil
);
1844 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1845 load_convert_to_unibyte
= !NILP (unibyte
);
1847 /* If lexical binding is active (either because it was specified in
1848 the file's header, or via a buffer-local variable), create an empty
1849 lexical environment, otherwise, turn off lexical binding. */
1850 lex_bound
= find_symbol_value (Qlexical_binding
);
1851 specbind (Qinternal_interpreter_environment
,
1852 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1853 ? Qnil
: list1 (Qt
)));
1855 GCPRO4 (sourcename
, readfun
, start
, end
);
1857 /* Try to ensure sourcename is a truename, except whilst preloading. */
1858 if (NILP (Vpurify_flag
)
1859 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1860 && !NILP (Ffboundp (Qfile_truename
)))
1861 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1863 LOADHIST_ATTACH (sourcename
);
1865 continue_reading_p
= 1;
1866 while (continue_reading_p
)
1868 ptrdiff_t count1
= SPECPDL_INDEX ();
1870 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1871 error ("Reading from killed buffer");
1875 /* Switch to the buffer we are reading from. */
1876 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1877 set_buffer_internal (b
);
1879 /* Save point in it. */
1880 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1881 /* Save ZV in it. */
1882 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1883 /* Those get unbound after we read one expression. */
1885 /* Set point and ZV around stuff to be read. */
1888 Fnarrow_to_region (make_number (BEGV
), end
);
1890 /* Just for cleanliness, convert END to a marker
1891 if it is an integer. */
1893 end
= Fpoint_max_marker ();
1896 /* On the first cycle, we can easily test here
1897 whether we are reading the whole buffer. */
1898 if (b
&& first_sexp
)
1899 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1906 while ((c
= READCHAR
) != '\n' && c
!= -1);
1911 unbind_to (count1
, Qnil
);
1915 /* Ignore whitespace here, so we can detect eof. */
1916 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1917 || c
== 0xa0) /* NBSP */
1920 if (!NILP (Vpurify_flag
) && c
== '(')
1922 val
= read_list (0, readcharfun
);
1927 read_objects
= Qnil
;
1928 if (!NILP (readfun
))
1930 val
= call1 (readfun
, readcharfun
);
1932 /* If READCHARFUN has set point to ZV, we should
1933 stop reading, even if the form read sets point
1934 to a different value when evaluated. */
1935 if (BUFFERP (readcharfun
))
1937 struct buffer
*buf
= XBUFFER (readcharfun
);
1938 if (BUF_PT (buf
) == BUF_ZV (buf
))
1939 continue_reading_p
= 0;
1942 else if (! NILP (Vload_read_function
))
1943 val
= call1 (Vload_read_function
, readcharfun
);
1945 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1948 if (!NILP (start
) && continue_reading_p
)
1949 start
= Fpoint_marker ();
1951 /* Restore saved point and BEGV. */
1952 unbind_to (count1
, Qnil
);
1954 /* Now eval what we just read. */
1955 if (!NILP (macroexpand
))
1956 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1958 val
= eval_sub (val
);
1962 Vvalues
= Fcons (val
, Vvalues
);
1963 if (EQ (Vstandard_output
, Qt
))
1972 build_load_history (sourcename
,
1973 stream
|| whole_buffer
);
1977 unbind_to (count
, Qnil
);
1980 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1981 doc
: /* Execute the current buffer as Lisp code.
1982 When called from a Lisp program (i.e., not interactively), this
1983 function accepts up to five optional arguments:
1984 BUFFER is the buffer to evaluate (nil means use current buffer).
1985 PRINTFLAG controls printing of output:
1986 A value of nil means discard it; anything else is stream for print.
1987 FILENAME specifies the file name to use for `load-history'.
1988 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1990 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1991 functions should work normally even if PRINTFLAG is nil.
1993 This function preserves the position of point. */)
1994 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1996 ptrdiff_t count
= SPECPDL_INDEX ();
1997 Lisp_Object tem
, buf
;
2000 buf
= Fcurrent_buffer ();
2002 buf
= Fget_buffer (buffer
);
2004 error ("No such buffer");
2006 if (NILP (printflag
) && NILP (do_allow_print
))
2011 if (NILP (filename
))
2012 filename
= BVAR (XBUFFER (buf
), filename
);
2014 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
2015 specbind (Qstandard_output
, tem
);
2016 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
2017 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2018 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
2019 readevalloop (buf
, 0, filename
,
2020 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
2021 unbind_to (count
, Qnil
);
2026 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2027 doc
: /* Execute the region as Lisp code.
2028 When called from programs, expects two arguments,
2029 giving starting and ending indices in the current buffer
2030 of the text to be executed.
2031 Programs can pass third argument PRINTFLAG which controls output:
2032 A value of nil means discard it; anything else is stream for printing it.
2033 Also the fourth argument READ-FUNCTION, if non-nil, is used
2034 instead of `read' to read each expression. It gets one argument
2035 which is the input stream for reading characters.
2037 This function does not move point. */)
2038 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2040 /* FIXME: Do the eval-sexp-add-defvars dance! */
2041 ptrdiff_t count
= SPECPDL_INDEX ();
2042 Lisp_Object tem
, cbuf
;
2044 cbuf
= Fcurrent_buffer ();
2046 if (NILP (printflag
))
2050 specbind (Qstandard_output
, tem
);
2051 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2053 /* `readevalloop' calls functions which check the type of start and end. */
2054 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2055 !NILP (printflag
), Qnil
, read_function
,
2058 return unbind_to (count
, Qnil
);
2062 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2063 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2064 If STREAM is nil, use the value of `standard-input' (which see).
2065 STREAM or the value of `standard-input' may be:
2066 a buffer (read from point and advance it)
2067 a marker (read from where it points and advance it)
2068 a function (call it with no arguments for each character,
2069 call it with a char as argument to push a char back)
2070 a string (takes text from string, starting at the beginning)
2071 t (read text line using minibuffer and use it, or read from
2072 standard input in batch mode). */)
2073 (Lisp_Object stream
)
2076 stream
= Vstandard_input
;
2077 if (EQ (stream
, Qt
))
2078 stream
= Qread_char
;
2079 if (EQ (stream
, Qread_char
))
2080 /* FIXME: ?! When is this used !? */
2081 return call1 (intern ("read-minibuffer"),
2082 build_string ("Lisp expression: "));
2084 return read_internal_start (stream
, Qnil
, Qnil
);
2087 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2088 doc
: /* Read one Lisp expression which is represented as text by STRING.
2089 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2090 FINAL-STRING-INDEX is an integer giving the position of the next
2091 remaining character in STRING.
2092 START and END optionally delimit a substring of STRING from which to read;
2093 they default to 0 and (length STRING) respectively. */)
2094 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2097 CHECK_STRING (string
);
2098 /* `read_internal_start' sets `read_from_string_index'. */
2099 ret
= read_internal_start (string
, start
, end
);
2100 return Fcons (ret
, make_number (read_from_string_index
));
2103 /* Function to set up the global context we need in toplevel read
2106 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2107 /* `start', `end' only used when stream is a string. */
2112 new_backquote_flag
= 0;
2113 read_objects
= Qnil
;
2114 if (EQ (Vread_with_symbol_positions
, Qt
)
2115 || EQ (Vread_with_symbol_positions
, stream
))
2116 Vread_symbol_positions_list
= Qnil
;
2118 if (STRINGP (stream
)
2119 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2121 ptrdiff_t startval
, endval
;
2124 if (STRINGP (stream
))
2127 string
= XCAR (stream
);
2130 endval
= SCHARS (string
);
2134 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2135 args_out_of_range (string
, end
);
2136 endval
= XINT (end
);
2143 CHECK_NUMBER (start
);
2144 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2145 args_out_of_range (string
, start
);
2146 startval
= XINT (start
);
2148 read_from_string_index
= startval
;
2149 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2150 read_from_string_limit
= endval
;
2153 retval
= read0 (stream
);
2154 if (EQ (Vread_with_symbol_positions
, Qt
)
2155 || EQ (Vread_with_symbol_positions
, stream
))
2156 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2161 /* Signal Qinvalid_read_syntax error.
2162 S is error string of length N (if > 0) */
2164 static _Noreturn
void
2165 invalid_syntax (const char *s
)
2167 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2171 /* Use this for recursive reads, in contexts where internal tokens
2175 read0 (Lisp_Object readcharfun
)
2177 register Lisp_Object val
;
2180 val
= read1 (readcharfun
, &c
, 0);
2184 xsignal1 (Qinvalid_read_syntax
,
2185 Fmake_string (make_number (1), make_number (c
)));
2188 static ptrdiff_t read_buffer_size
;
2189 static char *read_buffer
;
2191 /* Read a \-escape sequence, assuming we already read the `\'.
2192 If the escape sequence forces unibyte, return eight-bit char. */
2195 read_escape (Lisp_Object readcharfun
, bool stringp
)
2198 /* \u allows up to four hex digits, \U up to eight. Default to the
2199 behavior for \u, and change this value in the case that \U is seen. */
2200 int unicode_hex_count
= 4;
2205 end_of_file_error ();
2235 error ("Invalid escape character syntax");
2238 c
= read_escape (readcharfun
, 0);
2239 return c
| meta_modifier
;
2244 error ("Invalid escape character syntax");
2247 c
= read_escape (readcharfun
, 0);
2248 return c
| shift_modifier
;
2253 error ("Invalid escape character syntax");
2256 c
= read_escape (readcharfun
, 0);
2257 return c
| hyper_modifier
;
2262 error ("Invalid escape character syntax");
2265 c
= read_escape (readcharfun
, 0);
2266 return c
| alt_modifier
;
2270 if (stringp
|| c
!= '-')
2277 c
= read_escape (readcharfun
, 0);
2278 return c
| super_modifier
;
2283 error ("Invalid escape character syntax");
2287 c
= read_escape (readcharfun
, 0);
2288 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2289 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2290 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2291 return c
| ctrl_modifier
;
2292 /* ASCII control chars are made from letters (both cases),
2293 as well as the non-letters within 0100...0137. */
2294 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2295 return (c
& (037 | ~0177));
2296 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2297 return (c
& (037 | ~0177));
2299 return c
| ctrl_modifier
;
2309 /* An octal escape, as in ANSI C. */
2311 register int i
= c
- '0';
2312 register int count
= 0;
2315 if ((c
= READCHAR
) >= '0' && c
<= '7')
2327 if (i
>= 0x80 && i
< 0x100)
2328 i
= BYTE8_TO_CHAR (i
);
2333 /* A hex escape, as in ANSI C. */
2340 if (c
>= '0' && c
<= '9')
2345 else if ((c
>= 'a' && c
<= 'f')
2346 || (c
>= 'A' && c
<= 'F'))
2349 if (c
>= 'a' && c
<= 'f')
2359 /* Allow hex escapes as large as ?\xfffffff, because some
2360 packages use them to denote characters with modifiers. */
2361 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2362 error ("Hex character out of range: \\x%x...", i
);
2366 if (count
< 3 && i
>= 0x80)
2367 return BYTE8_TO_CHAR (i
);
2372 /* Post-Unicode-2.0: Up to eight hex chars. */
2373 unicode_hex_count
= 8;
2376 /* A Unicode escape. We only permit them in strings and characters,
2377 not arbitrarily in the source code, as in some other languages. */
2382 while (++count
<= unicode_hex_count
)
2385 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2387 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2388 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2389 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2391 error ("Non-hex digit used for Unicode escape");
2394 error ("Non-Unicode character: 0x%x", i
);
2403 /* Return the digit that CHARACTER stands for in the given BASE.
2404 Return -1 if CHARACTER is out of range for BASE,
2405 and -2 if CHARACTER is not valid for any supported BASE. */
2407 digit_to_number (int character
, int base
)
2411 if ('0' <= character
&& character
<= '9')
2412 digit
= character
- '0';
2413 else if ('a' <= character
&& character
<= 'z')
2414 digit
= character
- 'a' + 10;
2415 else if ('A' <= character
&& character
<= 'Z')
2416 digit
= character
- 'A' + 10;
2420 return digit
< base
? digit
: -1;
2423 /* Read an integer in radix RADIX using READCHARFUN to read
2424 characters. RADIX must be in the interval [2..36]; if it isn't, a
2425 read error is signaled . Value is the integer read. Signals an
2426 error if encountering invalid read syntax or if RADIX is out of
2430 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2432 /* Room for sign, leading 0, other digits, trailing null byte.
2433 Also, room for invalid syntax diagnostic. */
2434 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2435 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2437 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2439 if (radix
< 2 || radix
> 36)
2447 if (c
== '-' || c
== '+')
2458 /* Ignore redundant leading zeros, so the buffer doesn't
2459 fill up with them. */
2465 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2472 if (p
< buf
+ sizeof buf
- 1)
2486 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2487 invalid_syntax (buf
);
2490 return string_to_number (buf
, radix
, 0);
2494 /* If the next token is ')' or ']' or '.', we store that character
2495 in *PCH and the return value is not interesting. Else, we store
2496 zero in *PCH and we read and return one lisp object.
2498 FIRST_IN_LIST is true if this is the first element of a list. */
2501 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2504 bool uninterned_symbol
= 0;
2511 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2513 end_of_file_error ();
2518 return read_list (0, readcharfun
);
2521 return read_vector (readcharfun
, 0);
2537 /* Accept extended format for hashtables (extensible to
2539 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2540 Lisp_Object tmp
= read_list (0, readcharfun
);
2541 Lisp_Object head
= CAR_SAFE (tmp
);
2542 Lisp_Object data
= Qnil
;
2543 Lisp_Object val
= Qnil
;
2544 /* The size is 2 * number of allowed keywords to
2546 Lisp_Object params
[10];
2548 Lisp_Object key
= Qnil
;
2549 int param_count
= 0;
2551 if (!EQ (head
, Qhash_table
))
2552 error ("Invalid extended read marker at head of #s list "
2553 "(only hash-table allowed)");
2555 tmp
= CDR_SAFE (tmp
);
2557 /* This is repetitive but fast and simple. */
2558 params
[param_count
] = QCsize
;
2559 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2560 if (!NILP (params
[param_count
+ 1]))
2563 params
[param_count
] = QCtest
;
2564 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2565 if (!NILP (params
[param_count
+ 1]))
2568 params
[param_count
] = QCweakness
;
2569 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2570 if (!NILP (params
[param_count
+ 1]))
2573 params
[param_count
] = QCrehash_size
;
2574 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2575 if (!NILP (params
[param_count
+ 1]))
2578 params
[param_count
] = QCrehash_threshold
;
2579 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2580 if (!NILP (params
[param_count
+ 1]))
2583 /* This is the hashtable data. */
2584 data
= Fplist_get (tmp
, Qdata
);
2586 /* Now use params to make a new hashtable and fill it. */
2587 ht
= Fmake_hash_table (param_count
, params
);
2589 while (CONSP (data
))
2594 error ("Odd number of elements in hashtable data");
2597 Fputhash (key
, val
, ht
);
2603 invalid_syntax ("#");
2611 tmp
= read_vector (readcharfun
, 0);
2612 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2613 error ("Invalid size char-table");
2614 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2626 tmp
= read_vector (readcharfun
, 0);
2629 error ("Invalid size char-table");
2630 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2631 error ("Invalid depth in char-table");
2632 depth
= XINT (AREF (tmp
, 0));
2633 if (chartab_size
[depth
] != size
- 2)
2634 error ("Invalid size char-table");
2635 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2638 invalid_syntax ("#^^");
2640 invalid_syntax ("#^");
2645 length
= read1 (readcharfun
, pch
, first_in_list
);
2649 Lisp_Object tmp
, val
;
2650 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2651 unsigned char *data
;
2654 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2655 if (STRING_MULTIBYTE (tmp
)
2656 || (size_in_chars
!= SCHARS (tmp
)
2657 /* We used to print 1 char too many
2658 when the number of bits was a multiple of 8.
2659 Accept such input in case it came from an old
2661 && ! (XFASTINT (length
)
2662 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2663 invalid_syntax ("#&...");
2665 val
= make_uninit_bool_vector (XFASTINT (length
));
2666 data
= bool_vector_uchar_data (val
);
2667 memcpy (data
, SDATA (tmp
), size_in_chars
);
2668 /* Clear the extraneous bits in the last byte. */
2669 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2670 data
[size_in_chars
- 1]
2671 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2674 invalid_syntax ("#&...");
2678 /* Accept compiled functions at read-time so that we don't have to
2679 build them using function calls. */
2681 struct Lisp_Vector
*vec
;
2682 tmp
= read_vector (readcharfun
, 1);
2683 vec
= XVECTOR (tmp
);
2684 if (vec
->header
.size
== 0)
2685 invalid_syntax ("Empty byte-code object");
2686 make_byte_code (vec
);
2692 struct gcpro gcpro1
;
2695 /* Read the string itself. */
2696 tmp
= read1 (readcharfun
, &ch
, 0);
2697 if (ch
!= 0 || !STRINGP (tmp
))
2698 invalid_syntax ("#");
2700 /* Read the intervals and their properties. */
2703 Lisp_Object beg
, end
, plist
;
2705 beg
= read1 (readcharfun
, &ch
, 0);
2710 end
= read1 (readcharfun
, &ch
, 0);
2712 plist
= read1 (readcharfun
, &ch
, 0);
2714 invalid_syntax ("Invalid string property list");
2715 Fset_text_properties (beg
, end
, plist
, tmp
);
2721 /* #@NUMBER is used to skip NUMBER following bytes.
2722 That's used in .elc files to skip over doc strings
2723 and function definitions. */
2726 enum { extra
= 100 };
2727 ptrdiff_t i
, nskip
= 0, digits
= 0;
2729 /* Read a decimal integer. */
2730 while ((c
= READCHAR
) >= 0
2731 && c
>= '0' && c
<= '9')
2733 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2738 if (digits
== 2 && nskip
== 0)
2739 { /* We've just seen #@00, which means "skip to end". */
2740 skip_dyn_eof (readcharfun
);
2745 /* We can't use UNREAD here, because in the code below we side-step
2746 READCHAR. Instead, assume the first char after #@NNN occupies
2747 a single byte, which is the case normally since it's just
2753 if (load_force_doc_strings
2754 && (FROM_FILE_P (readcharfun
)))
2756 /* If we are supposed to force doc strings into core right now,
2757 record the last string that we skipped,
2758 and record where in the file it comes from. */
2760 /* But first exchange saved_doc_string
2761 with prev_saved_doc_string, so we save two strings. */
2763 char *temp
= saved_doc_string
;
2764 ptrdiff_t temp_size
= saved_doc_string_size
;
2765 file_offset temp_pos
= saved_doc_string_position
;
2766 ptrdiff_t temp_len
= saved_doc_string_length
;
2768 saved_doc_string
= prev_saved_doc_string
;
2769 saved_doc_string_size
= prev_saved_doc_string_size
;
2770 saved_doc_string_position
= prev_saved_doc_string_position
;
2771 saved_doc_string_length
= prev_saved_doc_string_length
;
2773 prev_saved_doc_string
= temp
;
2774 prev_saved_doc_string_size
= temp_size
;
2775 prev_saved_doc_string_position
= temp_pos
;
2776 prev_saved_doc_string_length
= temp_len
;
2779 if (saved_doc_string_size
== 0)
2781 saved_doc_string
= xmalloc (nskip
+ extra
);
2782 saved_doc_string_size
= nskip
+ extra
;
2784 if (nskip
> saved_doc_string_size
)
2786 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2787 saved_doc_string_size
= nskip
+ extra
;
2790 saved_doc_string_position
= file_tell (instream
);
2792 /* Copy that many characters into saved_doc_string. */
2794 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2795 saved_doc_string
[i
] = c
= getc (instream
);
2798 saved_doc_string_length
= i
;
2801 /* Skip that many bytes. */
2802 skip_dyn_bytes (readcharfun
, nskip
);
2808 /* #! appears at the beginning of an executable file.
2809 Skip the first line. */
2810 while (c
!= '\n' && c
>= 0)
2815 return Vload_file_name
;
2817 return list2 (Qfunction
, read0 (readcharfun
));
2818 /* #:foo is the uninterned symbol named foo. */
2821 uninterned_symbol
= 1;
2824 && c
!= 0xa0 /* NBSP */
2826 || strchr ("\"';()[]#`,", c
) == NULL
)))
2828 /* No symbol character follows, this is the empty
2831 return Fmake_symbol (empty_unibyte_string
);
2835 /* ## is the empty symbol. */
2837 return Fintern (empty_unibyte_string
, Qnil
);
2838 /* Reader forms that can reuse previously read objects. */
2839 if (c
>= '0' && c
<= '9')
2844 /* Read a non-negative integer. */
2845 while (c
>= '0' && c
<= '9')
2847 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2848 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2849 n
= MOST_POSITIVE_FIXNUM
+ 1;
2851 n
= n
* 10 + c
- '0';
2855 if (n
<= MOST_POSITIVE_FIXNUM
)
2857 if (c
== 'r' || c
== 'R')
2858 return read_integer (readcharfun
, n
);
2860 if (! NILP (Vread_circle
))
2862 /* #n=object returns object, but associates it with
2866 /* Make a placeholder for #n# to use temporarily. */
2867 Lisp_Object placeholder
;
2870 placeholder
= Fcons (Qnil
, Qnil
);
2871 cell
= Fcons (make_number (n
), placeholder
);
2872 read_objects
= Fcons (cell
, read_objects
);
2874 /* Read the object itself. */
2875 tem
= read0 (readcharfun
);
2877 /* Now put it everywhere the placeholder was... */
2878 substitute_object_in_subtree (tem
, placeholder
);
2880 /* ...and #n# will use the real value from now on. */
2881 Fsetcdr (cell
, tem
);
2886 /* #n# returns a previously read object. */
2889 tem
= Fassq (make_number (n
), read_objects
);
2895 /* Fall through to error message. */
2897 else if (c
== 'x' || c
== 'X')
2898 return read_integer (readcharfun
, 16);
2899 else if (c
== 'o' || c
== 'O')
2900 return read_integer (readcharfun
, 8);
2901 else if (c
== 'b' || c
== 'B')
2902 return read_integer (readcharfun
, 2);
2905 invalid_syntax ("#");
2908 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2912 return list2 (Qquote
, read0 (readcharfun
));
2916 int next_char
= READCHAR
;
2918 /* Transition from old-style to new-style:
2919 If we see "(`" it used to mean old-style, which usually works
2920 fine because ` should almost never appear in such a position
2921 for new-style. But occasionally we need "(`" to mean new
2922 style, so we try to distinguish the two by the fact that we
2923 can either write "( `foo" or "(` foo", where the first
2924 intends to use new-style whereas the second intends to use
2925 old-style. For Emacs-25, we should completely remove this
2926 first_in_list exception (old-style can still be obtained via
2928 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2930 Vold_style_backquotes
= Qt
;
2936 bool saved_new_backquote_flag
= new_backquote_flag
;
2938 new_backquote_flag
= 1;
2939 value
= read0 (readcharfun
);
2940 new_backquote_flag
= saved_new_backquote_flag
;
2942 return list2 (Qbackquote
, value
);
2947 int next_char
= READCHAR
;
2949 /* Transition from old-style to new-style:
2950 It used to be impossible to have a new-style , other than within
2951 a new-style `. This is sufficient when ` and , are used in the
2952 normal way, but ` and , can also appear in args to macros that
2953 will not interpret them in the usual way, in which case , may be
2954 used without any ` anywhere near.
2955 So we now use the same heuristic as for backquote: old-style
2956 unquotes are only recognized when first on a list, and when
2957 followed by a space.
2958 Because it's more difficult to peek 2 chars ahead, a new-style
2959 ,@ can still not be used outside of a `, unless it's in the middle
2961 if (new_backquote_flag
2963 || (next_char
!= ' ' && next_char
!= '@'))
2965 Lisp_Object comma_type
= Qnil
;
2970 comma_type
= Qcomma_at
;
2972 comma_type
= Qcomma_dot
;
2975 if (ch
>= 0) UNREAD (ch
);
2976 comma_type
= Qcomma
;
2979 value
= read0 (readcharfun
);
2980 return list2 (comma_type
, value
);
2984 Vold_style_backquotes
= Qt
;
2996 end_of_file_error ();
2998 /* Accept `single space' syntax like (list ? x) where the
2999 whitespace character is SPC or TAB.
3000 Other literal whitespace like NL, CR, and FF are not accepted,
3001 as there are well-established escape sequences for these. */
3002 if (c
== ' ' || c
== '\t')
3003 return make_number (c
);
3006 c
= read_escape (readcharfun
, 0);
3007 modifiers
= c
& CHAR_MODIFIER_MASK
;
3008 c
&= ~CHAR_MODIFIER_MASK
;
3009 if (CHAR_BYTE8_P (c
))
3010 c
= CHAR_TO_BYTE8 (c
);
3013 next_char
= READCHAR
;
3014 ok
= (next_char
<= 040
3015 || (next_char
< 0200
3016 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3019 return make_number (c
);
3021 invalid_syntax ("?");
3026 char *p
= read_buffer
;
3027 char *end
= read_buffer
+ read_buffer_size
;
3029 /* True if we saw an escape sequence specifying
3030 a multibyte character. */
3031 bool force_multibyte
= 0;
3032 /* True if we saw an escape sequence specifying
3033 a single-byte character. */
3034 bool force_singlebyte
= 0;
3036 ptrdiff_t nchars
= 0;
3038 while ((ch
= READCHAR
) >= 0
3041 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3043 ptrdiff_t offset
= p
- read_buffer
;
3044 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3045 memory_full (SIZE_MAX
);
3046 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3047 read_buffer_size
*= 2;
3048 p
= read_buffer
+ offset
;
3049 end
= read_buffer
+ read_buffer_size
;
3056 ch
= read_escape (readcharfun
, 1);
3058 /* CH is -1 if \ newline has just been seen. */
3061 if (p
== read_buffer
)
3066 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3067 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3069 if (CHAR_BYTE8_P (ch
))
3070 force_singlebyte
= 1;
3071 else if (! ASCII_CHAR_P (ch
))
3072 force_multibyte
= 1;
3073 else /* I.e. ASCII_CHAR_P (ch). */
3075 /* Allow `\C- ' and `\C-?'. */
3076 if (modifiers
== CHAR_CTL
)
3079 ch
= 0, modifiers
= 0;
3081 ch
= 127, modifiers
= 0;
3083 if (modifiers
& CHAR_SHIFT
)
3085 /* Shift modifier is valid only with [A-Za-z]. */
3086 if (ch
>= 'A' && ch
<= 'Z')
3087 modifiers
&= ~CHAR_SHIFT
;
3088 else if (ch
>= 'a' && ch
<= 'z')
3089 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3092 if (modifiers
& CHAR_META
)
3094 /* Move the meta bit to the right place for a
3096 modifiers
&= ~CHAR_META
;
3097 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3098 force_singlebyte
= 1;
3102 /* Any modifiers remaining are invalid. */
3104 error ("Invalid modifier in string");
3105 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3109 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3110 if (CHAR_BYTE8_P (ch
))
3111 force_singlebyte
= 1;
3112 else if (! ASCII_CHAR_P (ch
))
3113 force_multibyte
= 1;
3119 end_of_file_error ();
3121 /* If purifying, and string starts with \ newline,
3122 return zero instead. This is for doc strings
3123 that we are really going to find in etc/DOC.nn.nn. */
3124 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3125 return make_number (0);
3127 if (! force_multibyte
&& force_singlebyte
)
3129 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3130 forms. Convert it to unibyte. */
3131 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3133 p
= read_buffer
+ nchars
;
3136 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3138 || (p
- read_buffer
!= nchars
)));
3143 int next_char
= READCHAR
;
3146 if (next_char
<= 040
3147 || (next_char
< 0200
3148 && strchr ("\"';([#?`,", next_char
) != NULL
))
3154 /* Otherwise, we fall through! Note that the atom-reading loop
3155 below will now loop at least once, assuring that we will not
3156 try to UNREAD two characters in a row. */
3160 if (c
<= 040) goto retry
;
3161 if (c
== 0xa0) /* NBSP */
3166 char *p
= read_buffer
;
3168 EMACS_INT start_position
= readchar_count
- 1;
3171 char *end
= read_buffer
+ read_buffer_size
;
3175 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3177 ptrdiff_t offset
= p
- read_buffer
;
3178 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3179 memory_full (SIZE_MAX
);
3180 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3181 read_buffer_size
*= 2;
3182 p
= read_buffer
+ offset
;
3183 end
= read_buffer
+ read_buffer_size
;
3190 end_of_file_error ();
3195 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3201 && c
!= 0xa0 /* NBSP */
3203 || strchr ("\"';()[]#`,", c
) == NULL
));
3207 ptrdiff_t offset
= p
- read_buffer
;
3208 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3209 memory_full (SIZE_MAX
);
3210 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3211 read_buffer_size
*= 2;
3212 p
= read_buffer
+ offset
;
3213 end
= read_buffer
+ read_buffer_size
;
3219 if (!quoted
&& !uninterned_symbol
)
3221 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3222 if (! NILP (result
))
3226 Lisp_Object name
, result
;
3227 ptrdiff_t nbytes
= p
- read_buffer
;
3230 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3234 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3235 ? make_pure_string
: make_specified_string
)
3236 (read_buffer
, nchars
, nbytes
, multibyte
));
3237 result
= (uninterned_symbol
? Fmake_symbol (name
)
3238 : Fintern (name
, Qnil
));
3240 if (EQ (Vread_with_symbol_positions
, Qt
)
3241 || EQ (Vread_with_symbol_positions
, readcharfun
))
3242 Vread_symbol_positions_list
3243 = Fcons (Fcons (result
, make_number (start_position
)),
3244 Vread_symbol_positions_list
);
3252 /* List of nodes we've seen during substitute_object_in_subtree. */
3253 static Lisp_Object seen_list
;
3256 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3258 Lisp_Object check_object
;
3260 /* We haven't seen any objects when we start. */
3263 /* Make all the substitutions. */
3265 = substitute_object_recurse (object
, placeholder
, object
);
3267 /* Clear seen_list because we're done with it. */
3270 /* The returned object here is expected to always eq the
3272 if (!EQ (check_object
, object
))
3273 error ("Unexpected mutation error in reader");
3276 /* Feval doesn't get called from here, so no gc protection is needed. */
3277 #define SUBSTITUTE(get_val, set_val) \
3279 Lisp_Object old_value = get_val; \
3280 Lisp_Object true_value \
3281 = substitute_object_recurse (object, placeholder, \
3284 if (!EQ (old_value, true_value)) \
3291 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3293 /* If we find the placeholder, return the target object. */
3294 if (EQ (placeholder
, subtree
))
3297 /* If we've been to this node before, don't explore it again. */
3298 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3301 /* If this node can be the entry point to a cycle, remember that
3302 we've seen it. It can only be such an entry point if it was made
3303 by #n=, which means that we can find it as a value in
3305 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3306 seen_list
= Fcons (subtree
, seen_list
);
3308 /* Recurse according to subtree's type.
3309 Every branch must return a Lisp_Object. */
3310 switch (XTYPE (subtree
))
3312 case Lisp_Vectorlike
:
3314 ptrdiff_t i
, length
= 0;
3315 if (BOOL_VECTOR_P (subtree
))
3316 return subtree
; /* No sub-objects anyway. */
3317 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3318 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3319 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3320 else if (VECTORP (subtree
))
3321 length
= ASIZE (subtree
);
3323 /* An unknown pseudovector may contain non-Lisp fields, so we
3324 can't just blindly traverse all its fields. We used to call
3325 `Flength' which signaled `sequencep', so I just preserved this
3327 wrong_type_argument (Qsequencep
, subtree
);
3329 for (i
= 0; i
< length
; i
++)
3330 SUBSTITUTE (AREF (subtree
, i
),
3331 ASET (subtree
, i
, true_value
));
3337 SUBSTITUTE (XCAR (subtree
),
3338 XSETCAR (subtree
, true_value
));
3339 SUBSTITUTE (XCDR (subtree
),
3340 XSETCDR (subtree
, true_value
));
3346 /* Check for text properties in each interval.
3347 substitute_in_interval contains part of the logic. */
3349 INTERVAL root_interval
= string_intervals (subtree
);
3350 Lisp_Object arg
= Fcons (object
, placeholder
);
3352 traverse_intervals_noorder (root_interval
,
3353 &substitute_in_interval
, arg
);
3358 /* Other types don't recurse any further. */
3364 /* Helper function for substitute_object_recurse. */
3366 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3368 Lisp_Object object
= Fcar (arg
);
3369 Lisp_Object placeholder
= Fcdr (arg
);
3371 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3381 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3382 integer syntax and fits in a fixnum, else return the nearest float if CP has
3383 either floating point or integer syntax and BASE is 10, else return nil. If
3384 IGNORE_TRAILING, consider just the longest prefix of CP that has
3385 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3386 number has integer syntax but does not fit. */
3389 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3392 char const *cp
= string
;
3394 bool float_syntax
= 0;
3397 /* Compute NaN and infinities using a variable, to cope with compilers that
3398 think they are smarter than we are. */
3401 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3402 IEEE floating point hosts, and works around a formerly-common bug where
3403 atof ("-0.0") drops the sign. */
3404 bool negative
= *cp
== '-';
3406 bool signedp
= negative
|| *cp
== '+';
3411 leading_digit
= digit_to_number (*cp
, base
);
3412 if (leading_digit
>= 0)
3417 while (digit_to_number (*cp
, base
) >= 0);
3427 if ('0' <= *cp
&& *cp
<= '9')
3432 while ('0' <= *cp
&& *cp
<= '9');
3434 if (*cp
== 'e' || *cp
== 'E')
3436 char const *ecp
= cp
;
3438 if (*cp
== '+' || *cp
== '-')
3440 if ('0' <= *cp
&& *cp
<= '9')
3445 while ('0' <= *cp
&& *cp
<= '9');
3447 else if (cp
[-1] == '+'
3448 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3454 else if (cp
[-1] == '+'
3455 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3459 value
= zero
/ zero
;
3461 /* If that made a "negative" NaN, negate it. */
3464 union { double d
; char c
[sizeof (double)]; }
3465 u_data
, u_minus_zero
;
3467 u_minus_zero
.d
= -0.0;
3468 for (i
= 0; i
< sizeof (double); i
++)
3469 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3475 /* Now VALUE is a positive NaN. */
3481 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3482 || state
== (LEAD_INT
|E_EXP
));
3485 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3486 any prefix that matches. Otherwise, the entire string must match. */
3487 if (! (ignore_trailing
3488 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3489 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3492 /* If the number uses integer and not float syntax, and is in C-language
3493 range, use its value, preferably as a fixnum. */
3494 if (leading_digit
>= 0 && ! float_syntax
)
3498 /* Fast special case for single-digit integers. This also avoids a
3499 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3500 case some versions of strtoumax accept numbers like "0x1" that Emacs
3502 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3503 return make_number (negative
? -leading_digit
: leading_digit
);
3506 n
= strtoumax (string
+ signedp
, NULL
, base
);
3507 if (errno
== ERANGE
)
3509 /* Unfortunately there's no simple and accurate way to convert
3510 non-base-10 numbers that are out of C-language range. */
3512 xsignal1 (Qoverflow_error
, build_string (string
));
3514 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3516 EMACS_INT signed_n
= n
;
3517 return make_number (negative
? -signed_n
: signed_n
);
3523 /* Either the number uses float syntax, or it does not fit into a fixnum.
3524 Convert it from string to floating point, unless the value is already
3525 known because it is an infinity, a NAN, or its absolute value fits in
3528 value
= atof (string
+ signedp
);
3530 return make_float (negative
? -value
: value
);
3535 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3539 Lisp_Object tem
, item
, vector
;
3540 struct Lisp_Cons
*otem
;
3543 tem
= read_list (1, readcharfun
);
3544 len
= Flength (tem
);
3545 vector
= Fmake_vector (len
, Qnil
);
3547 size
= ASIZE (vector
);
3548 ptr
= XVECTOR (vector
)->contents
;
3549 for (i
= 0; i
< size
; i
++)
3552 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3553 bytecode object, the docstring containing the bytecode and
3554 constants values must be treated as unibyte and passed to
3555 Fread, to get the actual bytecode string and constants vector. */
3556 if (bytecodeflag
&& load_force_doc_strings
)
3558 if (i
== COMPILED_BYTECODE
)
3560 if (!STRINGP (item
))
3561 error ("Invalid byte code");
3563 /* Delay handling the bytecode slot until we know whether
3564 it is lazily-loaded (we can tell by whether the
3565 constants slot is nil). */
3566 ASET (vector
, COMPILED_CONSTANTS
, item
);
3569 else if (i
== COMPILED_CONSTANTS
)
3571 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3575 /* Coerce string to unibyte (like string-as-unibyte,
3576 but without generating extra garbage and
3577 guaranteeing no change in the contents). */
3578 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3579 STRING_SET_UNIBYTE (bytestr
);
3581 item
= Fread (Fcons (bytestr
, readcharfun
));
3583 error ("Invalid byte code");
3585 otem
= XCONS (item
);
3586 bytestr
= XCAR (item
);
3591 /* Now handle the bytecode slot. */
3592 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3594 else if (i
== COMPILED_DOC_STRING
3596 && ! STRING_MULTIBYTE (item
))
3598 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3599 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3601 item
= Fstring_as_multibyte (item
);
3604 ASET (vector
, i
, item
);
3612 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3615 read_list (bool flag
, Lisp_Object readcharfun
)
3617 Lisp_Object val
, tail
;
3618 Lisp_Object elt
, tem
;
3619 struct gcpro gcpro1
, gcpro2
;
3620 /* 0 is the normal case.
3621 1 means this list is a doc reference; replace it with the number 0.
3622 2 means this list is a doc reference; replace it with the doc string. */
3623 int doc_reference
= 0;
3625 /* Initialize this to 1 if we are reading a list. */
3626 bool first_in_list
= flag
<= 0;
3635 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3640 /* While building, if the list starts with #$, treat it specially. */
3641 if (EQ (elt
, Vload_file_name
)
3643 && !NILP (Vpurify_flag
))
3645 if (NILP (Vdoc_file_name
))
3646 /* We have not yet called Snarf-documentation, so assume
3647 this file is described in the DOC file
3648 and Snarf-documentation will fill in the right value later.
3649 For now, replace the whole list with 0. */
3652 /* We have already called Snarf-documentation, so make a relative
3653 file name for this file, so it can be found properly
3654 in the installed Lisp directory.
3655 We don't use Fexpand_file_name because that would make
3656 the directory absolute now. */
3657 elt
= concat2 (build_string ("../lisp/"),
3658 Ffile_name_nondirectory (elt
));
3660 else if (EQ (elt
, Vload_file_name
)
3662 && load_force_doc_strings
)
3671 invalid_syntax (") or . in a vector");
3679 XSETCDR (tail
, read0 (readcharfun
));
3681 val
= read0 (readcharfun
);
3682 read1 (readcharfun
, &ch
, 0);
3686 if (doc_reference
== 1)
3687 return make_number (0);
3688 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3691 file_offset saved_position
;
3692 /* Get a doc string from the file we are loading.
3693 If it's in saved_doc_string, get it from there.
3695 Here, we don't know if the string is a
3696 bytecode string or a doc string. As a
3697 bytecode string must be unibyte, we always
3698 return a unibyte string. If it is actually a
3699 doc string, caller must make it
3702 /* Position is negative for user variables. */
3703 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3704 if (pos
>= saved_doc_string_position
3705 && pos
< (saved_doc_string_position
3706 + saved_doc_string_length
))
3708 saved
= saved_doc_string
;
3709 saved_position
= saved_doc_string_position
;
3711 /* Look in prev_saved_doc_string the same way. */
3712 else if (pos
>= prev_saved_doc_string_position
3713 && pos
< (prev_saved_doc_string_position
3714 + prev_saved_doc_string_length
))
3716 saved
= prev_saved_doc_string
;
3717 saved_position
= prev_saved_doc_string_position
;
3721 ptrdiff_t start
= pos
- saved_position
;
3724 /* Process quoting with ^A,
3725 and find the end of the string,
3726 which is marked with ^_ (037). */
3727 for (from
= start
, to
= start
;
3728 saved
[from
] != 037;)
3730 int c
= saved
[from
++];
3734 saved
[to
++] = (c
== 1 ? c
3743 return make_unibyte_string (saved
+ start
,
3747 return get_doc_string (val
, 1, 0);
3752 invalid_syntax (". in wrong context");
3754 invalid_syntax ("] in a list");
3758 XSETCDR (tail
, tem
);
3765 static Lisp_Object initial_obarray
;
3767 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3769 static size_t oblookup_last_bucket_number
;
3771 /* Get an error if OBARRAY is not an obarray.
3772 If it is one, return it. */
3775 check_obarray (Lisp_Object obarray
)
3777 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3779 /* If Vobarray is now invalid, force it to be valid. */
3780 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3781 wrong_type_argument (Qvectorp
, obarray
);
3786 /* Intern the C string STR: return a symbol with that name,
3787 interned in the current obarray. */
3790 intern_1 (const char *str
, ptrdiff_t len
)
3792 Lisp_Object obarray
= check_obarray (Vobarray
);
3793 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3795 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3799 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3801 Lisp_Object obarray
= check_obarray (Vobarray
);
3802 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3807 if (NILP (Vpurify_flag
))
3808 /* Creating a non-pure string from a string literal not
3809 implemented yet. We could just use make_string here and live
3810 with the extra copy. */
3813 return Fintern (make_pure_c_string (str
, len
), obarray
);
3816 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3817 doc
: /* Return the canonical symbol whose name is STRING.
3818 If there is none, one is created by this function and returned.
3819 A second optional argument specifies the obarray to use;
3820 it defaults to the value of `obarray'. */)
3821 (Lisp_Object string
, Lisp_Object obarray
)
3823 register Lisp_Object tem
, sym
, *ptr
;
3825 if (NILP (obarray
)) obarray
= Vobarray
;
3826 obarray
= check_obarray (obarray
);
3828 CHECK_STRING (string
);
3830 tem
= oblookup (obarray
, SSDATA (string
),
3833 if (!INTEGERP (tem
))
3836 if (!NILP (Vpurify_flag
))
3837 string
= Fpurecopy (string
);
3838 sym
= Fmake_symbol (string
);
3840 if (EQ (obarray
, initial_obarray
))
3841 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3843 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3845 if ((SREF (string
, 0) == ':')
3846 && EQ (obarray
, initial_obarray
))
3848 XSYMBOL (sym
)->constant
= 1;
3849 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3850 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3853 ptr
= aref_addr (obarray
, XINT(tem
));
3855 set_symbol_next (sym
, XSYMBOL (*ptr
));
3857 set_symbol_next (sym
, NULL
);
3862 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3863 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3864 NAME may be a string or a symbol. If it is a symbol, that exact
3865 symbol is searched for.
3866 A second optional argument specifies the obarray to use;
3867 it defaults to the value of `obarray'. */)
3868 (Lisp_Object name
, Lisp_Object obarray
)
3870 register Lisp_Object tem
, string
;
3872 if (NILP (obarray
)) obarray
= Vobarray
;
3873 obarray
= check_obarray (obarray
);
3875 if (!SYMBOLP (name
))
3877 CHECK_STRING (name
);
3881 string
= SYMBOL_NAME (name
);
3883 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3884 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3890 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3891 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3892 The value is t if a symbol was found and deleted, nil otherwise.
3893 NAME may be a string or a symbol. If it is a symbol, that symbol
3894 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3895 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3896 usage: (unintern NAME OBARRAY) */)
3897 (Lisp_Object name
, Lisp_Object obarray
)
3899 register Lisp_Object string
, tem
;
3902 if (NILP (obarray
)) obarray
= Vobarray
;
3903 obarray
= check_obarray (obarray
);
3906 string
= SYMBOL_NAME (name
);
3909 CHECK_STRING (name
);
3913 tem
= oblookup (obarray
, SSDATA (string
),
3918 /* If arg was a symbol, don't delete anything but that symbol itself. */
3919 if (SYMBOLP (name
) && !EQ (name
, tem
))
3922 /* There are plenty of other symbols which will screw up the Emacs
3923 session if we unintern them, as well as even more ways to use
3924 `setq' or `fset' or whatnot to make the Emacs session
3925 unusable. Let's not go down this silly road. --Stef */
3926 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3927 error ("Attempt to unintern t or nil"); */
3929 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3931 hash
= oblookup_last_bucket_number
;
3933 if (EQ (AREF (obarray
, hash
), tem
))
3935 if (XSYMBOL (tem
)->next
)
3938 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3939 ASET (obarray
, hash
, sym
);
3942 ASET (obarray
, hash
, make_number (0));
3946 Lisp_Object tail
, following
;
3948 for (tail
= AREF (obarray
, hash
);
3949 XSYMBOL (tail
)->next
;
3952 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3953 if (EQ (following
, tem
))
3955 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3964 /* Return the symbol in OBARRAY whose names matches the string
3965 of SIZE characters (SIZE_BYTE bytes) at PTR.
3966 If there is no such symbol, return the integer bucket number of
3967 where the symbol would be if it were present.
3969 Also store the bucket number in oblookup_last_bucket_number. */
3972 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3976 register Lisp_Object tail
;
3977 Lisp_Object bucket
, tem
;
3979 obarray
= check_obarray (obarray
);
3980 obsize
= ASIZE (obarray
);
3982 /* This is sometimes needed in the middle of GC. */
3983 obsize
&= ~ARRAY_MARK_FLAG
;
3984 hash
= hash_string (ptr
, size_byte
) % obsize
;
3985 bucket
= AREF (obarray
, hash
);
3986 oblookup_last_bucket_number
= hash
;
3987 if (EQ (bucket
, make_number (0)))
3989 else if (!SYMBOLP (bucket
))
3990 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3992 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3994 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3995 && SCHARS (SYMBOL_NAME (tail
)) == size
3996 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3998 else if (XSYMBOL (tail
)->next
== 0)
4001 XSETINT (tem
, hash
);
4006 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
4009 register Lisp_Object tail
;
4010 CHECK_VECTOR (obarray
);
4011 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
4013 tail
= AREF (obarray
, i
);
4018 if (XSYMBOL (tail
)->next
== 0)
4020 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4026 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4028 call1 (function
, sym
);
4031 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4032 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4033 OBARRAY defaults to the value of `obarray'. */)
4034 (Lisp_Object function
, Lisp_Object obarray
)
4036 if (NILP (obarray
)) obarray
= Vobarray
;
4037 obarray
= check_obarray (obarray
);
4039 map_obarray (obarray
, mapatoms_1
, function
);
4043 #define OBARRAY_SIZE 1511
4048 Lisp_Object oblength
;
4049 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4051 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4053 Vobarray
= Fmake_vector (oblength
, make_number (0));
4054 initial_obarray
= Vobarray
;
4055 staticpro (&initial_obarray
);
4057 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
4058 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
4059 NILP (Vpurify_flag) check in intern_c_string. */
4060 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
4061 Qnil
= intern_c_string ("nil");
4063 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
4064 so those two need to be fixed manually. */
4065 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
4066 set_symbol_function (Qunbound
, Qnil
);
4067 set_symbol_plist (Qunbound
, Qnil
);
4068 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4069 XSYMBOL (Qnil
)->constant
= 1;
4070 XSYMBOL (Qnil
)->declared_special
= 1;
4071 set_symbol_plist (Qnil
, Qnil
);
4072 set_symbol_function (Qnil
, Qnil
);
4074 Qt
= intern_c_string ("t");
4075 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4076 XSYMBOL (Qnil
)->declared_special
= 1;
4077 XSYMBOL (Qt
)->constant
= 1;
4079 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4082 DEFSYM (Qvariable_documentation
, "variable-documentation");
4084 read_buffer
= xmalloc (size
);
4085 read_buffer_size
= size
;
4089 defsubr (struct Lisp_Subr
*sname
)
4091 Lisp_Object sym
, tem
;
4092 sym
= intern_c_string (sname
->symbol_name
);
4093 XSETPVECTYPE (sname
, PVEC_SUBR
);
4094 XSETSUBR (tem
, sname
);
4095 set_symbol_function (sym
, tem
);
4098 #ifdef NOTDEF /* Use fset in subr.el now! */
4100 defalias (struct Lisp_Subr
*sname
, char *string
)
4103 sym
= intern (string
);
4104 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4108 /* Define an "integer variable"; a symbol whose value is forwarded to a
4109 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4110 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4112 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4113 const char *namestring
, EMACS_INT
*address
)
4116 sym
= intern_c_string (namestring
);
4117 i_fwd
->type
= Lisp_Fwd_Int
;
4118 i_fwd
->intvar
= address
;
4119 XSYMBOL (sym
)->declared_special
= 1;
4120 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4121 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4124 /* Similar but define a variable whose value is t if address contains 1,
4125 nil if address contains 0. */
4127 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4128 const char *namestring
, bool *address
)
4131 sym
= intern_c_string (namestring
);
4132 b_fwd
->type
= Lisp_Fwd_Bool
;
4133 b_fwd
->boolvar
= address
;
4134 XSYMBOL (sym
)->declared_special
= 1;
4135 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4136 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4137 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4140 /* Similar but define a variable whose value is the Lisp Object stored
4141 at address. Two versions: with and without gc-marking of the C
4142 variable. The nopro version is used when that variable will be
4143 gc-marked for some other reason, since marking the same slot twice
4144 can cause trouble with strings. */
4146 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4147 const char *namestring
, Lisp_Object
*address
)
4150 sym
= intern_c_string (namestring
);
4151 o_fwd
->type
= Lisp_Fwd_Obj
;
4152 o_fwd
->objvar
= address
;
4153 XSYMBOL (sym
)->declared_special
= 1;
4154 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4155 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4159 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4160 const char *namestring
, Lisp_Object
*address
)
4162 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4163 staticpro (address
);
4166 /* Similar but define a variable whose value is the Lisp Object stored
4167 at a particular offset in the current kboard object. */
4170 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4171 const char *namestring
, int offset
)
4174 sym
= intern_c_string (namestring
);
4175 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4176 ko_fwd
->offset
= offset
;
4177 XSYMBOL (sym
)->declared_special
= 1;
4178 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4179 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4182 /* Check that the elements of lpath exist. */
4185 load_path_check (Lisp_Object lpath
)
4187 Lisp_Object path_tail
;
4189 /* The only elements that might not exist are those from
4190 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4192 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4194 Lisp_Object dirfile
;
4195 dirfile
= Fcar (path_tail
);
4196 if (STRINGP (dirfile
))
4198 dirfile
= Fdirectory_file_name (dirfile
);
4199 if (! file_accessible_directory_p (SSDATA (dirfile
)))
4200 dir_warning ("Lisp directory", XCAR (path_tail
));
4205 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4206 This does not include the standard site-lisp directories
4207 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4208 but it does (unless no_site_lisp is set) include site-lisp
4209 directories in the source/build directories if those exist and we
4210 are running uninstalled.
4212 Uses the following logic:
4213 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4214 The remainder is what happens when dumping works:
4215 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4216 Otherwise use PATH_LOADSEARCH.
4218 If !initialized, then just return PATH_DUMPLOADSEARCH.
4220 If Vinstallation_directory is not nil (ie, running uninstalled):
4221 If installation-dir/lisp exists and not already a member,
4222 we must be running uninstalled. Reset the load-path
4223 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4224 refers to the eventual installation directories. Since we
4225 are not yet installed, we should not use them, even if they exist.)
4226 If installation-dir/lisp does not exist, just add
4227 PATH_DUMPLOADSEARCH at the end instead.
4228 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4229 and not already a member) at the front.
4230 If installation-dir != source-dir (ie running an uninstalled,
4231 out-of-tree build) AND install-dir/src/Makefile exists BUT
4232 install-dir/src/Makefile.in does NOT exist (this is a sanity
4233 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4236 load_path_default (void)
4238 Lisp_Object lpath
= Qnil
;
4243 const char *loadpath
= ns_load_path ();
4246 normal
= PATH_LOADSEARCH
;
4248 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4250 lpath
= decode_env_path (0, normal
, 0);
4253 #else /* !CANNOT_DUMP */
4255 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4260 const char *loadpath
= ns_load_path ();
4261 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4263 lpath
= decode_env_path (0, normal
, 0);
4265 if (!NILP (Vinstallation_directory
))
4267 Lisp_Object tem
, tem1
;
4269 /* Add to the path the lisp subdir of the installation
4270 dir, if it is accessible. Note: in out-of-tree builds,
4271 this directory is empty save for Makefile. */
4272 tem
= Fexpand_file_name (build_string ("lisp"),
4273 Vinstallation_directory
);
4274 tem1
= Ffile_accessible_directory_p (tem
);
4277 if (NILP (Fmember (tem
, lpath
)))
4279 /* We are running uninstalled. The default load-path
4280 points to the eventual installed lisp directories.
4281 We should not use those now, even if they exist,
4282 so start over from a clean slate. */
4283 lpath
= list1 (tem
);
4287 /* That dir doesn't exist, so add the build-time
4288 Lisp dirs instead. */
4290 Lisp_Object dump_path
=
4291 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4292 lpath
= nconc2 (lpath
, dump_path
);
4295 /* Add site-lisp under the installation dir, if it exists. */
4298 tem
= Fexpand_file_name (build_string ("site-lisp"),
4299 Vinstallation_directory
);
4300 tem1
= Ffile_accessible_directory_p (tem
);
4303 if (NILP (Fmember (tem
, lpath
)))
4304 lpath
= Fcons (tem
, lpath
);
4308 /* If Emacs was not built in the source directory,
4309 and it is run from where it was built, add to load-path
4310 the lisp and site-lisp dirs under that directory. */
4312 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4316 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4317 Vinstallation_directory
);
4318 tem1
= Ffile_exists_p (tem
);
4320 /* Don't be fooled if they moved the entire source tree
4321 AFTER dumping Emacs. If the build directory is indeed
4322 different from the source dir, src/Makefile.in and
4323 src/Makefile will not be found together. */
4324 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4325 Vinstallation_directory
);
4326 tem2
= Ffile_exists_p (tem
);
4327 if (!NILP (tem1
) && NILP (tem2
))
4329 tem
= Fexpand_file_name (build_string ("lisp"),
4332 if (NILP (Fmember (tem
, lpath
)))
4333 lpath
= Fcons (tem
, lpath
);
4337 tem
= Fexpand_file_name (build_string ("site-lisp"),
4339 tem1
= Ffile_accessible_directory_p (tem
);
4342 if (NILP (Fmember (tem
, lpath
)))
4343 lpath
= Fcons (tem
, lpath
);
4347 } /* Vinstallation_directory != Vsource_directory */
4349 } /* if Vinstallation_directory */
4351 else /* !initialized */
4353 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4354 source directory. We used to add ../lisp (ie the lisp dir in
4355 the build directory) at the front here, but that should not
4356 be necessary, since in out of tree builds lisp/ is empty, save
4358 lpath
= decode_env_path (0, normal
, 0);
4360 #endif /* !CANNOT_DUMP */
4368 /* First, set Vload_path. */
4370 /* Ignore EMACSLOADPATH when dumping. */
4372 bool use_loadpath
= true;
4374 bool use_loadpath
= NILP (Vpurify_flag
);
4377 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4379 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4381 /* Check (non-nil) user-supplied elements. */
4382 load_path_check (Vload_path
);
4384 /* If no nils in the environment variable, use as-is.
4385 Otherwise, replace any nils with the default. */
4386 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4388 Lisp_Object elem
, elpath
= Vload_path
;
4389 Lisp_Object default_lpath
= load_path_default ();
4391 /* Check defaults, before adding site-lisp. */
4392 load_path_check (default_lpath
);
4394 /* Add the site-lisp directories to the front of the default. */
4397 Lisp_Object sitelisp
;
4398 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4399 if (! NILP (sitelisp
))
4400 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4405 /* Replace nils from EMACSLOADPATH by default. */
4406 while (CONSP (elpath
))
4409 elem
= XCAR (elpath
);
4410 elpath
= XCDR (elpath
);
4411 arg
[0] = Vload_path
;
4412 arg
[1] = NILP (elem
) ? default_lpath
: Fcons (elem
, Qnil
);
4413 Vload_path
= Fappend (2, arg
);
4415 } /* Fmemq (Qnil, Vload_path) */
4419 Vload_path
= load_path_default ();
4421 /* Check before adding site-lisp directories.
4422 The install should have created them, but they are not
4423 required, so no need to warn if they are absent.
4424 Or we might be running before installation. */
4425 load_path_check (Vload_path
);
4427 /* Add the site-lisp directories at the front. */
4428 if (initialized
&& !no_site_lisp
)
4430 Lisp_Object sitelisp
;
4431 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4432 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4438 load_in_progress
= 0;
4439 Vload_file_name
= Qnil
;
4440 Vstandard_input
= Qt
;
4441 Vloads_in_progress
= Qnil
;
4444 /* Print a warning that directory intended for use USE and with name
4445 DIRNAME cannot be accessed. On entry, errno should correspond to
4446 the access failure. Print the warning on stderr and put it in
4450 dir_warning (char const *use
, Lisp_Object dirname
)
4452 static char const format
[] = "Warning: %s `%s': %s\n";
4453 int access_errno
= errno
;
4454 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4456 /* Don't log the warning before we've initialized!! */
4459 char const *diagnostic
= emacs_strerror (access_errno
);
4461 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4462 + strlen (use
) + SBYTES (dirname
)
4463 + strlen (diagnostic
));
4464 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4466 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4472 syms_of_lread (void)
4475 defsubr (&Sread_from_string
);
4477 defsubr (&Sintern_soft
);
4478 defsubr (&Sunintern
);
4479 defsubr (&Sget_load_suffixes
);
4481 defsubr (&Seval_buffer
);
4482 defsubr (&Seval_region
);
4483 defsubr (&Sread_char
);
4484 defsubr (&Sread_char_exclusive
);
4485 defsubr (&Sread_event
);
4486 defsubr (&Sget_file_char
);
4487 defsubr (&Smapatoms
);
4488 defsubr (&Slocate_file_internal
);
4490 DEFVAR_LISP ("obarray", Vobarray
,
4491 doc
: /* Symbol table for use by `intern' and `read'.
4492 It is a vector whose length ought to be prime for best results.
4493 The vector's contents don't make sense if examined from Lisp programs;
4494 to find all the symbols in an obarray, use `mapatoms'. */);
4496 DEFVAR_LISP ("values", Vvalues
,
4497 doc
: /* List of values of all expressions which were read, evaluated and printed.
4498 Order is reverse chronological. */);
4499 XSYMBOL (intern ("values"))->declared_special
= 0;
4501 DEFVAR_LISP ("standard-input", Vstandard_input
,
4502 doc
: /* Stream for read to get input from.
4503 See documentation of `read' for possible values. */);
4504 Vstandard_input
= Qt
;
4506 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4507 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4509 If this variable is a buffer, then only forms read from that buffer
4510 will be added to `read-symbol-positions-list'.
4511 If this variable is t, then all read forms will be added.
4512 The effect of all other values other than nil are not currently
4513 defined, although they may be in the future.
4515 The positions are relative to the last call to `read' or
4516 `read-from-string'. It is probably a bad idea to set this variable at
4517 the toplevel; bind it instead. */);
4518 Vread_with_symbol_positions
= Qnil
;
4520 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4521 doc
: /* A list mapping read symbols to their positions.
4522 This variable is modified during calls to `read' or
4523 `read-from-string', but only when `read-with-symbol-positions' is
4526 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4527 CHAR-POSITION is an integer giving the offset of that occurrence of the
4528 symbol from the position where `read' or `read-from-string' started.
4530 Note that a symbol will appear multiple times in this list, if it was
4531 read multiple times. The list is in the same order as the symbols
4533 Vread_symbol_positions_list
= Qnil
;
4535 DEFVAR_LISP ("read-circle", Vread_circle
,
4536 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4539 DEFVAR_LISP ("load-path", Vload_path
,
4540 doc
: /* List of directories to search for files to load.
4541 Each element is a string (directory name) or nil (meaning `default-directory').
4542 Initialized during startup as described in Info node `(elisp)Library Search'. */);
4544 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4545 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4546 This list should not include the empty string.
4547 `load' and related functions try to append these suffixes, in order,
4548 to the specified file name if a Lisp suffix is allowed or required. */);
4549 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4550 build_pure_c_string (".el"));
4551 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4552 doc
: /* List of suffixes that indicate representations of \
4554 This list should normally start with the empty string.
4556 Enabling Auto Compression mode appends the suffixes in
4557 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4558 mode removes them again. `load' and related functions use this list to
4559 determine whether they should look for compressed versions of a file
4560 and, if so, which suffixes they should try to append to the file name
4561 in order to do so. However, if you want to customize which suffixes
4562 the loading functions recognize as compression suffixes, you should
4563 customize `jka-compr-load-suffixes' rather than the present variable. */);
4564 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4566 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4567 doc
: /* Non-nil if inside of `load'. */);
4568 DEFSYM (Qload_in_progress
, "load-in-progress");
4570 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4571 doc
: /* An alist of functions to be evalled when particular files are loaded.
4572 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4574 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4575 a symbol \(a feature name).
4577 When `load' is run and the file-name argument matches an element's
4578 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4579 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4581 An error in FORMS does not undo the load, but does prevent execution of
4582 the rest of the FORMS. */);
4583 Vafter_load_alist
= Qnil
;
4585 DEFVAR_LISP ("load-history", Vload_history
,
4586 doc
: /* Alist mapping loaded file names to symbols and features.
4587 Each alist element should be a list (FILE-NAME ENTRIES...), where
4588 FILE-NAME is the name of a file that has been loaded into Emacs.
4589 The file name is absolute and true (i.e. it doesn't contain symlinks).
4590 As an exception, one of the alist elements may have FILE-NAME nil,
4591 for symbols and features not associated with any file.
4593 The remaining ENTRIES in the alist element describe the functions and
4594 variables defined in that file, the features provided, and the
4595 features required. Each entry has the form `(provide . FEATURE)',
4596 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4597 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4598 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4599 autoload before this file redefined it as a function. In addition,
4600 entries may also be single symbols, which means that SYMBOL was
4601 defined by `defvar' or `defconst'.
4603 During preloading, the file name recorded is relative to the main Lisp
4604 directory. These file names are converted to absolute at startup. */);
4605 Vload_history
= Qnil
;
4607 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4608 doc
: /* Full name of file being loaded by `load'. */);
4609 Vload_file_name
= Qnil
;
4611 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4612 doc
: /* File name, including directory, of user's initialization file.
4613 If the file loaded had extension `.elc', and the corresponding source file
4614 exists, this variable contains the name of source file, suitable for use
4615 by functions like `custom-save-all' which edit the init file.
4616 While Emacs loads and evaluates the init file, value is the real name
4617 of the file, regardless of whether or not it has the `.elc' extension. */);
4618 Vuser_init_file
= Qnil
;
4620 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4621 doc
: /* Used for internal purposes by `load'. */);
4622 Vcurrent_load_list
= Qnil
;
4624 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4625 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4626 The default is nil, which means use the function `read'. */);
4627 Vload_read_function
= Qnil
;
4629 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4630 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4631 The value should be a function for doing code conversion before
4632 reading a source file. It can also be nil, in which case loading is
4633 done without any code conversion.
4635 If the value is a function, it is called with four arguments,
4636 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4637 the file to load, FILE is the non-absolute name (for messages etc.),
4638 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4639 `load'. The function should return t if the file was loaded. */);
4640 Vload_source_file_function
= Qnil
;
4642 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4643 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4644 This is useful when the file being loaded is a temporary copy. */);
4645 load_force_doc_strings
= 0;
4647 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4648 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4649 This is normally bound by `load' and `eval-buffer' to control `read',
4650 and is not meant for users to change. */);
4651 load_convert_to_unibyte
= 0;
4653 DEFVAR_LISP ("source-directory", Vsource_directory
,
4654 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4655 You cannot count on them to still be there! */);
4657 = Fexpand_file_name (build_string ("../"),
4658 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4660 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4661 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4662 Vpreloaded_file_list
= Qnil
;
4664 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4665 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4666 Vbyte_boolean_vars
= Qnil
;
4668 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4669 doc
: /* Non-nil means load dangerous compiled Lisp files.
4670 Some versions of XEmacs use different byte codes than Emacs. These
4671 incompatible byte codes can make Emacs crash when it tries to execute
4673 load_dangerous_libraries
= 0;
4675 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4676 doc
: /* Non-nil means force printing messages when loading Lisp files.
4677 This overrides the value of the NOMESSAGE argument to `load'. */);
4678 force_load_messages
= 0;
4680 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4681 doc
: /* Regular expression matching safe to load compiled Lisp files.
4682 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4683 from the file, and matches them against this regular expression.
4684 When the regular expression matches, the file is considered to be safe
4685 to load. See also `load-dangerous-libraries'. */);
4686 Vbytecomp_version_regexp
4687 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4689 DEFSYM (Qlexical_binding
, "lexical-binding");
4690 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4691 doc
: /* Whether to use lexical binding when evaluating code.
4692 Non-nil means that the code in the current buffer should be evaluated
4693 with lexical binding.
4694 This variable is automatically set from the file variables of an
4695 interpreted Lisp file read using `load'. Unlike other file local
4696 variables, this must be set in the first line of a file. */);
4697 Vlexical_binding
= Qnil
;
4698 Fmake_variable_buffer_local (Qlexical_binding
);
4700 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4701 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4702 Veval_buffer_list
= Qnil
;
4704 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4705 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4706 Vold_style_backquotes
= Qnil
;
4707 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4709 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4710 doc
: /* Non-nil means `load' prefers the newest version of a file.
4711 This applies when a filename suffix is not explicitly specified and
4712 `load' is trying various possible suffixes (see `load-suffixes' and
4713 `load-file-rep-suffixes'). Normally, it stops at the first file
4714 that exists unless you explicitly specify one or the other. If this
4715 option is non-nil, it checks all suffixes and uses whichever file is
4717 Note that if you customize this, obviously it will not affect files
4718 that are loaded before your customizations are read! */);
4719 load_prefer_newer
= 0;
4721 /* Vsource_directory was initialized in init_lread. */
4723 DEFSYM (Qcurrent_load_list
, "current-load-list");
4724 DEFSYM (Qstandard_input
, "standard-input");
4725 DEFSYM (Qread_char
, "read-char");
4726 DEFSYM (Qget_file_char
, "get-file-char");
4727 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4728 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4730 DEFSYM (Qbackquote
, "`");
4731 DEFSYM (Qcomma
, ",");
4732 DEFSYM (Qcomma_at
, ",@");
4733 DEFSYM (Qcomma_dot
, ",.");
4735 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4736 DEFSYM (Qascii_character
, "ascii-character");
4737 DEFSYM (Qfunction
, "function");
4738 DEFSYM (Qload
, "load");
4739 DEFSYM (Qload_file_name
, "load-file-name");
4740 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4741 DEFSYM (Qfile_truename
, "file-truename");
4742 DEFSYM (Qdir_ok
, "dir-ok");
4743 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4745 staticpro (&read_objects
);
4746 read_objects
= Qnil
;
4747 staticpro (&seen_list
);
4750 Vloads_in_progress
= Qnil
;
4751 staticpro (&Vloads_in_progress
);
4753 DEFSYM (Qhash_table
, "hash-table");
4754 DEFSYM (Qdata
, "data");
4755 DEFSYM (Qtest
, "test");
4756 DEFSYM (Qsize
, "size");
4757 DEFSYM (Qweakness
, "weakness");
4758 DEFSYM (Qrehash_size
, "rehash-size");
4759 DEFSYM (Qrehash_threshold
, "rehash-threshold");