1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2014 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
28 #include <limits.h> /* For CHAR_BIT. */
29 #include <stat-time.h>
31 #include "intervals.h"
32 #include "character.h"
40 #include "termhooks.h"
41 #include "blockinput.h"
55 #endif /* HAVE_SETLOCALE */
60 #define file_offset off_t
61 #define file_tell ftello
63 #define file_offset long
64 #define file_tell ftell
69 /* Hash table read constants. */
70 static Lisp_Object Qhash_table
, Qdata
;
71 static Lisp_Object Qtest
, Qsize
;
72 static Lisp_Object Qweakness
;
73 static Lisp_Object Qrehash_size
;
74 static Lisp_Object Qrehash_threshold
;
76 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
77 Lisp_Object Qstandard_input
;
78 Lisp_Object Qvariable_documentation
;
79 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
80 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
81 static Lisp_Object Qinhibit_file_name_operation
;
82 static Lisp_Object Qeval_buffer_list
;
83 Lisp_Object Qlexical_binding
;
84 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
86 /* Used instead of Qget_file_char while loading *.elc files compiled
87 by Emacs 21 or older. */
88 static Lisp_Object Qget_emacs_mule_file_char
;
90 static Lisp_Object Qload_force_doc_strings
;
92 static Lisp_Object Qload_in_progress
;
94 /* The association list of objects read with the #n=object form.
95 Each member of the list has the form (n . object), and is used to
96 look up the object for the corresponding #n# construct.
97 It must be set to nil before all top-level calls to read0. */
98 static Lisp_Object read_objects
;
100 /* File for get_file_char to read from. Use by load. */
101 static FILE *instream
;
103 /* For use within read-from-string (this reader is non-reentrant!!) */
104 static ptrdiff_t read_from_string_index
;
105 static ptrdiff_t read_from_string_index_byte
;
106 static ptrdiff_t read_from_string_limit
;
108 /* Number of characters read in the current call to Fread or
109 Fread_from_string. */
110 static EMACS_INT readchar_count
;
112 /* This contains the last string skipped with #@. */
113 static char *saved_doc_string
;
114 /* Length of buffer allocated in saved_doc_string. */
115 static ptrdiff_t saved_doc_string_size
;
116 /* Length of actual data in saved_doc_string. */
117 static ptrdiff_t saved_doc_string_length
;
118 /* This is the file position that string came from. */
119 static file_offset saved_doc_string_position
;
121 /* This contains the previous string skipped with #@.
122 We copy it from saved_doc_string when a new string
123 is put in saved_doc_string. */
124 static char *prev_saved_doc_string
;
125 /* Length of buffer allocated in prev_saved_doc_string. */
126 static ptrdiff_t prev_saved_doc_string_size
;
127 /* Length of actual data in prev_saved_doc_string. */
128 static ptrdiff_t prev_saved_doc_string_length
;
129 /* This is the file position that string came from. */
130 static file_offset prev_saved_doc_string_position
;
132 /* True means inside a new-style backquote
133 with no surrounding parentheses.
134 Fread initializes this to false, so we need not specbind it
135 or worry about what happens to it when there is an error. */
136 static bool new_backquote_flag
;
137 static Lisp_Object Qold_style_backquotes
;
139 /* A list of file names for files being loaded in Fload. Used to
140 check for recursive loads. */
142 static Lisp_Object Vloads_in_progress
;
144 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
147 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
148 Lisp_Object
, Lisp_Object
,
149 Lisp_Object
, Lisp_Object
);
151 /* Functions that read one byte from the current source READCHARFUN
152 or unreads one byte. If the integer argument C is -1, it returns
153 one read byte, or -1 when there's no more byte in the source. If C
154 is 0 or positive, it unreads C, and the return value is not
157 static int readbyte_for_lambda (int, Lisp_Object
);
158 static int readbyte_from_file (int, Lisp_Object
);
159 static int readbyte_from_string (int, Lisp_Object
);
161 /* Handle unreading and rereading of characters.
162 Write READCHAR to read a character,
163 UNREAD(c) to unread c to be read again.
165 These macros correctly read/unread multibyte characters. */
167 #define READCHAR readchar (readcharfun, NULL)
168 #define UNREAD(c) unreadchar (readcharfun, c)
170 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
171 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
173 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
174 Qlambda, or a cons, we use this to keep an unread character because
175 a file stream can't handle multibyte-char unreading. The value -1
176 means that there's no unread character. */
177 static int unread_char
;
180 readchar (Lisp_Object readcharfun
, bool *multibyte
)
184 int (*readbyte
) (int, Lisp_Object
);
185 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
187 bool emacs_mule_encoding
= 0;
194 if (BUFFERP (readcharfun
))
196 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
198 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
200 if (! BUFFER_LIVE_P (inbuffer
))
203 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
206 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
208 /* Fetch the character code from the buffer. */
209 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
210 BUF_INC_POS (inbuffer
, pt_byte
);
217 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
218 if (! ASCII_CHAR_P (c
))
219 c
= BYTE8_TO_CHAR (c
);
222 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
226 if (MARKERP (readcharfun
))
228 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
230 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
232 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
235 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
237 /* Fetch the character code from the buffer. */
238 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
239 BUF_INC_POS (inbuffer
, bytepos
);
246 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
247 if (! ASCII_CHAR_P (c
))
248 c
= BYTE8_TO_CHAR (c
);
252 XMARKER (readcharfun
)->bytepos
= bytepos
;
253 XMARKER (readcharfun
)->charpos
++;
258 if (EQ (readcharfun
, Qlambda
))
260 readbyte
= readbyte_for_lambda
;
264 if (EQ (readcharfun
, Qget_file_char
))
266 readbyte
= readbyte_from_file
;
270 if (STRINGP (readcharfun
))
272 if (read_from_string_index
>= read_from_string_limit
)
274 else if (STRING_MULTIBYTE (readcharfun
))
278 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
279 read_from_string_index
,
280 read_from_string_index_byte
);
284 c
= SREF (readcharfun
, read_from_string_index_byte
);
285 read_from_string_index
++;
286 read_from_string_index_byte
++;
291 if (CONSP (readcharfun
))
293 /* This is the case that read_vector is reading from a unibyte
294 string that contains a byte sequence previously skipped
295 because of #@NUMBER. The car part of readcharfun is that
296 string, and the cdr part is a value of readcharfun given to
298 readbyte
= readbyte_from_string
;
299 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
300 emacs_mule_encoding
= 1;
304 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
306 readbyte
= readbyte_from_file
;
307 emacs_mule_encoding
= 1;
311 tem
= call0 (readcharfun
);
318 if (unread_char
>= 0)
324 c
= (*readbyte
) (-1, readcharfun
);
329 if (ASCII_CHAR_P (c
))
331 if (emacs_mule_encoding
)
332 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
335 len
= BYTES_BY_CHAR_HEAD (c
);
338 c
= (*readbyte
) (-1, readcharfun
);
339 if (c
< 0 || ! TRAILING_CODE_P (c
))
342 (*readbyte
) (buf
[i
], readcharfun
);
343 return BYTE8_TO_CHAR (buf
[0]);
347 return STRING_CHAR (buf
);
350 #define FROM_FILE_P(readcharfun) \
351 (EQ (readcharfun, Qget_file_char) \
352 || EQ (readcharfun, Qget_emacs_mule_file_char))
355 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
357 if (FROM_FILE_P (readcharfun
))
359 block_input (); /* FIXME: Not sure if it's needed. */
360 fseek (instream
, n
, SEEK_CUR
);
364 { /* We're not reading directly from a file. In that case, it's difficult
365 to reliably count bytes, since these are usually meant for the file's
366 encoding, whereas we're now typically in the internal encoding.
367 But luckily, skip_dyn_bytes is used to skip over a single
368 dynamic-docstring (or dynamic byte-code) which is always quoted such
369 that \037 is the final char. */
373 } while (c
>= 0 && c
!= '\037');
378 skip_dyn_eof (Lisp_Object readcharfun
)
380 if (FROM_FILE_P (readcharfun
))
382 block_input (); /* FIXME: Not sure if it's needed. */
383 fseek (instream
, 0, SEEK_END
);
387 while (READCHAR
>= 0);
390 /* Unread the character C in the way appropriate for the stream READCHARFUN.
391 If the stream is a user function, call it with the char as argument. */
394 unreadchar (Lisp_Object readcharfun
, int c
)
398 /* Don't back up the pointer if we're unreading the end-of-input mark,
399 since readchar didn't advance it when we read it. */
401 else if (BUFFERP (readcharfun
))
403 struct buffer
*b
= XBUFFER (readcharfun
);
404 ptrdiff_t charpos
= BUF_PT (b
);
405 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
407 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
408 BUF_DEC_POS (b
, bytepos
);
412 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
414 else if (MARKERP (readcharfun
))
416 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
417 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
419 XMARKER (readcharfun
)->charpos
--;
420 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
421 BUF_DEC_POS (b
, bytepos
);
425 XMARKER (readcharfun
)->bytepos
= bytepos
;
427 else if (STRINGP (readcharfun
))
429 read_from_string_index
--;
430 read_from_string_index_byte
431 = string_char_to_byte (readcharfun
, read_from_string_index
);
433 else if (CONSP (readcharfun
))
437 else if (EQ (readcharfun
, Qlambda
))
441 else if (FROM_FILE_P (readcharfun
))
446 call1 (readcharfun
, make_number (c
));
450 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
452 return read_bytecode_char (c
>= 0);
457 readbyte_from_file (int c
, Lisp_Object readcharfun
)
462 ungetc (c
, instream
);
470 /* Interrupted reads have been observed while reading over the network. */
471 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
482 return (c
== EOF
? -1 : c
);
486 readbyte_from_string (int c
, Lisp_Object readcharfun
)
488 Lisp_Object string
= XCAR (readcharfun
);
492 read_from_string_index
--;
493 read_from_string_index_byte
494 = string_char_to_byte (string
, read_from_string_index
);
497 if (read_from_string_index
>= read_from_string_limit
)
500 FETCH_STRING_CHAR_ADVANCE (c
, string
,
501 read_from_string_index
,
502 read_from_string_index_byte
);
507 /* Read one non-ASCII character from INSTREAM. The character is
508 encoded in `emacs-mule' and the first byte is already read in
512 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
514 /* Emacs-mule coding uses at most 4-byte for one character. */
515 unsigned char buf
[4];
516 int len
= emacs_mule_bytes
[c
];
517 struct charset
*charset
;
522 /* C is not a valid leading-code of `emacs-mule'. */
523 return BYTE8_TO_CHAR (c
);
529 c
= (*readbyte
) (-1, readcharfun
);
533 (*readbyte
) (buf
[i
], readcharfun
);
534 return BYTE8_TO_CHAR (buf
[0]);
541 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
542 code
= buf
[1] & 0x7F;
546 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
547 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
549 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
550 code
= buf
[2] & 0x7F;
554 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
555 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
560 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
561 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
563 c
= DECODE_CHAR (charset
, code
);
565 Fsignal (Qinvalid_read_syntax
,
566 list1 (build_string ("invalid multibyte form")));
571 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
573 static Lisp_Object
read0 (Lisp_Object
);
574 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
576 static Lisp_Object
read_list (bool, Lisp_Object
);
577 static Lisp_Object
read_vector (Lisp_Object
, bool);
579 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
581 static void substitute_object_in_subtree (Lisp_Object
,
583 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
586 /* Get a character from the tty. */
588 /* Read input events until we get one that's acceptable for our purposes.
590 If NO_SWITCH_FRAME, switch-frame events are stashed
591 until we get a character we like, and then stuffed into
594 If ASCII_REQUIRED, check function key events to see
595 if the unmodified version of the symbol has a Qascii_character
596 property, and use that character, if present.
598 If ERROR_NONASCII, signal an error if the input we
599 get isn't an ASCII character with modifiers. If it's false but
600 ASCII_REQUIRED is true, just re-read until we get an ASCII
603 If INPUT_METHOD, invoke the current input method
604 if the character warrants that.
606 If SECONDS is a number, wait that many seconds for input, and
607 return Qnil if no input arrives within that time. */
610 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
611 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
613 Lisp_Object val
, delayed_switch_frame
;
614 struct timespec end_time
;
616 #ifdef HAVE_WINDOW_SYSTEM
617 if (display_hourglass_p
)
621 delayed_switch_frame
= Qnil
;
623 /* Compute timeout. */
624 if (NUMBERP (seconds
))
626 double duration
= extract_float (seconds
);
627 struct timespec wait_time
= dtotimespec (duration
);
628 end_time
= timespec_add (current_timespec (), wait_time
);
631 /* Read until we get an acceptable event. */
634 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
635 NUMBERP (seconds
) ? &end_time
: NULL
);
636 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
641 /* `switch-frame' events are put off until after the next ASCII
642 character. This is better than signaling an error just because
643 the last characters were typed to a separate minibuffer frame,
644 for example. Eventually, some code which can deal with
645 switch-frame events will read it and process it. */
647 && EVENT_HAS_PARAMETERS (val
)
648 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
650 delayed_switch_frame
= val
;
654 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
656 /* Convert certain symbols to their ASCII equivalents. */
659 Lisp_Object tem
, tem1
;
660 tem
= Fget (val
, Qevent_symbol_element_mask
);
663 tem1
= Fget (Fcar (tem
), Qascii_character
);
664 /* Merge this symbol's modifier bits
665 with the ASCII equivalent of its basic code. */
667 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
671 /* If we don't have a character now, deal with it appropriately. */
676 Vunread_command_events
= list1 (val
);
677 error ("Non-character input-event");
684 if (! NILP (delayed_switch_frame
))
685 unread_switch_frame
= delayed_switch_frame
;
689 #ifdef HAVE_WINDOW_SYSTEM
690 if (display_hourglass_p
)
699 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
700 doc
: /* Read a character from the command input (keyboard or macro).
701 It is returned as a number.
702 If the character has modifiers, they are resolved and reflected to the
703 character code if possible (e.g. C-SPC -> 0).
705 If the user generates an event which is not a character (i.e. a mouse
706 click or function key event), `read-char' signals an error. As an
707 exception, switch-frame events are put off until non-character events
709 If you want to read non-character events, or ignore them, call
710 `read-event' or `read-char-exclusive' instead.
712 If the optional argument PROMPT is non-nil, display that as a prompt.
713 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
714 input method is turned on in the current buffer, that input method
715 is used for reading a character.
716 If the optional argument SECONDS is non-nil, it should be a number
717 specifying the maximum number of seconds to wait for input. If no
718 input arrives in that time, return nil. SECONDS may be a
719 floating-point value. */)
720 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
725 message_with_string ("%s", prompt
, 0);
726 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
728 return (NILP (val
) ? Qnil
729 : make_number (char_resolve_modifier_mask (XINT (val
))));
732 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
733 doc
: /* Read an event object from the input stream.
734 If the optional argument PROMPT is non-nil, display that as a prompt.
735 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
736 input method is turned on in the current buffer, that input method
737 is used for reading a character.
738 If the optional argument SECONDS is non-nil, it should be a number
739 specifying the maximum number of seconds to wait for input. If no
740 input arrives in that time, return nil. SECONDS may be a
741 floating-point value. */)
742 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
745 message_with_string ("%s", prompt
, 0);
746 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
749 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
750 doc
: /* Read a character from the command input (keyboard or macro).
751 It is returned as a number. Non-character events are ignored.
752 If the character has modifiers, they are resolved and reflected to the
753 character code if possible (e.g. C-SPC -> 0).
755 If the optional argument PROMPT is non-nil, display that as a prompt.
756 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
757 input method is turned on in the current buffer, that input method
758 is used for reading a character.
759 If the optional argument SECONDS is non-nil, it should be a number
760 specifying the maximum number of seconds to wait for input. If no
761 input arrives in that time, return nil. SECONDS may be a
762 floating-point value. */)
763 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
768 message_with_string ("%s", prompt
, 0);
770 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
772 return (NILP (val
) ? Qnil
773 : make_number (char_resolve_modifier_mask (XINT (val
))));
776 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
777 doc
: /* Don't use this yourself. */)
780 register Lisp_Object val
;
782 XSETINT (val
, getc (instream
));
790 /* Return true if the lisp code read using READCHARFUN defines a non-nil
791 `lexical-binding' file variable. After returning, the stream is
792 positioned following the first line, if it is a comment or #! line,
793 otherwise nothing is read. */
796 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
809 while (ch
!= '\n' && ch
!= EOF
)
811 if (ch
== '\n') ch
= READCHAR
;
812 /* It is OK to leave the position after a #! line, since
813 that is what read1 does. */
817 /* The first line isn't a comment, just give up. */
823 /* Look for an appropriate file-variable in the first line. */
827 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
828 } beg_end_state
= NOMINAL
;
829 bool in_file_vars
= 0;
831 #define UPDATE_BEG_END_STATE(ch) \
832 if (beg_end_state == NOMINAL) \
833 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
834 else if (beg_end_state == AFTER_FIRST_DASH) \
835 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
836 else if (beg_end_state == AFTER_ASTERIX) \
839 in_file_vars = !in_file_vars; \
840 beg_end_state = NOMINAL; \
843 /* Skip until we get to the file vars, if any. */
847 UPDATE_BEG_END_STATE (ch
);
849 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
853 char var
[100], val
[100];
858 /* Read a variable name. */
859 while (ch
== ' ' || ch
== '\t')
863 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
865 if (i
< sizeof var
- 1)
867 UPDATE_BEG_END_STATE (ch
);
871 /* Stop scanning if no colon was found before end marker. */
872 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
875 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
881 /* Read a variable value. */
884 while (ch
== ' ' || ch
== '\t')
888 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
890 if (i
< sizeof val
- 1)
892 UPDATE_BEG_END_STATE (ch
);
896 /* The value was terminated by an end-marker, which remove. */
898 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
902 if (strcmp (var
, "lexical-binding") == 0)
905 rv
= (strcmp (val
, "nil") != 0);
911 while (ch
!= '\n' && ch
!= EOF
)
918 /* Value is a version number of byte compiled code if the file
919 associated with file descriptor FD is a compiled Lisp file that's
920 safe to load. Only files compiled with Emacs are safe to load.
921 Files compiled with XEmacs can lead to a crash in Fbyte_code
922 because of an incompatible change in the byte compiler. */
925 safe_to_load_version (int fd
)
931 /* Read the first few bytes from the file, and look for a line
932 specifying the byte compiler version used. */
933 nbytes
= emacs_read (fd
, buf
, sizeof buf
);
936 /* Skip to the next newline, skipping over the initial `ELC'
937 with NUL bytes following it, but note the version. */
938 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
943 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
944 buf
+ i
, nbytes
- i
) < 0)
948 lseek (fd
, 0, SEEK_SET
);
953 /* Callback for record_unwind_protect. Restore the old load list OLD,
954 after loading a file successfully. */
957 record_load_unwind (Lisp_Object old
)
959 Vloads_in_progress
= old
;
962 /* This handler function is used via internal_condition_case_1. */
965 load_error_handler (Lisp_Object data
)
971 load_warn_old_style_backquotes (Lisp_Object file
)
973 if (!NILP (Vold_style_backquotes
))
976 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
982 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
983 doc
: /* Return the suffixes that `load' should try if a suffix is \
985 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
988 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
989 while (CONSP (suffixes
))
991 Lisp_Object exts
= Vload_file_rep_suffixes
;
992 suffix
= XCAR (suffixes
);
993 suffixes
= XCDR (suffixes
);
998 lst
= Fcons (concat2 (suffix
, ext
), lst
);
1001 return Fnreverse (lst
);
1004 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1005 doc
: /* Execute a file of Lisp code named FILE.
1006 First try FILE with `.elc' appended, then try with `.el',
1007 then try FILE unmodified (the exact suffixes in the exact order are
1008 determined by `load-suffixes'). Environment variable references in
1009 FILE are replaced with their values by calling `substitute-in-file-name'.
1010 This function searches the directories in `load-path'.
1012 If optional second arg NOERROR is non-nil,
1013 report no error if FILE doesn't exist.
1014 Print messages at start and end of loading unless
1015 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1017 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1018 suffixes `.elc' or `.el' to the specified name FILE.
1019 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1020 the suffix `.elc' or `.el'; don't accept just FILE unless
1021 it ends in one of those suffixes or includes a directory name.
1023 If NOSUFFIX is nil, then if a file could not be found, try looking for
1024 a different representation of the file by adding non-empty suffixes to
1025 its name, before trying another file. Emacs uses this feature to find
1026 compressed versions of files when Auto Compression mode is enabled.
1027 If NOSUFFIX is non-nil, disable this feature.
1029 The suffixes that this function tries out, when NOSUFFIX is nil, are
1030 given by the return value of `get-load-suffixes' and the values listed
1031 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1032 return value of `get-load-suffixes' is used, i.e. the file name is
1033 required to have a non-empty suffix.
1035 When searching suffixes, this function normally stops at the first
1036 one that exists. If the option `load-prefer-newer' is non-nil,
1037 however, it tries all suffixes, and uses whichever file is the newest.
1039 Loading a file records its definitions, and its `provide' and
1040 `require' calls, in an element of `load-history' whose
1041 car is the file name loaded. See `load-history'.
1043 While the file is in the process of being loaded, the variable
1044 `load-in-progress' is non-nil and the variable `load-file-name'
1045 is bound to the file's name.
1047 Return t if the file exists and loads successfully. */)
1048 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1049 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1051 FILE *stream
= NULL
;
1054 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1055 Lisp_Object found
, efound
, hist_file_name
;
1056 /* True means we printed the ".el is newer" message. */
1058 /* True means we are loading a compiled file. */
1060 Lisp_Object handler
;
1062 const char *fmode
= "r";
1069 CHECK_STRING (file
);
1071 /* If file name is magic, call the handler. */
1072 /* This shouldn't be necessary any more now that `openp' handles it right.
1073 handler = Ffind_file_name_handler (file, Qload);
1074 if (!NILP (handler))
1075 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1077 /* Do this after the handler to avoid
1078 the need to gcpro noerror, nomessage and nosuffix.
1079 (Below here, we care only whether they are nil or not.)
1080 The presence of this call is the result of a historical accident:
1081 it used to be in every file-operation and when it got removed
1082 everywhere, it accidentally stayed here. Since then, enough people
1083 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1084 that it seemed risky to remove. */
1085 if (! NILP (noerror
))
1087 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1088 Qt
, load_error_handler
);
1095 file
= Fsubstitute_in_file_name (file
);
1097 /* Avoid weird lossage with null string as arg,
1098 since it would try to load a directory as a Lisp file. */
1099 if (SCHARS (file
) == 0)
1106 Lisp_Object suffixes
;
1108 GCPRO2 (file
, found
);
1110 if (! NILP (must_suffix
))
1112 /* Don't insist on adding a suffix if FILE already ends with one. */
1113 ptrdiff_t size
= SBYTES (file
);
1115 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1118 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1120 /* Don't insist on adding a suffix
1121 if the argument includes a directory name. */
1122 else if (! NILP (Ffile_name_directory (file
)))
1126 if (!NILP (nosuffix
))
1130 suffixes
= Fget_load_suffixes ();
1131 if (NILP (must_suffix
))
1135 arg
[1] = Vload_file_rep_suffixes
;
1136 suffixes
= Fappend (2, arg
);
1140 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1147 report_file_error ("Cannot open load file", file
);
1152 /* Tell startup.el whether or not we found the user's init file. */
1153 if (EQ (Qt
, Vuser_init_file
))
1154 Vuser_init_file
= found
;
1156 /* If FD is -2, that means openp found a magic file. */
1159 if (NILP (Fequal (found
, file
)))
1160 /* If FOUND is a different file name from FILE,
1161 find its handler even if we have already inhibited
1162 the `load' operation on FILE. */
1163 handler
= Ffind_file_name_handler (found
, Qt
);
1165 handler
= Ffind_file_name_handler (found
, Qload
);
1166 if (! NILP (handler
)) {
1168 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1171 /* Tramp has to deal with semi-broken packages that prepend
1172 drive letters to remote files. For that reason, Tramp
1173 catches file operations that test for file existence, which
1174 makes openp think X:/foo.elc files are remote. However,
1175 Tramp does not catch `load' operations for such files, so we
1176 end up with a nil as the `load' handler above. If we would
1177 continue with fd = -2, we will behave wrongly, and in
1178 particular try reading a .elc file in the "rt" mode instead
1179 of "rb". See bug #9311 for the results. To work around
1180 this, we try to open the file locally, and go with that if it
1182 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1190 record_unwind_protect_ptr (close_file_ptr_unwind
, &fd
);
1191 record_unwind_protect_ptr (fclose_ptr_unwind
, &stream
);
1194 /* Check if we're stuck in a recursive load cycle.
1196 2000-09-21: It's not possible to just check for the file loaded
1197 being a member of Vloads_in_progress. This fails because of the
1198 way the byte compiler currently works; `provide's are not
1199 evaluated, see font-lock.el/jit-lock.el as an example. This
1200 leads to a certain amount of ``normal'' recursion.
1202 Also, just loading a file recursively is not always an error in
1203 the general case; the second load may do something different. */
1207 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1208 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1209 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1210 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1211 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1214 /* All loads are by default dynamic, unless the file itself specifies
1215 otherwise using a file-variable in the first line. This is bound here
1216 so that it takes effect whether or not we use
1217 Vload_source_file_function. */
1218 specbind (Qlexical_binding
, Qnil
);
1220 /* Get the name for load-history. */
1221 hist_file_name
= (! NILP (Vpurify_flag
)
1222 ? concat2 (Ffile_name_directory (file
),
1223 Ffile_name_nondirectory (found
))
1228 /* Check for the presence of old-style quotes and warn about them. */
1229 specbind (Qold_style_backquotes
, Qnil
);
1230 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1232 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1233 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 0))
1234 /* Load .elc files directly, but not when they are
1235 remote and have no handler! */
1242 GCPRO3 (file
, found
, hist_file_name
);
1245 && ! (version
= safe_to_load_version (fd
)))
1248 if (!load_dangerous_libraries
)
1249 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1250 else if (!NILP (nomessage
) && !force_load_messages
)
1251 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1256 efound
= ENCODE_FILE (found
);
1262 /* openp already checked for newness, no point doing it again.
1263 FIXME would be nice to get a message when openp
1264 ignores suffix order due to load_prefer_newer. */
1265 if (!load_prefer_newer
)
1267 result
= stat (SSDATA (efound
), &s1
);
1270 SSET (efound
, SBYTES (efound
) - 1, 0);
1271 result
= stat (SSDATA (efound
), &s2
);
1272 SSET (efound
, SBYTES (efound
) - 1, 'c');
1276 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1278 /* Make the progress messages mention that source is newer. */
1281 /* If we won't print another message, mention this anyway. */
1282 if (!NILP (nomessage
) && !force_load_messages
)
1284 Lisp_Object msg_file
;
1285 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1286 message_with_string ("Source file `%s' newer than byte-compiled file",
1290 } /* !load_prefer_newer */
1296 /* We are loading a source file (*.el). */
1297 if (!NILP (Vload_source_file_function
))
1306 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1307 NILP (noerror
) ? Qnil
: Qt
,
1308 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1314 GCPRO3 (file
, found
, hist_file_name
);
1318 /* We somehow got here with fd == -2, meaning the file is deemed
1319 to be remote. Don't even try to reopen the file locally;
1320 just force a failure. */
1329 efound
= ENCODE_FILE (found
);
1330 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1332 stream
= fdopen (fd
, fmode
);
1336 report_file_error ("Opening stdio stream", file
);
1338 if (! NILP (Vpurify_flag
))
1339 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1341 if (NILP (nomessage
) || force_load_messages
)
1344 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1347 message_with_string ("Loading %s (source)...", file
, 1);
1349 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1351 else /* The typical case; compiled file newer than source file. */
1352 message_with_string ("Loading %s...", file
, 1);
1355 specbind (Qload_file_name
, found
);
1356 specbind (Qinhibit_file_name_operation
, Qnil
);
1357 specbind (Qload_in_progress
, Qt
);
1360 if (lisp_file_lexically_bound_p (Qget_file_char
))
1361 Fset (Qlexical_binding
, Qt
);
1363 if (! version
|| version
>= 22)
1364 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1365 0, Qnil
, Qnil
, Qnil
, Qnil
);
1368 /* We can't handle a file which was compiled with
1369 byte-compile-dynamic by older version of Emacs. */
1370 specbind (Qload_force_doc_strings
, Qt
);
1371 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1372 0, Qnil
, Qnil
, Qnil
, Qnil
);
1376 /* Run any eval-after-load forms for this file. */
1377 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1378 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1382 xfree (saved_doc_string
);
1383 saved_doc_string
= 0;
1384 saved_doc_string_size
= 0;
1386 xfree (prev_saved_doc_string
);
1387 prev_saved_doc_string
= 0;
1388 prev_saved_doc_string_size
= 0;
1390 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1393 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1396 message_with_string ("Loading %s (source)...done", file
, 1);
1398 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1400 else /* The typical case; compiled file newer than source file. */
1401 message_with_string ("Loading %s...done", file
, 1);
1408 complete_filename_p (Lisp_Object pathname
)
1410 const unsigned char *s
= SDATA (pathname
);
1411 return (IS_DIRECTORY_SEP (s
[0])
1412 || (SCHARS (pathname
) > 2
1413 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1416 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1417 doc
: /* Search for FILENAME through PATH.
1418 Returns the file's name in absolute form, or nil if not found.
1419 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1420 file name when searching.
1421 If non-nil, PREDICATE is used instead of `file-readable-p'.
1422 PREDICATE can also be an integer to pass to the faccessat(2) function,
1423 in which case file-name-handlers are ignored.
1424 This function will normally skip directories, so if you want it to find
1425 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1426 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1429 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1430 if (NILP (predicate
) && fd
>= 0)
1435 static Lisp_Object Qdir_ok
;
1437 /* Search for a file whose name is STR, looking in directories
1438 in the Lisp list PATH, and trying suffixes from SUFFIX.
1439 On success, return a file descriptor (or 1 or -2 as described below).
1440 On failure, return -1 and set errno.
1442 SUFFIXES is a list of strings containing possible suffixes.
1443 The empty suffix is automatically added if the list is empty.
1445 PREDICATE non-nil means don't open the files,
1446 just look for one that satisfies the predicate. In this case,
1447 return 1 on success. The predicate can be a lisp function or
1448 an integer to pass to `access' (in which case file-name-handlers
1451 If STOREPTR is nonzero, it points to a slot where the name of
1452 the file actually found should be stored as a Lisp string.
1453 nil is stored there on failure.
1455 If the file we find is remote, return -2
1456 but store the found remote file name in *STOREPTR.
1458 If NEWER is true, try all SUFFIXes and return the result for the
1459 newest file that exists. Does not apply to remote files,
1460 or if PREDICATE is specified. */
1463 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1464 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1466 ptrdiff_t fn_size
= 100;
1470 ptrdiff_t want_length
;
1471 Lisp_Object filename
;
1472 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
, gcpro7
;
1473 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1474 ptrdiff_t max_suffix_len
= 0;
1475 int last_errno
= ENOENT
;
1478 /* The last-modified time of the newest matching file found.
1479 Initialize it to something less than all valid timestamps. */
1480 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1484 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1486 CHECK_STRING_CAR (tail
);
1487 max_suffix_len
= max (max_suffix_len
,
1488 SBYTES (XCAR (tail
)));
1491 string
= filename
= encoded_fn
= save_string
= Qnil
;
1492 GCPRO7 (str
, string
, save_string
, filename
, path
, suffixes
, encoded_fn
);
1497 absolute
= complete_filename_p (str
);
1499 for (; CONSP (path
); path
= XCDR (path
))
1501 filename
= Fexpand_file_name (str
, XCAR (path
));
1502 if (!complete_filename_p (filename
))
1503 /* If there are non-absolute elts in PATH (eg "."). */
1504 /* Of course, this could conceivably lose if luser sets
1505 default-directory to be something non-absolute... */
1507 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1508 if (!complete_filename_p (filename
))
1509 /* Give up on this path element! */
1513 /* Calculate maximum length of any filename made from
1514 this path element/specified file name and any possible suffix. */
1515 want_length
= max_suffix_len
+ SBYTES (filename
);
1516 if (fn_size
<= want_length
)
1517 fn
= alloca (fn_size
= 100 + want_length
);
1519 /* Loop over suffixes. */
1520 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1521 CONSP (tail
); tail
= XCDR (tail
))
1523 Lisp_Object suffix
= XCAR (tail
);
1524 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1525 Lisp_Object handler
;
1527 /* Concatenate path element/specified name with the suffix.
1528 If the directory starts with /:, remove that. */
1529 int prefixlen
= ((SCHARS (filename
) > 2
1530 && SREF (filename
, 0) == '/'
1531 && SREF (filename
, 1) == ':')
1533 fnlen
= SBYTES (filename
) - prefixlen
;
1534 memcpy (fn
, SDATA (filename
) + prefixlen
, fnlen
);
1535 memcpy (fn
+ fnlen
, SDATA (suffix
), lsuffix
+ 1);
1537 /* Check that the file exists and is not a directory. */
1538 /* We used to only check for handlers on non-absolute file names:
1542 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1543 It's not clear why that was the case and it breaks things like
1544 (load "/bar.el") where the file is actually "/bar.el.gz". */
1545 /* make_string has its own ideas on when to return a unibyte
1546 string and when a multibyte string, but we know better.
1547 We must have a unibyte string when dumping, since
1548 file-name encoding is shaky at best at that time, and in
1549 particular default-file-name-coding-system is reset
1550 several times during loadup. We therefore don't want to
1551 encode the file before passing it to file I/O library
1553 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1554 string
= make_unibyte_string (fn
, fnlen
);
1556 string
= make_string (fn
, fnlen
);
1557 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1558 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1561 if (NILP (predicate
))
1562 exists
= !NILP (Ffile_readable_p (string
));
1565 Lisp_Object tmp
= call1 (predicate
, string
);
1568 else if (EQ (tmp
, Qdir_ok
)
1569 || NILP (Ffile_directory_p (string
)))
1574 last_errno
= EISDIR
;
1580 /* We succeeded; return this descriptor and filename. */
1593 encoded_fn
= ENCODE_FILE (string
);
1594 pfn
= SSDATA (encoded_fn
);
1596 /* Check that we can access or open it. */
1597 if (NATNUMP (predicate
))
1600 if (INT_MAX
< XFASTINT (predicate
))
1601 last_errno
= EINVAL
;
1602 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1606 if (file_directory_p (pfn
))
1607 last_errno
= EISDIR
;
1614 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1617 if (errno
!= ENOENT
)
1622 int err
= (fstat (fd
, &st
) != 0 ? errno
1623 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1635 if (newer
&& !NATNUMP (predicate
))
1637 struct timespec mtime
= get_stat_mtime (&st
);
1639 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1644 emacs_close (save_fd
);
1647 save_string
= string
;
1652 /* We succeeded; return this descriptor and filename. */
1660 /* No more suffixes. Return the newest. */
1661 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1664 *storeptr
= save_string
;
1680 /* Merge the list we've accumulated of globals from the current input source
1681 into the load_history variable. The details depend on whether
1682 the source has an associated file name or not.
1684 FILENAME is the file name that we are loading from.
1686 ENTIRE is true if loading that entire file, false if evaluating
1690 build_load_history (Lisp_Object filename
, bool entire
)
1692 Lisp_Object tail
, prev
, newelt
;
1693 Lisp_Object tem
, tem2
;
1696 tail
= Vload_history
;
1699 while (CONSP (tail
))
1703 /* Find the feature's previous assoc list... */
1704 if (!NILP (Fequal (filename
, Fcar (tem
))))
1708 /* If we're loading the entire file, remove old data. */
1712 Vload_history
= XCDR (tail
);
1714 Fsetcdr (prev
, XCDR (tail
));
1717 /* Otherwise, cons on new symbols that are not already members. */
1720 tem2
= Vcurrent_load_list
;
1722 while (CONSP (tem2
))
1724 newelt
= XCAR (tem2
);
1726 if (NILP (Fmember (newelt
, tem
)))
1727 Fsetcar (tail
, Fcons (XCAR (tem
),
1728 Fcons (newelt
, XCDR (tem
))));
1741 /* If we're loading an entire file, cons the new assoc onto the
1742 front of load-history, the most-recently-loaded position. Also
1743 do this if we didn't find an existing member for the file. */
1744 if (entire
|| !foundit
)
1745 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1750 readevalloop_1 (int old
)
1752 load_convert_to_unibyte
= old
;
1755 /* Signal an `end-of-file' error, if possible with file name
1758 static _Noreturn
void
1759 end_of_file_error (void)
1761 if (STRINGP (Vload_file_name
))
1762 xsignal1 (Qend_of_file
, Vload_file_name
);
1764 xsignal0 (Qend_of_file
);
1768 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1770 /* If we macroexpand the toplevel form non-recursively and it ends
1771 up being a `progn' (or if it was a progn to start), treat each
1772 form in the progn as a top-level form. This way, if one form in
1773 the progn defines a macro, that macro is in effect when we expand
1774 the remaining forms. See similar code in bytecomp.el. */
1775 val
= call2 (macroexpand
, val
, Qnil
);
1776 if (EQ (CAR_SAFE (val
), Qprogn
))
1778 Lisp_Object subforms
= XCDR (val
);
1780 for (; CONSP (subforms
); subforms
= XCDR (subforms
))
1781 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1785 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1790 /* UNIBYTE specifies how to set load_convert_to_unibyte
1791 for this invocation.
1792 READFUN, if non-nil, is used instead of `read'.
1794 START, END specify region to read in current buffer (from eval-region).
1795 If the input is not from a buffer, they must be nil. */
1798 readevalloop (Lisp_Object readcharfun
,
1800 Lisp_Object sourcename
,
1802 Lisp_Object unibyte
, Lisp_Object readfun
,
1803 Lisp_Object start
, Lisp_Object end
)
1806 register Lisp_Object val
;
1808 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1809 struct buffer
*b
= 0;
1810 bool continue_reading_p
;
1811 Lisp_Object lex_bound
;
1812 /* True if reading an entire buffer. */
1813 bool whole_buffer
= 0;
1814 /* True on the first time around. */
1815 bool first_sexp
= 1;
1816 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1818 if (NILP (Ffboundp (macroexpand
))
1819 /* Don't macroexpand in .elc files, since it should have been done
1820 already. We actually don't know whether we're in a .elc file or not,
1821 so we use circumstantial evidence: .el files normally go through
1822 Vload_source_file_function -> load-with-code-conversion
1824 || EQ (readcharfun
, Qget_file_char
)
1825 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1828 if (MARKERP (readcharfun
))
1831 start
= readcharfun
;
1834 if (BUFFERP (readcharfun
))
1835 b
= XBUFFER (readcharfun
);
1836 else if (MARKERP (readcharfun
))
1837 b
= XMARKER (readcharfun
)->buffer
;
1839 /* We assume START is nil when input is not from a buffer. */
1840 if (! NILP (start
) && !b
)
1843 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1844 specbind (Qcurrent_load_list
, Qnil
);
1845 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1846 load_convert_to_unibyte
= !NILP (unibyte
);
1848 /* If lexical binding is active (either because it was specified in
1849 the file's header, or via a buffer-local variable), create an empty
1850 lexical environment, otherwise, turn off lexical binding. */
1851 lex_bound
= find_symbol_value (Qlexical_binding
);
1852 specbind (Qinternal_interpreter_environment
,
1853 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1854 ? Qnil
: list1 (Qt
)));
1856 GCPRO4 (sourcename
, readfun
, start
, end
);
1858 /* Try to ensure sourcename is a truename, except whilst preloading. */
1859 if (NILP (Vpurify_flag
)
1860 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1861 && !NILP (Ffboundp (Qfile_truename
)))
1862 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1864 LOADHIST_ATTACH (sourcename
);
1866 continue_reading_p
= 1;
1867 while (continue_reading_p
)
1871 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1872 error ("Reading from killed buffer");
1876 /* Switch to the buffer we are reading from. */
1877 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1878 set_buffer_internal (b
);
1880 /* Save point in it. */
1881 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1882 /* Save ZV in it. */
1883 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1884 /* Those get unbound after we read one expression. */
1886 /* Set point and ZV around stuff to be read. */
1889 Fnarrow_to_region (make_number (BEGV
), end
);
1891 /* Just for cleanliness, convert END to a marker
1892 if it is an integer. */
1894 end
= Fpoint_max_marker ();
1897 /* On the first cycle, we can easily test here
1898 whether we are reading the whole buffer. */
1899 if (b
&& first_sexp
)
1900 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1907 while ((c
= READCHAR
) != '\n' && c
!= -1);
1916 /* Ignore whitespace here, so we can detect eof. */
1917 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1918 || c
== 0xa0) /* NBSP */
1921 if (!NILP (Vpurify_flag
) && c
== '(')
1923 val
= read_list (0, readcharfun
);
1928 read_objects
= Qnil
;
1929 if (!NILP (readfun
))
1931 val
= call1 (readfun
, readcharfun
);
1933 /* If READCHARFUN has set point to ZV, we should
1934 stop reading, even if the form read sets point
1935 to a different value when evaluated. */
1936 if (BUFFERP (readcharfun
))
1938 struct buffer
*buf
= XBUFFER (readcharfun
);
1939 if (BUF_PT (buf
) == BUF_ZV (buf
))
1940 continue_reading_p
= 0;
1943 else if (! NILP (Vload_read_function
))
1944 val
= call1 (Vload_read_function
, readcharfun
);
1946 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1949 if (!NILP (start
) && continue_reading_p
)
1950 start
= Fpoint_marker ();
1952 /* Restore saved point and BEGV. */
1955 /* Now eval what we just read. */
1956 if (!NILP (macroexpand
))
1957 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1959 val
= eval_sub (val
);
1963 Vvalues
= Fcons (val
, Vvalues
);
1964 if (EQ (Vstandard_output
, Qt
))
1973 build_load_history (sourcename
,
1974 stream
|| whole_buffer
);
1981 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1982 doc
: /* Execute the current buffer as Lisp code.
1983 When called from a Lisp program (i.e., not interactively), this
1984 function accepts up to five optional arguments:
1985 BUFFER is the buffer to evaluate (nil means use current buffer).
1986 PRINTFLAG controls printing of output:
1987 A value of nil means discard it; anything else is stream for print.
1988 FILENAME specifies the file name to use for `load-history'.
1989 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1991 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1992 functions should work normally even if PRINTFLAG is nil.
1994 This function preserves the position of point. */)
1995 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1998 Lisp_Object tem
, buf
;
2001 buf
= Fcurrent_buffer ();
2003 buf
= Fget_buffer (buffer
);
2005 error ("No such buffer");
2007 if (NILP (printflag
) && NILP (do_allow_print
))
2012 if (NILP (filename
))
2013 filename
= BVAR (XBUFFER (buf
), filename
);
2015 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
2016 specbind (Qstandard_output
, tem
);
2017 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
2018 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
2019 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
2020 readevalloop (buf
, 0, filename
,
2021 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
2027 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
2028 doc
: /* Execute the region as Lisp code.
2029 When called from programs, expects two arguments,
2030 giving starting and ending indices in the current buffer
2031 of the text to be executed.
2032 Programs can pass third argument PRINTFLAG which controls output:
2033 A value of nil means discard it; anything else is stream for printing it.
2034 Also the fourth argument READ-FUNCTION, if non-nil, is used
2035 instead of `read' to read each expression. It gets one argument
2036 which is the input stream for reading characters.
2038 This function does not move point. */)
2039 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2041 /* FIXME: Do the eval-sexp-add-defvars dance! */
2043 Lisp_Object tem
, cbuf
;
2045 cbuf
= Fcurrent_buffer ();
2047 if (NILP (printflag
))
2051 specbind (Qstandard_output
, tem
);
2052 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2054 /* `readevalloop' calls functions which check the type of start and end. */
2055 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2056 !NILP (printflag
), Qnil
, read_function
,
2064 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2065 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2066 If STREAM is nil, use the value of `standard-input' (which see).
2067 STREAM or the value of `standard-input' may be:
2068 a buffer (read from point and advance it)
2069 a marker (read from where it points and advance it)
2070 a function (call it with no arguments for each character,
2071 call it with a char as argument to push a char back)
2072 a string (takes text from string, starting at the beginning)
2073 t (read text line using minibuffer and use it, or read from
2074 standard input in batch mode). */)
2075 (Lisp_Object stream
)
2078 stream
= Vstandard_input
;
2079 if (EQ (stream
, Qt
))
2080 stream
= Qread_char
;
2081 if (EQ (stream
, Qread_char
))
2082 /* FIXME: ?! When is this used !? */
2083 return call1 (intern ("read-minibuffer"),
2084 build_string ("Lisp expression: "));
2086 return read_internal_start (stream
, Qnil
, Qnil
);
2089 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2090 doc
: /* Read one Lisp expression which is represented as text by STRING.
2091 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2092 FINAL-STRING-INDEX is an integer giving the position of the next
2093 remaining character in STRING.
2094 START and END optionally delimit a substring of STRING from which to read;
2095 they default to 0 and (length STRING) respectively. */)
2096 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2099 CHECK_STRING (string
);
2100 /* `read_internal_start' sets `read_from_string_index'. */
2101 ret
= read_internal_start (string
, start
, end
);
2102 return Fcons (ret
, make_number (read_from_string_index
));
2105 /* Function to set up the global context we need in toplevel read
2108 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2109 /* `start', `end' only used when stream is a string. */
2114 new_backquote_flag
= 0;
2115 read_objects
= Qnil
;
2116 if (EQ (Vread_with_symbol_positions
, Qt
)
2117 || EQ (Vread_with_symbol_positions
, stream
))
2118 Vread_symbol_positions_list
= Qnil
;
2120 if (STRINGP (stream
)
2121 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2123 ptrdiff_t startval
, endval
;
2126 if (STRINGP (stream
))
2129 string
= XCAR (stream
);
2132 endval
= SCHARS (string
);
2136 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2137 args_out_of_range (string
, end
);
2138 endval
= XINT (end
);
2145 CHECK_NUMBER (start
);
2146 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2147 args_out_of_range (string
, start
);
2148 startval
= XINT (start
);
2150 read_from_string_index
= startval
;
2151 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2152 read_from_string_limit
= endval
;
2155 retval
= read0 (stream
);
2156 if (EQ (Vread_with_symbol_positions
, Qt
)
2157 || EQ (Vread_with_symbol_positions
, stream
))
2158 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2163 /* Signal Qinvalid_read_syntax error.
2164 S is error string of length N (if > 0) */
2166 static _Noreturn
void
2167 invalid_syntax (const char *s
)
2169 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2173 /* Use this for recursive reads, in contexts where internal tokens
2177 read0 (Lisp_Object readcharfun
)
2179 register Lisp_Object val
;
2182 val
= read1 (readcharfun
, &c
, 0);
2186 xsignal1 (Qinvalid_read_syntax
,
2187 Fmake_string (make_number (1), make_number (c
)));
2190 static ptrdiff_t read_buffer_size
;
2191 static char *read_buffer
;
2193 /* Read a \-escape sequence, assuming we already read the `\'.
2194 If the escape sequence forces unibyte, return eight-bit char. */
2197 read_escape (Lisp_Object readcharfun
, bool stringp
)
2200 /* \u allows up to four hex digits, \U up to eight. Default to the
2201 behavior for \u, and change this value in the case that \U is seen. */
2202 int unicode_hex_count
= 4;
2207 end_of_file_error ();
2237 error ("Invalid escape character syntax");
2240 c
= read_escape (readcharfun
, 0);
2241 return c
| meta_modifier
;
2246 error ("Invalid escape character syntax");
2249 c
= read_escape (readcharfun
, 0);
2250 return c
| shift_modifier
;
2255 error ("Invalid escape character syntax");
2258 c
= read_escape (readcharfun
, 0);
2259 return c
| hyper_modifier
;
2264 error ("Invalid escape character syntax");
2267 c
= read_escape (readcharfun
, 0);
2268 return c
| alt_modifier
;
2272 if (stringp
|| c
!= '-')
2279 c
= read_escape (readcharfun
, 0);
2280 return c
| super_modifier
;
2285 error ("Invalid escape character syntax");
2289 c
= read_escape (readcharfun
, 0);
2290 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2291 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2292 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2293 return c
| ctrl_modifier
;
2294 /* ASCII control chars are made from letters (both cases),
2295 as well as the non-letters within 0100...0137. */
2296 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2297 return (c
& (037 | ~0177));
2298 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2299 return (c
& (037 | ~0177));
2301 return c
| ctrl_modifier
;
2311 /* An octal escape, as in ANSI C. */
2313 register int i
= c
- '0';
2314 register int count
= 0;
2317 if ((c
= READCHAR
) >= '0' && c
<= '7')
2329 if (i
>= 0x80 && i
< 0x100)
2330 i
= BYTE8_TO_CHAR (i
);
2335 /* A hex escape, as in ANSI C. */
2342 if (c
>= '0' && c
<= '9')
2347 else if ((c
>= 'a' && c
<= 'f')
2348 || (c
>= 'A' && c
<= 'F'))
2351 if (c
>= 'a' && c
<= 'f')
2361 /* Allow hex escapes as large as ?\xfffffff, because some
2362 packages use them to denote characters with modifiers. */
2363 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2364 error ("Hex character out of range: \\x%x...", i
);
2368 if (count
< 3 && i
>= 0x80)
2369 return BYTE8_TO_CHAR (i
);
2374 /* Post-Unicode-2.0: Up to eight hex chars. */
2375 unicode_hex_count
= 8;
2378 /* A Unicode escape. We only permit them in strings and characters,
2379 not arbitrarily in the source code, as in some other languages. */
2384 while (++count
<= unicode_hex_count
)
2387 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2389 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2390 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2391 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2393 error ("Non-hex digit used for Unicode escape");
2396 error ("Non-Unicode character: 0x%x", i
);
2405 /* Return the digit that CHARACTER stands for in the given BASE.
2406 Return -1 if CHARACTER is out of range for BASE,
2407 and -2 if CHARACTER is not valid for any supported BASE. */
2409 digit_to_number (int character
, int base
)
2413 if ('0' <= character
&& character
<= '9')
2414 digit
= character
- '0';
2415 else if ('a' <= character
&& character
<= 'z')
2416 digit
= character
- 'a' + 10;
2417 else if ('A' <= character
&& character
<= 'Z')
2418 digit
= character
- 'A' + 10;
2422 return digit
< base
? digit
: -1;
2425 /* Read an integer in radix RADIX using READCHARFUN to read
2426 characters. RADIX must be in the interval [2..36]; if it isn't, a
2427 read error is signaled . Value is the integer read. Signals an
2428 error if encountering invalid read syntax or if RADIX is out of
2432 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2434 /* Room for sign, leading 0, other digits, trailing null byte.
2435 Also, room for invalid syntax diagnostic. */
2436 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2437 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2439 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2441 if (radix
< 2 || radix
> 36)
2449 if (c
== '-' || c
== '+')
2460 /* Ignore redundant leading zeros, so the buffer doesn't
2461 fill up with them. */
2467 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2474 if (p
< buf
+ sizeof buf
- 1)
2488 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2489 invalid_syntax (buf
);
2492 return string_to_number (buf
, radix
, 0);
2496 /* If the next token is ')' or ']' or '.', we store that character
2497 in *PCH and the return value is not interesting. Else, we store
2498 zero in *PCH and we read and return one lisp object.
2500 FIRST_IN_LIST is true if this is the first element of a list. */
2503 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2506 bool uninterned_symbol
= 0;
2513 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2515 end_of_file_error ();
2520 return read_list (0, readcharfun
);
2523 return read_vector (readcharfun
, 0);
2539 /* Accept extended format for hashtables (extensible to
2541 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2542 Lisp_Object tmp
= read_list (0, readcharfun
);
2543 Lisp_Object head
= CAR_SAFE (tmp
);
2544 Lisp_Object data
= Qnil
;
2545 Lisp_Object val
= Qnil
;
2546 /* The size is 2 * number of allowed keywords to
2548 Lisp_Object params
[10];
2550 Lisp_Object key
= Qnil
;
2551 int param_count
= 0;
2553 if (!EQ (head
, Qhash_table
))
2554 error ("Invalid extended read marker at head of #s list "
2555 "(only hash-table allowed)");
2557 tmp
= CDR_SAFE (tmp
);
2559 /* This is repetitive but fast and simple. */
2560 params
[param_count
] = QCsize
;
2561 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2562 if (!NILP (params
[param_count
+ 1]))
2565 params
[param_count
] = QCtest
;
2566 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2567 if (!NILP (params
[param_count
+ 1]))
2570 params
[param_count
] = QCweakness
;
2571 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2572 if (!NILP (params
[param_count
+ 1]))
2575 params
[param_count
] = QCrehash_size
;
2576 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2577 if (!NILP (params
[param_count
+ 1]))
2580 params
[param_count
] = QCrehash_threshold
;
2581 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2582 if (!NILP (params
[param_count
+ 1]))
2585 /* This is the hashtable data. */
2586 data
= Fplist_get (tmp
, Qdata
);
2588 /* Now use params to make a new hashtable and fill it. */
2589 ht
= Fmake_hash_table (param_count
, params
);
2591 while (CONSP (data
))
2596 error ("Odd number of elements in hashtable data");
2599 Fputhash (key
, val
, ht
);
2605 invalid_syntax ("#");
2613 tmp
= read_vector (readcharfun
, 0);
2614 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2615 error ("Invalid size char-table");
2616 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2628 tmp
= read_vector (readcharfun
, 0);
2631 error ("Invalid size char-table");
2632 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2633 error ("Invalid depth in char-table");
2634 depth
= XINT (AREF (tmp
, 0));
2635 if (chartab_size
[depth
] != size
- 2)
2636 error ("Invalid size char-table");
2637 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2640 invalid_syntax ("#^" "^");
2642 invalid_syntax ("#^");
2647 length
= read1 (readcharfun
, pch
, first_in_list
);
2651 Lisp_Object tmp
, val
;
2652 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2653 unsigned char *data
;
2656 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2657 if (STRING_MULTIBYTE (tmp
)
2658 || (size_in_chars
!= SCHARS (tmp
)
2659 /* We used to print 1 char too many
2660 when the number of bits was a multiple of 8.
2661 Accept such input in case it came from an old
2663 && ! (XFASTINT (length
)
2664 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2665 invalid_syntax ("#&...");
2667 val
= make_uninit_bool_vector (XFASTINT (length
));
2668 data
= bool_vector_uchar_data (val
);
2669 memcpy (data
, SDATA (tmp
), size_in_chars
);
2670 /* Clear the extraneous bits in the last byte. */
2671 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2672 data
[size_in_chars
- 1]
2673 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2676 invalid_syntax ("#&...");
2680 /* Accept compiled functions at read-time so that we don't have to
2681 build them using function calls. */
2683 struct Lisp_Vector
*vec
;
2684 tmp
= read_vector (readcharfun
, 1);
2685 vec
= XVECTOR (tmp
);
2686 if (vec
->header
.size
== 0)
2687 invalid_syntax ("Empty byte-code object");
2688 make_byte_code (vec
);
2694 struct gcpro gcpro1
;
2697 /* Read the string itself. */
2698 tmp
= read1 (readcharfun
, &ch
, 0);
2699 if (ch
!= 0 || !STRINGP (tmp
))
2700 invalid_syntax ("#");
2702 /* Read the intervals and their properties. */
2705 Lisp_Object beg
, end
, plist
;
2707 beg
= read1 (readcharfun
, &ch
, 0);
2712 end
= read1 (readcharfun
, &ch
, 0);
2714 plist
= read1 (readcharfun
, &ch
, 0);
2716 invalid_syntax ("Invalid string property list");
2717 Fset_text_properties (beg
, end
, plist
, tmp
);
2723 /* #@NUMBER is used to skip NUMBER following bytes.
2724 That's used in .elc files to skip over doc strings
2725 and function definitions. */
2728 enum { extra
= 100 };
2729 ptrdiff_t i
, nskip
= 0, digits
= 0;
2731 /* Read a decimal integer. */
2732 while ((c
= READCHAR
) >= 0
2733 && c
>= '0' && c
<= '9')
2735 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2740 if (digits
== 2 && nskip
== 0)
2741 { /* We've just seen #@00, which means "skip to end". */
2742 skip_dyn_eof (readcharfun
);
2747 /* We can't use UNREAD here, because in the code below we side-step
2748 READCHAR. Instead, assume the first char after #@NNN occupies
2749 a single byte, which is the case normally since it's just
2755 if (load_force_doc_strings
2756 && (FROM_FILE_P (readcharfun
)))
2758 /* If we are supposed to force doc strings into core right now,
2759 record the last string that we skipped,
2760 and record where in the file it comes from. */
2762 /* But first exchange saved_doc_string
2763 with prev_saved_doc_string, so we save two strings. */
2765 char *temp
= saved_doc_string
;
2766 ptrdiff_t temp_size
= saved_doc_string_size
;
2767 file_offset temp_pos
= saved_doc_string_position
;
2768 ptrdiff_t temp_len
= saved_doc_string_length
;
2770 saved_doc_string
= prev_saved_doc_string
;
2771 saved_doc_string_size
= prev_saved_doc_string_size
;
2772 saved_doc_string_position
= prev_saved_doc_string_position
;
2773 saved_doc_string_length
= prev_saved_doc_string_length
;
2775 prev_saved_doc_string
= temp
;
2776 prev_saved_doc_string_size
= temp_size
;
2777 prev_saved_doc_string_position
= temp_pos
;
2778 prev_saved_doc_string_length
= temp_len
;
2781 if (saved_doc_string_size
== 0)
2783 saved_doc_string
= xmalloc_atomic (nskip
+ extra
);
2784 saved_doc_string_size
= nskip
+ extra
;
2786 if (nskip
> saved_doc_string_size
)
2788 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2789 saved_doc_string_size
= nskip
+ extra
;
2792 saved_doc_string_position
= file_tell (instream
);
2794 /* Copy that many characters into saved_doc_string. */
2796 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2797 saved_doc_string
[i
] = c
= getc (instream
);
2800 saved_doc_string_length
= i
;
2803 /* Skip that many bytes. */
2804 skip_dyn_bytes (readcharfun
, nskip
);
2810 /* #! appears at the beginning of an executable file.
2811 Skip the first line. */
2812 while (c
!= '\n' && c
>= 0)
2817 return Vload_file_name
;
2819 return list2 (Qfunction
, read0 (readcharfun
));
2820 /* #:foo is the uninterned symbol named foo. */
2823 uninterned_symbol
= 1;
2826 && c
!= 0xa0 /* NBSP */
2828 || strchr ("\"';()[]#`,", c
) == NULL
)))
2830 /* No symbol character follows, this is the empty
2833 return Fmake_symbol (empty_unibyte_string
);
2837 /* ## is the empty symbol. */
2839 return Fintern (empty_unibyte_string
, Qnil
);
2840 /* Reader forms that can reuse previously read objects. */
2841 if (c
>= '0' && c
<= '9')
2846 /* Read a non-negative integer. */
2847 while (c
>= '0' && c
<= '9')
2849 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2850 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2851 n
= MOST_POSITIVE_FIXNUM
+ 1;
2853 n
= n
* 10 + c
- '0';
2857 if (n
<= MOST_POSITIVE_FIXNUM
)
2859 if (c
== 'r' || c
== 'R')
2860 return read_integer (readcharfun
, n
);
2862 if (! NILP (Vread_circle
))
2864 /* #n=object returns object, but associates it with
2868 /* Make a placeholder for #n# to use temporarily. */
2869 Lisp_Object placeholder
;
2872 placeholder
= Fcons (Qnil
, Qnil
);
2873 cell
= Fcons (make_number (n
), placeholder
);
2874 read_objects
= Fcons (cell
, read_objects
);
2876 /* Read the object itself. */
2877 tem
= read0 (readcharfun
);
2879 /* Now put it everywhere the placeholder was... */
2880 substitute_object_in_subtree (tem
, placeholder
);
2882 /* ...and #n# will use the real value from now on. */
2883 Fsetcdr (cell
, tem
);
2888 /* #n# returns a previously read object. */
2891 tem
= Fassq (make_number (n
), read_objects
);
2897 /* Fall through to error message. */
2899 else if (c
== 'x' || c
== 'X')
2900 return read_integer (readcharfun
, 16);
2901 else if (c
== 'o' || c
== 'O')
2902 return read_integer (readcharfun
, 8);
2903 else if (c
== 'b' || c
== 'B')
2904 return read_integer (readcharfun
, 2);
2907 invalid_syntax ("#");
2910 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2914 return list2 (Qquote
, read0 (readcharfun
));
2918 int next_char
= READCHAR
;
2920 /* Transition from old-style to new-style:
2921 If we see "(`" it used to mean old-style, which usually works
2922 fine because ` should almost never appear in such a position
2923 for new-style. But occasionally we need "(`" to mean new
2924 style, so we try to distinguish the two by the fact that we
2925 can either write "( `foo" or "(` foo", where the first
2926 intends to use new-style whereas the second intends to use
2927 old-style. For Emacs-25, we should completely remove this
2928 first_in_list exception (old-style can still be obtained via
2930 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2932 Vold_style_backquotes
= Qt
;
2938 bool saved_new_backquote_flag
= new_backquote_flag
;
2940 new_backquote_flag
= 1;
2941 value
= read0 (readcharfun
);
2942 new_backquote_flag
= saved_new_backquote_flag
;
2944 return list2 (Qbackquote
, value
);
2949 int next_char
= READCHAR
;
2951 /* Transition from old-style to new-style:
2952 It used to be impossible to have a new-style , other than within
2953 a new-style `. This is sufficient when ` and , are used in the
2954 normal way, but ` and , can also appear in args to macros that
2955 will not interpret them in the usual way, in which case , may be
2956 used without any ` anywhere near.
2957 So we now use the same heuristic as for backquote: old-style
2958 unquotes are only recognized when first on a list, and when
2959 followed by a space.
2960 Because it's more difficult to peek 2 chars ahead, a new-style
2961 ,@ can still not be used outside of a `, unless it's in the middle
2963 if (new_backquote_flag
2965 || (next_char
!= ' ' && next_char
!= '@'))
2967 Lisp_Object comma_type
= Qnil
;
2972 comma_type
= Qcomma_at
;
2974 comma_type
= Qcomma_dot
;
2977 if (ch
>= 0) UNREAD (ch
);
2978 comma_type
= Qcomma
;
2981 value
= read0 (readcharfun
);
2982 return list2 (comma_type
, value
);
2986 Vold_style_backquotes
= Qt
;
2998 end_of_file_error ();
3000 /* Accept `single space' syntax like (list ? x) where the
3001 whitespace character is SPC or TAB.
3002 Other literal whitespace like NL, CR, and FF are not accepted,
3003 as there are well-established escape sequences for these. */
3004 if (c
== ' ' || c
== '\t')
3005 return make_number (c
);
3008 c
= read_escape (readcharfun
, 0);
3009 modifiers
= c
& CHAR_MODIFIER_MASK
;
3010 c
&= ~CHAR_MODIFIER_MASK
;
3011 if (CHAR_BYTE8_P (c
))
3012 c
= CHAR_TO_BYTE8 (c
);
3015 next_char
= READCHAR
;
3016 ok
= (next_char
<= 040
3017 || (next_char
< 0200
3018 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3021 return make_number (c
);
3023 invalid_syntax ("?");
3028 char *p
= read_buffer
;
3029 char *end
= read_buffer
+ read_buffer_size
;
3031 /* True if we saw an escape sequence specifying
3032 a multibyte character. */
3033 bool force_multibyte
= 0;
3034 /* True if we saw an escape sequence specifying
3035 a single-byte character. */
3036 bool force_singlebyte
= 0;
3038 ptrdiff_t nchars
= 0;
3040 while ((ch
= READCHAR
) >= 0
3043 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3045 ptrdiff_t offset
= p
- read_buffer
;
3046 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3047 memory_full (SIZE_MAX
);
3048 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3049 read_buffer_size
*= 2;
3050 p
= read_buffer
+ offset
;
3051 end
= read_buffer
+ read_buffer_size
;
3058 ch
= read_escape (readcharfun
, 1);
3060 /* CH is -1 if \ newline has just been seen. */
3063 if (p
== read_buffer
)
3068 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3069 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3071 if (CHAR_BYTE8_P (ch
))
3072 force_singlebyte
= 1;
3073 else if (! ASCII_CHAR_P (ch
))
3074 force_multibyte
= 1;
3075 else /* I.e. ASCII_CHAR_P (ch). */
3077 /* Allow `\C- ' and `\C-?'. */
3078 if (modifiers
== CHAR_CTL
)
3081 ch
= 0, modifiers
= 0;
3083 ch
= 127, modifiers
= 0;
3085 if (modifiers
& CHAR_SHIFT
)
3087 /* Shift modifier is valid only with [A-Za-z]. */
3088 if (ch
>= 'A' && ch
<= 'Z')
3089 modifiers
&= ~CHAR_SHIFT
;
3090 else if (ch
>= 'a' && ch
<= 'z')
3091 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3094 if (modifiers
& CHAR_META
)
3096 /* Move the meta bit to the right place for a
3098 modifiers
&= ~CHAR_META
;
3099 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3100 force_singlebyte
= 1;
3104 /* Any modifiers remaining are invalid. */
3106 error ("Invalid modifier in string");
3107 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3111 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3112 if (CHAR_BYTE8_P (ch
))
3113 force_singlebyte
= 1;
3114 else if (! ASCII_CHAR_P (ch
))
3115 force_multibyte
= 1;
3121 end_of_file_error ();
3123 /* If purifying, and string starts with \ newline,
3124 return zero instead. This is for doc strings
3125 that we are really going to find in etc/DOC.nn.nn. */
3126 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3127 return make_number (0);
3129 if (! force_multibyte
&& force_singlebyte
)
3131 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3132 forms. Convert it to unibyte. */
3133 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3135 p
= read_buffer
+ nchars
;
3138 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3140 || (p
- read_buffer
!= nchars
)));
3145 int next_char
= READCHAR
;
3148 if (next_char
<= 040
3149 || (next_char
< 0200
3150 && strchr ("\"';([#?`,", next_char
) != NULL
))
3156 /* Otherwise, we fall through! Note that the atom-reading loop
3157 below will now loop at least once, assuring that we will not
3158 try to UNREAD two characters in a row. */
3162 if (c
<= 040) goto retry
;
3163 if (c
== 0xa0) /* NBSP */
3168 char *p
= read_buffer
;
3170 EMACS_INT start_position
= readchar_count
- 1;
3173 char *end
= read_buffer
+ read_buffer_size
;
3177 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3179 ptrdiff_t offset
= p
- read_buffer
;
3180 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3181 memory_full (SIZE_MAX
);
3182 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3183 read_buffer_size
*= 2;
3184 p
= read_buffer
+ offset
;
3185 end
= read_buffer
+ read_buffer_size
;
3192 end_of_file_error ();
3197 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3203 && c
!= 0xa0 /* NBSP */
3205 || strchr ("\"';()[]#`,", c
) == NULL
));
3209 ptrdiff_t offset
= p
- read_buffer
;
3210 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3211 memory_full (SIZE_MAX
);
3212 read_buffer
= xrealloc (read_buffer
, read_buffer_size
* 2);
3213 read_buffer_size
*= 2;
3214 p
= read_buffer
+ offset
;
3215 end
= read_buffer
+ read_buffer_size
;
3221 if (!quoted
&& !uninterned_symbol
)
3223 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3224 if (! NILP (result
))
3228 Lisp_Object name
, result
;
3229 ptrdiff_t nbytes
= p
- read_buffer
;
3232 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3236 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3237 ? make_pure_string
: make_specified_string
)
3238 (read_buffer
, nchars
, nbytes
, multibyte
));
3239 result
= (uninterned_symbol
? Fmake_symbol (name
)
3240 : Fintern (name
, Qnil
));
3242 if (EQ (Vread_with_symbol_positions
, Qt
)
3243 || EQ (Vread_with_symbol_positions
, readcharfun
))
3244 Vread_symbol_positions_list
3245 = Fcons (Fcons (result
, make_number (start_position
)),
3246 Vread_symbol_positions_list
);
3254 /* List of nodes we've seen during substitute_object_in_subtree. */
3255 static Lisp_Object seen_list
;
3258 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3260 Lisp_Object check_object
;
3262 /* We haven't seen any objects when we start. */
3265 /* Make all the substitutions. */
3267 = substitute_object_recurse (object
, placeholder
, object
);
3269 /* Clear seen_list because we're done with it. */
3272 /* The returned object here is expected to always eq the
3274 if (!EQ (check_object
, object
))
3275 error ("Unexpected mutation error in reader");
3278 /* Feval doesn't get called from here, so no gc protection is needed. */
3279 #define SUBSTITUTE(get_val, set_val) \
3281 Lisp_Object old_value = get_val; \
3282 Lisp_Object true_value \
3283 = substitute_object_recurse (object, placeholder, \
3286 if (!EQ (old_value, true_value)) \
3293 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3295 /* If we find the placeholder, return the target object. */
3296 if (EQ (placeholder
, subtree
))
3299 /* If we've been to this node before, don't explore it again. */
3300 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3303 /* If this node can be the entry point to a cycle, remember that
3304 we've seen it. It can only be such an entry point if it was made
3305 by #n=, which means that we can find it as a value in
3307 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3308 seen_list
= Fcons (subtree
, seen_list
);
3310 /* Recurse according to subtree's type.
3311 Every branch must return a Lisp_Object. */
3312 if (VECTORLIKEP (subtree
))
3314 ptrdiff_t i
, length
= 0;
3315 if (BOOL_VECTOR_P (subtree
))
3316 return subtree
; /* No sub-objects anyway. */
3317 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3318 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3319 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3320 else if (VECTORP (subtree
))
3321 length
= ASIZE (subtree
);
3323 /* An unknown pseudovector may contain non-Lisp fields, so we
3324 can't just blindly traverse all its fields. We used to call
3325 `Flength' which signaled `sequencep', so I just preserved this
3327 wrong_type_argument (Qsequencep
, subtree
);
3329 for (i
= 0; i
< length
; i
++)
3330 SUBSTITUTE (AREF (subtree
, i
),
3331 ASET (subtree
, i
, true_value
));
3334 else if (CONSP (subtree
))
3336 SUBSTITUTE (XCAR (subtree
),
3337 XSETCAR (subtree
, true_value
));
3338 SUBSTITUTE (XCDR (subtree
),
3339 XSETCDR (subtree
, true_value
));
3342 else if (STRINGP (subtree
))
3344 /* Check for text properties in each interval.
3345 substitute_in_interval contains part of the logic. */
3347 INTERVAL root_interval
= string_intervals (subtree
);
3348 Lisp_Object arg
= Fcons (object
, placeholder
);
3350 traverse_intervals_noorder (root_interval
,
3351 &substitute_in_interval
, arg
);
3356 /* Other types don't recurse any further. */
3360 /* Helper function for substitute_object_recurse. */
3362 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3364 Lisp_Object object
= Fcar (arg
);
3365 Lisp_Object placeholder
= Fcdr (arg
);
3367 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3377 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3378 integer syntax and fits in a fixnum, else return the nearest float if CP has
3379 either floating point or integer syntax and BASE is 10, else return nil. If
3380 IGNORE_TRAILING, consider just the longest prefix of CP that has
3381 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3382 number has integer syntax but does not fit. */
3385 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3388 char const *cp
= string
;
3390 bool float_syntax
= 0;
3393 /* Compute NaN and infinities using a variable, to cope with compilers that
3394 think they are smarter than we are. */
3397 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3398 IEEE floating point hosts, and works around a formerly-common bug where
3399 atof ("-0.0") drops the sign. */
3400 bool negative
= *cp
== '-';
3402 bool signedp
= negative
|| *cp
== '+';
3407 leading_digit
= digit_to_number (*cp
, base
);
3408 if (leading_digit
>= 0)
3413 while (digit_to_number (*cp
, base
) >= 0);
3423 if ('0' <= *cp
&& *cp
<= '9')
3428 while ('0' <= *cp
&& *cp
<= '9');
3430 if (*cp
== 'e' || *cp
== 'E')
3432 char const *ecp
= cp
;
3434 if (*cp
== '+' || *cp
== '-')
3436 if ('0' <= *cp
&& *cp
<= '9')
3441 while ('0' <= *cp
&& *cp
<= '9');
3443 else if (cp
[-1] == '+'
3444 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3450 else if (cp
[-1] == '+'
3451 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3455 value
= zero
/ zero
;
3457 /* If that made a "negative" NaN, negate it. */
3460 union { double d
; char c
[sizeof (double)]; }
3461 u_data
, u_minus_zero
;
3463 u_minus_zero
.d
= -0.0;
3464 for (i
= 0; i
< sizeof (double); i
++)
3465 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3471 /* Now VALUE is a positive NaN. */
3477 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3478 || state
== (LEAD_INT
|E_EXP
));
3481 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3482 any prefix that matches. Otherwise, the entire string must match. */
3483 if (! (ignore_trailing
3484 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3485 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3488 /* If the number uses integer and not float syntax, and is in C-language
3489 range, use its value, preferably as a fixnum. */
3490 if (leading_digit
>= 0 && ! float_syntax
)
3494 /* Fast special case for single-digit integers. This also avoids a
3495 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3496 case some versions of strtoumax accept numbers like "0x1" that Emacs
3498 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3499 return make_number (negative
? -leading_digit
: leading_digit
);
3502 n
= strtoumax (string
+ signedp
, NULL
, base
);
3503 if (errno
== ERANGE
)
3505 /* Unfortunately there's no simple and accurate way to convert
3506 non-base-10 numbers that are out of C-language range. */
3508 xsignal1 (Qoverflow_error
, build_string (string
));
3510 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3512 EMACS_INT signed_n
= n
;
3513 return make_number (negative
? -signed_n
: signed_n
);
3519 /* Either the number uses float syntax, or it does not fit into a fixnum.
3520 Convert it from string to floating point, unless the value is already
3521 known because it is an infinity, a NAN, or its absolute value fits in
3524 value
= atof (string
+ signedp
);
3526 return make_float (negative
? -value
: value
);
3531 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3535 Lisp_Object tem
, item
, vector
;
3538 tem
= read_list (1, readcharfun
);
3539 len
= Flength (tem
);
3540 vector
= Fmake_vector (len
, Qnil
);
3542 size
= ASIZE (vector
);
3543 ptr
= XVECTOR (vector
)->contents
;
3544 for (i
= 0; i
< size
; i
++)
3547 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3548 bytecode object, the docstring containing the bytecode and
3549 constants values must be treated as unibyte and passed to
3550 Fread, to get the actual bytecode string and constants vector. */
3551 if (bytecodeflag
&& load_force_doc_strings
)
3553 if (i
== COMPILED_BYTECODE
)
3555 if (!STRINGP (item
))
3556 error ("Invalid byte code");
3558 /* Delay handling the bytecode slot until we know whether
3559 it is lazily-loaded (we can tell by whether the
3560 constants slot is nil). */
3561 ASET (vector
, COMPILED_CONSTANTS
, item
);
3564 else if (i
== COMPILED_CONSTANTS
)
3566 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3570 /* Coerce string to unibyte (like string-as-unibyte,
3571 but without generating extra garbage and
3572 guaranteeing no change in the contents). */
3573 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3574 STRING_SET_UNIBYTE (bytestr
);
3576 item
= Fread (Fcons (bytestr
, readcharfun
));
3578 error ("Invalid byte code");
3580 bytestr
= XCAR (item
);
3584 /* Now handle the bytecode slot. */
3585 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3587 else if (i
== COMPILED_DOC_STRING
3589 && ! STRING_MULTIBYTE (item
))
3591 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3592 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3594 item
= Fstring_as_multibyte (item
);
3597 ASET (vector
, i
, item
);
3603 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3606 read_list (bool flag
, Lisp_Object readcharfun
)
3608 Lisp_Object val
, tail
;
3609 Lisp_Object elt
, tem
;
3610 struct gcpro gcpro1
, gcpro2
;
3611 /* 0 is the normal case.
3612 1 means this list is a doc reference; replace it with the number 0.
3613 2 means this list is a doc reference; replace it with the doc string. */
3614 int doc_reference
= 0;
3616 /* Initialize this to 1 if we are reading a list. */
3617 bool first_in_list
= flag
<= 0;
3626 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3631 /* While building, if the list starts with #$, treat it specially. */
3632 if (EQ (elt
, Vload_file_name
)
3634 && !NILP (Vpurify_flag
))
3636 if (NILP (Vdoc_file_name
))
3637 /* We have not yet called Snarf-documentation, so assume
3638 this file is described in the DOC file
3639 and Snarf-documentation will fill in the right value later.
3640 For now, replace the whole list with 0. */
3643 /* We have already called Snarf-documentation, so make a relative
3644 file name for this file, so it can be found properly
3645 in the installed Lisp directory.
3646 We don't use Fexpand_file_name because that would make
3647 the directory absolute now. */
3648 elt
= concat2 (build_string ("../lisp/"),
3649 Ffile_name_nondirectory (elt
));
3651 else if (EQ (elt
, Vload_file_name
)
3653 && load_force_doc_strings
)
3662 invalid_syntax (") or . in a vector");
3670 XSETCDR (tail
, read0 (readcharfun
));
3672 val
= read0 (readcharfun
);
3673 read1 (readcharfun
, &ch
, 0);
3677 if (doc_reference
== 1)
3678 return make_number (0);
3679 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3682 file_offset saved_position
;
3683 /* Get a doc string from the file we are loading.
3684 If it's in saved_doc_string, get it from there.
3686 Here, we don't know if the string is a
3687 bytecode string or a doc string. As a
3688 bytecode string must be unibyte, we always
3689 return a unibyte string. If it is actually a
3690 doc string, caller must make it
3693 /* Position is negative for user variables. */
3694 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3695 if (pos
>= saved_doc_string_position
3696 && pos
< (saved_doc_string_position
3697 + saved_doc_string_length
))
3699 saved
= saved_doc_string
;
3700 saved_position
= saved_doc_string_position
;
3702 /* Look in prev_saved_doc_string the same way. */
3703 else if (pos
>= prev_saved_doc_string_position
3704 && pos
< (prev_saved_doc_string_position
3705 + prev_saved_doc_string_length
))
3707 saved
= prev_saved_doc_string
;
3708 saved_position
= prev_saved_doc_string_position
;
3712 ptrdiff_t start
= pos
- saved_position
;
3715 /* Process quoting with ^A,
3716 and find the end of the string,
3717 which is marked with ^_ (037). */
3718 for (from
= start
, to
= start
;
3719 saved
[from
] != 037;)
3721 int c
= saved
[from
++];
3725 saved
[to
++] = (c
== 1 ? c
3734 return make_unibyte_string (saved
+ start
,
3738 return get_doc_string (val
, 1, 0);
3743 invalid_syntax (". in wrong context");
3745 invalid_syntax ("] in a list");
3749 XSETCDR (tail
, tem
);
3756 static Lisp_Object initial_obarray
;
3759 obhash (Lisp_Object obarray
)
3761 Lisp_Object tem
= scm_hashq_get_handle (obarrays
, obarray
);
3762 if (SCM_UNLIKELY (scm_is_false (tem
)))
3763 tem
= scm_hashq_create_handle_x (obarrays
, obarray
,
3764 scm_make_obarray ());
3765 return scm_cdr (tem
);
3768 /* Get an error if OBARRAY is not an obarray.
3769 If it is one, return it. */
3772 check_obarray (Lisp_Object obarray
)
3774 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3776 /* If Vobarray is now invalid, force it to be valid. */
3777 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3778 wrong_type_argument (Qvectorp
, obarray
);
3783 /* Intern the C string STR: return a symbol with that name,
3784 interned in the current obarray. */
3787 intern_1 (const char *str
, ptrdiff_t len
)
3789 Lisp_Object obarray
= check_obarray (Vobarray
);
3790 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3792 return SYMBOLP (tem
) ? tem
: Fintern (make_string (str
, len
), obarray
);
3796 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3798 Lisp_Object obarray
= check_obarray (Vobarray
);
3799 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3804 if (NILP (Vpurify_flag
))
3805 /* Creating a non-pure string from a string literal not
3806 implemented yet. We could just use make_string here and live
3807 with the extra copy. */
3810 return Fintern (make_pure_c_string (str
, len
), obarray
);
3813 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3814 doc
: /* Return the canonical symbol whose name is STRING.
3815 If there is none, one is created by this function and returned.
3816 A second optional argument specifies the obarray to use;
3817 it defaults to the value of `obarray'. */)
3818 (Lisp_Object string
, Lisp_Object obarray
)
3820 register Lisp_Object tem
, sym
, *ptr
;
3822 if (NILP (obarray
)) obarray
= Vobarray
;
3823 obarray
= check_obarray (obarray
);
3825 CHECK_STRING (string
);
3827 tem
= oblookup (obarray
, SSDATA (string
),
3833 if (!NILP (Vpurify_flag
))
3834 string
= Fpurecopy (string
);
3836 sym
= scm_intern (scm_from_utf8_stringn (SSDATA (string
),
3839 initialize_symbol (sym
, string
);
3841 if ((SREF (string
, 0) == ':')
3842 && EQ (obarray
, initial_obarray
))
3844 XSYMBOL (sym
)->constant
= 1;
3845 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3846 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3849 return scm_intern (scm_from_utf8_stringn (SSDATA (string
),
3854 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3855 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3856 NAME may be a string or a symbol. If it is a symbol, that exact
3857 symbol is searched for.
3858 A second optional argument specifies the obarray to use;
3859 it defaults to the value of `obarray'. */)
3860 (Lisp_Object name
, Lisp_Object obarray
)
3862 register Lisp_Object tem
, string
;
3864 if (NILP (obarray
)) obarray
= Vobarray
;
3865 obarray
= check_obarray (obarray
);
3867 if (!SYMBOLP (name
))
3869 CHECK_STRING (name
);
3873 string
= SYMBOL_NAME (name
);
3875 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3876 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3882 DEFUN ("find-symbol", Ffind_symbol
, Sfind_symbol
, 1, 2, 0,
3883 doc
: /* find-symbol */)
3884 (Lisp_Object string
, Lisp_Object obarray
)
3888 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3889 CHECK_STRING (string
);
3891 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3893 return scm_values (scm_list_2 (Qnil
, Qnil
));
3895 return scm_values (scm_list_2 (tem
, Qt
));
3898 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3899 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3900 The value is t if a symbol was found and deleted, nil otherwise.
3901 NAME may be a string or a symbol. If it is a symbol, that symbol
3902 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3903 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3904 usage: (unintern NAME OBARRAY) */)
3905 (Lisp_Object name
, Lisp_Object obarray
)
3912 obarray
= check_obarray (obarray
);
3917 scm_find_symbol (scm_symbol_to_string (name
),
3920 string
= SYMBOL_NAME (name
);
3924 CHECK_STRING (name
);
3929 return (scm_is_true (scm_unintern (name
, obhash (obarray
))) ? Qt
: Qnil
);
3932 /* Return the symbol in OBARRAY whose names matches the string
3933 of SIZE characters (SIZE_BYTE bytes) at PTR.
3934 If there is no such symbol, return the integer bucket number of
3935 where the symbol would be if it were present.
3937 Also store the bucket number in oblookup_last_bucket_number. */
3940 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3943 Lisp_Object string2
= scm_from_utf8_stringn (ptr
, size_byte
);
3945 obarray
= check_obarray (obarray
);
3946 sym
= scm_find_symbol (string2
, obhash (obarray
));
3947 if (scm_is_true (sym
)
3948 && scm_is_true (scm_module_variable (symbol_module
, sym
)))
3950 if (EQ (sym
, Qnil_
))
3952 else if (EQ (sym
, Qt_
))
3958 return make_number (0);
3962 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3964 Lisp_Object
proc (Lisp_Object sym
)
3966 Lisp_Object tem
= Ffind_symbol (SYMBOL_NAME (sym
), obarray
);
3967 if (scm_is_true (scm_c_value_ref (tem
, 1))
3968 && EQ (sym
, scm_c_value_ref (tem
, 0)))
3970 return SCM_UNSPECIFIED
;
3972 CHECK_VECTOR (obarray
);
3973 scm_obarray_for_each (scm_c_make_gsubr ("proc", 1, 0, 0, proc
),
3978 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3980 call1 (function
, sym
);
3983 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3984 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3985 OBARRAY defaults to the value of `obarray'. */)
3986 (Lisp_Object function
, Lisp_Object obarray
)
3988 if (NILP (obarray
)) obarray
= Vobarray
;
3989 obarray
= check_obarray (obarray
);
3991 map_obarray (obarray
, mapatoms_1
, function
);
3995 #define OBARRAY_SIZE 1511
4000 Lisp_Object oblength
;
4001 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
4003 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4005 Vobarray
= Fmake_vector (oblength
, make_number (0));
4006 initial_obarray
= Vobarray
;
4007 staticpro (&initial_obarray
);
4009 obarrays
= scm_make_hash_table (SCM_UNDEFINED
);
4010 scm_hashq_set_x (obarrays
, Vobarray
, SCM_UNDEFINED
);
4012 Qnil
= SCM_ELISP_NIL
;
4015 Qnil_
= intern_c_string ("nil");
4016 SET_SYMBOL_VAL (XSYMBOL (Qnil_
), Qnil
);
4017 XSYMBOL (Qnil_
)->constant
= 1;
4018 XSYMBOL (Qnil_
)->declared_special
= 1;
4020 Qt_
= intern_c_string ("t");
4021 SET_SYMBOL_VAL (XSYMBOL (Qt_
), Qt
);
4022 XSYMBOL (Qt_
)->constant
= 1;
4023 XSYMBOL (Qt_
)->declared_special
= 1;
4025 Qunbound
= Fmake_symbol (build_pure_c_string ("unbound"));
4026 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
4028 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4031 DEFSYM (Qvariable_documentation
, "variable-documentation");
4033 read_buffer
= xmalloc_atomic (size
);
4034 read_buffer_size
= size
;
4038 defsubr (struct Lisp_Subr
*sname
)
4040 Lisp_Object sym
, tem
;
4041 sym
= intern_c_string (sname
->symbol_name
);
4042 SCM_NEWSMOB (sname
->header
.self
, lisp_vectorlike_tag
, sname
);
4043 XSETPVECTYPE (sname
, PVEC_SUBR
);
4044 XSETSUBR (tem
, sname
);
4045 set_symbol_function (sym
, tem
);
4048 /* Define an "integer variable"; a symbol whose value is forwarded to a
4049 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4050 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4052 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4053 const char *namestring
, EMACS_INT
*address
)
4056 sym
= intern_c_string (namestring
);
4057 i_fwd
->type
= Lisp_Fwd_Int
;
4058 i_fwd
->intvar
= address
;
4059 XSYMBOL (sym
)->declared_special
= 1;
4060 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4061 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4064 /* Similar but define a variable whose value is t if address contains 1,
4065 nil if address contains 0. */
4067 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4068 const char *namestring
, bool *address
)
4071 sym
= intern_c_string (namestring
);
4072 b_fwd
->type
= Lisp_Fwd_Bool
;
4073 b_fwd
->boolvar
= address
;
4074 XSYMBOL (sym
)->declared_special
= 1;
4075 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4076 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4077 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4080 /* Similar but define a variable whose value is the Lisp Object stored
4081 at address. Two versions: with and without gc-marking of the C
4082 variable. The nopro version is used when that variable will be
4083 gc-marked for some other reason, since marking the same slot twice
4084 can cause trouble with strings. */
4086 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4087 const char *namestring
, Lisp_Object
*address
)
4090 sym
= intern_c_string (namestring
);
4091 o_fwd
->type
= Lisp_Fwd_Obj
;
4092 o_fwd
->objvar
= address
;
4093 XSYMBOL (sym
)->declared_special
= 1;
4094 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4095 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4099 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4100 const char *namestring
, Lisp_Object
*address
)
4102 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4103 staticpro (address
);
4106 /* Similar but define a variable whose value is the Lisp Object stored
4107 at a particular offset in the current kboard object. */
4110 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4111 const char *namestring
, int offset
)
4114 sym
= intern_c_string (namestring
);
4115 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4116 ko_fwd
->offset
= offset
;
4117 XSYMBOL (sym
)->declared_special
= 1;
4118 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4119 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4122 /* Check that the elements of lpath exist. */
4125 load_path_check (Lisp_Object lpath
)
4127 Lisp_Object path_tail
;
4129 /* The only elements that might not exist are those from
4130 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4132 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4134 Lisp_Object dirfile
;
4135 dirfile
= Fcar (path_tail
);
4136 if (STRINGP (dirfile
))
4138 dirfile
= Fdirectory_file_name (dirfile
);
4139 if (! file_accessible_directory_p (SSDATA (dirfile
)))
4140 dir_warning ("Lisp directory", XCAR (path_tail
));
4145 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4146 This does not include the standard site-lisp directories
4147 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4148 but it does (unless no_site_lisp is set) include site-lisp
4149 directories in the source/build directories if those exist and we
4150 are running uninstalled.
4152 Uses the following logic:
4153 If CANNOT_DUMP: Use PATH_LOADSEARCH.
4154 The remainder is what happens when dumping works:
4155 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4156 Otherwise use PATH_LOADSEARCH.
4158 If !initialized, then just return PATH_DUMPLOADSEARCH.
4160 If Vinstallation_directory is not nil (ie, running uninstalled):
4161 If installation-dir/lisp exists and not already a member,
4162 we must be running uninstalled. Reset the load-path
4163 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4164 refers to the eventual installation directories. Since we
4165 are not yet installed, we should not use them, even if they exist.)
4166 If installation-dir/lisp does not exist, just add
4167 PATH_DUMPLOADSEARCH at the end instead.
4168 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4169 and not already a member) at the front.
4170 If installation-dir != source-dir (ie running an uninstalled,
4171 out-of-tree build) AND install-dir/src/Makefile exists BUT
4172 install-dir/src/Makefile.in does NOT exist (this is a sanity
4173 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4176 load_path_default (void)
4178 Lisp_Object lpath
= Qnil
;
4183 const char *loadpath
= ns_load_path ();
4186 normal
= PATH_LOADSEARCH
;
4188 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4190 lpath
= decode_env_path (0, normal
, 0);
4193 #else /* !CANNOT_DUMP */
4195 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4200 const char *loadpath
= ns_load_path ();
4201 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4203 lpath
= decode_env_path (0, normal
, 0);
4205 if (!NILP (Vinstallation_directory
))
4207 Lisp_Object tem
, tem1
;
4209 /* Add to the path the lisp subdir of the installation
4210 dir, if it is accessible. Note: in out-of-tree builds,
4211 this directory is empty save for Makefile. */
4212 tem
= Fexpand_file_name (build_string ("lisp"),
4213 Vinstallation_directory
);
4214 tem1
= Ffile_accessible_directory_p (tem
);
4217 if (NILP (Fmember (tem
, lpath
)))
4219 /* We are running uninstalled. The default load-path
4220 points to the eventual installed lisp directories.
4221 We should not use those now, even if they exist,
4222 so start over from a clean slate. */
4223 lpath
= list1 (tem
);
4227 /* That dir doesn't exist, so add the build-time
4228 Lisp dirs instead. */
4230 Lisp_Object dump_path
=
4231 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4232 lpath
= nconc2 (lpath
, dump_path
);
4235 /* Add site-lisp under the installation dir, if it exists. */
4238 tem
= Fexpand_file_name (build_string ("site-lisp"),
4239 Vinstallation_directory
);
4240 tem1
= Ffile_accessible_directory_p (tem
);
4243 if (NILP (Fmember (tem
, lpath
)))
4244 lpath
= Fcons (tem
, lpath
);
4248 /* If Emacs was not built in the source directory,
4249 and it is run from where it was built, add to load-path
4250 the lisp and site-lisp dirs under that directory. */
4252 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4256 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4257 Vinstallation_directory
);
4258 tem1
= Ffile_exists_p (tem
);
4260 /* Don't be fooled if they moved the entire source tree
4261 AFTER dumping Emacs. If the build directory is indeed
4262 different from the source dir, src/Makefile.in and
4263 src/Makefile will not be found together. */
4264 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4265 Vinstallation_directory
);
4266 tem2
= Ffile_exists_p (tem
);
4267 if (!NILP (tem1
) && NILP (tem2
))
4269 tem
= Fexpand_file_name (build_string ("lisp"),
4272 if (NILP (Fmember (tem
, lpath
)))
4273 lpath
= Fcons (tem
, lpath
);
4277 tem
= Fexpand_file_name (build_string ("site-lisp"),
4279 tem1
= Ffile_accessible_directory_p (tem
);
4282 if (NILP (Fmember (tem
, lpath
)))
4283 lpath
= Fcons (tem
, lpath
);
4287 } /* Vinstallation_directory != Vsource_directory */
4289 } /* if Vinstallation_directory */
4291 else /* !initialized */
4293 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4294 source directory. We used to add ../lisp (ie the lisp dir in
4295 the build directory) at the front here, but that should not
4296 be necessary, since in out of tree builds lisp/ is empty, save
4298 lpath
= decode_env_path (0, normal
, 0);
4300 #endif /* !CANNOT_DUMP */
4308 /* First, set Vload_path. */
4310 /* Ignore EMACSLOADPATH when dumping. */
4312 bool use_loadpath
= true;
4314 bool use_loadpath
= NILP (Vpurify_flag
);
4317 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4319 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4321 /* Check (non-nil) user-supplied elements. */
4322 load_path_check (Vload_path
);
4324 /* If no nils in the environment variable, use as-is.
4325 Otherwise, replace any nils with the default. */
4326 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4328 Lisp_Object elem
, elpath
= Vload_path
;
4329 Lisp_Object default_lpath
= load_path_default ();
4331 /* Check defaults, before adding site-lisp. */
4332 load_path_check (default_lpath
);
4334 /* Add the site-lisp directories to the front of the default. */
4337 Lisp_Object sitelisp
;
4338 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4339 if (! NILP (sitelisp
))
4340 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4345 /* Replace nils from EMACSLOADPATH by default. */
4346 while (CONSP (elpath
))
4349 elem
= XCAR (elpath
);
4350 elpath
= XCDR (elpath
);
4351 arg
[0] = Vload_path
;
4352 arg
[1] = NILP (elem
) ? default_lpath
: Fcons (elem
, Qnil
);
4353 Vload_path
= Fappend (2, arg
);
4355 } /* Fmemq (Qnil, Vload_path) */
4359 Vload_path
= load_path_default ();
4361 /* Check before adding site-lisp directories.
4362 The install should have created them, but they are not
4363 required, so no need to warn if they are absent.
4364 Or we might be running before installation. */
4365 load_path_check (Vload_path
);
4367 /* Add the site-lisp directories at the front. */
4368 if (initialized
&& !no_site_lisp
)
4370 Lisp_Object sitelisp
;
4371 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4372 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4378 load_in_progress
= 0;
4379 Vload_file_name
= Qnil
;
4380 Vstandard_input
= Qt
;
4381 Vloads_in_progress
= Qnil
;
4384 /* Print a warning that directory intended for use USE and with name
4385 DIRNAME cannot be accessed. On entry, errno should correspond to
4386 the access failure. Print the warning on stderr and put it in
4390 dir_warning (char const *use
, Lisp_Object dirname
)
4392 static char const format
[] = "Warning: %s `%s': %s\n";
4393 int access_errno
= errno
;
4394 fprintf (stderr
, format
, use
, SSDATA (dirname
), strerror (access_errno
));
4396 /* Don't log the warning before we've initialized!! */
4399 char const *diagnostic
= emacs_strerror (access_errno
);
4401 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4402 + strlen (use
) + SBYTES (dirname
)
4403 + strlen (diagnostic
));
4404 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4406 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4412 syms_of_lread (void)
4416 DEFVAR_LISP ("obarray", Vobarray
,
4417 doc
: /* Symbol table for use by `intern' and `read'.
4418 It is a vector whose length ought to be prime for best results.
4419 The vector's contents don't make sense if examined from Lisp programs;
4420 to find all the symbols in an obarray, use `mapatoms'. */);
4422 DEFVAR_LISP ("values", Vvalues
,
4423 doc
: /* List of values of all expressions which were read, evaluated and printed.
4424 Order is reverse chronological. */);
4425 XSYMBOL (intern ("values"))->declared_special
= 0;
4427 DEFVAR_LISP ("standard-input", Vstandard_input
,
4428 doc
: /* Stream for read to get input from.
4429 See documentation of `read' for possible values. */);
4430 Vstandard_input
= Qt
;
4432 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4433 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4435 If this variable is a buffer, then only forms read from that buffer
4436 will be added to `read-symbol-positions-list'.
4437 If this variable is t, then all read forms will be added.
4438 The effect of all other values other than nil are not currently
4439 defined, although they may be in the future.
4441 The positions are relative to the last call to `read' or
4442 `read-from-string'. It is probably a bad idea to set this variable at
4443 the toplevel; bind it instead. */);
4444 Vread_with_symbol_positions
= Qnil
;
4446 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4447 doc
: /* A list mapping read symbols to their positions.
4448 This variable is modified during calls to `read' or
4449 `read-from-string', but only when `read-with-symbol-positions' is
4452 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4453 CHAR-POSITION is an integer giving the offset of that occurrence of the
4454 symbol from the position where `read' or `read-from-string' started.
4456 Note that a symbol will appear multiple times in this list, if it was
4457 read multiple times. The list is in the same order as the symbols
4459 Vread_symbol_positions_list
= Qnil
;
4461 DEFVAR_LISP ("read-circle", Vread_circle
,
4462 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4465 DEFVAR_LISP ("load-path", Vload_path
,
4466 doc
: /* List of directories to search for files to load.
4467 Each element is a string (directory name) or nil (meaning `default-directory').
4468 Initialized during startup as described in Info node `(elisp)Library Search'. */);
4470 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4471 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4472 This list should not include the empty string.
4473 `load' and related functions try to append these suffixes, in order,
4474 to the specified file name if a Lisp suffix is allowed or required. */);
4475 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4476 build_pure_c_string (".el"));
4477 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4478 doc
: /* List of suffixes that indicate representations of \
4480 This list should normally start with the empty string.
4482 Enabling Auto Compression mode appends the suffixes in
4483 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4484 mode removes them again. `load' and related functions use this list to
4485 determine whether they should look for compressed versions of a file
4486 and, if so, which suffixes they should try to append to the file name
4487 in order to do so. However, if you want to customize which suffixes
4488 the loading functions recognize as compression suffixes, you should
4489 customize `jka-compr-load-suffixes' rather than the present variable. */);
4490 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4492 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4493 doc
: /* Non-nil if inside of `load'. */);
4494 DEFSYM (Qload_in_progress
, "load-in-progress");
4496 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4497 doc
: /* An alist of functions to be evalled when particular files are loaded.
4498 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4500 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4501 a symbol \(a feature name).
4503 When `load' is run and the file-name argument matches an element's
4504 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4505 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4507 An error in FORMS does not undo the load, but does prevent execution of
4508 the rest of the FORMS. */);
4509 Vafter_load_alist
= Qnil
;
4511 DEFVAR_LISP ("load-history", Vload_history
,
4512 doc
: /* Alist mapping loaded file names to symbols and features.
4513 Each alist element should be a list (FILE-NAME ENTRIES...), where
4514 FILE-NAME is the name of a file that has been loaded into Emacs.
4515 The file name is absolute and true (i.e. it doesn't contain symlinks).
4516 As an exception, one of the alist elements may have FILE-NAME nil,
4517 for symbols and features not associated with any file.
4519 The remaining ENTRIES in the alist element describe the functions and
4520 variables defined in that file, the features provided, and the
4521 features required. Each entry has the form `(provide . FEATURE)',
4522 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4523 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4524 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4525 autoload before this file redefined it as a function. In addition,
4526 entries may also be single symbols, which means that SYMBOL was
4527 defined by `defvar' or `defconst'.
4529 During preloading, the file name recorded is relative to the main Lisp
4530 directory. These file names are converted to absolute at startup. */);
4531 Vload_history
= Qnil
;
4533 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4534 doc
: /* Full name of file being loaded by `load'. */);
4535 Vload_file_name
= Qnil
;
4537 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4538 doc
: /* File name, including directory, of user's initialization file.
4539 If the file loaded had extension `.elc', and the corresponding source file
4540 exists, this variable contains the name of source file, suitable for use
4541 by functions like `custom-save-all' which edit the init file.
4542 While Emacs loads and evaluates the init file, value is the real name
4543 of the file, regardless of whether or not it has the `.elc' extension. */);
4544 Vuser_init_file
= Qnil
;
4546 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4547 doc
: /* Used for internal purposes by `load'. */);
4548 Vcurrent_load_list
= Qnil
;
4550 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4551 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4552 The default is nil, which means use the function `read'. */);
4553 Vload_read_function
= Qnil
;
4555 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4556 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4557 The value should be a function for doing code conversion before
4558 reading a source file. It can also be nil, in which case loading is
4559 done without any code conversion.
4561 If the value is a function, it is called with four arguments,
4562 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4563 the file to load, FILE is the non-absolute name (for messages etc.),
4564 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4565 `load'. The function should return t if the file was loaded. */);
4566 Vload_source_file_function
= Qnil
;
4568 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4569 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4570 This is useful when the file being loaded is a temporary copy. */);
4571 load_force_doc_strings
= 0;
4573 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4574 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4575 This is normally bound by `load' and `eval-buffer' to control `read',
4576 and is not meant for users to change. */);
4577 load_convert_to_unibyte
= 0;
4579 DEFVAR_LISP ("source-directory", Vsource_directory
,
4580 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4581 You cannot count on them to still be there! */);
4583 = Fexpand_file_name (build_string ("../"),
4584 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4586 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4587 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4588 Vpreloaded_file_list
= Qnil
;
4590 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4591 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4592 Vbyte_boolean_vars
= Qnil
;
4594 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4595 doc
: /* Non-nil means load dangerous compiled Lisp files.
4596 Some versions of XEmacs use different byte codes than Emacs. These
4597 incompatible byte codes can make Emacs crash when it tries to execute
4599 load_dangerous_libraries
= 0;
4601 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4602 doc
: /* Non-nil means force printing messages when loading Lisp files.
4603 This overrides the value of the NOMESSAGE argument to `load'. */);
4604 force_load_messages
= 0;
4606 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4607 doc
: /* Regular expression matching safe to load compiled Lisp files.
4608 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4609 from the file, and matches them against this regular expression.
4610 When the regular expression matches, the file is considered to be safe
4611 to load. See also `load-dangerous-libraries'. */);
4612 Vbytecomp_version_regexp
4613 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4615 DEFSYM (Qlexical_binding
, "lexical-binding");
4616 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4617 doc
: /* Whether to use lexical binding when evaluating code.
4618 Non-nil means that the code in the current buffer should be evaluated
4619 with lexical binding.
4620 This variable is automatically set from the file variables of an
4621 interpreted Lisp file read using `load'. Unlike other file local
4622 variables, this must be set in the first line of a file. */);
4623 Vlexical_binding
= Qnil
;
4624 Fmake_variable_buffer_local (Qlexical_binding
);
4626 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4627 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4628 Veval_buffer_list
= Qnil
;
4630 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4631 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4632 Vold_style_backquotes
= Qnil
;
4633 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4635 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4636 doc
: /* Non-nil means `load' prefers the newest version of a file.
4637 This applies when a filename suffix is not explicitly specified and
4638 `load' is trying various possible suffixes (see `load-suffixes' and
4639 `load-file-rep-suffixes'). Normally, it stops at the first file
4640 that exists unless you explicitly specify one or the other. If this
4641 option is non-nil, it checks all suffixes and uses whichever file is
4643 Note that if you customize this, obviously it will not affect files
4644 that are loaded before your customizations are read! */);
4645 load_prefer_newer
= 0;
4647 /* Vsource_directory was initialized in init_lread. */
4649 DEFSYM (Qcurrent_load_list
, "current-load-list");
4650 DEFSYM (Qstandard_input
, "standard-input");
4651 DEFSYM (Qread_char
, "read-char");
4652 DEFSYM (Qget_file_char
, "get-file-char");
4653 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4654 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4656 DEFSYM (Qbackquote
, "`");
4657 DEFSYM (Qcomma
, ",");
4658 DEFSYM (Qcomma_at
, ",@");
4659 DEFSYM (Qcomma_dot
, ",.");
4661 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4662 DEFSYM (Qascii_character
, "ascii-character");
4663 DEFSYM (Qfunction
, "function");
4664 DEFSYM (Qload
, "load");
4665 DEFSYM (Qload_file_name
, "load-file-name");
4666 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4667 DEFSYM (Qfile_truename
, "file-truename");
4668 DEFSYM (Qdir_ok
, "dir-ok");
4669 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4671 staticpro (&read_objects
);
4672 read_objects
= Qnil
;
4673 staticpro (&seen_list
);
4676 Vloads_in_progress
= Qnil
;
4677 staticpro (&Vloads_in_progress
);
4679 DEFSYM (Qhash_table
, "hash-table");
4680 DEFSYM (Qdata
, "data");
4681 DEFSYM (Qtest
, "test");
4682 DEFSYM (Qsize
, "size");
4683 DEFSYM (Qweakness
, "weakness");
4684 DEFSYM (Qrehash_size
, "rehash-size");
4685 DEFSYM (Qrehash_threshold
, "rehash-threshold");