1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2013 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
28 #include <limits.h> /* For CHAR_BIT. */
29 #include <stat-time.h>
31 #include "intervals.h"
32 #include "character.h"
40 #include "termhooks.h"
41 #include "blockinput.h"
55 #endif /* HAVE_SETLOCALE */
60 #define file_offset off_t
61 #define file_tell ftello
63 #define file_offset long
64 #define file_tell ftell
67 /* Hash table read constants. */
68 static Lisp_Object Qhash_table
, Qdata
;
69 static Lisp_Object Qtest
, Qsize
;
70 static Lisp_Object Qweakness
;
71 static Lisp_Object Qrehash_size
;
72 static Lisp_Object Qrehash_threshold
;
74 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
75 Lisp_Object Qstandard_input
;
76 Lisp_Object Qvariable_documentation
;
77 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
78 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
79 static Lisp_Object Qinhibit_file_name_operation
;
80 static Lisp_Object Qeval_buffer_list
;
81 Lisp_Object Qlexical_binding
;
82 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
84 /* Used instead of Qget_file_char while loading *.elc files compiled
85 by Emacs 21 or older. */
86 static Lisp_Object Qget_emacs_mule_file_char
;
88 static Lisp_Object Qload_force_doc_strings
;
90 static Lisp_Object Qload_in_progress
;
92 /* The association list of objects read with the #n=object form.
93 Each member of the list has the form (n . object), and is used to
94 look up the object for the corresponding #n# construct.
95 It must be set to nil before all top-level calls to read0. */
96 static Lisp_Object read_objects
;
98 /* File for get_file_char to read from. Use by load. */
99 static FILE *instream
;
101 /* For use within read-from-string (this reader is non-reentrant!!) */
102 static ptrdiff_t read_from_string_index
;
103 static ptrdiff_t read_from_string_index_byte
;
104 static ptrdiff_t read_from_string_limit
;
106 /* Number of characters read in the current call to Fread or
107 Fread_from_string. */
108 static EMACS_INT readchar_count
;
110 /* This contains the last string skipped with #@. */
111 static char *saved_doc_string
;
112 /* Length of buffer allocated in saved_doc_string. */
113 static ptrdiff_t saved_doc_string_size
;
114 /* Length of actual data in saved_doc_string. */
115 static ptrdiff_t saved_doc_string_length
;
116 /* This is the file position that string came from. */
117 static file_offset saved_doc_string_position
;
119 /* This contains the previous string skipped with #@.
120 We copy it from saved_doc_string when a new string
121 is put in saved_doc_string. */
122 static char *prev_saved_doc_string
;
123 /* Length of buffer allocated in prev_saved_doc_string. */
124 static ptrdiff_t prev_saved_doc_string_size
;
125 /* Length of actual data in prev_saved_doc_string. */
126 static ptrdiff_t prev_saved_doc_string_length
;
127 /* This is the file position that string came from. */
128 static file_offset prev_saved_doc_string_position
;
130 /* True means inside a new-style backquote
131 with no surrounding parentheses.
132 Fread initializes this to false, so we need not specbind it
133 or worry about what happens to it when there is an error. */
134 static bool new_backquote_flag
;
135 static Lisp_Object Qold_style_backquotes
;
137 /* A list of file names for files being loaded in Fload. Used to
138 check for recursive loads. */
140 static Lisp_Object Vloads_in_progress
;
142 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
145 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
146 Lisp_Object
, Lisp_Object
,
147 Lisp_Object
, Lisp_Object
);
149 /* Functions that read one byte from the current source READCHARFUN
150 or unreads one byte. If the integer argument C is -1, it returns
151 one read byte, or -1 when there's no more byte in the source. If C
152 is 0 or positive, it unreads C, and the return value is not
155 static int readbyte_for_lambda (int, Lisp_Object
);
156 static int readbyte_from_file (int, Lisp_Object
);
157 static int readbyte_from_string (int, Lisp_Object
);
159 /* Handle unreading and rereading of characters.
160 Write READCHAR to read a character,
161 UNREAD(c) to unread c to be read again.
163 These macros correctly read/unread multibyte characters. */
165 #define READCHAR readchar (readcharfun, NULL)
166 #define UNREAD(c) unreadchar (readcharfun, c)
168 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
169 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
171 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
172 Qlambda, or a cons, we use this to keep an unread character because
173 a file stream can't handle multibyte-char unreading. The value -1
174 means that there's no unread character. */
175 static int unread_char
;
178 readchar (Lisp_Object readcharfun
, bool *multibyte
)
182 int (*readbyte
) (int, Lisp_Object
);
183 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
185 bool emacs_mule_encoding
= 0;
192 if (BUFFERP (readcharfun
))
194 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
196 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
198 if (! BUFFER_LIVE_P (inbuffer
))
201 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
204 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
206 /* Fetch the character code from the buffer. */
207 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
208 BUF_INC_POS (inbuffer
, pt_byte
);
215 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
216 if (! ASCII_BYTE_P (c
))
217 c
= BYTE8_TO_CHAR (c
);
220 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
224 if (MARKERP (readcharfun
))
226 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
228 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
230 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
233 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
235 /* Fetch the character code from the buffer. */
236 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
237 BUF_INC_POS (inbuffer
, bytepos
);
244 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
245 if (! ASCII_BYTE_P (c
))
246 c
= BYTE8_TO_CHAR (c
);
250 XMARKER (readcharfun
)->bytepos
= bytepos
;
251 XMARKER (readcharfun
)->charpos
++;
256 if (EQ (readcharfun
, Qlambda
))
258 readbyte
= readbyte_for_lambda
;
262 if (EQ (readcharfun
, Qget_file_char
))
264 readbyte
= readbyte_from_file
;
268 if (STRINGP (readcharfun
))
270 if (read_from_string_index
>= read_from_string_limit
)
272 else if (STRING_MULTIBYTE (readcharfun
))
276 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
277 read_from_string_index
,
278 read_from_string_index_byte
);
282 c
= SREF (readcharfun
, read_from_string_index_byte
);
283 read_from_string_index
++;
284 read_from_string_index_byte
++;
289 if (CONSP (readcharfun
))
291 /* This is the case that read_vector is reading from a unibyte
292 string that contains a byte sequence previously skipped
293 because of #@NUMBER. The car part of readcharfun is that
294 string, and the cdr part is a value of readcharfun given to
296 readbyte
= readbyte_from_string
;
297 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
298 emacs_mule_encoding
= 1;
302 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
304 readbyte
= readbyte_from_file
;
305 emacs_mule_encoding
= 1;
309 tem
= call0 (readcharfun
);
316 if (unread_char
>= 0)
322 c
= (*readbyte
) (-1, readcharfun
);
327 if (ASCII_BYTE_P (c
))
329 if (emacs_mule_encoding
)
330 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
333 len
= BYTES_BY_CHAR_HEAD (c
);
336 c
= (*readbyte
) (-1, readcharfun
);
337 if (c
< 0 || ! TRAILING_CODE_P (c
))
340 (*readbyte
) (buf
[i
], readcharfun
);
341 return BYTE8_TO_CHAR (buf
[0]);
345 return STRING_CHAR (buf
);
348 #define FROM_FILE_P(readcharfun) \
349 (EQ (readcharfun, Qget_file_char) \
350 || EQ (readcharfun, Qget_emacs_mule_file_char))
353 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
355 if (FROM_FILE_P (readcharfun
))
357 block_input (); /* FIXME: Not sure if it's needed. */
358 fseek (instream
, n
, SEEK_CUR
);
362 { /* We're not reading directly from a file. In that case, it's difficult
363 to reliably count bytes, since these are usually meant for the file's
364 encoding, whereas we're now typically in the internal encoding.
365 But luckily, skip_dyn_bytes is used to skip over a single
366 dynamic-docstring (or dynamic byte-code) which is always quoted such
367 that \037 is the final char. */
371 } while (c
>= 0 && c
!= '\037');
376 skip_dyn_eof (Lisp_Object readcharfun
)
378 if (FROM_FILE_P (readcharfun
))
380 block_input (); /* FIXME: Not sure if it's needed. */
381 fseek (instream
, 0, SEEK_END
);
385 while (READCHAR
>= 0);
388 /* Unread the character C in the way appropriate for the stream READCHARFUN.
389 If the stream is a user function, call it with the char as argument. */
392 unreadchar (Lisp_Object readcharfun
, int c
)
396 /* Don't back up the pointer if we're unreading the end-of-input mark,
397 since readchar didn't advance it when we read it. */
399 else if (BUFFERP (readcharfun
))
401 struct buffer
*b
= XBUFFER (readcharfun
);
402 ptrdiff_t charpos
= BUF_PT (b
);
403 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
405 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
406 BUF_DEC_POS (b
, bytepos
);
410 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
412 else if (MARKERP (readcharfun
))
414 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
415 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
417 XMARKER (readcharfun
)->charpos
--;
418 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
419 BUF_DEC_POS (b
, bytepos
);
423 XMARKER (readcharfun
)->bytepos
= bytepos
;
425 else if (STRINGP (readcharfun
))
427 read_from_string_index
--;
428 read_from_string_index_byte
429 = string_char_to_byte (readcharfun
, read_from_string_index
);
431 else if (CONSP (readcharfun
))
435 else if (EQ (readcharfun
, Qlambda
))
439 else if (FROM_FILE_P (readcharfun
))
444 call1 (readcharfun
, make_number (c
));
448 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
450 return read_bytecode_char (c
>= 0);
455 readbyte_from_file (int c
, Lisp_Object readcharfun
)
460 ungetc (c
, instream
);
468 /* Interrupted reads have been observed while reading over the network. */
469 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
480 return (c
== EOF
? -1 : c
);
484 readbyte_from_string (int c
, Lisp_Object readcharfun
)
486 Lisp_Object string
= XCAR (readcharfun
);
490 read_from_string_index
--;
491 read_from_string_index_byte
492 = string_char_to_byte (string
, read_from_string_index
);
495 if (read_from_string_index
>= read_from_string_limit
)
498 FETCH_STRING_CHAR_ADVANCE (c
, string
,
499 read_from_string_index
,
500 read_from_string_index_byte
);
505 /* Read one non-ASCII character from INSTREAM. The character is
506 encoded in `emacs-mule' and the first byte is already read in
510 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
512 /* Emacs-mule coding uses at most 4-byte for one character. */
513 unsigned char buf
[4];
514 int len
= emacs_mule_bytes
[c
];
515 struct charset
*charset
;
520 /* C is not a valid leading-code of `emacs-mule'. */
521 return BYTE8_TO_CHAR (c
);
527 c
= (*readbyte
) (-1, readcharfun
);
531 (*readbyte
) (buf
[i
], readcharfun
);
532 return BYTE8_TO_CHAR (buf
[0]);
539 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
540 code
= buf
[1] & 0x7F;
544 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
545 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
547 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
548 code
= buf
[2] & 0x7F;
552 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
553 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
558 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
559 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
561 c
= DECODE_CHAR (charset
, code
);
563 Fsignal (Qinvalid_read_syntax
,
564 list1 (build_string ("invalid multibyte form")));
569 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
571 static Lisp_Object
read0 (Lisp_Object
);
572 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
574 static Lisp_Object
read_list (bool, Lisp_Object
);
575 static Lisp_Object
read_vector (Lisp_Object
, bool);
577 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
579 static void substitute_object_in_subtree (Lisp_Object
,
581 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
584 /* Get a character from the tty. */
586 /* Read input events until we get one that's acceptable for our purposes.
588 If NO_SWITCH_FRAME, switch-frame events are stashed
589 until we get a character we like, and then stuffed into
592 If ASCII_REQUIRED, check function key events to see
593 if the unmodified version of the symbol has a Qascii_character
594 property, and use that character, if present.
596 If ERROR_NONASCII, signal an error if the input we
597 get isn't an ASCII character with modifiers. If it's false but
598 ASCII_REQUIRED is true, just re-read until we get an ASCII
601 If INPUT_METHOD, invoke the current input method
602 if the character warrants that.
604 If SECONDS is a number, wait that many seconds for input, and
605 return Qnil if no input arrives within that time. */
608 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
609 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
611 Lisp_Object val
, delayed_switch_frame
;
612 struct timespec end_time
;
614 #ifdef HAVE_WINDOW_SYSTEM
615 if (display_hourglass_p
)
619 delayed_switch_frame
= Qnil
;
621 /* Compute timeout. */
622 if (NUMBERP (seconds
))
624 double duration
= extract_float (seconds
);
625 struct timespec wait_time
= dtotimespec (duration
);
626 end_time
= timespec_add (current_timespec (), wait_time
);
629 /* Read until we get an acceptable event. */
632 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
633 NUMBERP (seconds
) ? &end_time
: NULL
);
634 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
639 /* `switch-frame' events are put off until after the next ASCII
640 character. This is better than signaling an error just because
641 the last characters were typed to a separate minibuffer frame,
642 for example. Eventually, some code which can deal with
643 switch-frame events will read it and process it. */
645 && EVENT_HAS_PARAMETERS (val
)
646 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
648 delayed_switch_frame
= val
;
652 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
654 /* Convert certain symbols to their ASCII equivalents. */
657 Lisp_Object tem
, tem1
;
658 tem
= Fget (val
, Qevent_symbol_element_mask
);
661 tem1
= Fget (Fcar (tem
), Qascii_character
);
662 /* Merge this symbol's modifier bits
663 with the ASCII equivalent of its basic code. */
665 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
669 /* If we don't have a character now, deal with it appropriately. */
674 Vunread_command_events
= list1 (val
);
675 error ("Non-character input-event");
682 if (! NILP (delayed_switch_frame
))
683 unread_switch_frame
= delayed_switch_frame
;
687 #ifdef HAVE_WINDOW_SYSTEM
688 if (display_hourglass_p
)
697 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
698 doc
: /* Read a character from the command input (keyboard or macro).
699 It is returned as a number.
700 If the character has modifiers, they are resolved and reflected to the
701 character code if possible (e.g. C-SPC -> 0).
703 If the user generates an event which is not a character (i.e. a mouse
704 click or function key event), `read-char' signals an error. As an
705 exception, switch-frame events are put off until non-character events
707 If you want to read non-character events, or ignore them, call
708 `read-event' or `read-char-exclusive' instead.
710 If the optional argument PROMPT is non-nil, display that as a prompt.
711 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
712 input method is turned on in the current buffer, that input method
713 is used for reading a character.
714 If the optional argument SECONDS is non-nil, it should be a number
715 specifying the maximum number of seconds to wait for input. If no
716 input arrives in that time, return nil. SECONDS may be a
717 floating-point value. */)
718 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
723 message_with_string ("%s", prompt
, 0);
724 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
726 return (NILP (val
) ? Qnil
727 : make_number (char_resolve_modifier_mask (XINT (val
))));
730 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
731 doc
: /* Read an event object from the input stream.
732 If the optional argument PROMPT is non-nil, display that as a prompt.
733 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
734 input method is turned on in the current buffer, that input method
735 is used for reading a character.
736 If the optional argument SECONDS is non-nil, it should be a number
737 specifying the maximum number of seconds to wait for input. If no
738 input arrives in that time, return nil. SECONDS may be a
739 floating-point value. */)
740 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
743 message_with_string ("%s", prompt
, 0);
744 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
747 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
748 doc
: /* Read a character from the command input (keyboard or macro).
749 It is returned as a number. Non-character events are ignored.
750 If the character has modifiers, they are resolved and reflected to the
751 character code if possible (e.g. C-SPC -> 0).
753 If the optional argument PROMPT is non-nil, display that as a prompt.
754 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
755 input method is turned on in the current buffer, that input method
756 is used for reading a character.
757 If the optional argument SECONDS is non-nil, it should be a number
758 specifying the maximum number of seconds to wait for input. If no
759 input arrives in that time, return nil. SECONDS may be a
760 floating-point value. */)
761 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
766 message_with_string ("%s", prompt
, 0);
768 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
770 return (NILP (val
) ? Qnil
771 : make_number (char_resolve_modifier_mask (XINT (val
))));
774 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
775 doc
: /* Don't use this yourself. */)
778 register Lisp_Object val
;
780 XSETINT (val
, getc (instream
));
788 /* Return true if the lisp code read using READCHARFUN defines a non-nil
789 `lexical-binding' file variable. After returning, the stream is
790 positioned following the first line, if it is a comment or #! line,
791 otherwise nothing is read. */
794 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
807 while (ch
!= '\n' && ch
!= EOF
)
809 if (ch
== '\n') ch
= READCHAR
;
810 /* It is OK to leave the position after a #! line, since
811 that is what read1 does. */
815 /* The first line isn't a comment, just give up. */
821 /* Look for an appropriate file-variable in the first line. */
825 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
826 } beg_end_state
= NOMINAL
;
827 bool in_file_vars
= 0;
829 #define UPDATE_BEG_END_STATE(ch) \
830 if (beg_end_state == NOMINAL) \
831 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
832 else if (beg_end_state == AFTER_FIRST_DASH) \
833 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
834 else if (beg_end_state == AFTER_ASTERIX) \
837 in_file_vars = !in_file_vars; \
838 beg_end_state = NOMINAL; \
841 /* Skip until we get to the file vars, if any. */
845 UPDATE_BEG_END_STATE (ch
);
847 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
851 char var
[100], val
[100];
856 /* Read a variable name. */
857 while (ch
== ' ' || ch
== '\t')
861 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
863 if (i
< sizeof var
- 1)
865 UPDATE_BEG_END_STATE (ch
);
869 /* Stop scanning if no colon was found before end marker. */
870 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
873 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
879 /* Read a variable value. */
882 while (ch
== ' ' || ch
== '\t')
886 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
888 if (i
< sizeof val
- 1)
890 UPDATE_BEG_END_STATE (ch
);
894 /* The value was terminated by an end-marker, which remove. */
896 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
900 if (strcmp (var
, "lexical-binding") == 0)
903 rv
= (strcmp (val
, "nil") != 0);
909 while (ch
!= '\n' && ch
!= EOF
)
916 /* Value is a version number of byte compiled code if the file
917 associated with file descriptor FD is a compiled Lisp file that's
918 safe to load. Only files compiled with Emacs are safe to load.
919 Files compiled with XEmacs can lead to a crash in Fbyte_code
920 because of an incompatible change in the byte compiler. */
923 safe_to_load_version (int fd
)
929 /* Read the first few bytes from the file, and look for a line
930 specifying the byte compiler version used. */
931 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
934 /* Skip to the next newline, skipping over the initial `ELC'
935 with NUL bytes following it, but note the version. */
936 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
941 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
942 buf
+ i
, nbytes
- i
) < 0)
946 lseek (fd
, 0, SEEK_SET
);
951 /* Callback for record_unwind_protect. Restore the old load list OLD,
952 after loading a file successfully. */
955 record_load_unwind (Lisp_Object old
)
957 Vloads_in_progress
= old
;
960 /* This handler function is used via internal_condition_case_1. */
963 load_error_handler (Lisp_Object data
)
969 load_warn_old_style_backquotes (Lisp_Object file
)
971 if (!NILP (Vold_style_backquotes
))
974 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
980 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
981 doc
: /* Return the suffixes that `load' should try if a suffix is \
983 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
986 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
987 while (CONSP (suffixes
))
989 Lisp_Object exts
= Vload_file_rep_suffixes
;
990 suffix
= XCAR (suffixes
);
991 suffixes
= XCDR (suffixes
);
996 lst
= Fcons (concat2 (suffix
, ext
), lst
);
999 return Fnreverse (lst
);
1002 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1003 doc
: /* Execute a file of Lisp code named FILE.
1004 First try FILE with `.elc' appended, then try with `.el',
1005 then try FILE unmodified (the exact suffixes in the exact order are
1006 determined by `load-suffixes'). Environment variable references in
1007 FILE are replaced with their values by calling `substitute-in-file-name'.
1008 This function searches the directories in `load-path'.
1010 If optional second arg NOERROR is non-nil,
1011 report no error if FILE doesn't exist.
1012 Print messages at start and end of loading unless
1013 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1015 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1016 suffixes `.elc' or `.el' to the specified name FILE.
1017 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1018 the suffix `.elc' or `.el'; don't accept just FILE unless
1019 it ends in one of those suffixes or includes a directory name.
1021 If NOSUFFIX is nil, then if a file could not be found, try looking for
1022 a different representation of the file by adding non-empty suffixes to
1023 its name, before trying another file. Emacs uses this feature to find
1024 compressed versions of files when Auto Compression mode is enabled.
1025 If NOSUFFIX is non-nil, disable this feature.
1027 The suffixes that this function tries out, when NOSUFFIX is nil, are
1028 given by the return value of `get-load-suffixes' and the values listed
1029 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1030 return value of `get-load-suffixes' is used, i.e. the file name is
1031 required to have a non-empty suffix.
1033 Loading a file records its definitions, and its `provide' and
1034 `require' calls, in an element of `load-history' whose
1035 car is the file name loaded. See `load-history'.
1037 While the file is in the process of being loaded, the variable
1038 `load-in-progress' is non-nil and the variable `load-file-name'
1039 is bound to the file's name.
1041 Return t if the file exists and loads successfully. */)
1042 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1043 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1048 ptrdiff_t count
= SPECPDL_INDEX ();
1049 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1050 Lisp_Object found
, efound
, hist_file_name
;
1051 /* True means we printed the ".el is newer" message. */
1053 /* True means we are loading a compiled file. */
1055 Lisp_Object handler
;
1057 const char *fmode
= "r";
1064 CHECK_STRING (file
);
1066 /* If file name is magic, call the handler. */
1067 /* This shouldn't be necessary any more now that `openp' handles it right.
1068 handler = Ffind_file_name_handler (file, Qload);
1069 if (!NILP (handler))
1070 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1072 /* Do this after the handler to avoid
1073 the need to gcpro noerror, nomessage and nosuffix.
1074 (Below here, we care only whether they are nil or not.)
1075 The presence of this call is the result of a historical accident:
1076 it used to be in every file-operation and when it got removed
1077 everywhere, it accidentally stayed here. Since then, enough people
1078 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1079 that it seemed risky to remove. */
1080 if (! NILP (noerror
))
1082 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1083 Qt
, load_error_handler
);
1088 file
= Fsubstitute_in_file_name (file
);
1090 /* Avoid weird lossage with null string as arg,
1091 since it would try to load a directory as a Lisp file. */
1092 if (SCHARS (file
) == 0)
1099 Lisp_Object suffixes
;
1101 GCPRO2 (file
, found
);
1103 if (! NILP (must_suffix
))
1105 /* Don't insist on adding a suffix if FILE already ends with one. */
1106 ptrdiff_t size
= SBYTES (file
);
1108 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1111 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1113 /* Don't insist on adding a suffix
1114 if the argument includes a directory name. */
1115 else if (! NILP (Ffile_name_directory (file
)))
1119 if (!NILP (nosuffix
))
1123 suffixes
= Fget_load_suffixes ();
1124 if (NILP (must_suffix
))
1128 arg
[1] = Vload_file_rep_suffixes
;
1129 suffixes
= Fappend (2, arg
);
1133 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
);
1140 report_file_error ("Cannot open load file", file
);
1144 /* Tell startup.el whether or not we found the user's init file. */
1145 if (EQ (Qt
, Vuser_init_file
))
1146 Vuser_init_file
= found
;
1148 /* If FD is -2, that means openp found a magic file. */
1151 if (NILP (Fequal (found
, file
)))
1152 /* If FOUND is a different file name from FILE,
1153 find its handler even if we have already inhibited
1154 the `load' operation on FILE. */
1155 handler
= Ffind_file_name_handler (found
, Qt
);
1157 handler
= Ffind_file_name_handler (found
, Qload
);
1158 if (! NILP (handler
))
1159 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1161 /* Tramp has to deal with semi-broken packages that prepend
1162 drive letters to remote files. For that reason, Tramp
1163 catches file operations that test for file existence, which
1164 makes openp think X:/foo.elc files are remote. However,
1165 Tramp does not catch `load' operations for such files, so we
1166 end up with a nil as the `load' handler above. If we would
1167 continue with fd = -2, we will behave wrongly, and in
1168 particular try reading a .elc file in the "rt" mode instead
1169 of "rb". See bug #9311 for the results. To work around
1170 this, we try to open the file locally, and go with that if it
1172 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1180 /* Pacify older GCC with --enable-gcc-warnings. */
1181 IF_LINT (fd_index
= 0);
1185 fd_index
= SPECPDL_INDEX ();
1186 record_unwind_protect_int (close_file_unwind
, fd
);
1189 /* Check if we're stuck in a recursive load cycle.
1191 2000-09-21: It's not possible to just check for the file loaded
1192 being a member of Vloads_in_progress. This fails because of the
1193 way the byte compiler currently works; `provide's are not
1194 evaluated, see font-lock.el/jit-lock.el as an example. This
1195 leads to a certain amount of ``normal'' recursion.
1197 Also, just loading a file recursively is not always an error in
1198 the general case; the second load may do something different. */
1202 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1203 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1204 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1205 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1206 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1209 /* All loads are by default dynamic, unless the file itself specifies
1210 otherwise using a file-variable in the first line. This is bound here
1211 so that it takes effect whether or not we use
1212 Vload_source_file_function. */
1213 specbind (Qlexical_binding
, Qnil
);
1215 /* Get the name for load-history. */
1216 hist_file_name
= (! NILP (Vpurify_flag
)
1217 ? concat2 (Ffile_name_directory (file
),
1218 Ffile_name_nondirectory (found
))
1223 /* Check for the presence of old-style quotes and warn about them. */
1224 specbind (Qold_style_backquotes
, Qnil
);
1225 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1227 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1228 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1229 /* Load .elc files directly, but not when they are
1230 remote and have no handler! */
1237 GCPRO3 (file
, found
, hist_file_name
);
1240 && ! (version
= safe_to_load_version (fd
)))
1243 if (!load_dangerous_libraries
)
1244 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1245 else if (!NILP (nomessage
) && !force_load_messages
)
1246 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1251 efound
= ENCODE_FILE (found
);
1256 result
= stat (SSDATA (efound
), &s1
);
1259 SSET (efound
, SBYTES (efound
) - 1, 0);
1260 result
= stat (SSDATA (efound
), &s2
);
1261 SSET (efound
, SBYTES (efound
) - 1, 'c');
1265 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1267 /* Make the progress messages mention that source is newer. */
1270 /* If we won't print another message, mention this anyway. */
1271 if (!NILP (nomessage
) && !force_load_messages
)
1273 Lisp_Object msg_file
;
1274 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1275 message_with_string ("Source file `%s' newer than byte-compiled file",
1284 /* We are loading a source file (*.el). */
1285 if (!NILP (Vload_source_file_function
))
1292 clear_unwind_protect (fd_index
);
1294 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1295 NILP (noerror
) ? Qnil
: Qt
,
1296 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1297 return unbind_to (count
, val
);
1301 GCPRO3 (file
, found
, hist_file_name
);
1305 /* We somehow got here with fd == -2, meaning the file is deemed
1306 to be remote. Don't even try to reopen the file locally;
1307 just force a failure. */
1315 clear_unwind_protect (fd_index
);
1316 efound
= ENCODE_FILE (found
);
1317 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1319 stream
= fdopen (fd
, fmode
);
1323 report_file_error ("Opening stdio stream", file
);
1324 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1326 if (! NILP (Vpurify_flag
))
1327 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1329 if (NILP (nomessage
) || force_load_messages
)
1332 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1335 message_with_string ("Loading %s (source)...", file
, 1);
1337 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1339 else /* The typical case; compiled file newer than source file. */
1340 message_with_string ("Loading %s...", file
, 1);
1343 specbind (Qload_file_name
, found
);
1344 specbind (Qinhibit_file_name_operation
, Qnil
);
1345 specbind (Qload_in_progress
, Qt
);
1348 if (lisp_file_lexically_bound_p (Qget_file_char
))
1349 Fset (Qlexical_binding
, Qt
);
1351 if (! version
|| version
>= 22)
1352 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1353 0, Qnil
, Qnil
, Qnil
, Qnil
);
1356 /* We can't handle a file which was compiled with
1357 byte-compile-dynamic by older version of Emacs. */
1358 specbind (Qload_force_doc_strings
, Qt
);
1359 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1360 0, Qnil
, Qnil
, Qnil
, Qnil
);
1362 unbind_to (count
, Qnil
);
1364 /* Run any eval-after-load forms for this file. */
1365 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1366 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1370 xfree (saved_doc_string
);
1371 saved_doc_string
= 0;
1372 saved_doc_string_size
= 0;
1374 xfree (prev_saved_doc_string
);
1375 prev_saved_doc_string
= 0;
1376 prev_saved_doc_string_size
= 0;
1378 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1381 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1384 message_with_string ("Loading %s (source)...done", file
, 1);
1386 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1388 else /* The typical case; compiled file newer than source file. */
1389 message_with_string ("Loading %s...done", file
, 1);
1396 complete_filename_p (Lisp_Object pathname
)
1398 const unsigned char *s
= SDATA (pathname
);
1399 return (IS_DIRECTORY_SEP (s
[0])
1400 || (SCHARS (pathname
) > 2
1401 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1404 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1405 doc
: /* Search for FILENAME through PATH.
1406 Returns the file's name in absolute form, or nil if not found.
1407 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1408 file name when searching.
1409 If non-nil, PREDICATE is used instead of `file-readable-p'.
1410 PREDICATE can also be an integer to pass to the faccessat(2) function,
1411 in which case file-name-handlers are ignored.
1412 This function will normally skip directories, so if you want it to find
1413 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1414 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1417 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1418 if (NILP (predicate
) && fd
>= 0)
1423 static Lisp_Object Qdir_ok
;
1425 /* Search for a file whose name is STR, looking in directories
1426 in the Lisp list PATH, and trying suffixes from SUFFIX.
1427 On success, return a file descriptor (or 1 or -2 as described below).
1428 On failure, return -1 and set errno.
1430 SUFFIXES is a list of strings containing possible suffixes.
1431 The empty suffix is automatically added if the list is empty.
1433 PREDICATE non-nil means don't open the files,
1434 just look for one that satisfies the predicate. In this case,
1435 return 1 on success. The predicate can be a lisp function or
1436 an integer to pass to `access' (in which case file-name-handlers
1439 If STOREPTR is nonzero, it points to a slot where the name of
1440 the file actually found should be stored as a Lisp string.
1441 nil is stored there on failure.
1443 If the file we find is remote, return -2
1444 but store the found remote file name in *STOREPTR. */
1447 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1448 Lisp_Object
*storeptr
, Lisp_Object predicate
)
1450 ptrdiff_t fn_size
= 100;
1454 ptrdiff_t want_length
;
1455 Lisp_Object filename
;
1456 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1457 Lisp_Object string
, tail
, encoded_fn
;
1458 ptrdiff_t max_suffix_len
= 0;
1459 int last_errno
= ENOENT
;
1463 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1465 CHECK_STRING_CAR (tail
);
1466 max_suffix_len
= max (max_suffix_len
,
1467 SBYTES (XCAR (tail
)));
1470 string
= filename
= encoded_fn
= Qnil
;
1471 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1476 if (complete_filename_p (str
))
1479 for (; CONSP (path
); path
= XCDR (path
))
1481 filename
= Fexpand_file_name (str
, XCAR (path
));
1482 if (!complete_filename_p (filename
))
1483 /* If there are non-absolute elts in PATH (eg "."). */
1484 /* Of course, this could conceivably lose if luser sets
1485 default-directory to be something non-absolute... */
1487 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1488 if (!complete_filename_p (filename
))
1489 /* Give up on this path element! */
1493 /* Calculate maximum length of any filename made from
1494 this path element/specified file name and any possible suffix. */
1495 want_length
= max_suffix_len
+ SBYTES (filename
);
1496 if (fn_size
<= want_length
)
1497 fn
= alloca (fn_size
= 100 + want_length
);
1499 /* Loop over suffixes. */
1500 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1501 CONSP (tail
); tail
= XCDR (tail
))
1503 ptrdiff_t fnlen
, lsuffix
= SBYTES (XCAR (tail
));
1504 Lisp_Object handler
;
1506 /* Concatenate path element/specified name with the suffix.
1507 If the directory starts with /:, remove that. */
1508 int prefixlen
= ((SCHARS (filename
) > 2
1509 && SREF (filename
, 0) == '/'
1510 && SREF (filename
, 1) == ':')
1512 fnlen
= SBYTES (filename
) - prefixlen
;
1513 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1514 memcpy (fn
+ fnlen
, SDATA (XCAR (tail
)), lsuffix
+ 1);
1516 /* Check that the file exists and is not a directory. */
1517 /* We used to only check for handlers on non-absolute file names:
1521 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1522 It's not clear why that was the case and it breaks things like
1523 (load "/bar.el") where the file is actually "/bar.el.gz". */
1524 string
= make_string (fn
, fnlen
);
1525 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1526 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1529 if (NILP (predicate
))
1530 exists
= !NILP (Ffile_readable_p (string
));
1533 Lisp_Object tmp
= call1 (predicate
, string
);
1536 else if (EQ (tmp
, Qdir_ok
)
1537 || NILP (Ffile_directory_p (string
)))
1542 last_errno
= EISDIR
;
1548 /* We succeeded; return this descriptor and filename. */
1560 encoded_fn
= ENCODE_FILE (string
);
1561 pfn
= SSDATA (encoded_fn
);
1563 /* Check that we can access or open it. */
1564 if (NATNUMP (predicate
))
1567 if (INT_MAX
< XFASTINT (predicate
))
1568 last_errno
= EINVAL
;
1569 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1573 if (file_directory_p (pfn
))
1574 last_errno
= EISDIR
;
1581 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1584 if (errno
!= ENOENT
)
1590 int err
= (fstat (fd
, &st
) != 0 ? errno
1591 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1603 /* We succeeded; return this descriptor and filename. */
1621 /* Merge the list we've accumulated of globals from the current input source
1622 into the load_history variable. The details depend on whether
1623 the source has an associated file name or not.
1625 FILENAME is the file name that we are loading from.
1627 ENTIRE is true if loading that entire file, false if evaluating
1631 build_load_history (Lisp_Object filename
, bool entire
)
1633 Lisp_Object tail
, prev
, newelt
;
1634 Lisp_Object tem
, tem2
;
1637 tail
= Vload_history
;
1640 while (CONSP (tail
))
1644 /* Find the feature's previous assoc list... */
1645 if (!NILP (Fequal (filename
, Fcar (tem
))))
1649 /* If we're loading the entire file, remove old data. */
1653 Vload_history
= XCDR (tail
);
1655 Fsetcdr (prev
, XCDR (tail
));
1658 /* Otherwise, cons on new symbols that are not already members. */
1661 tem2
= Vcurrent_load_list
;
1663 while (CONSP (tem2
))
1665 newelt
= XCAR (tem2
);
1667 if (NILP (Fmember (newelt
, tem
)))
1668 Fsetcar (tail
, Fcons (XCAR (tem
),
1669 Fcons (newelt
, XCDR (tem
))));
1682 /* If we're loading an entire file, cons the new assoc onto the
1683 front of load-history, the most-recently-loaded position. Also
1684 do this if we didn't find an existing member for the file. */
1685 if (entire
|| !foundit
)
1686 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1691 readevalloop_1 (int old
)
1693 load_convert_to_unibyte
= old
;
1696 /* Signal an `end-of-file' error, if possible with file name
1699 static _Noreturn
void
1700 end_of_file_error (void)
1702 if (STRINGP (Vload_file_name
))
1703 xsignal1 (Qend_of_file
, Vload_file_name
);
1705 xsignal0 (Qend_of_file
);
1708 /* UNIBYTE specifies how to set load_convert_to_unibyte
1709 for this invocation.
1710 READFUN, if non-nil, is used instead of `read'.
1712 START, END specify region to read in current buffer (from eval-region).
1713 If the input is not from a buffer, they must be nil. */
1716 readevalloop (Lisp_Object readcharfun
,
1718 Lisp_Object sourcename
,
1720 Lisp_Object unibyte
, Lisp_Object readfun
,
1721 Lisp_Object start
, Lisp_Object end
)
1724 register Lisp_Object val
;
1725 ptrdiff_t count
= SPECPDL_INDEX ();
1726 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1727 struct buffer
*b
= 0;
1728 bool continue_reading_p
;
1729 Lisp_Object lex_bound
;
1730 /* True if reading an entire buffer. */
1731 bool whole_buffer
= 0;
1732 /* True on the first time around. */
1733 bool first_sexp
= 1;
1734 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1736 if (NILP (Ffboundp (macroexpand
))
1737 /* Don't macroexpand in .elc files, since it should have been done
1738 already. We actually don't know whether we're in a .elc file or not,
1739 so we use circumstantial evidence: .el files normally go through
1740 Vload_source_file_function -> load-with-code-conversion
1742 || EQ (readcharfun
, Qget_file_char
)
1743 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1746 if (MARKERP (readcharfun
))
1749 start
= readcharfun
;
1752 if (BUFFERP (readcharfun
))
1753 b
= XBUFFER (readcharfun
);
1754 else if (MARKERP (readcharfun
))
1755 b
= XMARKER (readcharfun
)->buffer
;
1757 /* We assume START is nil when input is not from a buffer. */
1758 if (! NILP (start
) && !b
)
1761 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1762 specbind (Qcurrent_load_list
, Qnil
);
1763 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1764 load_convert_to_unibyte
= !NILP (unibyte
);
1766 /* If lexical binding is active (either because it was specified in
1767 the file's header, or via a buffer-local variable), create an empty
1768 lexical environment, otherwise, turn off lexical binding. */
1769 lex_bound
= find_symbol_value (Qlexical_binding
);
1770 specbind (Qinternal_interpreter_environment
,
1771 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1772 ? Qnil
: list1 (Qt
)));
1774 GCPRO4 (sourcename
, readfun
, start
, end
);
1776 /* Try to ensure sourcename is a truename, except whilst preloading. */
1777 if (NILP (Vpurify_flag
)
1778 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1779 && !NILP (Ffboundp (Qfile_truename
)))
1780 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1782 LOADHIST_ATTACH (sourcename
);
1784 continue_reading_p
= 1;
1785 while (continue_reading_p
)
1787 ptrdiff_t count1
= SPECPDL_INDEX ();
1789 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1790 error ("Reading from killed buffer");
1794 /* Switch to the buffer we are reading from. */
1795 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1796 set_buffer_internal (b
);
1798 /* Save point in it. */
1799 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1800 /* Save ZV in it. */
1801 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1802 /* Those get unbound after we read one expression. */
1804 /* Set point and ZV around stuff to be read. */
1807 Fnarrow_to_region (make_number (BEGV
), end
);
1809 /* Just for cleanliness, convert END to a marker
1810 if it is an integer. */
1812 end
= Fpoint_max_marker ();
1815 /* On the first cycle, we can easily test here
1816 whether we are reading the whole buffer. */
1817 if (b
&& first_sexp
)
1818 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1825 while ((c
= READCHAR
) != '\n' && c
!= -1);
1830 unbind_to (count1
, Qnil
);
1834 /* Ignore whitespace here, so we can detect eof. */
1835 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1836 || c
== 0xa0) /* NBSP */
1839 if (!NILP (Vpurify_flag
) && c
== '(')
1841 val
= read_list (0, readcharfun
);
1846 read_objects
= Qnil
;
1847 if (!NILP (readfun
))
1849 val
= call1 (readfun
, readcharfun
);
1851 /* If READCHARFUN has set point to ZV, we should
1852 stop reading, even if the form read sets point
1853 to a different value when evaluated. */
1854 if (BUFFERP (readcharfun
))
1856 struct buffer
*buf
= XBUFFER (readcharfun
);
1857 if (BUF_PT (buf
) == BUF_ZV (buf
))
1858 continue_reading_p
= 0;
1861 else if (! NILP (Vload_read_function
))
1862 val
= call1 (Vload_read_function
, readcharfun
);
1864 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1867 if (!NILP (start
) && continue_reading_p
)
1868 start
= Fpoint_marker ();
1870 /* Restore saved point and BEGV. */
1871 unbind_to (count1
, Qnil
);
1873 /* Now eval what we just read. */
1874 if (!NILP (macroexpand
))
1875 val
= call1 (macroexpand
, val
);
1876 val
= eval_sub (val
);
1880 Vvalues
= Fcons (val
, Vvalues
);
1881 if (EQ (Vstandard_output
, Qt
))
1890 build_load_history (sourcename
,
1891 stream
|| whole_buffer
);
1895 unbind_to (count
, Qnil
);
1898 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1899 doc
: /* Execute the current buffer as Lisp code.
1900 When called from a Lisp program (i.e., not interactively), this
1901 function accepts up to five optional arguments:
1902 BUFFER is the buffer to evaluate (nil means use current buffer).
1903 PRINTFLAG controls printing of output:
1904 A value of nil means discard it; anything else is stream for print.
1905 FILENAME specifies the file name to use for `load-history'.
1906 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1908 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1909 functions should work normally even if PRINTFLAG is nil.
1911 This function preserves the position of point. */)
1912 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1914 ptrdiff_t count
= SPECPDL_INDEX ();
1915 Lisp_Object tem
, buf
;
1918 buf
= Fcurrent_buffer ();
1920 buf
= Fget_buffer (buffer
);
1922 error ("No such buffer");
1924 if (NILP (printflag
) && NILP (do_allow_print
))
1929 if (NILP (filename
))
1930 filename
= BVAR (XBUFFER (buf
), filename
);
1932 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1933 specbind (Qstandard_output
, tem
);
1934 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1935 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1936 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1937 readevalloop (buf
, 0, filename
,
1938 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1939 unbind_to (count
, Qnil
);
1944 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1945 doc
: /* Execute the region as Lisp code.
1946 When called from programs, expects two arguments,
1947 giving starting and ending indices in the current buffer
1948 of the text to be executed.
1949 Programs can pass third argument PRINTFLAG which controls output:
1950 A value of nil means discard it; anything else is stream for printing it.
1951 Also the fourth argument READ-FUNCTION, if non-nil, is used
1952 instead of `read' to read each expression. It gets one argument
1953 which is the input stream for reading characters.
1955 This function does not move point. */)
1956 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1958 /* FIXME: Do the eval-sexp-add-defvars dance! */
1959 ptrdiff_t count
= SPECPDL_INDEX ();
1960 Lisp_Object tem
, cbuf
;
1962 cbuf
= Fcurrent_buffer ();
1964 if (NILP (printflag
))
1968 specbind (Qstandard_output
, tem
);
1969 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1971 /* `readevalloop' calls functions which check the type of start and end. */
1972 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1973 !NILP (printflag
), Qnil
, read_function
,
1976 return unbind_to (count
, Qnil
);
1980 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1981 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1982 If STREAM is nil, use the value of `standard-input' (which see).
1983 STREAM or the value of `standard-input' may be:
1984 a buffer (read from point and advance it)
1985 a marker (read from where it points and advance it)
1986 a function (call it with no arguments for each character,
1987 call it with a char as argument to push a char back)
1988 a string (takes text from string, starting at the beginning)
1989 t (read text line using minibuffer and use it, or read from
1990 standard input in batch mode). */)
1991 (Lisp_Object stream
)
1994 stream
= Vstandard_input
;
1995 if (EQ (stream
, Qt
))
1996 stream
= Qread_char
;
1997 if (EQ (stream
, Qread_char
))
1998 /* FIXME: ¿¡ When is this used !? */
1999 return call1 (intern ("read-minibuffer"),
2000 build_string ("Lisp expression: "));
2002 return read_internal_start (stream
, Qnil
, Qnil
);
2005 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2006 doc
: /* Read one Lisp expression which is represented as text by STRING.
2007 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2008 FINAL-STRING-INDEX is an integer giving the position of the next
2009 remaining character in STRING.
2010 START and END optionally delimit a substring of STRING from which to read;
2011 they default to 0 and (length STRING) respectively. */)
2012 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2015 CHECK_STRING (string
);
2016 /* `read_internal_start' sets `read_from_string_index'. */
2017 ret
= read_internal_start (string
, start
, end
);
2018 return Fcons (ret
, make_number (read_from_string_index
));
2021 /* Function to set up the global context we need in toplevel read
2024 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2025 /* `start', `end' only used when stream is a string. */
2030 new_backquote_flag
= 0;
2031 read_objects
= Qnil
;
2032 if (EQ (Vread_with_symbol_positions
, Qt
)
2033 || EQ (Vread_with_symbol_positions
, stream
))
2034 Vread_symbol_positions_list
= Qnil
;
2036 if (STRINGP (stream
)
2037 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2039 ptrdiff_t startval
, endval
;
2042 if (STRINGP (stream
))
2045 string
= XCAR (stream
);
2048 endval
= SCHARS (string
);
2052 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2053 args_out_of_range (string
, end
);
2054 endval
= XINT (end
);
2061 CHECK_NUMBER (start
);
2062 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2063 args_out_of_range (string
, start
);
2064 startval
= XINT (start
);
2066 read_from_string_index
= startval
;
2067 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2068 read_from_string_limit
= endval
;
2071 retval
= read0 (stream
);
2072 if (EQ (Vread_with_symbol_positions
, Qt
)
2073 || EQ (Vread_with_symbol_positions
, stream
))
2074 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2079 /* Signal Qinvalid_read_syntax error.
2080 S is error string of length N (if > 0) */
2082 static _Noreturn
void
2083 invalid_syntax (const char *s
)
2085 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2089 /* Use this for recursive reads, in contexts where internal tokens
2093 read0 (Lisp_Object readcharfun
)
2095 register Lisp_Object val
;
2098 val
= read1 (readcharfun
, &c
, 0);
2102 xsignal1 (Qinvalid_read_syntax
,
2103 Fmake_string (make_number (1), make_number (c
)));
2106 static ptrdiff_t read_buffer_size
;
2107 static char *read_buffer
;
2109 /* Read a \-escape sequence, assuming we already read the `\'.
2110 If the escape sequence forces unibyte, return eight-bit char. */
2113 read_escape (Lisp_Object readcharfun
, bool stringp
)
2116 /* \u allows up to four hex digits, \U up to eight. Default to the
2117 behavior for \u, and change this value in the case that \U is seen. */
2118 int unicode_hex_count
= 4;
2123 end_of_file_error ();
2153 error ("Invalid escape character syntax");
2156 c
= read_escape (readcharfun
, 0);
2157 return c
| meta_modifier
;
2162 error ("Invalid escape character syntax");
2165 c
= read_escape (readcharfun
, 0);
2166 return c
| shift_modifier
;
2171 error ("Invalid escape character syntax");
2174 c
= read_escape (readcharfun
, 0);
2175 return c
| hyper_modifier
;
2180 error ("Invalid escape character syntax");
2183 c
= read_escape (readcharfun
, 0);
2184 return c
| alt_modifier
;
2188 if (stringp
|| c
!= '-')
2195 c
= read_escape (readcharfun
, 0);
2196 return c
| super_modifier
;
2201 error ("Invalid escape character syntax");
2205 c
= read_escape (readcharfun
, 0);
2206 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2207 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2208 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2209 return c
| ctrl_modifier
;
2210 /* ASCII control chars are made from letters (both cases),
2211 as well as the non-letters within 0100...0137. */
2212 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2213 return (c
& (037 | ~0177));
2214 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2215 return (c
& (037 | ~0177));
2217 return c
| ctrl_modifier
;
2227 /* An octal escape, as in ANSI C. */
2229 register int i
= c
- '0';
2230 register int count
= 0;
2233 if ((c
= READCHAR
) >= '0' && c
<= '7')
2245 if (i
>= 0x80 && i
< 0x100)
2246 i
= BYTE8_TO_CHAR (i
);
2251 /* A hex escape, as in ANSI C. */
2258 if (c
>= '0' && c
<= '9')
2263 else if ((c
>= 'a' && c
<= 'f')
2264 || (c
>= 'A' && c
<= 'F'))
2267 if (c
>= 'a' && c
<= 'f')
2277 /* Allow hex escapes as large as ?\xfffffff, because some
2278 packages use them to denote characters with modifiers. */
2279 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2280 error ("Hex character out of range: \\x%x...", i
);
2284 if (count
< 3 && i
>= 0x80)
2285 return BYTE8_TO_CHAR (i
);
2290 /* Post-Unicode-2.0: Up to eight hex chars. */
2291 unicode_hex_count
= 8;
2294 /* A Unicode escape. We only permit them in strings and characters,
2295 not arbitrarily in the source code, as in some other languages. */
2300 while (++count
<= unicode_hex_count
)
2303 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2305 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2306 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2307 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2309 error ("Non-hex digit used for Unicode escape");
2312 error ("Non-Unicode character: 0x%x", i
);
2321 /* Return the digit that CHARACTER stands for in the given BASE.
2322 Return -1 if CHARACTER is out of range for BASE,
2323 and -2 if CHARACTER is not valid for any supported BASE. */
2325 digit_to_number (int character
, int base
)
2329 if ('0' <= character
&& character
<= '9')
2330 digit
= character
- '0';
2331 else if ('a' <= character
&& character
<= 'z')
2332 digit
= character
- 'a' + 10;
2333 else if ('A' <= character
&& character
<= 'Z')
2334 digit
= character
- 'A' + 10;
2338 return digit
< base
? digit
: -1;
2341 /* Read an integer in radix RADIX using READCHARFUN to read
2342 characters. RADIX must be in the interval [2..36]; if it isn't, a
2343 read error is signaled . Value is the integer read. Signals an
2344 error if encountering invalid read syntax or if RADIX is out of
2348 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2350 /* Room for sign, leading 0, other digits, trailing null byte.
2351 Also, room for invalid syntax diagnostic. */
2352 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2353 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2355 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2357 if (radix
< 2 || radix
> 36)
2365 if (c
== '-' || c
== '+')
2376 /* Ignore redundant leading zeros, so the buffer doesn't
2377 fill up with them. */
2383 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2390 if (p
< buf
+ sizeof buf
- 1)
2404 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2405 invalid_syntax (buf
);
2408 return string_to_number (buf
, radix
, 0);
2412 /* If the next token is ')' or ']' or '.', we store that character
2413 in *PCH and the return value is not interesting. Else, we store
2414 zero in *PCH and we read and return one lisp object.
2416 FIRST_IN_LIST is true if this is the first element of a list. */
2419 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2422 bool uninterned_symbol
= 0;
2429 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2431 end_of_file_error ();
2436 return read_list (0, readcharfun
);
2439 return read_vector (readcharfun
, 0);
2455 /* Accept extended format for hashtables (extensible to
2457 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2458 Lisp_Object tmp
= read_list (0, readcharfun
);
2459 Lisp_Object head
= CAR_SAFE (tmp
);
2460 Lisp_Object data
= Qnil
;
2461 Lisp_Object val
= Qnil
;
2462 /* The size is 2 * number of allowed keywords to
2464 Lisp_Object params
[10];
2466 Lisp_Object key
= Qnil
;
2467 int param_count
= 0;
2469 if (!EQ (head
, Qhash_table
))
2470 error ("Invalid extended read marker at head of #s list "
2471 "(only hash-table allowed)");
2473 tmp
= CDR_SAFE (tmp
);
2475 /* This is repetitive but fast and simple. */
2476 params
[param_count
] = QCsize
;
2477 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2478 if (!NILP (params
[param_count
+ 1]))
2481 params
[param_count
] = QCtest
;
2482 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2483 if (!NILP (params
[param_count
+ 1]))
2486 params
[param_count
] = QCweakness
;
2487 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2488 if (!NILP (params
[param_count
+ 1]))
2491 params
[param_count
] = QCrehash_size
;
2492 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2493 if (!NILP (params
[param_count
+ 1]))
2496 params
[param_count
] = QCrehash_threshold
;
2497 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2498 if (!NILP (params
[param_count
+ 1]))
2501 /* This is the hashtable data. */
2502 data
= Fplist_get (tmp
, Qdata
);
2504 /* Now use params to make a new hashtable and fill it. */
2505 ht
= Fmake_hash_table (param_count
, params
);
2507 while (CONSP (data
))
2512 error ("Odd number of elements in hashtable data");
2515 Fputhash (key
, val
, ht
);
2521 invalid_syntax ("#");
2529 tmp
= read_vector (readcharfun
, 0);
2530 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2531 error ("Invalid size char-table");
2532 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2544 tmp
= read_vector (readcharfun
, 0);
2547 error ("Invalid size char-table");
2548 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2549 error ("Invalid depth in char-table");
2550 depth
= XINT (AREF (tmp
, 0));
2551 if (chartab_size
[depth
] != size
- 2)
2552 error ("Invalid size char-table");
2553 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2556 invalid_syntax ("#^^");
2558 invalid_syntax ("#^");
2563 length
= read1 (readcharfun
, pch
, first_in_list
);
2567 Lisp_Object tmp
, val
;
2568 EMACS_INT size_in_chars
2569 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2570 / BOOL_VECTOR_BITS_PER_CHAR
);
2573 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2574 if (STRING_MULTIBYTE (tmp
)
2575 || (size_in_chars
!= SCHARS (tmp
)
2576 /* We used to print 1 char too many
2577 when the number of bits was a multiple of 8.
2578 Accept such input in case it came from an old
2580 && ! (XFASTINT (length
)
2581 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2582 invalid_syntax ("#&...");
2584 val
= Fmake_bool_vector (length
, Qnil
);
2585 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2586 /* Clear the extraneous bits in the last byte. */
2587 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2588 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2589 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2592 invalid_syntax ("#&...");
2596 /* Accept compiled functions at read-time so that we don't have to
2597 build them using function calls. */
2599 tmp
= read_vector (readcharfun
, 1);
2600 struct Lisp_Vector
* vec
= XVECTOR (tmp
);
2601 if (vec
->header
.size
==0)
2602 invalid_syntax ("Empty byte-code object");
2603 make_byte_code (vec
);
2609 struct gcpro gcpro1
;
2612 /* Read the string itself. */
2613 tmp
= read1 (readcharfun
, &ch
, 0);
2614 if (ch
!= 0 || !STRINGP (tmp
))
2615 invalid_syntax ("#");
2617 /* Read the intervals and their properties. */
2620 Lisp_Object beg
, end
, plist
;
2622 beg
= read1 (readcharfun
, &ch
, 0);
2627 end
= read1 (readcharfun
, &ch
, 0);
2629 plist
= read1 (readcharfun
, &ch
, 0);
2631 invalid_syntax ("Invalid string property list");
2632 Fset_text_properties (beg
, end
, plist
, tmp
);
2638 /* #@NUMBER is used to skip NUMBER following bytes.
2639 That's used in .elc files to skip over doc strings
2640 and function definitions. */
2643 enum { extra
= 100 };
2644 ptrdiff_t i
, nskip
= 0, digits
= 0;
2646 /* Read a decimal integer. */
2647 while ((c
= READCHAR
) >= 0
2648 && c
>= '0' && c
<= '9')
2650 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2655 if (digits
== 2 && nskip
== 0)
2656 { /* We've just seen #@00, which means "skip to end". */
2657 skip_dyn_eof (readcharfun
);
2662 /* We can't use UNREAD here, because in the code below we side-step
2663 READCHAR. Instead, assume the first char after #@NNN occupies
2664 a single byte, which is the case normally since it's just
2670 if (load_force_doc_strings
2671 && (FROM_FILE_P (readcharfun
)))
2673 /* If we are supposed to force doc strings into core right now,
2674 record the last string that we skipped,
2675 and record where in the file it comes from. */
2677 /* But first exchange saved_doc_string
2678 with prev_saved_doc_string, so we save two strings. */
2680 char *temp
= saved_doc_string
;
2681 ptrdiff_t temp_size
= saved_doc_string_size
;
2682 file_offset temp_pos
= saved_doc_string_position
;
2683 ptrdiff_t temp_len
= saved_doc_string_length
;
2685 saved_doc_string
= prev_saved_doc_string
;
2686 saved_doc_string_size
= prev_saved_doc_string_size
;
2687 saved_doc_string_position
= prev_saved_doc_string_position
;
2688 saved_doc_string_length
= prev_saved_doc_string_length
;
2690 prev_saved_doc_string
= temp
;
2691 prev_saved_doc_string_size
= temp_size
;
2692 prev_saved_doc_string_position
= temp_pos
;
2693 prev_saved_doc_string_length
= temp_len
;
2696 if (saved_doc_string_size
== 0)
2698 saved_doc_string
= xmalloc (nskip
+ extra
);
2699 saved_doc_string_size
= nskip
+ extra
;
2701 if (nskip
> saved_doc_string_size
)
2703 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2704 saved_doc_string_size
= nskip
+ extra
;
2707 saved_doc_string_position
= file_tell (instream
);
2709 /* Copy that many characters into saved_doc_string. */
2711 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2712 saved_doc_string
[i
] = c
= getc (instream
);
2715 saved_doc_string_length
= i
;
2718 /* Skip that many bytes. */
2719 skip_dyn_bytes (readcharfun
, nskip
);
2725 /* #! appears at the beginning of an executable file.
2726 Skip the first line. */
2727 while (c
!= '\n' && c
>= 0)
2732 return Vload_file_name
;
2734 return list2 (Qfunction
, read0 (readcharfun
));
2735 /* #:foo is the uninterned symbol named foo. */
2738 uninterned_symbol
= 1;
2741 && c
!= 0xa0 /* NBSP */
2743 || strchr ("\"';()[]#`,", c
) == NULL
)))
2745 /* No symbol character follows, this is the empty
2748 return Fmake_symbol (empty_unibyte_string
);
2752 /* ## is the empty symbol. */
2754 return Fintern (empty_unibyte_string
, Qnil
);
2755 /* Reader forms that can reuse previously read objects. */
2756 if (c
>= '0' && c
<= '9')
2761 /* Read a non-negative integer. */
2762 while (c
>= '0' && c
<= '9')
2764 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2765 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2766 n
= MOST_POSITIVE_FIXNUM
+ 1;
2768 n
= n
* 10 + c
- '0';
2772 if (n
<= MOST_POSITIVE_FIXNUM
)
2774 if (c
== 'r' || c
== 'R')
2775 return read_integer (readcharfun
, n
);
2777 if (! NILP (Vread_circle
))
2779 /* #n=object returns object, but associates it with
2783 /* Make a placeholder for #n# to use temporarily. */
2784 Lisp_Object placeholder
;
2787 placeholder
= Fcons (Qnil
, Qnil
);
2788 cell
= Fcons (make_number (n
), placeholder
);
2789 read_objects
= Fcons (cell
, read_objects
);
2791 /* Read the object itself. */
2792 tem
= read0 (readcharfun
);
2794 /* Now put it everywhere the placeholder was... */
2795 substitute_object_in_subtree (tem
, placeholder
);
2797 /* ...and #n# will use the real value from now on. */
2798 Fsetcdr (cell
, tem
);
2803 /* #n# returns a previously read object. */
2806 tem
= Fassq (make_number (n
), read_objects
);
2812 /* Fall through to error message. */
2814 else if (c
== 'x' || c
== 'X')
2815 return read_integer (readcharfun
, 16);
2816 else if (c
== 'o' || c
== 'O')
2817 return read_integer (readcharfun
, 8);
2818 else if (c
== 'b' || c
== 'B')
2819 return read_integer (readcharfun
, 2);
2822 invalid_syntax ("#");
2825 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2829 return list2 (Qquote
, read0 (readcharfun
));
2833 int next_char
= READCHAR
;
2835 /* Transition from old-style to new-style:
2836 If we see "(`" it used to mean old-style, which usually works
2837 fine because ` should almost never appear in such a position
2838 for new-style. But occasionally we need "(`" to mean new
2839 style, so we try to distinguish the two by the fact that we
2840 can either write "( `foo" or "(` foo", where the first
2841 intends to use new-style whereas the second intends to use
2842 old-style. For Emacs-25, we should completely remove this
2843 first_in_list exception (old-style can still be obtained via
2845 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2847 Vold_style_backquotes
= Qt
;
2853 bool saved_new_backquote_flag
= new_backquote_flag
;
2855 new_backquote_flag
= 1;
2856 value
= read0 (readcharfun
);
2857 new_backquote_flag
= saved_new_backquote_flag
;
2859 return list2 (Qbackquote
, value
);
2864 int next_char
= READCHAR
;
2866 /* Transition from old-style to new-style:
2867 It used to be impossible to have a new-style , other than within
2868 a new-style `. This is sufficient when ` and , are used in the
2869 normal way, but ` and , can also appear in args to macros that
2870 will not interpret them in the usual way, in which case , may be
2871 used without any ` anywhere near.
2872 So we now use the same heuristic as for backquote: old-style
2873 unquotes are only recognized when first on a list, and when
2874 followed by a space.
2875 Because it's more difficult to peek 2 chars ahead, a new-style
2876 ,@ can still not be used outside of a `, unless it's in the middle
2878 if (new_backquote_flag
2880 || (next_char
!= ' ' && next_char
!= '@'))
2882 Lisp_Object comma_type
= Qnil
;
2887 comma_type
= Qcomma_at
;
2889 comma_type
= Qcomma_dot
;
2892 if (ch
>= 0) UNREAD (ch
);
2893 comma_type
= Qcomma
;
2896 value
= read0 (readcharfun
);
2897 return list2 (comma_type
, value
);
2901 Vold_style_backquotes
= Qt
;
2913 end_of_file_error ();
2915 /* Accept `single space' syntax like (list ? x) where the
2916 whitespace character is SPC or TAB.
2917 Other literal whitespace like NL, CR, and FF are not accepted,
2918 as there are well-established escape sequences for these. */
2919 if (c
== ' ' || c
== '\t')
2920 return make_number (c
);
2923 c
= read_escape (readcharfun
, 0);
2924 modifiers
= c
& CHAR_MODIFIER_MASK
;
2925 c
&= ~CHAR_MODIFIER_MASK
;
2926 if (CHAR_BYTE8_P (c
))
2927 c
= CHAR_TO_BYTE8 (c
);
2930 next_char
= READCHAR
;
2931 ok
= (next_char
<= 040
2932 || (next_char
< 0200
2933 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2936 return make_number (c
);
2938 invalid_syntax ("?");
2943 char *p
= read_buffer
;
2944 char *end
= read_buffer
+ read_buffer_size
;
2946 /* True if we saw an escape sequence specifying
2947 a multibyte character. */
2948 bool force_multibyte
= 0;
2949 /* True if we saw an escape sequence specifying
2950 a single-byte character. */
2951 bool force_singlebyte
= 0;
2953 ptrdiff_t nchars
= 0;
2955 while ((ch
= READCHAR
) >= 0
2958 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2960 ptrdiff_t offset
= p
- read_buffer
;
2961 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2962 memory_full (SIZE_MAX
);
2963 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
2964 read_buffer_size
*= 2;
2965 p
= read_buffer
+ offset
;
2966 end
= read_buffer
+ read_buffer_size
;
2973 ch
= read_escape (readcharfun
, 1);
2975 /* CH is -1 if \ newline has just been seen. */
2978 if (p
== read_buffer
)
2983 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2984 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2986 if (CHAR_BYTE8_P (ch
))
2987 force_singlebyte
= 1;
2988 else if (! ASCII_CHAR_P (ch
))
2989 force_multibyte
= 1;
2990 else /* I.e. ASCII_CHAR_P (ch). */
2992 /* Allow `\C- ' and `\C-?'. */
2993 if (modifiers
== CHAR_CTL
)
2996 ch
= 0, modifiers
= 0;
2998 ch
= 127, modifiers
= 0;
3000 if (modifiers
& CHAR_SHIFT
)
3002 /* Shift modifier is valid only with [A-Za-z]. */
3003 if (ch
>= 'A' && ch
<= 'Z')
3004 modifiers
&= ~CHAR_SHIFT
;
3005 else if (ch
>= 'a' && ch
<= 'z')
3006 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3009 if (modifiers
& CHAR_META
)
3011 /* Move the meta bit to the right place for a
3013 modifiers
&= ~CHAR_META
;
3014 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3015 force_singlebyte
= 1;
3019 /* Any modifiers remaining are invalid. */
3021 error ("Invalid modifier in string");
3022 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3026 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3027 if (CHAR_BYTE8_P (ch
))
3028 force_singlebyte
= 1;
3029 else if (! ASCII_CHAR_P (ch
))
3030 force_multibyte
= 1;
3036 end_of_file_error ();
3038 /* If purifying, and string starts with \ newline,
3039 return zero instead. This is for doc strings
3040 that we are really going to find in etc/DOC.nn.nn. */
3041 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3042 return make_number (0);
3044 if (! force_multibyte
&& force_singlebyte
)
3046 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3047 forms. Convert it to unibyte. */
3048 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3050 p
= read_buffer
+ nchars
;
3053 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3055 || (p
- read_buffer
!= nchars
)));
3060 int next_char
= READCHAR
;
3063 if (next_char
<= 040
3064 || (next_char
< 0200
3065 && strchr ("\"';([#?`,", next_char
) != NULL
))
3071 /* Otherwise, we fall through! Note that the atom-reading loop
3072 below will now loop at least once, assuring that we will not
3073 try to UNREAD two characters in a row. */
3077 if (c
<= 040) goto retry
;
3078 if (c
== 0xa0) /* NBSP */
3083 char *p
= read_buffer
;
3085 EMACS_INT start_position
= readchar_count
- 1;
3088 char *end
= read_buffer
+ read_buffer_size
;
3092 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3094 ptrdiff_t offset
= p
- read_buffer
;
3095 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3096 memory_full (SIZE_MAX
);
3097 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3098 read_buffer_size
*= 2;
3099 p
= read_buffer
+ offset
;
3100 end
= read_buffer
+ read_buffer_size
;
3107 end_of_file_error ();
3112 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3118 && c
!= 0xa0 /* NBSP */
3120 || strchr ("\"';()[]#`,", c
) == NULL
));
3124 ptrdiff_t offset
= p
- read_buffer
;
3125 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3126 memory_full (SIZE_MAX
);
3127 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3128 read_buffer_size
*= 2;
3129 p
= read_buffer
+ offset
;
3130 end
= read_buffer
+ read_buffer_size
;
3136 if (!quoted
&& !uninterned_symbol
)
3138 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3139 if (! NILP (result
))
3143 Lisp_Object name
, result
;
3144 ptrdiff_t nbytes
= p
- read_buffer
;
3147 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3151 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3152 ? make_pure_string
: make_specified_string
)
3153 (read_buffer
, nchars
, nbytes
, multibyte
));
3154 result
= (uninterned_symbol
? Fmake_symbol (name
)
3155 : Fintern (name
, Qnil
));
3157 if (EQ (Vread_with_symbol_positions
, Qt
)
3158 || EQ (Vread_with_symbol_positions
, readcharfun
))
3159 Vread_symbol_positions_list
3160 = Fcons (Fcons (result
, make_number (start_position
)),
3161 Vread_symbol_positions_list
);
3169 /* List of nodes we've seen during substitute_object_in_subtree. */
3170 static Lisp_Object seen_list
;
3173 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3175 Lisp_Object check_object
;
3177 /* We haven't seen any objects when we start. */
3180 /* Make all the substitutions. */
3182 = substitute_object_recurse (object
, placeholder
, object
);
3184 /* Clear seen_list because we're done with it. */
3187 /* The returned object here is expected to always eq the
3189 if (!EQ (check_object
, object
))
3190 error ("Unexpected mutation error in reader");
3193 /* Feval doesn't get called from here, so no gc protection is needed. */
3194 #define SUBSTITUTE(get_val, set_val) \
3196 Lisp_Object old_value = get_val; \
3197 Lisp_Object true_value \
3198 = substitute_object_recurse (object, placeholder, \
3201 if (!EQ (old_value, true_value)) \
3208 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3210 /* If we find the placeholder, return the target object. */
3211 if (EQ (placeholder
, subtree
))
3214 /* If we've been to this node before, don't explore it again. */
3215 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3218 /* If this node can be the entry point to a cycle, remember that
3219 we've seen it. It can only be such an entry point if it was made
3220 by #n=, which means that we can find it as a value in
3222 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3223 seen_list
= Fcons (subtree
, seen_list
);
3225 /* Recurse according to subtree's type.
3226 Every branch must return a Lisp_Object. */
3227 switch (XTYPE (subtree
))
3229 case Lisp_Vectorlike
:
3231 ptrdiff_t i
, length
= 0;
3232 if (BOOL_VECTOR_P (subtree
))
3233 return subtree
; /* No sub-objects anyway. */
3234 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3235 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3236 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3237 else if (VECTORP (subtree
))
3238 length
= ASIZE (subtree
);
3240 /* An unknown pseudovector may contain non-Lisp fields, so we
3241 can't just blindly traverse all its fields. We used to call
3242 `Flength' which signaled `sequencep', so I just preserved this
3244 wrong_type_argument (Qsequencep
, subtree
);
3246 for (i
= 0; i
< length
; i
++)
3247 SUBSTITUTE (AREF (subtree
, i
),
3248 ASET (subtree
, i
, true_value
));
3254 SUBSTITUTE (XCAR (subtree
),
3255 XSETCAR (subtree
, true_value
));
3256 SUBSTITUTE (XCDR (subtree
),
3257 XSETCDR (subtree
, true_value
));
3263 /* Check for text properties in each interval.
3264 substitute_in_interval contains part of the logic. */
3266 INTERVAL root_interval
= string_intervals (subtree
);
3267 Lisp_Object arg
= Fcons (object
, placeholder
);
3269 traverse_intervals_noorder (root_interval
,
3270 &substitute_in_interval
, arg
);
3275 /* Other types don't recurse any further. */
3281 /* Helper function for substitute_object_recurse. */
3283 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3285 Lisp_Object object
= Fcar (arg
);
3286 Lisp_Object placeholder
= Fcdr (arg
);
3288 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3298 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3299 integer syntax and fits in a fixnum, else return the nearest float if CP has
3300 either floating point or integer syntax and BASE is 10, else return nil. If
3301 IGNORE_TRAILING, consider just the longest prefix of CP that has
3302 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3303 number has integer syntax but does not fit. */
3306 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3309 char const *cp
= string
;
3311 bool float_syntax
= 0;
3314 /* Compute NaN and infinities using a variable, to cope with compilers that
3315 think they are smarter than we are. */
3318 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3319 IEEE floating point hosts, and works around a formerly-common bug where
3320 atof ("-0.0") drops the sign. */
3321 bool negative
= *cp
== '-';
3323 bool signedp
= negative
|| *cp
== '+';
3328 leading_digit
= digit_to_number (*cp
, base
);
3329 if (leading_digit
>= 0)
3334 while (digit_to_number (*cp
, base
) >= 0);
3344 if ('0' <= *cp
&& *cp
<= '9')
3349 while ('0' <= *cp
&& *cp
<= '9');
3351 if (*cp
== 'e' || *cp
== 'E')
3353 char const *ecp
= cp
;
3355 if (*cp
== '+' || *cp
== '-')
3357 if ('0' <= *cp
&& *cp
<= '9')
3362 while ('0' <= *cp
&& *cp
<= '9');
3364 else if (cp
[-1] == '+'
3365 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3371 else if (cp
[-1] == '+'
3372 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3376 value
= zero
/ zero
;
3378 /* If that made a "negative" NaN, negate it. */
3381 union { double d
; char c
[sizeof (double)]; }
3382 u_data
, u_minus_zero
;
3384 u_minus_zero
.d
= -0.0;
3385 for (i
= 0; i
< sizeof (double); i
++)
3386 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3392 /* Now VALUE is a positive NaN. */
3398 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3399 || state
== (LEAD_INT
|E_EXP
));
3402 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3403 any prefix that matches. Otherwise, the entire string must match. */
3404 if (! (ignore_trailing
3405 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3406 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3409 /* If the number uses integer and not float syntax, and is in C-language
3410 range, use its value, preferably as a fixnum. */
3411 if (leading_digit
>= 0 && ! float_syntax
)
3415 /* Fast special case for single-digit integers. This also avoids a
3416 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3417 case some versions of strtoumax accept numbers like "0x1" that Emacs
3419 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3420 return make_number (negative
? -leading_digit
: leading_digit
);
3423 n
= strtoumax (string
+ signedp
, NULL
, base
);
3424 if (errno
== ERANGE
)
3426 /* Unfortunately there's no simple and accurate way to convert
3427 non-base-10 numbers that are out of C-language range. */
3429 xsignal1 (Qoverflow_error
, build_string (string
));
3431 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3433 EMACS_INT signed_n
= n
;
3434 return make_number (negative
? -signed_n
: signed_n
);
3440 /* Either the number uses float syntax, or it does not fit into a fixnum.
3441 Convert it from string to floating point, unless the value is already
3442 known because it is an infinity, a NAN, or its absolute value fits in
3445 value
= atof (string
+ signedp
);
3447 return make_float (negative
? -value
: value
);
3452 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3456 Lisp_Object tem
, item
, vector
;
3457 struct Lisp_Cons
*otem
;
3460 tem
= read_list (1, readcharfun
);
3461 len
= Flength (tem
);
3462 vector
= Fmake_vector (len
, Qnil
);
3464 size
= ASIZE (vector
);
3465 ptr
= XVECTOR (vector
)->u
.contents
;
3466 for (i
= 0; i
< size
; i
++)
3469 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3470 bytecode object, the docstring containing the bytecode and
3471 constants values must be treated as unibyte and passed to
3472 Fread, to get the actual bytecode string and constants vector. */
3473 if (bytecodeflag
&& load_force_doc_strings
)
3475 if (i
== COMPILED_BYTECODE
)
3477 if (!STRINGP (item
))
3478 error ("Invalid byte code");
3480 /* Delay handling the bytecode slot until we know whether
3481 it is lazily-loaded (we can tell by whether the
3482 constants slot is nil). */
3483 ASET (vector
, COMPILED_CONSTANTS
, item
);
3486 else if (i
== COMPILED_CONSTANTS
)
3488 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3492 /* Coerce string to unibyte (like string-as-unibyte,
3493 but without generating extra garbage and
3494 guaranteeing no change in the contents). */
3495 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3496 STRING_SET_UNIBYTE (bytestr
);
3498 item
= Fread (Fcons (bytestr
, readcharfun
));
3500 error ("Invalid byte code");
3502 otem
= XCONS (item
);
3503 bytestr
= XCAR (item
);
3508 /* Now handle the bytecode slot. */
3509 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3511 else if (i
== COMPILED_DOC_STRING
3513 && ! STRING_MULTIBYTE (item
))
3515 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3516 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3518 item
= Fstring_as_multibyte (item
);
3521 ASET (vector
, i
, item
);
3529 /* FLAG means check for ] to terminate rather than ) and . */
3532 read_list (bool flag
, Lisp_Object readcharfun
)
3534 Lisp_Object val
, tail
;
3535 Lisp_Object elt
, tem
;
3536 struct gcpro gcpro1
, gcpro2
;
3537 /* 0 is the normal case.
3538 1 means this list is a doc reference; replace it with the number 0.
3539 2 means this list is a doc reference; replace it with the doc string. */
3540 int doc_reference
= 0;
3542 /* Initialize this to 1 if we are reading a list. */
3543 bool first_in_list
= flag
<= 0;
3552 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3557 /* While building, if the list starts with #$, treat it specially. */
3558 if (EQ (elt
, Vload_file_name
)
3560 && !NILP (Vpurify_flag
))
3562 if (NILP (Vdoc_file_name
))
3563 /* We have not yet called Snarf-documentation, so assume
3564 this file is described in the DOC file
3565 and Snarf-documentation will fill in the right value later.
3566 For now, replace the whole list with 0. */
3569 /* We have already called Snarf-documentation, so make a relative
3570 file name for this file, so it can be found properly
3571 in the installed Lisp directory.
3572 We don't use Fexpand_file_name because that would make
3573 the directory absolute now. */
3574 elt
= concat2 (build_string ("../lisp/"),
3575 Ffile_name_nondirectory (elt
));
3577 else if (EQ (elt
, Vload_file_name
)
3579 && load_force_doc_strings
)
3588 invalid_syntax (") or . in a vector");
3596 XSETCDR (tail
, read0 (readcharfun
));
3598 val
= read0 (readcharfun
);
3599 read1 (readcharfun
, &ch
, 0);
3603 if (doc_reference
== 1)
3604 return make_number (0);
3605 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3608 file_offset saved_position
;
3609 /* Get a doc string from the file we are loading.
3610 If it's in saved_doc_string, get it from there.
3612 Here, we don't know if the string is a
3613 bytecode string or a doc string. As a
3614 bytecode string must be unibyte, we always
3615 return a unibyte string. If it is actually a
3616 doc string, caller must make it
3619 /* Position is negative for user variables. */
3620 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3621 if (pos
>= saved_doc_string_position
3622 && pos
< (saved_doc_string_position
3623 + saved_doc_string_length
))
3625 saved
= saved_doc_string
;
3626 saved_position
= saved_doc_string_position
;
3628 /* Look in prev_saved_doc_string the same way. */
3629 else if (pos
>= prev_saved_doc_string_position
3630 && pos
< (prev_saved_doc_string_position
3631 + prev_saved_doc_string_length
))
3633 saved
= prev_saved_doc_string
;
3634 saved_position
= prev_saved_doc_string_position
;
3638 ptrdiff_t start
= pos
- saved_position
;
3641 /* Process quoting with ^A,
3642 and find the end of the string,
3643 which is marked with ^_ (037). */
3644 for (from
= start
, to
= start
;
3645 saved
[from
] != 037;)
3647 int c
= saved
[from
++];
3651 saved
[to
++] = (c
== 1 ? c
3660 return make_unibyte_string (saved
+ start
,
3664 return get_doc_string (val
, 1, 0);
3669 invalid_syntax (". in wrong context");
3671 invalid_syntax ("] in a list");
3675 XSETCDR (tail
, tem
);
3682 static Lisp_Object initial_obarray
;
3684 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3686 static size_t oblookup_last_bucket_number
;
3688 /* Get an error if OBARRAY is not an obarray.
3689 If it is one, return it. */
3692 check_obarray (Lisp_Object obarray
)
3694 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3696 /* If Vobarray is now invalid, force it to be valid. */
3697 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3698 wrong_type_argument (Qvectorp
, obarray
);
3703 /* Intern the C string STR: return a symbol with that name,
3704 interned in the current obarray. */
3707 intern_1 (const char *str
, ptrdiff_t len
)
3709 Lisp_Object obarray
= check_obarray (Vobarray
);
3710 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3712 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3716 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3718 Lisp_Object obarray
= check_obarray (Vobarray
);
3719 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3724 if (NILP (Vpurify_flag
))
3725 /* Creating a non-pure string from a string literal not
3726 implemented yet. We could just use make_string here and live
3727 with the extra copy. */
3730 return Fintern (make_pure_c_string (str
, len
), obarray
);
3733 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3734 doc
: /* Return the canonical symbol whose name is STRING.
3735 If there is none, one is created by this function and returned.
3736 A second optional argument specifies the obarray to use;
3737 it defaults to the value of `obarray'. */)
3738 (Lisp_Object string
, Lisp_Object obarray
)
3740 register Lisp_Object tem
, sym
, *ptr
;
3742 if (NILP (obarray
)) obarray
= Vobarray
;
3743 obarray
= check_obarray (obarray
);
3745 CHECK_STRING (string
);
3747 tem
= oblookup (obarray
, SSDATA (string
),
3750 if (!INTEGERP (tem
))
3753 if (!NILP (Vpurify_flag
))
3754 string
= Fpurecopy (string
);
3755 sym
= Fmake_symbol (string
);
3757 if (EQ (obarray
, initial_obarray
))
3758 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3760 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3762 if ((SREF (string
, 0) == ':')
3763 && EQ (obarray
, initial_obarray
))
3765 XSYMBOL (sym
)->constant
= 1;
3766 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3767 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3770 ptr
= aref_addr (obarray
, XINT(tem
));
3772 set_symbol_next (sym
, XSYMBOL (*ptr
));
3774 set_symbol_next (sym
, NULL
);
3779 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3780 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3781 NAME may be a string or a symbol. If it is a symbol, that exact
3782 symbol is searched for.
3783 A second optional argument specifies the obarray to use;
3784 it defaults to the value of `obarray'. */)
3785 (Lisp_Object name
, Lisp_Object obarray
)
3787 register Lisp_Object tem
, string
;
3789 if (NILP (obarray
)) obarray
= Vobarray
;
3790 obarray
= check_obarray (obarray
);
3792 if (!SYMBOLP (name
))
3794 CHECK_STRING (name
);
3798 string
= SYMBOL_NAME (name
);
3800 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3801 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3807 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3808 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3809 The value is t if a symbol was found and deleted, nil otherwise.
3810 NAME may be a string or a symbol. If it is a symbol, that symbol
3811 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3812 OBARRAY defaults to the value of the variable `obarray'. */)
3813 (Lisp_Object name
, Lisp_Object obarray
)
3815 register Lisp_Object string
, tem
;
3818 if (NILP (obarray
)) obarray
= Vobarray
;
3819 obarray
= check_obarray (obarray
);
3822 string
= SYMBOL_NAME (name
);
3825 CHECK_STRING (name
);
3829 tem
= oblookup (obarray
, SSDATA (string
),
3834 /* If arg was a symbol, don't delete anything but that symbol itself. */
3835 if (SYMBOLP (name
) && !EQ (name
, tem
))
3838 /* There are plenty of other symbols which will screw up the Emacs
3839 session if we unintern them, as well as even more ways to use
3840 `setq' or `fset' or whatnot to make the Emacs session
3841 unusable. Let's not go down this silly road. --Stef */
3842 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3843 error ("Attempt to unintern t or nil"); */
3845 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3847 hash
= oblookup_last_bucket_number
;
3849 if (EQ (AREF (obarray
, hash
), tem
))
3851 if (XSYMBOL (tem
)->next
)
3854 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
3855 ASET (obarray
, hash
, sym
);
3858 ASET (obarray
, hash
, make_number (0));
3862 Lisp_Object tail
, following
;
3864 for (tail
= AREF (obarray
, hash
);
3865 XSYMBOL (tail
)->next
;
3868 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3869 if (EQ (following
, tem
))
3871 set_symbol_next (tail
, XSYMBOL (following
)->next
);
3880 /* Return the symbol in OBARRAY whose names matches the string
3881 of SIZE characters (SIZE_BYTE bytes) at PTR.
3882 If there is no such symbol in OBARRAY, return nil.
3884 Also store the bucket number in oblookup_last_bucket_number. */
3887 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3891 register Lisp_Object tail
;
3892 Lisp_Object bucket
, tem
;
3894 obarray
= check_obarray (obarray
);
3895 obsize
= ASIZE (obarray
);
3897 /* This is sometimes needed in the middle of GC. */
3898 obsize
&= ~ARRAY_MARK_FLAG
;
3899 hash
= hash_string (ptr
, size_byte
) % obsize
;
3900 bucket
= AREF (obarray
, hash
);
3901 oblookup_last_bucket_number
= hash
;
3902 if (EQ (bucket
, make_number (0)))
3904 else if (!SYMBOLP (bucket
))
3905 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3907 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3909 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3910 && SCHARS (SYMBOL_NAME (tail
)) == size
3911 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3913 else if (XSYMBOL (tail
)->next
== 0)
3916 XSETINT (tem
, hash
);
3921 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3924 register Lisp_Object tail
;
3925 CHECK_VECTOR (obarray
);
3926 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3928 tail
= AREF (obarray
, i
);
3933 if (XSYMBOL (tail
)->next
== 0)
3935 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3941 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3943 call1 (function
, sym
);
3946 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3947 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3948 OBARRAY defaults to the value of `obarray'. */)
3949 (Lisp_Object function
, Lisp_Object obarray
)
3951 if (NILP (obarray
)) obarray
= Vobarray
;
3952 obarray
= check_obarray (obarray
);
3954 map_obarray (obarray
, mapatoms_1
, function
);
3958 #define OBARRAY_SIZE 1511
3963 Lisp_Object oblength
;
3964 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3966 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3968 Vobarray
= Fmake_vector (oblength
, make_number (0));
3969 initial_obarray
= Vobarray
;
3970 staticpro (&initial_obarray
);
3972 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
3973 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3974 NILP (Vpurify_flag) check in intern_c_string. */
3975 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3976 Qnil
= intern_c_string ("nil");
3978 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3979 so those two need to be fixed manually. */
3980 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3981 set_symbol_function (Qunbound
, Qnil
);
3982 set_symbol_plist (Qunbound
, Qnil
);
3983 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3984 XSYMBOL (Qnil
)->constant
= 1;
3985 XSYMBOL (Qnil
)->declared_special
= 1;
3986 set_symbol_plist (Qnil
, Qnil
);
3987 set_symbol_function (Qnil
, Qnil
);
3989 Qt
= intern_c_string ("t");
3990 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3991 XSYMBOL (Qnil
)->declared_special
= 1;
3992 XSYMBOL (Qt
)->constant
= 1;
3994 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3997 DEFSYM (Qvariable_documentation
, "variable-documentation");
3999 read_buffer
= xmalloc (size
);
4000 read_buffer_size
= size
;
4004 defsubr (struct Lisp_Subr
*sname
)
4006 Lisp_Object sym
, tem
;
4007 sym
= intern_c_string (sname
->symbol_name
);
4008 XSETPVECTYPE (sname
, PVEC_SUBR
);
4009 XSETSUBR (tem
, sname
);
4010 set_symbol_function (sym
, tem
);
4013 #ifdef NOTDEF /* Use fset in subr.el now! */
4015 defalias (struct Lisp_Subr
*sname
, char *string
)
4018 sym
= intern (string
);
4019 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4023 /* Define an "integer variable"; a symbol whose value is forwarded to a
4024 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4025 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4027 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4028 const char *namestring
, EMACS_INT
*address
)
4031 sym
= intern_c_string (namestring
);
4032 i_fwd
->type
= Lisp_Fwd_Int
;
4033 i_fwd
->intvar
= address
;
4034 XSYMBOL (sym
)->declared_special
= 1;
4035 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4036 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4039 /* Similar but define a variable whose value is t if address contains 1,
4040 nil if address contains 0. */
4042 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4043 const char *namestring
, bool *address
)
4046 sym
= intern_c_string (namestring
);
4047 b_fwd
->type
= Lisp_Fwd_Bool
;
4048 b_fwd
->boolvar
= address
;
4049 XSYMBOL (sym
)->declared_special
= 1;
4050 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4051 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4052 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4055 /* Similar but define a variable whose value is the Lisp Object stored
4056 at address. Two versions: with and without gc-marking of the C
4057 variable. The nopro version is used when that variable will be
4058 gc-marked for some other reason, since marking the same slot twice
4059 can cause trouble with strings. */
4061 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4062 const char *namestring
, Lisp_Object
*address
)
4065 sym
= intern_c_string (namestring
);
4066 o_fwd
->type
= Lisp_Fwd_Obj
;
4067 o_fwd
->objvar
= address
;
4068 XSYMBOL (sym
)->declared_special
= 1;
4069 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4070 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4074 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4075 const char *namestring
, Lisp_Object
*address
)
4077 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4078 staticpro (address
);
4081 /* Similar but define a variable whose value is the Lisp Object stored
4082 at a particular offset in the current kboard object. */
4085 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4086 const char *namestring
, int offset
)
4089 sym
= intern_c_string (namestring
);
4090 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4091 ko_fwd
->offset
= offset
;
4092 XSYMBOL (sym
)->declared_special
= 1;
4093 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4094 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4097 /* Check that the elements of Vload_path exist. */
4100 load_path_check (void)
4102 Lisp_Object path_tail
;
4104 /* The only elements that might not exist are those from
4105 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4107 for (path_tail
= Vload_path
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4109 Lisp_Object dirfile
;
4110 dirfile
= Fcar (path_tail
);
4111 if (STRINGP (dirfile
))
4113 dirfile
= Fdirectory_file_name (dirfile
);
4114 if (! file_accessible_directory_p (SSDATA (dirfile
)))
4115 dir_warning ("Lisp directory", XCAR (path_tail
));
4120 /* Record the value of load-path used at the start of dumping
4121 so we can see if the site changed it later during dumping. */
4122 static Lisp_Object dump_path
;
4124 /* Compute the default Vload_path, with the following logic:
4126 use EMACSLOADPATH env-var if set; otherwise use PATH_LOADSEARCH,
4127 prepending PATH_SITELOADSEARCH unless --no-site-lisp.
4128 The remainder is what happens when dumping works:
4129 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4130 Otherwise use EMACSLOADPATH if set, else PATH_LOADSEARCH.
4132 If !initialized, then just set both Vload_path and dump_path.
4133 If initialized, then if Vload_path != dump_path, do nothing.
4134 (Presumably the load-path has already been changed by something.
4135 This can only be from a site-load file during dumping,
4136 or because EMACSLOADPATH is set.)
4137 If Vinstallation_directory is not nil (ie, running uninstalled):
4138 If installation-dir/lisp exists and not already a member,
4139 we must be running uninstalled. Reset the load-path
4140 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4141 refers to the eventual installation directories. Since we
4142 are not yet installed, we should not use them, even if they exist.)
4143 If installation-dir/lisp does not exist, just add dump_path at the
4145 Add installation-dir/leim (if exists and not already a member) at the front.
4146 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4147 and not already a member) at the front.
4148 If installation-dir != source-dir (ie running an uninstalled,
4149 out-of-tree build) AND install-dir/src/Makefile exists BUT
4150 install-dir/src/Makefile.in does NOT exist (this is a sanity
4151 check), then repeat the above steps for source-dir/lisp,
4153 Finally, add the site-lisp directories at the front (if !no_site_lisp).
4163 const char *loadpath
= ns_load_path ();
4166 normal
= PATH_LOADSEARCH
;
4168 Vload_path
= decode_env_path ("EMACSLOADPATH", loadpath
? loadpath
: normal
);
4170 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4175 /* FIXME CANNOT_DUMP platforms should get source-dir/lisp etc added
4176 to their load-path too, AFAICS. I don't think we can tell the
4177 difference between initialized and !initialized in this case,
4178 so we'll have to do it unconditionally when Vinstallation_directory
4180 if (!no_site_lisp
&& !egetenv ("EMACSLOADPATH"))
4182 Lisp_Object sitelisp
;
4183 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4184 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4186 #else /* !CANNOT_DUMP */
4187 if (NILP (Vpurify_flag
))
4189 normal
= PATH_LOADSEARCH
;
4190 /* If the EMACSLOADPATH environment variable is set, use its value.
4191 This doesn't apply if we're dumping. */
4192 if (egetenv ("EMACSLOADPATH"))
4193 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4196 normal
= PATH_DUMPLOADSEARCH
;
4198 /* In a dumped Emacs, we normally reset the value of Vload_path using
4199 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4200 the source directory, instead of the path of the installed elisp
4201 libraries. However, if it appears that Vload_path has already been
4202 changed from the default that was saved before dumping, don't
4203 change it further. Changes can only be due to EMACSLOADPATH, or
4204 site-lisp files that were processed during dumping. */
4207 if (NILP (Fequal (dump_path
, Vload_path
)))
4209 /* Do not make any changes, just check the elements exist. */
4210 /* Note: --no-site-lisp is ignored.
4211 I don't know what to do about this. */
4217 const char *loadpath
= ns_load_path ();
4218 Vload_path
= decode_env_path (0, loadpath
? loadpath
: normal
);
4220 Vload_path
= decode_env_path (0, normal
);
4222 if (!NILP (Vinstallation_directory
))
4224 Lisp_Object tem
, tem1
;
4226 /* Add to the path the lisp subdir of the installation
4227 dir, if it is accessible. Note: in out-of-tree builds,
4228 this directory is empty save for Makefile. */
4229 tem
= Fexpand_file_name (build_string ("lisp"),
4230 Vinstallation_directory
);
4231 tem1
= Ffile_accessible_directory_p (tem
);
4234 if (NILP (Fmember (tem
, Vload_path
)))
4236 /* We are running uninstalled. The default load-path
4237 points to the eventual installed lisp, leim
4238 directories. We should not use those now, even
4239 if they exist, so start over from a clean slate. */
4240 Vload_path
= list1 (tem
);
4244 /* That dir doesn't exist, so add the build-time
4245 Lisp dirs instead. */
4246 Vload_path
= nconc2 (Vload_path
, dump_path
);
4248 /* Add leim under the installation dir, if it is accessible. */
4249 tem
= Fexpand_file_name (build_string ("leim"),
4250 Vinstallation_directory
);
4251 tem1
= Ffile_accessible_directory_p (tem
);
4254 if (NILP (Fmember (tem
, Vload_path
)))
4255 Vload_path
= Fcons (tem
, Vload_path
);
4258 /* Add site-lisp under the installation dir, if it exists. */
4261 tem
= Fexpand_file_name (build_string ("site-lisp"),
4262 Vinstallation_directory
);
4263 tem1
= Ffile_accessible_directory_p (tem
);
4266 if (NILP (Fmember (tem
, Vload_path
)))
4267 Vload_path
= Fcons (tem
, Vload_path
);
4271 /* If Emacs was not built in the source directory,
4272 and it is run from where it was built, add to load-path
4273 the lisp, leim and site-lisp dirs under that directory. */
4275 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4279 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4280 Vinstallation_directory
);
4281 tem1
= Ffile_exists_p (tem
);
4283 /* Don't be fooled if they moved the entire source tree
4284 AFTER dumping Emacs. If the build directory is indeed
4285 different from the source dir, src/Makefile.in and
4286 src/Makefile will not be found together. */
4287 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4288 Vinstallation_directory
);
4289 tem2
= Ffile_exists_p (tem
);
4290 if (!NILP (tem1
) && NILP (tem2
))
4292 tem
= Fexpand_file_name (build_string ("lisp"),
4295 if (NILP (Fmember (tem
, Vload_path
)))
4296 Vload_path
= Fcons (tem
, Vload_path
);
4298 tem
= Fexpand_file_name (build_string ("leim"),
4301 if (NILP (Fmember (tem
, Vload_path
)))
4302 Vload_path
= Fcons (tem
, Vload_path
);
4306 tem
= Fexpand_file_name (build_string ("site-lisp"),
4308 tem1
= Ffile_accessible_directory_p (tem
);
4311 if (NILP (Fmember (tem
, Vload_path
)))
4312 Vload_path
= Fcons (tem
, Vload_path
);
4316 } /* Vinstallation_directory != Vsource_directory */
4318 } /* if Vinstallation_directory */
4320 /* Check before adding the site-lisp directories.
4321 The install should have created them, but they are not
4322 required, so no need to warn if they are absent.
4323 Or we might be running before installation. */
4326 /* Add the site-lisp directories at the front. */
4329 Lisp_Object sitelisp
;
4330 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4331 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4333 } /* if dump_path == Vload_path */
4335 else /* !initialized */
4337 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4338 source directory. We used to add ../lisp (ie the lisp dir in
4339 the build directory) at the front here, but that caused trouble
4340 because it was copied from dump_path into Vload_path, above,
4341 when Vinstallation_directory was non-nil. It should not be
4342 necessary, since in out of tree builds lisp/ is empty, save
4344 Vload_path
= decode_env_path (0, normal
);
4345 dump_path
= Vload_path
;
4346 /* No point calling load_path_check; load-path only contains essential
4347 elements from the source directory at this point. They cannot
4348 be missing unless something went extremely (and improbably)
4349 wrong, in which case the build will fail in obvious ways. */
4351 #endif /* !CANNOT_DUMP */
4355 load_in_progress
= 0;
4356 Vload_file_name
= Qnil
;
4357 Vstandard_input
= Qt
;
4358 Vloads_in_progress
= Qnil
;
4361 /* Print a warning that directory intended for use USE and with name
4362 DIRNAME cannot be accessed. On entry, errno should correspond to
4363 the access failure. Print the warning on stderr and put it in
4367 dir_warning (char const *use
, Lisp_Object dirname
)
4369 static char const format
[] = "Warning: %s `%s': %s\n";
4370 int access_errno
= errno
;
4371 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4373 /* Don't log the warning before we've initialized!! */
4376 char const *diagnostic
= emacs_strerror (access_errno
);
4378 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4379 + strlen (use
) + SBYTES (dirname
)
4380 + strlen (diagnostic
));
4381 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4383 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4389 syms_of_lread (void)
4392 defsubr (&Sread_from_string
);
4394 defsubr (&Sintern_soft
);
4395 defsubr (&Sunintern
);
4396 defsubr (&Sget_load_suffixes
);
4398 defsubr (&Seval_buffer
);
4399 defsubr (&Seval_region
);
4400 defsubr (&Sread_char
);
4401 defsubr (&Sread_char_exclusive
);
4402 defsubr (&Sread_event
);
4403 defsubr (&Sget_file_char
);
4404 defsubr (&Smapatoms
);
4405 defsubr (&Slocate_file_internal
);
4407 DEFVAR_LISP ("obarray", Vobarray
,
4408 doc
: /* Symbol table for use by `intern' and `read'.
4409 It is a vector whose length ought to be prime for best results.
4410 The vector's contents don't make sense if examined from Lisp programs;
4411 to find all the symbols in an obarray, use `mapatoms'. */);
4413 DEFVAR_LISP ("values", Vvalues
,
4414 doc
: /* List of values of all expressions which were read, evaluated and printed.
4415 Order is reverse chronological. */);
4416 XSYMBOL (intern ("values"))->declared_special
= 0;
4418 DEFVAR_LISP ("standard-input", Vstandard_input
,
4419 doc
: /* Stream for read to get input from.
4420 See documentation of `read' for possible values. */);
4421 Vstandard_input
= Qt
;
4423 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4424 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4426 If this variable is a buffer, then only forms read from that buffer
4427 will be added to `read-symbol-positions-list'.
4428 If this variable is t, then all read forms will be added.
4429 The effect of all other values other than nil are not currently
4430 defined, although they may be in the future.
4432 The positions are relative to the last call to `read' or
4433 `read-from-string'. It is probably a bad idea to set this variable at
4434 the toplevel; bind it instead. */);
4435 Vread_with_symbol_positions
= Qnil
;
4437 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4438 doc
: /* A list mapping read symbols to their positions.
4439 This variable is modified during calls to `read' or
4440 `read-from-string', but only when `read-with-symbol-positions' is
4443 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4444 CHAR-POSITION is an integer giving the offset of that occurrence of the
4445 symbol from the position where `read' or `read-from-string' started.
4447 Note that a symbol will appear multiple times in this list, if it was
4448 read multiple times. The list is in the same order as the symbols
4450 Vread_symbol_positions_list
= Qnil
;
4452 DEFVAR_LISP ("read-circle", Vread_circle
,
4453 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4456 DEFVAR_LISP ("load-path", Vload_path
,
4457 doc
: /* List of directories to search for files to load.
4458 Each element is a string (directory name) or nil (try default directory).
4459 Initialized based on EMACSLOADPATH environment variable, if any,
4460 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4462 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4463 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4464 This list should not include the empty string.
4465 `load' and related functions try to append these suffixes, in order,
4466 to the specified file name if a Lisp suffix is allowed or required. */);
4467 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4468 build_pure_c_string (".el"));
4469 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4470 doc
: /* List of suffixes that indicate representations of \
4472 This list should normally start with the empty string.
4474 Enabling Auto Compression mode appends the suffixes in
4475 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4476 mode removes them again. `load' and related functions use this list to
4477 determine whether they should look for compressed versions of a file
4478 and, if so, which suffixes they should try to append to the file name
4479 in order to do so. However, if you want to customize which suffixes
4480 the loading functions recognize as compression suffixes, you should
4481 customize `jka-compr-load-suffixes' rather than the present variable. */);
4482 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4484 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4485 doc
: /* Non-nil if inside of `load'. */);
4486 DEFSYM (Qload_in_progress
, "load-in-progress");
4488 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4489 doc
: /* An alist of functions to be evalled when particular files are loaded.
4490 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4492 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4493 a symbol \(a feature name).
4495 When `load' is run and the file-name argument matches an element's
4496 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4497 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4499 An error in FORMS does not undo the load, but does prevent execution of
4500 the rest of the FORMS. */);
4501 Vafter_load_alist
= Qnil
;
4503 DEFVAR_LISP ("load-history", Vload_history
,
4504 doc
: /* Alist mapping loaded file names to symbols and features.
4505 Each alist element should be a list (FILE-NAME ENTRIES...), where
4506 FILE-NAME is the name of a file that has been loaded into Emacs.
4507 The file name is absolute and true (i.e. it doesn't contain symlinks).
4508 As an exception, one of the alist elements may have FILE-NAME nil,
4509 for symbols and features not associated with any file.
4511 The remaining ENTRIES in the alist element describe the functions and
4512 variables defined in that file, the features provided, and the
4513 features required. Each entry has the form `(provide . FEATURE)',
4514 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4515 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4516 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4517 autoload before this file redefined it as a function. In addition,
4518 entries may also be single symbols, which means that SYMBOL was
4519 defined by `defvar' or `defconst'.
4521 During preloading, the file name recorded is relative to the main Lisp
4522 directory. These file names are converted to absolute at startup. */);
4523 Vload_history
= Qnil
;
4525 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4526 doc
: /* Full name of file being loaded by `load'. */);
4527 Vload_file_name
= Qnil
;
4529 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4530 doc
: /* File name, including directory, of user's initialization file.
4531 If the file loaded had extension `.elc', and the corresponding source file
4532 exists, this variable contains the name of source file, suitable for use
4533 by functions like `custom-save-all' which edit the init file.
4534 While Emacs loads and evaluates the init file, value is the real name
4535 of the file, regardless of whether or not it has the `.elc' extension. */);
4536 Vuser_init_file
= Qnil
;
4538 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4539 doc
: /* Used for internal purposes by `load'. */);
4540 Vcurrent_load_list
= Qnil
;
4542 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4543 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4544 The default is nil, which means use the function `read'. */);
4545 Vload_read_function
= Qnil
;
4547 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4548 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4549 The value should be a function for doing code conversion before
4550 reading a source file. It can also be nil, in which case loading is
4551 done without any code conversion.
4553 If the value is a function, it is called with four arguments,
4554 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4555 the file to load, FILE is the non-absolute name (for messages etc.),
4556 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4557 `load'. The function should return t if the file was loaded. */);
4558 Vload_source_file_function
= Qnil
;
4560 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4561 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4562 This is useful when the file being loaded is a temporary copy. */);
4563 load_force_doc_strings
= 0;
4565 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4566 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4567 This is normally bound by `load' and `eval-buffer' to control `read',
4568 and is not meant for users to change. */);
4569 load_convert_to_unibyte
= 0;
4571 DEFVAR_LISP ("source-directory", Vsource_directory
,
4572 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4573 You cannot count on them to still be there! */);
4575 = Fexpand_file_name (build_string ("../"),
4576 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4578 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4579 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4580 Vpreloaded_file_list
= Qnil
;
4582 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4583 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4584 Vbyte_boolean_vars
= Qnil
;
4586 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4587 doc
: /* Non-nil means load dangerous compiled Lisp files.
4588 Some versions of XEmacs use different byte codes than Emacs. These
4589 incompatible byte codes can make Emacs crash when it tries to execute
4591 load_dangerous_libraries
= 0;
4593 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4594 doc
: /* Non-nil means force printing messages when loading Lisp files.
4595 This overrides the value of the NOMESSAGE argument to `load'. */);
4596 force_load_messages
= 0;
4598 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4599 doc
: /* Regular expression matching safe to load compiled Lisp files.
4600 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4601 from the file, and matches them against this regular expression.
4602 When the regular expression matches, the file is considered to be safe
4603 to load. See also `load-dangerous-libraries'. */);
4604 Vbytecomp_version_regexp
4605 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4607 DEFSYM (Qlexical_binding
, "lexical-binding");
4608 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4609 doc
: /* Whether to use lexical binding when evaluating code.
4610 Non-nil means that the code in the current buffer should be evaluated
4611 with lexical binding.
4612 This variable is automatically set from the file variables of an
4613 interpreted Lisp file read using `load'. Unlike other file local
4614 variables, this must be set in the first line of a file. */);
4615 Vlexical_binding
= Qnil
;
4616 Fmake_variable_buffer_local (Qlexical_binding
);
4618 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4619 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4620 Veval_buffer_list
= Qnil
;
4622 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4623 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4624 Vold_style_backquotes
= Qnil
;
4625 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4627 /* Vsource_directory was initialized in init_lread. */
4629 DEFSYM (Qcurrent_load_list
, "current-load-list");
4630 DEFSYM (Qstandard_input
, "standard-input");
4631 DEFSYM (Qread_char
, "read-char");
4632 DEFSYM (Qget_file_char
, "get-file-char");
4633 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4634 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4636 DEFSYM (Qbackquote
, "`");
4637 DEFSYM (Qcomma
, ",");
4638 DEFSYM (Qcomma_at
, ",@");
4639 DEFSYM (Qcomma_dot
, ",.");
4641 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4642 DEFSYM (Qascii_character
, "ascii-character");
4643 DEFSYM (Qfunction
, "function");
4644 DEFSYM (Qload
, "load");
4645 DEFSYM (Qload_file_name
, "load-file-name");
4646 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4647 DEFSYM (Qfile_truename
, "file-truename");
4648 DEFSYM (Qdir_ok
, "dir-ok");
4649 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4651 staticpro (&dump_path
);
4653 staticpro (&read_objects
);
4654 read_objects
= Qnil
;
4655 staticpro (&seen_list
);
4658 Vloads_in_progress
= Qnil
;
4659 staticpro (&Vloads_in_progress
);
4661 DEFSYM (Qhash_table
, "hash-table");
4662 DEFSYM (Qdata
, "data");
4663 DEFSYM (Qtest
, "test");
4664 DEFSYM (Qsize
, "size");
4665 DEFSYM (Qweakness
, "weakness");
4666 DEFSYM (Qrehash_size
, "rehash-size");
4667 DEFSYM (Qrehash_threshold
, "rehash-threshold");