1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2013 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
28 #include <limits.h> /* For CHAR_BIT. */
29 #include <stat-time.h>
31 #include "intervals.h"
32 #include "character.h"
40 #include "termhooks.h"
42 #include "blockinput.h"
56 #endif /* HAVE_SETLOCALE */
61 #define file_offset off_t
62 #define file_tell ftello
64 #define file_offset long
65 #define file_tell ftell
68 /* Hash table read constants. */
69 static Lisp_Object Qhash_table
, Qdata
;
70 static Lisp_Object Qtest
, Qsize
;
71 static Lisp_Object Qweakness
;
72 static Lisp_Object Qrehash_size
;
73 static Lisp_Object Qrehash_threshold
;
75 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
76 Lisp_Object Qstandard_input
;
77 Lisp_Object Qvariable_documentation
;
78 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
79 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
80 static Lisp_Object Qinhibit_file_name_operation
;
81 static Lisp_Object Qeval_buffer_list
;
82 Lisp_Object Qlexical_binding
;
83 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
85 /* Used instead of Qget_file_char while loading *.elc files compiled
86 by Emacs 21 or older. */
87 static Lisp_Object Qget_emacs_mule_file_char
;
89 static Lisp_Object Qload_force_doc_strings
;
91 static Lisp_Object Qload_in_progress
;
93 /* The association list of objects read with the #n=object form.
94 Each member of the list has the form (n . object), and is used to
95 look up the object for the corresponding #n# construct.
96 It must be set to nil before all top-level calls to read0. */
97 static Lisp_Object read_objects
;
99 /* List of descriptors now open for Fload. */
100 static Lisp_Object load_descriptor_list
;
102 /* File for get_file_char to read from. Use by load. */
103 static FILE *instream
;
105 /* For use within read-from-string (this reader is non-reentrant!!) */
106 static ptrdiff_t read_from_string_index
;
107 static ptrdiff_t read_from_string_index_byte
;
108 static ptrdiff_t read_from_string_limit
;
110 /* Number of characters read in the current call to Fread or
111 Fread_from_string. */
112 static EMACS_INT readchar_count
;
114 /* This contains the last string skipped with #@. */
115 static char *saved_doc_string
;
116 /* Length of buffer allocated in saved_doc_string. */
117 static ptrdiff_t saved_doc_string_size
;
118 /* Length of actual data in saved_doc_string. */
119 static ptrdiff_t saved_doc_string_length
;
120 /* This is the file position that string came from. */
121 static file_offset saved_doc_string_position
;
123 /* This contains the previous string skipped with #@.
124 We copy it from saved_doc_string when a new string
125 is put in saved_doc_string. */
126 static char *prev_saved_doc_string
;
127 /* Length of buffer allocated in prev_saved_doc_string. */
128 static ptrdiff_t prev_saved_doc_string_size
;
129 /* Length of actual data in prev_saved_doc_string. */
130 static ptrdiff_t prev_saved_doc_string_length
;
131 /* This is the file position that string came from. */
132 static file_offset prev_saved_doc_string_position
;
134 /* True means inside a new-style backquote
135 with no surrounding parentheses.
136 Fread initializes this to false, so we need not specbind it
137 or worry about what happens to it when there is an error. */
138 static bool new_backquote_flag
;
139 static Lisp_Object Qold_style_backquotes
;
141 /* A list of file names for files being loaded in Fload. Used to
142 check for recursive loads. */
144 static Lisp_Object Vloads_in_progress
;
146 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
149 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
150 Lisp_Object
, Lisp_Object
,
151 Lisp_Object
, Lisp_Object
);
152 static Lisp_Object
load_unwind (Lisp_Object
);
153 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
155 /* Functions that read one byte from the current source READCHARFUN
156 or unreads one byte. If the integer argument C is -1, it returns
157 one read byte, or -1 when there's no more byte in the source. If C
158 is 0 or positive, it unreads C, and the return value is not
161 static int readbyte_for_lambda (int, Lisp_Object
);
162 static int readbyte_from_file (int, Lisp_Object
);
163 static int readbyte_from_string (int, Lisp_Object
);
165 /* Handle unreading and rereading of characters.
166 Write READCHAR to read a character,
167 UNREAD(c) to unread c to be read again.
169 These macros correctly read/unread multibyte characters. */
171 #define READCHAR readchar (readcharfun, NULL)
172 #define UNREAD(c) unreadchar (readcharfun, c)
174 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
175 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
177 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
178 Qlambda, or a cons, we use this to keep an unread character because
179 a file stream can't handle multibyte-char unreading. The value -1
180 means that there's no unread character. */
181 static int unread_char
;
184 readchar (Lisp_Object readcharfun
, bool *multibyte
)
188 int (*readbyte
) (int, Lisp_Object
);
189 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
191 bool emacs_mule_encoding
= 0;
198 if (BUFFERP (readcharfun
))
200 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
202 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
204 if (! BUFFER_LIVE_P (inbuffer
))
207 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
210 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
212 /* Fetch the character code from the buffer. */
213 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
214 BUF_INC_POS (inbuffer
, pt_byte
);
221 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
222 if (! ASCII_BYTE_P (c
))
223 c
= BYTE8_TO_CHAR (c
);
226 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
230 if (MARKERP (readcharfun
))
232 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
234 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
236 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
239 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
241 /* Fetch the character code from the buffer. */
242 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
243 BUF_INC_POS (inbuffer
, bytepos
);
250 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
251 if (! ASCII_BYTE_P (c
))
252 c
= BYTE8_TO_CHAR (c
);
256 XMARKER (readcharfun
)->bytepos
= bytepos
;
257 XMARKER (readcharfun
)->charpos
++;
262 if (EQ (readcharfun
, Qlambda
))
264 readbyte
= readbyte_for_lambda
;
268 if (EQ (readcharfun
, Qget_file_char
))
270 readbyte
= readbyte_from_file
;
274 if (STRINGP (readcharfun
))
276 if (read_from_string_index
>= read_from_string_limit
)
278 else if (STRING_MULTIBYTE (readcharfun
))
282 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
283 read_from_string_index
,
284 read_from_string_index_byte
);
288 c
= SREF (readcharfun
, read_from_string_index_byte
);
289 read_from_string_index
++;
290 read_from_string_index_byte
++;
295 if (CONSP (readcharfun
))
297 /* This is the case that read_vector is reading from a unibyte
298 string that contains a byte sequence previously skipped
299 because of #@NUMBER. The car part of readcharfun is that
300 string, and the cdr part is a value of readcharfun given to
302 readbyte
= readbyte_from_string
;
303 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
304 emacs_mule_encoding
= 1;
308 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
310 readbyte
= readbyte_from_file
;
311 emacs_mule_encoding
= 1;
315 tem
= call0 (readcharfun
);
322 if (unread_char
>= 0)
328 c
= (*readbyte
) (-1, readcharfun
);
333 if (ASCII_BYTE_P (c
))
335 if (emacs_mule_encoding
)
336 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
339 len
= BYTES_BY_CHAR_HEAD (c
);
342 c
= (*readbyte
) (-1, readcharfun
);
343 if (c
< 0 || ! TRAILING_CODE_P (c
))
346 (*readbyte
) (buf
[i
], readcharfun
);
347 return BYTE8_TO_CHAR (buf
[0]);
351 return STRING_CHAR (buf
);
354 #define FROM_FILE_P(readcharfun) \
355 (EQ (readcharfun, Qget_file_char) \
356 || EQ (readcharfun, Qget_emacs_mule_file_char))
359 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
361 if (FROM_FILE_P (readcharfun
))
363 block_input (); /* FIXME: Not sure if it's needed. */
364 fseek (instream
, n
, SEEK_CUR
);
368 { /* We're not reading directly from a file. In that case, it's difficult
369 to reliably count bytes, since these are usually meant for the file's
370 encoding, whereas we're now typically in the internal encoding.
371 But luckily, skip_dyn_bytes is used to skip over a single
372 dynamic-docstring (or dynamic byte-code) which is always quoted such
373 that \037 is the final char. */
377 } while (c
>= 0 && c
!= '\037');
381 /* Unread the character C in the way appropriate for the stream READCHARFUN.
382 If the stream is a user function, call it with the char as argument. */
385 unreadchar (Lisp_Object readcharfun
, int c
)
389 /* Don't back up the pointer if we're unreading the end-of-input mark,
390 since readchar didn't advance it when we read it. */
392 else if (BUFFERP (readcharfun
))
394 struct buffer
*b
= XBUFFER (readcharfun
);
395 ptrdiff_t charpos
= BUF_PT (b
);
396 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
398 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
399 BUF_DEC_POS (b
, bytepos
);
403 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
405 else if (MARKERP (readcharfun
))
407 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
408 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
410 XMARKER (readcharfun
)->charpos
--;
411 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
412 BUF_DEC_POS (b
, bytepos
);
416 XMARKER (readcharfun
)->bytepos
= bytepos
;
418 else if (STRINGP (readcharfun
))
420 read_from_string_index
--;
421 read_from_string_index_byte
422 = string_char_to_byte (readcharfun
, read_from_string_index
);
424 else if (CONSP (readcharfun
))
428 else if (EQ (readcharfun
, Qlambda
))
432 else if (FROM_FILE_P (readcharfun
))
437 call1 (readcharfun
, make_number (c
));
441 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
443 return read_bytecode_char (c
>= 0);
448 readbyte_from_file (int c
, Lisp_Object readcharfun
)
453 ungetc (c
, instream
);
461 /* Interrupted reads have been observed while reading over the network. */
462 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
473 return (c
== EOF
? -1 : c
);
477 readbyte_from_string (int c
, Lisp_Object readcharfun
)
479 Lisp_Object string
= XCAR (readcharfun
);
483 read_from_string_index
--;
484 read_from_string_index_byte
485 = string_char_to_byte (string
, read_from_string_index
);
488 if (read_from_string_index
>= read_from_string_limit
)
491 FETCH_STRING_CHAR_ADVANCE (c
, string
,
492 read_from_string_index
,
493 read_from_string_index_byte
);
498 /* Read one non-ASCII character from INSTREAM. The character is
499 encoded in `emacs-mule' and the first byte is already read in
503 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
505 /* Emacs-mule coding uses at most 4-byte for one character. */
506 unsigned char buf
[4];
507 int len
= emacs_mule_bytes
[c
];
508 struct charset
*charset
;
513 /* C is not a valid leading-code of `emacs-mule'. */
514 return BYTE8_TO_CHAR (c
);
520 c
= (*readbyte
) (-1, readcharfun
);
524 (*readbyte
) (buf
[i
], readcharfun
);
525 return BYTE8_TO_CHAR (buf
[0]);
532 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
533 code
= buf
[1] & 0x7F;
537 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
538 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
540 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
541 code
= buf
[2] & 0x7F;
545 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
546 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
551 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
552 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
554 c
= DECODE_CHAR (charset
, code
);
556 Fsignal (Qinvalid_read_syntax
,
557 Fcons (build_string ("invalid multibyte form"), Qnil
));
562 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
564 static Lisp_Object
read0 (Lisp_Object
);
565 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
567 static Lisp_Object
read_list (bool, Lisp_Object
);
568 static Lisp_Object
read_vector (Lisp_Object
, bool);
570 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
572 static void substitute_object_in_subtree (Lisp_Object
,
574 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
577 /* Get a character from the tty. */
579 /* Read input events until we get one that's acceptable for our purposes.
581 If NO_SWITCH_FRAME, switch-frame events are stashed
582 until we get a character we like, and then stuffed into
585 If ASCII_REQUIRED, check function key events to see
586 if the unmodified version of the symbol has a Qascii_character
587 property, and use that character, if present.
589 If ERROR_NONASCII, signal an error if the input we
590 get isn't an ASCII character with modifiers. If it's false but
591 ASCII_REQUIRED is true, just re-read until we get an ASCII
594 If INPUT_METHOD, invoke the current input method
595 if the character warrants that.
597 If SECONDS is a number, wait that many seconds for input, and
598 return Qnil if no input arrives within that time. */
601 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
602 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
604 Lisp_Object val
, delayed_switch_frame
;
607 #ifdef HAVE_WINDOW_SYSTEM
608 if (display_hourglass_p
)
612 delayed_switch_frame
= Qnil
;
614 /* Compute timeout. */
615 if (NUMBERP (seconds
))
617 double duration
= extract_float (seconds
);
618 EMACS_TIME wait_time
= EMACS_TIME_FROM_DOUBLE (duration
);
619 end_time
= add_emacs_time (current_emacs_time (), wait_time
);
622 /* Read until we get an acceptable event. */
625 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
626 NUMBERP (seconds
) ? &end_time
: NULL
);
627 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
632 /* `switch-frame' events are put off until after the next ASCII
633 character. This is better than signaling an error just because
634 the last characters were typed to a separate minibuffer frame,
635 for example. Eventually, some code which can deal with
636 switch-frame events will read it and process it. */
638 && EVENT_HAS_PARAMETERS (val
)
639 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
641 delayed_switch_frame
= val
;
645 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
647 /* Convert certain symbols to their ASCII equivalents. */
650 Lisp_Object tem
, tem1
;
651 tem
= Fget (val
, Qevent_symbol_element_mask
);
654 tem1
= Fget (Fcar (tem
), Qascii_character
);
655 /* Merge this symbol's modifier bits
656 with the ASCII equivalent of its basic code. */
658 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
662 /* If we don't have a character now, deal with it appropriately. */
667 Vunread_command_events
= Fcons (val
, Qnil
);
668 error ("Non-character input-event");
675 if (! NILP (delayed_switch_frame
))
676 unread_switch_frame
= delayed_switch_frame
;
680 #ifdef HAVE_WINDOW_SYSTEM
681 if (display_hourglass_p
)
690 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
691 doc
: /* Read a character from the command input (keyboard or macro).
692 It is returned as a number.
693 If the character has modifiers, they are resolved and reflected to the
694 character code if possible (e.g. C-SPC -> 0).
696 If the user generates an event which is not a character (i.e. a mouse
697 click or function key event), `read-char' signals an error. As an
698 exception, switch-frame events are put off until non-character events
700 If you want to read non-character events, or ignore them, call
701 `read-event' or `read-char-exclusive' instead.
703 If the optional argument PROMPT is non-nil, display that as a prompt.
704 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
705 input method is turned on in the current buffer, that input method
706 is used for reading a character.
707 If the optional argument SECONDS is non-nil, it should be a number
708 specifying the maximum number of seconds to wait for input. If no
709 input arrives in that time, return nil. SECONDS may be a
710 floating-point value. */)
711 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
716 message_with_string ("%s", prompt
, 0);
717 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
719 return (NILP (val
) ? Qnil
720 : make_number (char_resolve_modifier_mask (XINT (val
))));
723 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
724 doc
: /* Read an event object from the input stream.
725 If the optional argument PROMPT is non-nil, display that as a prompt.
726 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
727 input method is turned on in the current buffer, that input method
728 is used for reading a character.
729 If the optional argument SECONDS is non-nil, it should be a number
730 specifying the maximum number of seconds to wait for input. If no
731 input arrives in that time, return nil. SECONDS may be a
732 floating-point value. */)
733 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
736 message_with_string ("%s", prompt
, 0);
737 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
740 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
741 doc
: /* Read a character from the command input (keyboard or macro).
742 It is returned as a number. Non-character events are ignored.
743 If the character has modifiers, they are resolved and reflected to the
744 character code if possible (e.g. C-SPC -> 0).
746 If the optional argument PROMPT is non-nil, display that as a prompt.
747 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
748 input method is turned on in the current buffer, that input method
749 is used for reading a character.
750 If the optional argument SECONDS is non-nil, it should be a number
751 specifying the maximum number of seconds to wait for input. If no
752 input arrives in that time, return nil. SECONDS may be a
753 floating-point value. */)
754 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
759 message_with_string ("%s", prompt
, 0);
761 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
763 return (NILP (val
) ? Qnil
764 : make_number (char_resolve_modifier_mask (XINT (val
))));
767 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
768 doc
: /* Don't use this yourself. */)
771 register Lisp_Object val
;
773 XSETINT (val
, getc (instream
));
781 /* Return true if the lisp code read using READCHARFUN defines a non-nil
782 `lexical-binding' file variable. After returning, the stream is
783 positioned following the first line, if it is a comment or #! line,
784 otherwise nothing is read. */
787 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
800 while (ch
!= '\n' && ch
!= EOF
)
802 if (ch
== '\n') ch
= READCHAR
;
803 /* It is OK to leave the position after a #! line, since
804 that is what read1 does. */
808 /* The first line isn't a comment, just give up. */
814 /* Look for an appropriate file-variable in the first line. */
818 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
819 } beg_end_state
= NOMINAL
;
820 bool in_file_vars
= 0;
822 #define UPDATE_BEG_END_STATE(ch) \
823 if (beg_end_state == NOMINAL) \
824 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
825 else if (beg_end_state == AFTER_FIRST_DASH) \
826 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
827 else if (beg_end_state == AFTER_ASTERIX) \
830 in_file_vars = !in_file_vars; \
831 beg_end_state = NOMINAL; \
834 /* Skip until we get to the file vars, if any. */
838 UPDATE_BEG_END_STATE (ch
);
840 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
844 char var
[100], val
[100];
849 /* Read a variable name. */
850 while (ch
== ' ' || ch
== '\t')
854 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
856 if (i
< sizeof var
- 1)
858 UPDATE_BEG_END_STATE (ch
);
862 /* Stop scanning if no colon was found before end marker. */
863 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
866 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
872 /* Read a variable value. */
875 while (ch
== ' ' || ch
== '\t')
879 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
881 if (i
< sizeof val
- 1)
883 UPDATE_BEG_END_STATE (ch
);
887 /* The value was terminated by an end-marker, which remove. */
889 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
893 if (strcmp (var
, "lexical-binding") == 0)
896 rv
= (strcmp (val
, "nil") != 0);
902 while (ch
!= '\n' && ch
!= EOF
)
909 /* Value is a version number of byte compiled code if the file
910 associated with file descriptor FD is a compiled Lisp file that's
911 safe to load. Only files compiled with Emacs are safe to load.
912 Files compiled with XEmacs can lead to a crash in Fbyte_code
913 because of an incompatible change in the byte compiler. */
916 safe_to_load_version (int fd
)
922 /* Read the first few bytes from the file, and look for a line
923 specifying the byte compiler version used. */
924 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
927 /* Skip to the next newline, skipping over the initial `ELC'
928 with NUL bytes following it, but note the version. */
929 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
934 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
935 buf
+ i
, nbytes
- i
) < 0)
939 lseek (fd
, 0, SEEK_SET
);
944 /* Callback for record_unwind_protect. Restore the old load list OLD,
945 after loading a file successfully. */
948 record_load_unwind (Lisp_Object old
)
950 return Vloads_in_progress
= old
;
953 /* This handler function is used via internal_condition_case_1. */
956 load_error_handler (Lisp_Object data
)
962 load_warn_old_style_backquotes (Lisp_Object file
)
964 if (!NILP (Vold_style_backquotes
))
967 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
974 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
975 doc
: /* Return the suffixes that `load' should try if a suffix is \
977 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
980 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
981 while (CONSP (suffixes
))
983 Lisp_Object exts
= Vload_file_rep_suffixes
;
984 suffix
= XCAR (suffixes
);
985 suffixes
= XCDR (suffixes
);
990 lst
= Fcons (concat2 (suffix
, ext
), lst
);
993 return Fnreverse (lst
);
996 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
997 doc
: /* Execute a file of Lisp code named FILE.
998 First try FILE with `.elc' appended, then try with `.el',
999 then try FILE unmodified (the exact suffixes in the exact order are
1000 determined by `load-suffixes'). Environment variable references in
1001 FILE are replaced with their values by calling `substitute-in-file-name'.
1002 This function searches the directories in `load-path'.
1004 If optional second arg NOERROR is non-nil,
1005 report no error if FILE doesn't exist.
1006 Print messages at start and end of loading unless
1007 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1009 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1010 suffixes `.elc' or `.el' to the specified name FILE.
1011 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1012 the suffix `.elc' or `.el'; don't accept just FILE unless
1013 it ends in one of those suffixes or includes a directory name.
1015 If NOSUFFIX is nil, then if a file could not be found, try looking for
1016 a different representation of the file by adding non-empty suffixes to
1017 its name, before trying another file. Emacs uses this feature to find
1018 compressed versions of files when Auto Compression mode is enabled.
1019 If NOSUFFIX is non-nil, disable this feature.
1021 The suffixes that this function tries out, when NOSUFFIX is nil, are
1022 given by the return value of `get-load-suffixes' and the values listed
1023 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1024 return value of `get-load-suffixes' is used, i.e. the file name is
1025 required to have a non-empty suffix.
1027 Loading a file records its definitions, and its `provide' and
1028 `require' calls, in an element of `load-history' whose
1029 car is the file name loaded. See `load-history'.
1031 While the file is in the process of being loaded, the variable
1032 `load-in-progress' is non-nil and the variable `load-file-name'
1033 is bound to the file's name.
1035 Return t if the file exists and loads successfully. */)
1036 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1038 register FILE *stream
;
1039 register int fd
= -1;
1040 ptrdiff_t count
= SPECPDL_INDEX ();
1041 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1042 Lisp_Object found
, efound
, hist_file_name
;
1043 /* True means we printed the ".el is newer" message. */
1045 /* True means we are loading a compiled file. */
1047 Lisp_Object handler
;
1049 const char *fmode
= "r";
1057 CHECK_STRING (file
);
1059 /* If file name is magic, call the handler. */
1060 /* This shouldn't be necessary any more now that `openp' handles it right.
1061 handler = Ffind_file_name_handler (file, Qload);
1062 if (!NILP (handler))
1063 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1065 /* Do this after the handler to avoid
1066 the need to gcpro noerror, nomessage and nosuffix.
1067 (Below here, we care only whether they are nil or not.)
1068 The presence of this call is the result of a historical accident:
1069 it used to be in every file-operation and when it got removed
1070 everywhere, it accidentally stayed here. Since then, enough people
1071 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1072 that it seemed risky to remove. */
1073 if (! NILP (noerror
))
1075 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1076 Qt
, load_error_handler
);
1081 file
= Fsubstitute_in_file_name (file
);
1084 /* Avoid weird lossage with null string as arg,
1085 since it would try to load a directory as a Lisp file. */
1086 if (SBYTES (file
) > 0)
1088 ptrdiff_t size
= SBYTES (file
);
1091 GCPRO2 (file
, found
);
1093 if (! NILP (must_suffix
))
1095 /* Don't insist on adding a suffix if FILE already ends with one. */
1097 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1100 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1102 /* Don't insist on adding a suffix
1103 if the argument includes a directory name. */
1104 else if (! NILP (Ffile_name_directory (file
)))
1108 fd
= openp (Vload_path
, file
,
1109 (!NILP (nosuffix
) ? Qnil
1110 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1111 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1112 tmp
[1] = Vload_file_rep_suffixes
,
1121 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1125 /* Tell startup.el whether or not we found the user's init file. */
1126 if (EQ (Qt
, Vuser_init_file
))
1127 Vuser_init_file
= found
;
1129 /* If FD is -2, that means openp found a magic file. */
1132 if (NILP (Fequal (found
, file
)))
1133 /* If FOUND is a different file name from FILE,
1134 find its handler even if we have already inhibited
1135 the `load' operation on FILE. */
1136 handler
= Ffind_file_name_handler (found
, Qt
);
1138 handler
= Ffind_file_name_handler (found
, Qload
);
1139 if (! NILP (handler
))
1140 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1142 /* Tramp has to deal with semi-broken packages that prepend
1143 drive letters to remote files. For that reason, Tramp
1144 catches file operations that test for file existence, which
1145 makes openp think X:/foo.elc files are remote. However,
1146 Tramp does not catch `load' operations for such files, so we
1147 end up with a nil as the `load' handler above. If we would
1148 continue with fd = -2, we will behave wrongly, and in
1149 particular try reading a .elc file in the "rt" mode instead
1150 of "rb". See bug #9311 for the results. To work around
1151 this, we try to open the file locally, and go with that if it
1153 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1159 /* Check if we're stuck in a recursive load cycle.
1161 2000-09-21: It's not possible to just check for the file loaded
1162 being a member of Vloads_in_progress. This fails because of the
1163 way the byte compiler currently works; `provide's are not
1164 evaluated, see font-lock.el/jit-lock.el as an example. This
1165 leads to a certain amount of ``normal'' recursion.
1167 Also, just loading a file recursively is not always an error in
1168 the general case; the second load may do something different. */
1172 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1173 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1177 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1179 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1180 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1183 /* All loads are by default dynamic, unless the file itself specifies
1184 otherwise using a file-variable in the first line. This is bound here
1185 so that it takes effect whether or not we use
1186 Vload_source_file_function. */
1187 specbind (Qlexical_binding
, Qnil
);
1189 /* Get the name for load-history. */
1190 hist_file_name
= (! NILP (Vpurify_flag
)
1191 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1192 tmp
[1] = Ffile_name_nondirectory (found
),
1198 /* Check for the presence of old-style quotes and warn about them. */
1199 specbind (Qold_style_backquotes
, Qnil
);
1200 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1202 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1203 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1204 /* Load .elc files directly, but not when they are
1205 remote and have no handler! */
1212 GCPRO3 (file
, found
, hist_file_name
);
1215 && ! (version
= safe_to_load_version (fd
)))
1218 if (!load_dangerous_libraries
)
1222 error ("File `%s' was not compiled in Emacs",
1225 else if (!NILP (nomessage
) && !force_load_messages
)
1226 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1231 efound
= ENCODE_FILE (found
);
1236 result
= stat (SSDATA (efound
), &s1
);
1239 SSET (efound
, SBYTES (efound
) - 1, 0);
1240 result
= stat (SSDATA (efound
), &s2
);
1241 SSET (efound
, SBYTES (efound
) - 1, 'c');
1245 && EMACS_TIME_LT (get_stat_mtime (&s1
), get_stat_mtime (&s2
)))
1247 /* Make the progress messages mention that source is newer. */
1250 /* If we won't print another message, mention this anyway. */
1251 if (!NILP (nomessage
) && !force_load_messages
)
1253 Lisp_Object msg_file
;
1254 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1255 message_with_string ("Source file `%s' newer than byte-compiled file",
1264 /* We are loading a source file (*.el). */
1265 if (!NILP (Vload_source_file_function
))
1271 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1272 NILP (noerror
) ? Qnil
: Qt
,
1273 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1274 return unbind_to (count
, val
);
1278 GCPRO3 (file
, found
, hist_file_name
);
1281 efound
= ENCODE_FILE (found
);
1282 /* If we somehow got here with fd == -2, meaning the file is deemed
1283 to be remote, don't even try to reopen the file locally; just
1284 force a failure instead. */
1288 stream
= fopen (SSDATA (efound
), fmode
);
1292 #else /* not WINDOWSNT */
1293 stream
= fdopen (fd
, fmode
);
1294 #endif /* not WINDOWSNT */
1298 error ("Failure to create stdio stream for %s", SDATA (file
));
1301 if (! NILP (Vpurify_flag
))
1302 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1304 if (NILP (nomessage
) || force_load_messages
)
1307 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1310 message_with_string ("Loading %s (source)...", file
, 1);
1312 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1314 else /* The typical case; compiled file newer than source file. */
1315 message_with_string ("Loading %s...", file
, 1);
1318 record_unwind_protect (load_unwind
, make_save_pointer (stream
));
1319 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1320 specbind (Qload_file_name
, found
);
1321 specbind (Qinhibit_file_name_operation
, Qnil
);
1322 load_descriptor_list
1323 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1324 specbind (Qload_in_progress
, Qt
);
1327 if (lisp_file_lexically_bound_p (Qget_file_char
))
1328 Fset (Qlexical_binding
, Qt
);
1330 if (! version
|| version
>= 22)
1331 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1332 0, Qnil
, Qnil
, Qnil
, Qnil
);
1335 /* We can't handle a file which was compiled with
1336 byte-compile-dynamic by older version of Emacs. */
1337 specbind (Qload_force_doc_strings
, Qt
);
1338 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1339 0, Qnil
, Qnil
, Qnil
, Qnil
);
1341 unbind_to (count
, Qnil
);
1343 /* Run any eval-after-load forms for this file. */
1344 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1345 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1349 xfree (saved_doc_string
);
1350 saved_doc_string
= 0;
1351 saved_doc_string_size
= 0;
1353 xfree (prev_saved_doc_string
);
1354 prev_saved_doc_string
= 0;
1355 prev_saved_doc_string_size
= 0;
1357 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1360 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1363 message_with_string ("Loading %s (source)...done", file
, 1);
1365 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1367 else /* The typical case; compiled file newer than source file. */
1368 message_with_string ("Loading %s...done", file
, 1);
1375 load_unwind (Lisp_Object arg
) /* Used as unwind-protect function in load. */
1377 FILE *stream
= XSAVE_POINTER (arg
, 0);
1388 load_descriptor_unwind (Lisp_Object oldlist
)
1390 load_descriptor_list
= oldlist
;
1394 /* Close all descriptors in use for Floads.
1395 This is used when starting a subprocess. */
1398 close_load_descs (void)
1402 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1403 emacs_close (XFASTINT (XCAR (tail
)));
1408 complete_filename_p (Lisp_Object pathname
)
1410 const unsigned char *s
= SDATA (pathname
);
1411 return (IS_DIRECTORY_SEP (s
[0])
1412 || (SCHARS (pathname
) > 2
1413 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1416 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1417 doc
: /* Search for FILENAME through PATH.
1418 Returns the file's name in absolute form, or nil if not found.
1419 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1420 file name when searching.
1421 If non-nil, PREDICATE is used instead of `file-readable-p'.
1422 PREDICATE can also be an integer to pass to the faccessat(2) function,
1423 in which case file-name-handlers are ignored.
1424 This function will normally skip directories, so if you want it to find
1425 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1426 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1429 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1430 if (NILP (predicate
) && fd
> 0)
1435 static Lisp_Object Qdir_ok
;
1437 /* Search for a file whose name is STR, looking in directories
1438 in the Lisp list PATH, and trying suffixes from SUFFIX.
1439 On success, returns a file descriptor. On failure, returns -1.
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 returns 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. */
1458 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1460 ptrdiff_t fn_size
= 100;
1464 ptrdiff_t want_length
;
1465 Lisp_Object filename
;
1466 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1467 Lisp_Object string
, tail
, encoded_fn
;
1468 ptrdiff_t max_suffix_len
= 0;
1472 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1474 CHECK_STRING_CAR (tail
);
1475 max_suffix_len
= max (max_suffix_len
,
1476 SBYTES (XCAR (tail
)));
1479 string
= filename
= encoded_fn
= Qnil
;
1480 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1485 if (complete_filename_p (str
))
1488 for (; CONSP (path
); path
= XCDR (path
))
1490 filename
= Fexpand_file_name (str
, XCAR (path
));
1491 if (!complete_filename_p (filename
))
1492 /* If there are non-absolute elts in PATH (eg "."). */
1493 /* Of course, this could conceivably lose if luser sets
1494 default-directory to be something non-absolute... */
1496 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1497 if (!complete_filename_p (filename
))
1498 /* Give up on this path element! */
1502 /* Calculate maximum length of any filename made from
1503 this path element/specified file name and any possible suffix. */
1504 want_length
= max_suffix_len
+ SBYTES (filename
);
1505 if (fn_size
<= want_length
)
1506 fn
= alloca (fn_size
= 100 + want_length
);
1508 /* Loop over suffixes. */
1509 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1510 CONSP (tail
); tail
= XCDR (tail
))
1512 ptrdiff_t fnlen
, lsuffix
= SBYTES (XCAR (tail
));
1513 Lisp_Object handler
;
1515 /* Concatenate path element/specified name with the suffix.
1516 If the directory starts with /:, remove that. */
1517 int prefixlen
= ((SCHARS (filename
) > 2
1518 && SREF (filename
, 0) == '/'
1519 && SREF (filename
, 1) == ':')
1521 fnlen
= SBYTES (filename
) - prefixlen
;
1522 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1523 memcpy (fn
+ fnlen
, SDATA (XCAR (tail
)), lsuffix
+ 1);
1525 /* Check that the file exists and is not a directory. */
1526 /* We used to only check for handlers on non-absolute file names:
1530 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1531 It's not clear why that was the case and it breaks things like
1532 (load "/bar.el") where the file is actually "/bar.el.gz". */
1533 string
= make_string (fn
, fnlen
);
1534 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1535 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1538 if (NILP (predicate
))
1539 exists
= !NILP (Ffile_readable_p (string
));
1542 Lisp_Object tmp
= call1 (predicate
, string
);
1543 exists
= !NILP (tmp
)
1544 && (EQ (tmp
, Qdir_ok
)
1545 || NILP (Ffile_directory_p (string
)));
1550 /* We succeeded; return this descriptor and filename. */
1562 encoded_fn
= ENCODE_FILE (string
);
1563 pfn
= SSDATA (encoded_fn
);
1565 /* Check that we can access or open it. */
1566 if (NATNUMP (predicate
))
1567 fd
= (((XFASTINT (predicate
) & ~INT_MAX
) == 0
1568 && (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1571 && ! file_directory_p (pfn
))
1576 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1578 && (fstat (fd
, &st
) != 0 || S_ISDIR (st
.st_mode
)))
1587 /* We succeeded; return this descriptor and filename. */
1604 /* Merge the list we've accumulated of globals from the current input source
1605 into the load_history variable. The details depend on whether
1606 the source has an associated file name or not.
1608 FILENAME is the file name that we are loading from.
1610 ENTIRE is true if loading that entire file, false if evaluating
1614 build_load_history (Lisp_Object filename
, bool entire
)
1616 Lisp_Object tail
, prev
, newelt
;
1617 Lisp_Object tem
, tem2
;
1620 tail
= Vload_history
;
1623 while (CONSP (tail
))
1627 /* Find the feature's previous assoc list... */
1628 if (!NILP (Fequal (filename
, Fcar (tem
))))
1632 /* If we're loading the entire file, remove old data. */
1636 Vload_history
= XCDR (tail
);
1638 Fsetcdr (prev
, XCDR (tail
));
1641 /* Otherwise, cons on new symbols that are not already members. */
1644 tem2
= Vcurrent_load_list
;
1646 while (CONSP (tem2
))
1648 newelt
= XCAR (tem2
);
1650 if (NILP (Fmember (newelt
, tem
)))
1651 Fsetcar (tail
, Fcons (XCAR (tem
),
1652 Fcons (newelt
, XCDR (tem
))));
1665 /* If we're loading an entire file, cons the new assoc onto the
1666 front of load-history, the most-recently-loaded position. Also
1667 do this if we didn't find an existing member for the file. */
1668 if (entire
|| !foundit
)
1669 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1674 readevalloop_1 (Lisp_Object old
)
1676 load_convert_to_unibyte
= ! NILP (old
);
1680 /* Signal an `end-of-file' error, if possible with file name
1683 static _Noreturn
void
1684 end_of_file_error (void)
1686 if (STRINGP (Vload_file_name
))
1687 xsignal1 (Qend_of_file
, Vload_file_name
);
1689 xsignal0 (Qend_of_file
);
1692 /* UNIBYTE specifies how to set load_convert_to_unibyte
1693 for this invocation.
1694 READFUN, if non-nil, is used instead of `read'.
1696 START, END specify region to read in current buffer (from eval-region).
1697 If the input is not from a buffer, they must be nil. */
1700 readevalloop (Lisp_Object readcharfun
,
1702 Lisp_Object sourcename
,
1704 Lisp_Object unibyte
, Lisp_Object readfun
,
1705 Lisp_Object start
, Lisp_Object end
)
1708 register Lisp_Object val
;
1709 ptrdiff_t count
= SPECPDL_INDEX ();
1710 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1711 struct buffer
*b
= 0;
1712 bool continue_reading_p
;
1713 Lisp_Object lex_bound
;
1714 /* True if reading an entire buffer. */
1715 bool whole_buffer
= 0;
1716 /* True on the first time around. */
1717 bool first_sexp
= 1;
1718 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1720 if (NILP (Ffboundp (macroexpand
))
1721 /* Don't macroexpand in .elc files, since it should have been done
1722 already. We actually don't know whether we're in a .elc file or not,
1723 so we use circumstantial evidence: .el files normally go through
1724 Vload_source_file_function -> load-with-code-conversion
1726 || EQ (readcharfun
, Qget_file_char
)
1727 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1730 if (MARKERP (readcharfun
))
1733 start
= readcharfun
;
1736 if (BUFFERP (readcharfun
))
1737 b
= XBUFFER (readcharfun
);
1738 else if (MARKERP (readcharfun
))
1739 b
= XMARKER (readcharfun
)->buffer
;
1741 /* We assume START is nil when input is not from a buffer. */
1742 if (! NILP (start
) && !b
)
1745 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1746 specbind (Qcurrent_load_list
, Qnil
);
1747 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1748 load_convert_to_unibyte
= !NILP (unibyte
);
1750 /* If lexical binding is active (either because it was specified in
1751 the file's header, or via a buffer-local variable), create an empty
1752 lexical environment, otherwise, turn off lexical binding. */
1753 lex_bound
= find_symbol_value (Qlexical_binding
);
1754 specbind (Qinternal_interpreter_environment
,
1755 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1756 ? Qnil
: Fcons (Qt
, Qnil
));
1758 GCPRO4 (sourcename
, readfun
, start
, end
);
1760 /* Try to ensure sourcename is a truename, except whilst preloading. */
1761 if (NILP (Vpurify_flag
)
1762 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1763 && !NILP (Ffboundp (Qfile_truename
)))
1764 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1766 LOADHIST_ATTACH (sourcename
);
1768 continue_reading_p
= 1;
1769 while (continue_reading_p
)
1771 ptrdiff_t count1
= SPECPDL_INDEX ();
1773 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1774 error ("Reading from killed buffer");
1778 /* Switch to the buffer we are reading from. */
1779 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1780 set_buffer_internal (b
);
1782 /* Save point in it. */
1783 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1784 /* Save ZV in it. */
1785 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1786 /* Those get unbound after we read one expression. */
1788 /* Set point and ZV around stuff to be read. */
1791 Fnarrow_to_region (make_number (BEGV
), end
);
1793 /* Just for cleanliness, convert END to a marker
1794 if it is an integer. */
1796 end
= Fpoint_max_marker ();
1799 /* On the first cycle, we can easily test here
1800 whether we are reading the whole buffer. */
1801 if (b
&& first_sexp
)
1802 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1809 while ((c
= READCHAR
) != '\n' && c
!= -1);
1814 unbind_to (count1
, Qnil
);
1818 /* Ignore whitespace here, so we can detect eof. */
1819 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1820 || c
== 0xa0) /* NBSP */
1823 if (!NILP (Vpurify_flag
) && c
== '(')
1825 val
= read_list (0, readcharfun
);
1830 read_objects
= Qnil
;
1831 if (!NILP (readfun
))
1833 val
= call1 (readfun
, readcharfun
);
1835 /* If READCHARFUN has set point to ZV, we should
1836 stop reading, even if the form read sets point
1837 to a different value when evaluated. */
1838 if (BUFFERP (readcharfun
))
1840 struct buffer
*buf
= XBUFFER (readcharfun
);
1841 if (BUF_PT (buf
) == BUF_ZV (buf
))
1842 continue_reading_p
= 0;
1845 else if (! NILP (Vload_read_function
))
1846 val
= call1 (Vload_read_function
, readcharfun
);
1848 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1851 if (!NILP (start
) && continue_reading_p
)
1852 start
= Fpoint_marker ();
1854 /* Restore saved point and BEGV. */
1855 unbind_to (count1
, Qnil
);
1857 /* Now eval what we just read. */
1858 if (!NILP (macroexpand
))
1859 val
= call1 (macroexpand
, val
);
1860 val
= eval_sub (val
);
1864 Vvalues
= Fcons (val
, Vvalues
);
1865 if (EQ (Vstandard_output
, Qt
))
1874 build_load_history (sourcename
,
1875 stream
|| whole_buffer
);
1879 unbind_to (count
, Qnil
);
1882 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1883 doc
: /* Execute the current buffer as Lisp code.
1884 When called from a Lisp program (i.e., not interactively), this
1885 function accepts up to five optional arguments:
1886 BUFFER is the buffer to evaluate (nil means use current buffer).
1887 PRINTFLAG controls printing of output:
1888 A value of nil means discard it; anything else is stream for print.
1889 FILENAME specifies the file name to use for `load-history'.
1890 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1892 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1893 functions should work normally even if PRINTFLAG is nil.
1895 This function preserves the position of point. */)
1896 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1898 ptrdiff_t count
= SPECPDL_INDEX ();
1899 Lisp_Object tem
, buf
;
1902 buf
= Fcurrent_buffer ();
1904 buf
= Fget_buffer (buffer
);
1906 error ("No such buffer");
1908 if (NILP (printflag
) && NILP (do_allow_print
))
1913 if (NILP (filename
))
1914 filename
= BVAR (XBUFFER (buf
), filename
);
1916 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1917 specbind (Qstandard_output
, tem
);
1918 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1919 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1920 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1921 readevalloop (buf
, 0, filename
,
1922 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1923 unbind_to (count
, Qnil
);
1928 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1929 doc
: /* Execute the region as Lisp code.
1930 When called from programs, expects two arguments,
1931 giving starting and ending indices in the current buffer
1932 of the text to be executed.
1933 Programs can pass third argument PRINTFLAG which controls output:
1934 A value of nil means discard it; anything else is stream for printing it.
1935 Also the fourth argument READ-FUNCTION, if non-nil, is used
1936 instead of `read' to read each expression. It gets one argument
1937 which is the input stream for reading characters.
1939 This function does not move point. */)
1940 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1942 /* FIXME: Do the eval-sexp-add-defvars dance! */
1943 ptrdiff_t count
= SPECPDL_INDEX ();
1944 Lisp_Object tem
, cbuf
;
1946 cbuf
= Fcurrent_buffer ();
1948 if (NILP (printflag
))
1952 specbind (Qstandard_output
, tem
);
1953 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1955 /* `readevalloop' calls functions which check the type of start and end. */
1956 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1957 !NILP (printflag
), Qnil
, read_function
,
1960 return unbind_to (count
, Qnil
);
1964 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1965 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1966 If STREAM is nil, use the value of `standard-input' (which see).
1967 STREAM or the value of `standard-input' may be:
1968 a buffer (read from point and advance it)
1969 a marker (read from where it points and advance it)
1970 a function (call it with no arguments for each character,
1971 call it with a char as argument to push a char back)
1972 a string (takes text from string, starting at the beginning)
1973 t (read text line using minibuffer and use it, or read from
1974 standard input in batch mode). */)
1975 (Lisp_Object stream
)
1978 stream
= Vstandard_input
;
1979 if (EQ (stream
, Qt
))
1980 stream
= Qread_char
;
1981 if (EQ (stream
, Qread_char
))
1982 /* FIXME: ¿¡ When is this used !? */
1983 return call1 (intern ("read-minibuffer"),
1984 build_string ("Lisp expression: "));
1986 return read_internal_start (stream
, Qnil
, Qnil
);
1989 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1990 doc
: /* Read one Lisp expression which is represented as text by STRING.
1991 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1992 FINAL-STRING-INDEX is an integer giving the position of the next
1993 remaining character in STRING.
1994 START and END optionally delimit a substring of STRING from which to read;
1995 they default to 0 and (length STRING) respectively. */)
1996 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1999 CHECK_STRING (string
);
2000 /* `read_internal_start' sets `read_from_string_index'. */
2001 ret
= read_internal_start (string
, start
, end
);
2002 return Fcons (ret
, make_number (read_from_string_index
));
2005 /* Function to set up the global context we need in toplevel read
2008 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2009 /* `start', `end' only used when stream is a string. */
2014 new_backquote_flag
= 0;
2015 read_objects
= Qnil
;
2016 if (EQ (Vread_with_symbol_positions
, Qt
)
2017 || EQ (Vread_with_symbol_positions
, stream
))
2018 Vread_symbol_positions_list
= Qnil
;
2020 if (STRINGP (stream
)
2021 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2023 ptrdiff_t startval
, endval
;
2026 if (STRINGP (stream
))
2029 string
= XCAR (stream
);
2032 endval
= SCHARS (string
);
2036 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2037 args_out_of_range (string
, end
);
2038 endval
= XINT (end
);
2045 CHECK_NUMBER (start
);
2046 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2047 args_out_of_range (string
, start
);
2048 startval
= XINT (start
);
2050 read_from_string_index
= startval
;
2051 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2052 read_from_string_limit
= endval
;
2055 retval
= read0 (stream
);
2056 if (EQ (Vread_with_symbol_positions
, Qt
)
2057 || EQ (Vread_with_symbol_positions
, stream
))
2058 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2063 /* Signal Qinvalid_read_syntax error.
2064 S is error string of length N (if > 0) */
2066 static _Noreturn
void
2067 invalid_syntax (const char *s
)
2069 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2073 /* Use this for recursive reads, in contexts where internal tokens
2077 read0 (Lisp_Object readcharfun
)
2079 register Lisp_Object val
;
2082 val
= read1 (readcharfun
, &c
, 0);
2086 xsignal1 (Qinvalid_read_syntax
,
2087 Fmake_string (make_number (1), make_number (c
)));
2090 static ptrdiff_t read_buffer_size
;
2091 static char *read_buffer
;
2093 /* Read a \-escape sequence, assuming we already read the `\'.
2094 If the escape sequence forces unibyte, return eight-bit char. */
2097 read_escape (Lisp_Object readcharfun
, bool stringp
)
2100 /* \u allows up to four hex digits, \U up to eight. Default to the
2101 behavior for \u, and change this value in the case that \U is seen. */
2102 int unicode_hex_count
= 4;
2107 end_of_file_error ();
2137 error ("Invalid escape character syntax");
2140 c
= read_escape (readcharfun
, 0);
2141 return c
| meta_modifier
;
2146 error ("Invalid escape character syntax");
2149 c
= read_escape (readcharfun
, 0);
2150 return c
| shift_modifier
;
2155 error ("Invalid escape character syntax");
2158 c
= read_escape (readcharfun
, 0);
2159 return c
| hyper_modifier
;
2164 error ("Invalid escape character syntax");
2167 c
= read_escape (readcharfun
, 0);
2168 return c
| alt_modifier
;
2172 if (stringp
|| c
!= '-')
2179 c
= read_escape (readcharfun
, 0);
2180 return c
| super_modifier
;
2185 error ("Invalid escape character syntax");
2189 c
= read_escape (readcharfun
, 0);
2190 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2191 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2192 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2193 return c
| ctrl_modifier
;
2194 /* ASCII control chars are made from letters (both cases),
2195 as well as the non-letters within 0100...0137. */
2196 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2197 return (c
& (037 | ~0177));
2198 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2199 return (c
& (037 | ~0177));
2201 return c
| ctrl_modifier
;
2211 /* An octal escape, as in ANSI C. */
2213 register int i
= c
- '0';
2214 register int count
= 0;
2217 if ((c
= READCHAR
) >= '0' && c
<= '7')
2229 if (i
>= 0x80 && i
< 0x100)
2230 i
= BYTE8_TO_CHAR (i
);
2235 /* A hex escape, as in ANSI C. */
2242 if (c
>= '0' && c
<= '9')
2247 else if ((c
>= 'a' && c
<= 'f')
2248 || (c
>= 'A' && c
<= 'F'))
2251 if (c
>= 'a' && c
<= 'f')
2261 /* Allow hex escapes as large as ?\xfffffff, because some
2262 packages use them to denote characters with modifiers. */
2263 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2264 error ("Hex character out of range: \\x%x...", i
);
2268 if (count
< 3 && i
>= 0x80)
2269 return BYTE8_TO_CHAR (i
);
2274 /* Post-Unicode-2.0: Up to eight hex chars. */
2275 unicode_hex_count
= 8;
2278 /* A Unicode escape. We only permit them in strings and characters,
2279 not arbitrarily in the source code, as in some other languages. */
2284 while (++count
<= unicode_hex_count
)
2287 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2289 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2290 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2291 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2293 error ("Non-hex digit used for Unicode escape");
2296 error ("Non-Unicode character: 0x%x", i
);
2305 /* Return the digit that CHARACTER stands for in the given BASE.
2306 Return -1 if CHARACTER is out of range for BASE,
2307 and -2 if CHARACTER is not valid for any supported BASE. */
2309 digit_to_number (int character
, int base
)
2313 if ('0' <= character
&& character
<= '9')
2314 digit
= character
- '0';
2315 else if ('a' <= character
&& character
<= 'z')
2316 digit
= character
- 'a' + 10;
2317 else if ('A' <= character
&& character
<= 'Z')
2318 digit
= character
- 'A' + 10;
2322 return digit
< base
? digit
: -1;
2325 /* Read an integer in radix RADIX using READCHARFUN to read
2326 characters. RADIX must be in the interval [2..36]; if it isn't, a
2327 read error is signaled . Value is the integer read. Signals an
2328 error if encountering invalid read syntax or if RADIX is out of
2332 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2334 /* Room for sign, leading 0, other digits, trailing null byte.
2335 Also, room for invalid syntax diagnostic. */
2336 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2337 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2339 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2341 if (radix
< 2 || radix
> 36)
2349 if (c
== '-' || c
== '+')
2360 /* Ignore redundant leading zeros, so the buffer doesn't
2361 fill up with them. */
2367 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2374 if (p
< buf
+ sizeof buf
- 1)
2388 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2389 invalid_syntax (buf
);
2392 return string_to_number (buf
, radix
, 0);
2396 /* If the next token is ')' or ']' or '.', we store that character
2397 in *PCH and the return value is not interesting. Else, we store
2398 zero in *PCH and we read and return one lisp object.
2400 FIRST_IN_LIST is true if this is the first element of a list. */
2403 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2406 bool uninterned_symbol
= 0;
2413 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2415 end_of_file_error ();
2420 return read_list (0, readcharfun
);
2423 return read_vector (readcharfun
, 0);
2439 /* Accept extended format for hashtables (extensible to
2441 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2442 Lisp_Object tmp
= read_list (0, readcharfun
);
2443 Lisp_Object head
= CAR_SAFE (tmp
);
2444 Lisp_Object data
= Qnil
;
2445 Lisp_Object val
= Qnil
;
2446 /* The size is 2 * number of allowed keywords to
2448 Lisp_Object params
[10];
2450 Lisp_Object key
= Qnil
;
2451 int param_count
= 0;
2453 if (!EQ (head
, Qhash_table
))
2454 error ("Invalid extended read marker at head of #s list "
2455 "(only hash-table allowed)");
2457 tmp
= CDR_SAFE (tmp
);
2459 /* This is repetitive but fast and simple. */
2460 params
[param_count
] = QCsize
;
2461 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2462 if (!NILP (params
[param_count
+ 1]))
2465 params
[param_count
] = QCtest
;
2466 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2467 if (!NILP (params
[param_count
+ 1]))
2470 params
[param_count
] = QCweakness
;
2471 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2472 if (!NILP (params
[param_count
+ 1]))
2475 params
[param_count
] = QCrehash_size
;
2476 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2477 if (!NILP (params
[param_count
+ 1]))
2480 params
[param_count
] = QCrehash_threshold
;
2481 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2482 if (!NILP (params
[param_count
+ 1]))
2485 /* This is the hashtable data. */
2486 data
= Fplist_get (tmp
, Qdata
);
2488 /* Now use params to make a new hashtable and fill it. */
2489 ht
= Fmake_hash_table (param_count
, params
);
2491 while (CONSP (data
))
2496 error ("Odd number of elements in hashtable data");
2499 Fputhash (key
, val
, ht
);
2505 invalid_syntax ("#");
2513 tmp
= read_vector (readcharfun
, 0);
2514 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2515 error ("Invalid size char-table");
2516 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2528 tmp
= read_vector (readcharfun
, 0);
2531 error ("Invalid size char-table");
2532 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2533 error ("Invalid depth in char-table");
2534 depth
= XINT (AREF (tmp
, 0));
2535 if (chartab_size
[depth
] != size
- 2)
2536 error ("Invalid size char-table");
2537 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2540 invalid_syntax ("#^^");
2542 invalid_syntax ("#^");
2547 length
= read1 (readcharfun
, pch
, first_in_list
);
2551 Lisp_Object tmp
, val
;
2552 EMACS_INT size_in_chars
2553 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2554 / BOOL_VECTOR_BITS_PER_CHAR
);
2557 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2558 if (STRING_MULTIBYTE (tmp
)
2559 || (size_in_chars
!= SCHARS (tmp
)
2560 /* We used to print 1 char too many
2561 when the number of bits was a multiple of 8.
2562 Accept such input in case it came from an old
2564 && ! (XFASTINT (length
)
2565 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2566 invalid_syntax ("#&...");
2568 val
= Fmake_bool_vector (length
, Qnil
);
2569 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2570 /* Clear the extraneous bits in the last byte. */
2571 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2572 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2573 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2576 invalid_syntax ("#&...");
2580 /* Accept compiled functions at read-time so that we don't have to
2581 build them using function calls. */
2583 tmp
= read_vector (readcharfun
, 1);
2584 make_byte_code (XVECTOR (tmp
));
2590 struct gcpro gcpro1
;
2593 /* Read the string itself. */
2594 tmp
= read1 (readcharfun
, &ch
, 0);
2595 if (ch
!= 0 || !STRINGP (tmp
))
2596 invalid_syntax ("#");
2598 /* Read the intervals and their properties. */
2601 Lisp_Object beg
, end
, plist
;
2603 beg
= read1 (readcharfun
, &ch
, 0);
2608 end
= read1 (readcharfun
, &ch
, 0);
2610 plist
= read1 (readcharfun
, &ch
, 0);
2612 invalid_syntax ("Invalid string property list");
2613 Fset_text_properties (beg
, end
, plist
, tmp
);
2619 /* #@NUMBER is used to skip NUMBER following bytes.
2620 That's used in .elc files to skip over doc strings
2621 and function definitions. */
2624 enum { extra
= 100 };
2625 ptrdiff_t i
, nskip
= 0;
2627 /* Read a decimal integer. */
2628 while ((c
= READCHAR
) >= 0
2629 && c
>= '0' && c
<= '9')
2631 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2637 /* We can't use UNREAD here, because in the code below we side-step
2638 READCHAR. Instead, assume the first char after #@NNN occupies
2639 a single byte, which is the case normally since it's just
2645 if (load_force_doc_strings
2646 && (FROM_FILE_P (readcharfun
)))
2648 /* If we are supposed to force doc strings into core right now,
2649 record the last string that we skipped,
2650 and record where in the file it comes from. */
2652 /* But first exchange saved_doc_string
2653 with prev_saved_doc_string, so we save two strings. */
2655 char *temp
= saved_doc_string
;
2656 ptrdiff_t temp_size
= saved_doc_string_size
;
2657 file_offset temp_pos
= saved_doc_string_position
;
2658 ptrdiff_t temp_len
= saved_doc_string_length
;
2660 saved_doc_string
= prev_saved_doc_string
;
2661 saved_doc_string_size
= prev_saved_doc_string_size
;
2662 saved_doc_string_position
= prev_saved_doc_string_position
;
2663 saved_doc_string_length
= prev_saved_doc_string_length
;
2665 prev_saved_doc_string
= temp
;
2666 prev_saved_doc_string_size
= temp_size
;
2667 prev_saved_doc_string_position
= temp_pos
;
2668 prev_saved_doc_string_length
= temp_len
;
2671 if (saved_doc_string_size
== 0)
2673 saved_doc_string
= xmalloc (nskip
+ extra
);
2674 saved_doc_string_size
= nskip
+ extra
;
2676 if (nskip
> saved_doc_string_size
)
2678 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2679 saved_doc_string_size
= nskip
+ extra
;
2682 saved_doc_string_position
= file_tell (instream
);
2684 /* Copy that many characters into saved_doc_string. */
2686 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2687 saved_doc_string
[i
] = c
= getc (instream
);
2690 saved_doc_string_length
= i
;
2693 /* Skip that many bytes. */
2694 skip_dyn_bytes (readcharfun
, nskip
);
2700 /* #! appears at the beginning of an executable file.
2701 Skip the first line. */
2702 while (c
!= '\n' && c
>= 0)
2707 return Vload_file_name
;
2709 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2710 /* #:foo is the uninterned symbol named foo. */
2713 uninterned_symbol
= 1;
2716 && c
!= 0xa0 /* NBSP */
2718 || strchr ("\"';()[]#`,", c
) == NULL
)))
2720 /* No symbol character follows, this is the empty
2723 return Fmake_symbol (empty_unibyte_string
);
2727 /* ## is the empty symbol. */
2729 return Fintern (empty_unibyte_string
, Qnil
);
2730 /* Reader forms that can reuse previously read objects. */
2731 if (c
>= '0' && c
<= '9')
2736 /* Read a non-negative integer. */
2737 while (c
>= '0' && c
<= '9')
2739 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2740 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2741 n
= MOST_POSITIVE_FIXNUM
+ 1;
2743 n
= n
* 10 + c
- '0';
2747 if (n
<= MOST_POSITIVE_FIXNUM
)
2749 if (c
== 'r' || c
== 'R')
2750 return read_integer (readcharfun
, n
);
2752 if (! NILP (Vread_circle
))
2754 /* #n=object returns object, but associates it with
2758 /* Make a placeholder for #n# to use temporarily. */
2759 Lisp_Object placeholder
;
2762 placeholder
= Fcons (Qnil
, Qnil
);
2763 cell
= Fcons (make_number (n
), placeholder
);
2764 read_objects
= Fcons (cell
, read_objects
);
2766 /* Read the object itself. */
2767 tem
= read0 (readcharfun
);
2769 /* Now put it everywhere the placeholder was... */
2770 substitute_object_in_subtree (tem
, placeholder
);
2772 /* ...and #n# will use the real value from now on. */
2773 Fsetcdr (cell
, tem
);
2778 /* #n# returns a previously read object. */
2781 tem
= Fassq (make_number (n
), read_objects
);
2787 /* Fall through to error message. */
2789 else if (c
== 'x' || c
== 'X')
2790 return read_integer (readcharfun
, 16);
2791 else if (c
== 'o' || c
== 'O')
2792 return read_integer (readcharfun
, 8);
2793 else if (c
== 'b' || c
== 'B')
2794 return read_integer (readcharfun
, 2);
2797 invalid_syntax ("#");
2800 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2805 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2810 int next_char
= READCHAR
;
2812 /* Transition from old-style to new-style:
2813 If we see "(`" it used to mean old-style, which usually works
2814 fine because ` should almost never appear in such a position
2815 for new-style. But occasionally we need "(`" to mean new
2816 style, so we try to distinguish the two by the fact that we
2817 can either write "( `foo" or "(` foo", where the first
2818 intends to use new-style whereas the second intends to use
2819 old-style. For Emacs-25, we should completely remove this
2820 first_in_list exception (old-style can still be obtained via
2822 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2824 Vold_style_backquotes
= Qt
;
2830 bool saved_new_backquote_flag
= new_backquote_flag
;
2832 new_backquote_flag
= 1;
2833 value
= read0 (readcharfun
);
2834 new_backquote_flag
= saved_new_backquote_flag
;
2836 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2841 int next_char
= READCHAR
;
2843 /* Transition from old-style to new-style:
2844 It used to be impossible to have a new-style , other than within
2845 a new-style `. This is sufficient when ` and , are used in the
2846 normal way, but ` and , can also appear in args to macros that
2847 will not interpret them in the usual way, in which case , may be
2848 used without any ` anywhere near.
2849 So we now use the same heuristic as for backquote: old-style
2850 unquotes are only recognized when first on a list, and when
2851 followed by a space.
2852 Because it's more difficult to peek 2 chars ahead, a new-style
2853 ,@ can still not be used outside of a `, unless it's in the middle
2855 if (new_backquote_flag
2857 || (next_char
!= ' ' && next_char
!= '@'))
2859 Lisp_Object comma_type
= Qnil
;
2864 comma_type
= Qcomma_at
;
2866 comma_type
= Qcomma_dot
;
2869 if (ch
>= 0) UNREAD (ch
);
2870 comma_type
= Qcomma
;
2873 value
= read0 (readcharfun
);
2874 return Fcons (comma_type
, Fcons (value
, Qnil
));
2878 Vold_style_backquotes
= Qt
;
2890 end_of_file_error ();
2892 /* Accept `single space' syntax like (list ? x) where the
2893 whitespace character is SPC or TAB.
2894 Other literal whitespace like NL, CR, and FF are not accepted,
2895 as there are well-established escape sequences for these. */
2896 if (c
== ' ' || c
== '\t')
2897 return make_number (c
);
2900 c
= read_escape (readcharfun
, 0);
2901 modifiers
= c
& CHAR_MODIFIER_MASK
;
2902 c
&= ~CHAR_MODIFIER_MASK
;
2903 if (CHAR_BYTE8_P (c
))
2904 c
= CHAR_TO_BYTE8 (c
);
2907 next_char
= READCHAR
;
2908 ok
= (next_char
<= 040
2909 || (next_char
< 0200
2910 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2913 return make_number (c
);
2915 invalid_syntax ("?");
2920 char *p
= read_buffer
;
2921 char *end
= read_buffer
+ read_buffer_size
;
2923 /* True if we saw an escape sequence specifying
2924 a multibyte character. */
2925 bool force_multibyte
= 0;
2926 /* True if we saw an escape sequence specifying
2927 a single-byte character. */
2928 bool force_singlebyte
= 0;
2930 ptrdiff_t nchars
= 0;
2932 while ((ch
= READCHAR
) >= 0
2935 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2937 ptrdiff_t offset
= p
- read_buffer
;
2938 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2939 memory_full (SIZE_MAX
);
2940 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
2941 read_buffer_size
*= 2;
2942 p
= read_buffer
+ offset
;
2943 end
= read_buffer
+ read_buffer_size
;
2950 ch
= read_escape (readcharfun
, 1);
2952 /* CH is -1 if \ newline has just been seen. */
2955 if (p
== read_buffer
)
2960 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2961 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2963 if (CHAR_BYTE8_P (ch
))
2964 force_singlebyte
= 1;
2965 else if (! ASCII_CHAR_P (ch
))
2966 force_multibyte
= 1;
2967 else /* I.e. ASCII_CHAR_P (ch). */
2969 /* Allow `\C- ' and `\C-?'. */
2970 if (modifiers
== CHAR_CTL
)
2973 ch
= 0, modifiers
= 0;
2975 ch
= 127, modifiers
= 0;
2977 if (modifiers
& CHAR_SHIFT
)
2979 /* Shift modifier is valid only with [A-Za-z]. */
2980 if (ch
>= 'A' && ch
<= 'Z')
2981 modifiers
&= ~CHAR_SHIFT
;
2982 else if (ch
>= 'a' && ch
<= 'z')
2983 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2986 if (modifiers
& CHAR_META
)
2988 /* Move the meta bit to the right place for a
2990 modifiers
&= ~CHAR_META
;
2991 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2992 force_singlebyte
= 1;
2996 /* Any modifiers remaining are invalid. */
2998 error ("Invalid modifier in string");
2999 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3003 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3004 if (CHAR_BYTE8_P (ch
))
3005 force_singlebyte
= 1;
3006 else if (! ASCII_CHAR_P (ch
))
3007 force_multibyte
= 1;
3013 end_of_file_error ();
3015 /* If purifying, and string starts with \ newline,
3016 return zero instead. This is for doc strings
3017 that we are really going to find in etc/DOC.nn.nn. */
3018 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3019 return make_number (0);
3021 if (! force_multibyte
&& force_singlebyte
)
3023 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3024 forms. Convert it to unibyte. */
3025 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3027 p
= read_buffer
+ nchars
;
3030 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3032 || (p
- read_buffer
!= nchars
)));
3037 int next_char
= READCHAR
;
3040 if (next_char
<= 040
3041 || (next_char
< 0200
3042 && strchr ("\"';([#?`,", next_char
) != NULL
))
3048 /* Otherwise, we fall through! Note that the atom-reading loop
3049 below will now loop at least once, assuring that we will not
3050 try to UNREAD two characters in a row. */
3054 if (c
<= 040) goto retry
;
3055 if (c
== 0xa0) /* NBSP */
3060 char *p
= read_buffer
;
3062 EMACS_INT start_position
= readchar_count
- 1;
3065 char *end
= read_buffer
+ read_buffer_size
;
3069 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3071 ptrdiff_t offset
= p
- read_buffer
;
3072 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3073 memory_full (SIZE_MAX
);
3074 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3075 read_buffer_size
*= 2;
3076 p
= read_buffer
+ offset
;
3077 end
= read_buffer
+ read_buffer_size
;
3084 end_of_file_error ();
3089 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3095 && c
!= 0xa0 /* NBSP */
3097 || strchr ("\"';()[]#`,", c
) == NULL
));
3101 ptrdiff_t offset
= p
- read_buffer
;
3102 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3103 memory_full (SIZE_MAX
);
3104 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3105 read_buffer_size
*= 2;
3106 p
= read_buffer
+ offset
;
3107 end
= read_buffer
+ read_buffer_size
;
3113 if (!quoted
&& !uninterned_symbol
)
3115 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3116 if (! NILP (result
))
3120 Lisp_Object name
, result
;
3121 ptrdiff_t nbytes
= p
- read_buffer
;
3124 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3128 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3129 ? make_pure_string
: make_specified_string
)
3130 (read_buffer
, nchars
, nbytes
, multibyte
));
3131 result
= (uninterned_symbol
? Fmake_symbol (name
)
3132 : Fintern (name
, Qnil
));
3134 if (EQ (Vread_with_symbol_positions
, Qt
)
3135 || EQ (Vread_with_symbol_positions
, readcharfun
))
3136 Vread_symbol_positions_list
3137 = Fcons (Fcons (result
, make_number (start_position
)),
3138 Vread_symbol_positions_list
);
3146 /* List of nodes we've seen during substitute_object_in_subtree. */
3147 static Lisp_Object seen_list
;
3150 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3152 Lisp_Object check_object
;
3154 /* We haven't seen any objects when we start. */
3157 /* Make all the substitutions. */
3159 = substitute_object_recurse (object
, placeholder
, object
);
3161 /* Clear seen_list because we're done with it. */
3164 /* The returned object here is expected to always eq the
3166 if (!EQ (check_object
, object
))
3167 error ("Unexpected mutation error in reader");
3170 /* Feval doesn't get called from here, so no gc protection is needed. */
3171 #define SUBSTITUTE(get_val, set_val) \
3173 Lisp_Object old_value = get_val; \
3174 Lisp_Object true_value \
3175 = substitute_object_recurse (object, placeholder, \
3178 if (!EQ (old_value, true_value)) \
3185 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3187 /* If we find the placeholder, return the target object. */
3188 if (EQ (placeholder
, subtree
))
3191 /* If we've been to this node before, don't explore it again. */
3192 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3195 /* If this node can be the entry point to a cycle, remember that
3196 we've seen it. It can only be such an entry point if it was made
3197 by #n=, which means that we can find it as a value in
3199 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3200 seen_list
= Fcons (subtree
, seen_list
);
3202 /* Recurse according to subtree's type.
3203 Every branch must return a Lisp_Object. */
3204 switch (XTYPE (subtree
))
3206 case Lisp_Vectorlike
:
3208 ptrdiff_t i
, length
= 0;
3209 if (BOOL_VECTOR_P (subtree
))
3210 return subtree
; /* No sub-objects anyway. */
3211 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3212 || COMPILEDP (subtree
))
3213 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3214 else if (VECTORP (subtree
))
3215 length
= ASIZE (subtree
);
3217 /* An unknown pseudovector may contain non-Lisp fields, so we
3218 can't just blindly traverse all its fields. We used to call
3219 `Flength' which signaled `sequencep', so I just preserved this
3221 wrong_type_argument (Qsequencep
, subtree
);
3223 for (i
= 0; i
< length
; i
++)
3224 SUBSTITUTE (AREF (subtree
, i
),
3225 ASET (subtree
, i
, true_value
));
3231 SUBSTITUTE (XCAR (subtree
),
3232 XSETCAR (subtree
, true_value
));
3233 SUBSTITUTE (XCDR (subtree
),
3234 XSETCDR (subtree
, true_value
));
3240 /* Check for text properties in each interval.
3241 substitute_in_interval contains part of the logic. */
3243 INTERVAL root_interval
= string_intervals (subtree
);
3244 Lisp_Object arg
= Fcons (object
, placeholder
);
3246 traverse_intervals_noorder (root_interval
,
3247 &substitute_in_interval
, arg
);
3252 /* Other types don't recurse any further. */
3258 /* Helper function for substitute_object_recurse. */
3260 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3262 Lisp_Object object
= Fcar (arg
);
3263 Lisp_Object placeholder
= Fcdr (arg
);
3265 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3275 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3276 integer syntax and fits in a fixnum, else return the nearest float if CP has
3277 either floating point or integer syntax and BASE is 10, else return nil. If
3278 IGNORE_TRAILING, consider just the longest prefix of CP that has
3279 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3280 number has integer syntax but does not fit. */
3283 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3286 char const *cp
= string
;
3288 bool float_syntax
= 0;
3291 /* Compute NaN and infinities using a variable, to cope with compilers that
3292 think they are smarter than we are. */
3295 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3296 IEEE floating point hosts, and works around a formerly-common bug where
3297 atof ("-0.0") drops the sign. */
3298 bool negative
= *cp
== '-';
3300 bool signedp
= negative
|| *cp
== '+';
3305 leading_digit
= digit_to_number (*cp
, base
);
3306 if (leading_digit
>= 0)
3311 while (digit_to_number (*cp
, base
) >= 0);
3321 if ('0' <= *cp
&& *cp
<= '9')
3326 while ('0' <= *cp
&& *cp
<= '9');
3328 if (*cp
== 'e' || *cp
== 'E')
3330 char const *ecp
= cp
;
3332 if (*cp
== '+' || *cp
== '-')
3334 if ('0' <= *cp
&& *cp
<= '9')
3339 while ('0' <= *cp
&& *cp
<= '9');
3341 else if (cp
[-1] == '+'
3342 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3348 else if (cp
[-1] == '+'
3349 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3353 value
= zero
/ zero
;
3355 /* If that made a "negative" NaN, negate it. */
3358 union { double d
; char c
[sizeof (double)]; }
3359 u_data
, u_minus_zero
;
3361 u_minus_zero
.d
= -0.0;
3362 for (i
= 0; i
< sizeof (double); i
++)
3363 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3369 /* Now VALUE is a positive NaN. */
3375 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3376 || state
== (LEAD_INT
|E_EXP
));
3379 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3380 any prefix that matches. Otherwise, the entire string must match. */
3381 if (! (ignore_trailing
3382 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3383 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3386 /* If the number uses integer and not float syntax, and is in C-language
3387 range, use its value, preferably as a fixnum. */
3388 if (leading_digit
>= 0 && ! float_syntax
)
3392 /* Fast special case for single-digit integers. This also avoids a
3393 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3394 case some versions of strtoumax accept numbers like "0x1" that Emacs
3396 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3397 return make_number (negative
? -leading_digit
: leading_digit
);
3400 n
= strtoumax (string
+ signedp
, NULL
, base
);
3401 if (errno
== ERANGE
)
3403 /* Unfortunately there's no simple and accurate way to convert
3404 non-base-10 numbers that are out of C-language range. */
3406 xsignal1 (Qoverflow_error
, build_string (string
));
3408 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3410 EMACS_INT signed_n
= n
;
3411 return make_number (negative
? -signed_n
: signed_n
);
3417 /* Either the number uses float syntax, or it does not fit into a fixnum.
3418 Convert it from string to floating point, unless the value is already
3419 known because it is an infinity, a NAN, or its absolute value fits in
3422 value
= atof (string
+ signedp
);
3424 return make_float (negative
? -value
: value
);
3429 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3433 Lisp_Object tem
, item
, vector
;
3434 struct Lisp_Cons
*otem
;
3437 tem
= read_list (1, readcharfun
);
3438 len
= Flength (tem
);
3439 vector
= Fmake_vector (len
, Qnil
);
3441 size
= ASIZE (vector
);
3442 ptr
= XVECTOR (vector
)->contents
;
3443 for (i
= 0; i
< size
; i
++)
3446 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3447 bytecode object, the docstring containing the bytecode and
3448 constants values must be treated as unibyte and passed to
3449 Fread, to get the actual bytecode string and constants vector. */
3450 if (bytecodeflag
&& load_force_doc_strings
)
3452 if (i
== COMPILED_BYTECODE
)
3454 if (!STRINGP (item
))
3455 error ("Invalid byte code");
3457 /* Delay handling the bytecode slot until we know whether
3458 it is lazily-loaded (we can tell by whether the
3459 constants slot is nil). */
3460 ASET (vector
, COMPILED_CONSTANTS
, item
);
3463 else if (i
== COMPILED_CONSTANTS
)
3465 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3469 /* Coerce string to unibyte (like string-as-unibyte,
3470 but without generating extra garbage and
3471 guaranteeing no change in the contents). */
3472 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3473 STRING_SET_UNIBYTE (bytestr
);
3475 item
= Fread (Fcons (bytestr
, readcharfun
));
3477 error ("Invalid byte code");
3479 otem
= XCONS (item
);
3480 bytestr
= XCAR (item
);
3485 /* Now handle the bytecode slot. */
3486 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3488 else if (i
== COMPILED_DOC_STRING
3490 && ! STRING_MULTIBYTE (item
))
3492 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3493 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3495 item
= Fstring_as_multibyte (item
);
3498 ASET (vector
, i
, item
);
3506 /* FLAG means check for ] to terminate rather than ) and . */
3509 read_list (bool flag
, Lisp_Object readcharfun
)
3511 Lisp_Object val
, tail
;
3512 Lisp_Object elt
, tem
;
3513 struct gcpro gcpro1
, gcpro2
;
3514 /* 0 is the normal case.
3515 1 means this list is a doc reference; replace it with the number 0.
3516 2 means this list is a doc reference; replace it with the doc string. */
3517 int doc_reference
= 0;
3519 /* Initialize this to 1 if we are reading a list. */
3520 bool first_in_list
= flag
<= 0;
3529 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3534 /* While building, if the list starts with #$, treat it specially. */
3535 if (EQ (elt
, Vload_file_name
)
3537 && !NILP (Vpurify_flag
))
3539 if (NILP (Vdoc_file_name
))
3540 /* We have not yet called Snarf-documentation, so assume
3541 this file is described in the DOC-MM.NN file
3542 and Snarf-documentation will fill in the right value later.
3543 For now, replace the whole list with 0. */
3546 /* We have already called Snarf-documentation, so make a relative
3547 file name for this file, so it can be found properly
3548 in the installed Lisp directory.
3549 We don't use Fexpand_file_name because that would make
3550 the directory absolute now. */
3551 elt
= concat2 (build_string ("../lisp/"),
3552 Ffile_name_nondirectory (elt
));
3554 else if (EQ (elt
, Vload_file_name
)
3556 && load_force_doc_strings
)
3565 invalid_syntax (") or . in a vector");
3573 XSETCDR (tail
, read0 (readcharfun
));
3575 val
= read0 (readcharfun
);
3576 read1 (readcharfun
, &ch
, 0);
3580 if (doc_reference
== 1)
3581 return make_number (0);
3582 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3585 file_offset saved_position
;
3586 /* Get a doc string from the file we are loading.
3587 If it's in saved_doc_string, get it from there.
3589 Here, we don't know if the string is a
3590 bytecode string or a doc string. As a
3591 bytecode string must be unibyte, we always
3592 return a unibyte string. If it is actually a
3593 doc string, caller must make it
3596 /* Position is negative for user variables. */
3597 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3598 if (pos
>= saved_doc_string_position
3599 && pos
< (saved_doc_string_position
3600 + saved_doc_string_length
))
3602 saved
= saved_doc_string
;
3603 saved_position
= saved_doc_string_position
;
3605 /* Look in prev_saved_doc_string the same way. */
3606 else if (pos
>= prev_saved_doc_string_position
3607 && pos
< (prev_saved_doc_string_position
3608 + prev_saved_doc_string_length
))
3610 saved
= prev_saved_doc_string
;
3611 saved_position
= prev_saved_doc_string_position
;
3615 ptrdiff_t start
= pos
- saved_position
;
3618 /* Process quoting with ^A,
3619 and find the end of the string,
3620 which is marked with ^_ (037). */
3621 for (from
= start
, to
= start
;
3622 saved
[from
] != 037;)
3624 int c
= saved
[from
++];
3628 saved
[to
++] = (c
== 1 ? c
3637 return make_unibyte_string (saved
+ start
,
3641 return get_doc_string (val
, 1, 0);
3646 invalid_syntax (". in wrong context");
3648 invalid_syntax ("] in a list");
3650 tem
= Fcons (elt
, Qnil
);
3652 XSETCDR (tail
, tem
);
3659 static Lisp_Object initial_obarray
;
3661 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3663 static size_t oblookup_last_bucket_number
;
3665 /* Get an error if OBARRAY is not an obarray.
3666 If it is one, return it. */
3669 check_obarray (Lisp_Object obarray
)
3671 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3673 /* If Vobarray is now invalid, force it to be valid. */
3674 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3675 wrong_type_argument (Qvectorp
, obarray
);
3680 /* Intern the C string STR: return a symbol with that name,
3681 interned in the current obarray. */
3684 intern_1 (const char *str
, ptrdiff_t len
)
3686 Lisp_Object obarray
= check_obarray (Vobarray
);
3687 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3689 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3693 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3695 Lisp_Object obarray
= check_obarray (Vobarray
);
3696 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3701 if (NILP (Vpurify_flag
))
3702 /* Creating a non-pure string from a string literal not
3703 implemented yet. We could just use make_string here and live
3704 with the extra copy. */
3707 return Fintern (make_pure_c_string (str
, len
), obarray
);
3710 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3711 doc
: /* Return the canonical symbol whose name is STRING.
3712 If there is none, one is created by this function and returned.
3713 A second optional argument specifies the obarray to use;
3714 it defaults to the value of `obarray'. */)
3715 (Lisp_Object string
, Lisp_Object obarray
)
3717 register Lisp_Object tem
, sym
, *ptr
;
3719 if (NILP (obarray
)) obarray
= Vobarray
;
3720 obarray
= check_obarray (obarray
);
3722 CHECK_STRING (string
);
3724 tem
= oblookup (obarray
, SSDATA (string
),
3727 if (!INTEGERP (tem
))
3730 if (!NILP (Vpurify_flag
))
3731 string
= Fpurecopy (string
);
3732 sym
= Fmake_symbol (string
);
3734 if (EQ (obarray
, initial_obarray
))
3735 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3737 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3739 if ((SREF (string
, 0) == ':')
3740 && EQ (obarray
, initial_obarray
))
3742 XSYMBOL (sym
)->constant
= 1;
3743 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3744 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3747 ptr
= aref_addr (obarray
, XINT(tem
));
3749 set_symbol_next (sym
, XSYMBOL (*ptr
));
3751 set_symbol_next (sym
, NULL
);
3756 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3757 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3758 NAME may be a string or a symbol. If it is a symbol, that exact
3759 symbol is searched for.
3760 A second optional argument specifies the obarray to use;
3761 it defaults to the value of `obarray'. */)
3762 (Lisp_Object name
, Lisp_Object obarray
)
3764 register Lisp_Object tem
, string
;
3766 if (NILP (obarray
)) obarray
= Vobarray
;
3767 obarray
= check_obarray (obarray
);
3769 if (!SYMBOLP (name
))
3771 CHECK_STRING (name
);
3775 string
= SYMBOL_NAME (name
);
3777 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3778 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3784 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3785 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3786 The value is t if a symbol was found and deleted, nil otherwise.
3787 NAME may be a string or a symbol. If it is a symbol, that symbol
3788 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3789 OBARRAY defaults to the value of the variable `obarray'. */)
3790 (Lisp_Object name
, Lisp_Object obarray
)
3792 register Lisp_Object string
, tem
;
3795 if (NILP (obarray
)) obarray
= Vobarray
;
3796 obarray
= check_obarray (obarray
);
3799 string
= SYMBOL_NAME (name
);
3802 CHECK_STRING (name
);
3806 tem
= oblookup (obarray
, SSDATA (string
),
3811 /* If arg was a symbol, don't delete anything but that symbol itself. */
3812 if (SYMBOLP (name
) && !EQ (name
, tem
))
3815 /* There are plenty of other symbols which will screw up the Emacs
3816 session if we unintern them, as well as even more ways to use
3817 `setq' or `fset' or whatnot to make the Emacs session
3818 unusable. Let's not go down this silly road. --Stef */
3819 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3820 error ("Attempt to unintern t or nil"); */
3822 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3824 hash
= oblookup_last_bucket_number
;
3826 if (EQ (AREF (obarray
, hash
), tem
))
3828 if (XSYMBOL (tem
)->next
)
3831 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3832 ASET (obarray
, hash
, sym
);
3835 ASET (obarray
, hash
, make_number (0));
3839 Lisp_Object tail
, following
;
3841 for (tail
= AREF (obarray
, hash
);
3842 XSYMBOL (tail
)->next
;
3845 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3846 if (EQ (following
, tem
))
3848 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3857 /* Return the symbol in OBARRAY whose names matches the string
3858 of SIZE characters (SIZE_BYTE bytes) at PTR.
3859 If there is no such symbol in OBARRAY, return nil.
3861 Also store the bucket number in oblookup_last_bucket_number. */
3864 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3868 register Lisp_Object tail
;
3869 Lisp_Object bucket
, tem
;
3871 obarray
= check_obarray (obarray
);
3872 obsize
= ASIZE (obarray
);
3874 /* This is sometimes needed in the middle of GC. */
3875 obsize
&= ~ARRAY_MARK_FLAG
;
3876 hash
= hash_string (ptr
, size_byte
) % obsize
;
3877 bucket
= AREF (obarray
, hash
);
3878 oblookup_last_bucket_number
= hash
;
3879 if (EQ (bucket
, make_number (0)))
3881 else if (!SYMBOLP (bucket
))
3882 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3884 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3886 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3887 && SCHARS (SYMBOL_NAME (tail
)) == size
3888 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3890 else if (XSYMBOL (tail
)->next
== 0)
3893 XSETINT (tem
, hash
);
3898 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3901 register Lisp_Object tail
;
3902 CHECK_VECTOR (obarray
);
3903 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3905 tail
= AREF (obarray
, i
);
3910 if (XSYMBOL (tail
)->next
== 0)
3912 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3918 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3920 call1 (function
, sym
);
3923 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3924 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3925 OBARRAY defaults to the value of `obarray'. */)
3926 (Lisp_Object function
, Lisp_Object obarray
)
3928 if (NILP (obarray
)) obarray
= Vobarray
;
3929 obarray
= check_obarray (obarray
);
3931 map_obarray (obarray
, mapatoms_1
, function
);
3935 #define OBARRAY_SIZE 1511
3940 Lisp_Object oblength
;
3941 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3943 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3945 Vobarray
= Fmake_vector (oblength
, make_number (0));
3946 initial_obarray
= Vobarray
;
3947 staticpro (&initial_obarray
);
3949 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
3950 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3951 NILP (Vpurify_flag) check in intern_c_string. */
3952 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3953 Qnil
= intern_c_string ("nil");
3955 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3956 so those two need to be fixed manually. */
3957 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3958 set_symbol_function (Qunbound
, Qnil
);
3959 set_symbol_plist (Qunbound
, Qnil
);
3960 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3961 XSYMBOL (Qnil
)->constant
= 1;
3962 XSYMBOL (Qnil
)->declared_special
= 1;
3963 set_symbol_plist (Qnil
, Qnil
);
3964 set_symbol_function (Qnil
, Qnil
);
3966 Qt
= intern_c_string ("t");
3967 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3968 XSYMBOL (Qnil
)->declared_special
= 1;
3969 XSYMBOL (Qt
)->constant
= 1;
3971 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3974 DEFSYM (Qvariable_documentation
, "variable-documentation");
3976 read_buffer
= xmalloc (size
);
3977 read_buffer_size
= size
;
3981 defsubr (struct Lisp_Subr
*sname
)
3983 Lisp_Object sym
, tem
;
3984 sym
= intern_c_string (sname
->symbol_name
);
3985 XSETPVECTYPE (sname
, PVEC_SUBR
);
3986 XSETSUBR (tem
, sname
);
3987 set_symbol_function (sym
, tem
);
3990 #ifdef NOTDEF /* Use fset in subr.el now! */
3992 defalias (struct Lisp_Subr
*sname
, char *string
)
3995 sym
= intern (string
);
3996 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4000 /* Define an "integer variable"; a symbol whose value is forwarded to a
4001 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4002 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4004 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4005 const char *namestring
, EMACS_INT
*address
)
4008 sym
= intern_c_string (namestring
);
4009 i_fwd
->type
= Lisp_Fwd_Int
;
4010 i_fwd
->intvar
= address
;
4011 XSYMBOL (sym
)->declared_special
= 1;
4012 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4013 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4016 /* Similar but define a variable whose value is t if address contains 1,
4017 nil if address contains 0. */
4019 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4020 const char *namestring
, bool *address
)
4023 sym
= intern_c_string (namestring
);
4024 b_fwd
->type
= Lisp_Fwd_Bool
;
4025 b_fwd
->boolvar
= address
;
4026 XSYMBOL (sym
)->declared_special
= 1;
4027 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4028 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4029 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4032 /* Similar but define a variable whose value is the Lisp Object stored
4033 at address. Two versions: with and without gc-marking of the C
4034 variable. The nopro version is used when that variable will be
4035 gc-marked for some other reason, since marking the same slot twice
4036 can cause trouble with strings. */
4038 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4039 const char *namestring
, Lisp_Object
*address
)
4042 sym
= intern_c_string (namestring
);
4043 o_fwd
->type
= Lisp_Fwd_Obj
;
4044 o_fwd
->objvar
= address
;
4045 XSYMBOL (sym
)->declared_special
= 1;
4046 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4047 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4051 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4052 const char *namestring
, Lisp_Object
*address
)
4054 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4055 staticpro (address
);
4058 /* Similar but define a variable whose value is the Lisp Object stored
4059 at a particular offset in the current kboard object. */
4062 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4063 const char *namestring
, int offset
)
4066 sym
= intern_c_string (namestring
);
4067 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4068 ko_fwd
->offset
= offset
;
4069 XSYMBOL (sym
)->declared_special
= 1;
4070 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4071 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4074 /* Check that the elements of Vload_path exist. */
4077 load_path_check (void)
4079 Lisp_Object path_tail
;
4081 /* The only elements that might not exist are those from
4082 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4084 for (path_tail
= Vload_path
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4086 Lisp_Object dirfile
;
4087 dirfile
= Fcar (path_tail
);
4088 if (STRINGP (dirfile
))
4090 dirfile
= Fdirectory_file_name (dirfile
);
4091 if (! file_accessible_directory_p (SSDATA (dirfile
)))
4092 dir_warning ("Lisp directory", XCAR (path_tail
));
4097 /* Record the value of load-path used at the start of dumping
4098 so we can see if the site changed it later during dumping. */
4099 static Lisp_Object dump_path
;
4101 /* Compute the default Vload_path, with the following logic:
4103 use EMACSLOADPATH env-var if set; otherwise use PATH_LOADSEARCH,
4104 prepending PATH_SITELOADSEARCH unless --no-site-lisp.
4105 The remainder is what happens when dumping works:
4106 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4107 Otherwise use EMACSLOADPATH if set, else PATH_LOADSEARCH.
4109 If !initialized, then just set both Vload_path and dump_path.
4110 If initialized, then if Vload_path != dump_path, do nothing.
4111 (Presumably the load-path has already been changed by something.
4112 This can only be from a site-load file during dumping,
4113 or because EMACSLOADPATH is set.)
4114 If Vinstallation_directory is not nil (ie, running uninstalled):
4115 If installation-dir/lisp exists and not already a member,
4116 we must be running uninstalled. Reset the load-path
4117 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4118 refers to the eventual installation directories. Since we
4119 are not yet installed, we should not use them, even if they exist.)
4120 If installation-dir/lisp does not exist, just add dump_path at the
4122 Add installation-dir/leim (if exists and not already a member) at the front.
4123 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4124 and not already a member) at the front.
4125 If installation-dir != source-dir (ie running an uninstalled,
4126 out-of-tree build) AND install-dir/src/Makefile exists BUT
4127 install-dir/src/Makefile.in does NOT exist (this is a sanity
4128 check), then repeat the above steps for source-dir/lisp,
4130 Finally, add the site-lisp directories at the front (if !no_site_lisp).
4140 const char *loadpath
= ns_load_path ();
4143 normal
= PATH_LOADSEARCH
;
4145 Vload_path
= decode_env_path ("EMACSLOADPATH", loadpath
? loadpath
: normal
);
4147 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4152 /* FIXME CANNOT_DUMP platforms should get source-dir/lisp etc added
4153 to their load-path too, AFAICS. I don't think we can tell the
4154 difference between initialized and !initialized in this case,
4155 so we'll have to do it unconditionally when Vinstallation_directory
4157 if (!no_site_lisp
&& !egetenv ("EMACSLOADPATH"))
4159 Lisp_Object sitelisp
;
4160 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4161 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4163 #else /* !CANNOT_DUMP */
4164 if (NILP (Vpurify_flag
))
4166 normal
= PATH_LOADSEARCH
;
4167 /* If the EMACSLOADPATH environment variable is set, use its value.
4168 This doesn't apply if we're dumping. */
4169 if (egetenv ("EMACSLOADPATH"))
4170 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4173 normal
= PATH_DUMPLOADSEARCH
;
4175 /* In a dumped Emacs, we normally reset the value of Vload_path using
4176 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4177 the source directory, instead of the path of the installed elisp
4178 libraries. However, if it appears that Vload_path has already been
4179 changed from the default that was saved before dumping, don't
4180 change it further. Changes can only be due to EMACSLOADPATH, or
4181 site-lisp files that were processed during dumping. */
4184 if (NILP (Fequal (dump_path
, Vload_path
)))
4186 /* Do not make any changes, just check the elements exist. */
4187 /* Note: --no-site-lisp is ignored.
4188 I don't know what to do about this. */
4194 const char *loadpath
= ns_load_path ();
4195 Vload_path
= decode_env_path (0, loadpath
? loadpath
: normal
);
4197 Vload_path
= decode_env_path (0, normal
);
4199 if (!NILP (Vinstallation_directory
))
4201 Lisp_Object tem
, tem1
;
4203 /* Add to the path the lisp subdir of the installation
4204 dir, if it is accessible. Note: in out-of-tree builds,
4205 this directory is empty save for Makefile. */
4206 tem
= Fexpand_file_name (build_string ("lisp"),
4207 Vinstallation_directory
);
4208 tem1
= Ffile_accessible_directory_p (tem
);
4211 if (NILP (Fmember (tem
, Vload_path
)))
4213 /* We are running uninstalled. The default load-path
4214 points to the eventual installed lisp, leim
4215 directories. We should not use those now, even
4216 if they exist, so start over from a clean slate. */
4217 Vload_path
= Fcons (tem
, Qnil
);
4221 /* That dir doesn't exist, so add the build-time
4222 Lisp dirs instead. */
4223 Vload_path
= nconc2 (Vload_path
, dump_path
);
4225 /* Add leim under the installation dir, if it is accessible. */
4226 tem
= Fexpand_file_name (build_string ("leim"),
4227 Vinstallation_directory
);
4228 tem1
= Ffile_accessible_directory_p (tem
);
4231 if (NILP (Fmember (tem
, Vload_path
)))
4232 Vload_path
= Fcons (tem
, Vload_path
);
4235 /* Add site-lisp under the installation dir, if it exists. */
4238 tem
= Fexpand_file_name (build_string ("site-lisp"),
4239 Vinstallation_directory
);
4240 tem1
= Ffile_accessible_directory_p (tem
);
4243 if (NILP (Fmember (tem
, Vload_path
)))
4244 Vload_path
= Fcons (tem
, Vload_path
);
4248 /* If Emacs was not built in the source directory,
4249 and it is run from where it was built, add to load-path
4250 the lisp, leim and site-lisp dirs under that directory. */
4252 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4256 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4257 Vinstallation_directory
);
4258 tem1
= Ffile_exists_p (tem
);
4260 /* Don't be fooled if they moved the entire source tree
4261 AFTER dumping Emacs. If the build directory is indeed
4262 different from the source dir, src/Makefile.in and
4263 src/Makefile will not be found together. */
4264 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4265 Vinstallation_directory
);
4266 tem2
= Ffile_exists_p (tem
);
4267 if (!NILP (tem1
) && NILP (tem2
))
4269 tem
= Fexpand_file_name (build_string ("lisp"),
4272 if (NILP (Fmember (tem
, Vload_path
)))
4273 Vload_path
= Fcons (tem
, Vload_path
);
4275 tem
= Fexpand_file_name (build_string ("leim"),
4278 if (NILP (Fmember (tem
, Vload_path
)))
4279 Vload_path
= Fcons (tem
, Vload_path
);
4283 tem
= Fexpand_file_name (build_string ("site-lisp"),
4285 tem1
= Ffile_accessible_directory_p (tem
);
4288 if (NILP (Fmember (tem
, Vload_path
)))
4289 Vload_path
= Fcons (tem
, Vload_path
);
4293 } /* Vinstallation_directory != Vsource_directory */
4295 } /* if Vinstallation_directory */
4297 /* Check before adding the site-lisp directories.
4298 The install should have created them, but they are not
4299 required, so no need to warn if they are absent.
4300 Or we might be running before installation. */
4303 /* Add the site-lisp directories at the front. */
4306 Lisp_Object sitelisp
;
4307 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4308 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4310 } /* if dump_path == Vload_path */
4312 else /* !initialized */
4314 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4315 source directory. We used to add ../lisp (ie the lisp dir in
4316 the build directory) at the front here, but that caused trouble
4317 because it was copied from dump_path into Vload_path, above,
4318 when Vinstallation_directory was non-nil. It should not be
4319 necessary, since in out of tree builds lisp/ is empty, save
4321 Vload_path
= decode_env_path (0, normal
);
4322 dump_path
= Vload_path
;
4323 /* No point calling load_path_check; load-path only contains essential
4324 elements from the source directory at this point. They cannot
4325 be missing unless something went extremely (and improbably)
4326 wrong, in which case the build will fail in obvious ways. */
4328 #endif /* !CANNOT_DUMP */
4332 load_in_progress
= 0;
4333 Vload_file_name
= Qnil
;
4335 load_descriptor_list
= Qnil
;
4337 Vstandard_input
= Qt
;
4338 Vloads_in_progress
= Qnil
;
4341 /* Print a warning that directory intended for use USE and with name
4342 DIRNAME cannot be accessed. On entry, errno should correspond to
4343 the access failure. Print the warning on stderr and put it in
4347 dir_warning (char const *use
, Lisp_Object dirname
)
4349 static char const format
[] = "Warning: %s `%s': %s\n";
4350 int access_errno
= errno
;
4351 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4353 /* Don't log the warning before we've initialized!! */
4356 char const *diagnostic
= emacs_strerror (access_errno
);
4358 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4359 + strlen (use
) + SBYTES (dirname
)
4360 + strlen (diagnostic
));
4361 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4363 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4369 syms_of_lread (void)
4372 defsubr (&Sread_from_string
);
4374 defsubr (&Sintern_soft
);
4375 defsubr (&Sunintern
);
4376 defsubr (&Sget_load_suffixes
);
4378 defsubr (&Seval_buffer
);
4379 defsubr (&Seval_region
);
4380 defsubr (&Sread_char
);
4381 defsubr (&Sread_char_exclusive
);
4382 defsubr (&Sread_event
);
4383 defsubr (&Sget_file_char
);
4384 defsubr (&Smapatoms
);
4385 defsubr (&Slocate_file_internal
);
4387 DEFVAR_LISP ("obarray", Vobarray
,
4388 doc
: /* Symbol table for use by `intern' and `read'.
4389 It is a vector whose length ought to be prime for best results.
4390 The vector's contents don't make sense if examined from Lisp programs;
4391 to find all the symbols in an obarray, use `mapatoms'. */);
4393 DEFVAR_LISP ("values", Vvalues
,
4394 doc
: /* List of values of all expressions which were read, evaluated and printed.
4395 Order is reverse chronological. */);
4396 XSYMBOL (intern ("values"))->declared_special
= 0;
4398 DEFVAR_LISP ("standard-input", Vstandard_input
,
4399 doc
: /* Stream for read to get input from.
4400 See documentation of `read' for possible values. */);
4401 Vstandard_input
= Qt
;
4403 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4404 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4406 If this variable is a buffer, then only forms read from that buffer
4407 will be added to `read-symbol-positions-list'.
4408 If this variable is t, then all read forms will be added.
4409 The effect of all other values other than nil are not currently
4410 defined, although they may be in the future.
4412 The positions are relative to the last call to `read' or
4413 `read-from-string'. It is probably a bad idea to set this variable at
4414 the toplevel; bind it instead. */);
4415 Vread_with_symbol_positions
= Qnil
;
4417 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4418 doc
: /* A list mapping read symbols to their positions.
4419 This variable is modified during calls to `read' or
4420 `read-from-string', but only when `read-with-symbol-positions' is
4423 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4424 CHAR-POSITION is an integer giving the offset of that occurrence of the
4425 symbol from the position where `read' or `read-from-string' started.
4427 Note that a symbol will appear multiple times in this list, if it was
4428 read multiple times. The list is in the same order as the symbols
4430 Vread_symbol_positions_list
= Qnil
;
4432 DEFVAR_LISP ("read-circle", Vread_circle
,
4433 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4436 DEFVAR_LISP ("load-path", Vload_path
,
4437 doc
: /* List of directories to search for files to load.
4438 Each element is a string (directory name) or nil (try default directory).
4439 Initialized based on EMACSLOADPATH environment variable, if any,
4440 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4442 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4443 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4444 This list should not include the empty string.
4445 `load' and related functions try to append these suffixes, in order,
4446 to the specified file name if a Lisp suffix is allowed or required. */);
4447 Vload_suffixes
= Fcons (build_pure_c_string (".elc"),
4448 Fcons (build_pure_c_string (".el"), Qnil
));
4449 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4450 doc
: /* List of suffixes that indicate representations of \
4452 This list should normally start with the empty string.
4454 Enabling Auto Compression mode appends the suffixes in
4455 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4456 mode removes them again. `load' and related functions use this list to
4457 determine whether they should look for compressed versions of a file
4458 and, if so, which suffixes they should try to append to the file name
4459 in order to do so. However, if you want to customize which suffixes
4460 the loading functions recognize as compression suffixes, you should
4461 customize `jka-compr-load-suffixes' rather than the present variable. */);
4462 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4464 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4465 doc
: /* Non-nil if inside of `load'. */);
4466 DEFSYM (Qload_in_progress
, "load-in-progress");
4468 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4469 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4470 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4472 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4473 a symbol \(a feature name).
4475 When `load' is run and the file-name argument matches an element's
4476 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4477 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4479 An error in FORMS does not undo the load, but does prevent execution of
4480 the rest of the FORMS. */);
4481 Vafter_load_alist
= Qnil
;
4483 DEFVAR_LISP ("load-history", Vload_history
,
4484 doc
: /* Alist mapping loaded file names to symbols and features.
4485 Each alist element should be a list (FILE-NAME ENTRIES...), where
4486 FILE-NAME is the name of a file that has been loaded into Emacs.
4487 The file name is absolute and true (i.e. it doesn't contain symlinks).
4488 As an exception, one of the alist elements may have FILE-NAME nil,
4489 for symbols and features not associated with any file.
4491 The remaining ENTRIES in the alist element describe the functions and
4492 variables defined in that file, the features provided, and the
4493 features required. Each entry has the form `(provide . FEATURE)',
4494 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4495 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4496 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4497 autoload before this file redefined it as a function. In addition,
4498 entries may also be single symbols, which means that SYMBOL was
4499 defined by `defvar' or `defconst'.
4501 During preloading, the file name recorded is relative to the main Lisp
4502 directory. These file names are converted to absolute at startup. */);
4503 Vload_history
= Qnil
;
4505 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4506 doc
: /* Full name of file being loaded by `load'. */);
4507 Vload_file_name
= Qnil
;
4509 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4510 doc
: /* File name, including directory, of user's initialization file.
4511 If the file loaded had extension `.elc', and the corresponding source file
4512 exists, this variable contains the name of source file, suitable for use
4513 by functions like `custom-save-all' which edit the init file.
4514 While Emacs loads and evaluates the init file, value is the real name
4515 of the file, regardless of whether or not it has the `.elc' extension. */);
4516 Vuser_init_file
= Qnil
;
4518 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4519 doc
: /* Used for internal purposes by `load'. */);
4520 Vcurrent_load_list
= Qnil
;
4522 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4523 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4524 The default is nil, which means use the function `read'. */);
4525 Vload_read_function
= Qnil
;
4527 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4528 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4529 The value should be a function for doing code conversion before
4530 reading a source file. It can also be nil, in which case loading is
4531 done without any code conversion.
4533 If the value is a function, it is called with four arguments,
4534 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4535 the file to load, FILE is the non-absolute name (for messages etc.),
4536 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4537 `load'. The function should return t if the file was loaded. */);
4538 Vload_source_file_function
= Qnil
;
4540 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4541 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4542 This is useful when the file being loaded is a temporary copy. */);
4543 load_force_doc_strings
= 0;
4545 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4546 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4547 This is normally bound by `load' and `eval-buffer' to control `read',
4548 and is not meant for users to change. */);
4549 load_convert_to_unibyte
= 0;
4551 DEFVAR_LISP ("source-directory", Vsource_directory
,
4552 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4553 You cannot count on them to still be there! */);
4555 = Fexpand_file_name (build_string ("../"),
4556 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4558 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4559 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4560 Vpreloaded_file_list
= Qnil
;
4562 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4563 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4564 Vbyte_boolean_vars
= Qnil
;
4566 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4567 doc
: /* Non-nil means load dangerous compiled Lisp files.
4568 Some versions of XEmacs use different byte codes than Emacs. These
4569 incompatible byte codes can make Emacs crash when it tries to execute
4571 load_dangerous_libraries
= 0;
4573 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4574 doc
: /* Non-nil means force printing messages when loading Lisp files.
4575 This overrides the value of the NOMESSAGE argument to `load'. */);
4576 force_load_messages
= 0;
4578 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4579 doc
: /* Regular expression matching safe to load compiled Lisp files.
4580 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4581 from the file, and matches them against this regular expression.
4582 When the regular expression matches, the file is considered to be safe
4583 to load. See also `load-dangerous-libraries'. */);
4584 Vbytecomp_version_regexp
4585 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4587 DEFSYM (Qlexical_binding
, "lexical-binding");
4588 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4589 doc
: /* Whether to use lexical binding when evaluating code.
4590 Non-nil means that the code in the current buffer should be evaluated
4591 with lexical binding.
4592 This variable is automatically set from the file variables of an
4593 interpreted Lisp file read using `load'. Unlike other file local
4594 variables, this must be set in the first line of a file. */);
4595 Vlexical_binding
= Qnil
;
4596 Fmake_variable_buffer_local (Qlexical_binding
);
4598 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4599 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4600 Veval_buffer_list
= Qnil
;
4602 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4603 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4604 Vold_style_backquotes
= Qnil
;
4605 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4607 /* Vsource_directory was initialized in init_lread. */
4609 load_descriptor_list
= Qnil
;
4610 staticpro (&load_descriptor_list
);
4612 DEFSYM (Qcurrent_load_list
, "current-load-list");
4613 DEFSYM (Qstandard_input
, "standard-input");
4614 DEFSYM (Qread_char
, "read-char");
4615 DEFSYM (Qget_file_char
, "get-file-char");
4616 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4617 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4619 DEFSYM (Qbackquote
, "`");
4620 DEFSYM (Qcomma
, ",");
4621 DEFSYM (Qcomma_at
, ",@");
4622 DEFSYM (Qcomma_dot
, ",.");
4624 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4625 DEFSYM (Qascii_character
, "ascii-character");
4626 DEFSYM (Qfunction
, "function");
4627 DEFSYM (Qload
, "load");
4628 DEFSYM (Qload_file_name
, "load-file-name");
4629 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4630 DEFSYM (Qfile_truename
, "file-truename");
4631 DEFSYM (Qdir_ok
, "dir-ok");
4632 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4634 staticpro (&dump_path
);
4636 staticpro (&read_objects
);
4637 read_objects
= Qnil
;
4638 staticpro (&seen_list
);
4641 Vloads_in_progress
= Qnil
;
4642 staticpro (&Vloads_in_progress
);
4644 DEFSYM (Qhash_table
, "hash-table");
4645 DEFSYM (Qdata
, "data");
4646 DEFSYM (Qtest
, "test");
4647 DEFSYM (Qsize
, "size");
4648 DEFSYM (Qweakness
, "weakness");
4649 DEFSYM (Qrehash_size
, "rehash-size");
4650 DEFSYM (Qrehash_threshold
, "rehash-threshold");