1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2011 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
27 #include <limits.h> /* for CHAR_BIT */
30 #include "intervals.h"
32 #include "character.h"
39 #include "termhooks.h"
41 #include "blockinput.h"
52 #endif /* HAVE_SETLOCALE */
57 #define file_offset off_t
58 #define file_tell ftello
60 #define file_offset long
61 #define file_tell ftell
64 /* hash table read constants */
65 static Lisp_Object Qhash_table
, Qdata
;
66 static Lisp_Object Qtest
, Qsize
;
67 static Lisp_Object Qweakness
;
68 static Lisp_Object Qrehash_size
;
69 static Lisp_Object Qrehash_threshold
;
71 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
72 Lisp_Object Qstandard_input
;
73 Lisp_Object Qvariable_documentation
;
74 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
75 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
76 static Lisp_Object Qinhibit_file_name_operation
;
77 static Lisp_Object Qeval_buffer_list
;
78 static Lisp_Object Qlexical_binding
;
79 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
81 /* Used instead of Qget_file_char while loading *.elc files compiled
82 by Emacs 21 or older. */
83 static Lisp_Object Qget_emacs_mule_file_char
;
85 static Lisp_Object Qload_force_doc_strings
;
87 extern Lisp_Object Qinternal_interpreter_environment
;
89 static Lisp_Object Qload_in_progress
;
91 /* The association list of objects read with the #n=object form.
92 Each member of the list has the form (n . object), and is used to
93 look up the object for the corresponding #n# construct.
94 It must be set to nil before all top-level calls to read0. */
95 static Lisp_Object read_objects
;
97 /* Nonzero means READCHAR should read bytes one by one (not character)
98 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
99 This is set to 1 by read1 temporarily while handling #@NUMBER. */
100 static int load_each_byte
;
102 /* List of descriptors now open for Fload. */
103 static Lisp_Object load_descriptor_list
;
105 /* File for get_file_char to read from. Use by load. */
106 static FILE *instream
;
108 /* When nonzero, read conses in pure space */
109 static int read_pure
;
111 /* For use within read-from-string (this reader is non-reentrant!!) */
112 static ptrdiff_t read_from_string_index
;
113 static ptrdiff_t read_from_string_index_byte
;
114 static ptrdiff_t read_from_string_limit
;
116 /* Number of characters read in the current call to Fread or
117 Fread_from_string. */
118 static EMACS_INT readchar_count
;
120 /* This contains the last string skipped with #@. */
121 static char *saved_doc_string
;
122 /* Length of buffer allocated in saved_doc_string. */
123 static ptrdiff_t saved_doc_string_size
;
124 /* Length of actual data in saved_doc_string. */
125 static ptrdiff_t saved_doc_string_length
;
126 /* This is the file position that string came from. */
127 static file_offset saved_doc_string_position
;
129 /* This contains the previous string skipped with #@.
130 We copy it from saved_doc_string when a new string
131 is put in saved_doc_string. */
132 static char *prev_saved_doc_string
;
133 /* Length of buffer allocated in prev_saved_doc_string. */
134 static ptrdiff_t prev_saved_doc_string_size
;
135 /* Length of actual data in prev_saved_doc_string. */
136 static ptrdiff_t prev_saved_doc_string_length
;
137 /* This is the file position that string came from. */
138 static file_offset prev_saved_doc_string_position
;
140 /* Nonzero means inside a new-style backquote
141 with no surrounding parentheses.
142 Fread initializes this to zero, so we need not specbind it
143 or worry about what happens to it when there is an error. */
144 static int new_backquote_flag
;
145 static Lisp_Object Qold_style_backquotes
;
147 /* A list of file names for files being loaded in Fload. Used to
148 check for recursive loads. */
150 static Lisp_Object Vloads_in_progress
;
152 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
155 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
, int,
156 Lisp_Object
, Lisp_Object
,
157 Lisp_Object
, Lisp_Object
);
158 static Lisp_Object
load_unwind (Lisp_Object
);
159 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
161 static void invalid_syntax (const char *) NO_RETURN
;
162 static void end_of_file_error (void) NO_RETURN
;
165 /* Functions that read one byte from the current source READCHARFUN
166 or unreads one byte. If the integer argument C is -1, it returns
167 one read byte, or -1 when there's no more byte in the source. If C
168 is 0 or positive, it unreads C, and the return value is not
171 static int readbyte_for_lambda (int, Lisp_Object
);
172 static int readbyte_from_file (int, Lisp_Object
);
173 static int readbyte_from_string (int, Lisp_Object
);
175 /* Handle unreading and rereading of characters.
176 Write READCHAR to read a character,
177 UNREAD(c) to unread c to be read again.
179 These macros correctly read/unread multibyte characters. */
181 #define READCHAR readchar (readcharfun, NULL)
182 #define UNREAD(c) unreadchar (readcharfun, c)
184 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
185 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
187 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
188 Qlambda, or a cons, we use this to keep an unread character because
189 a file stream can't handle multibyte-char unreading. The value -1
190 means that there's no unread character. */
191 static int unread_char
;
194 readchar (Lisp_Object readcharfun
, int *multibyte
)
198 int (*readbyte
) (int, Lisp_Object
);
199 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
201 int emacs_mule_encoding
= 0;
208 if (BUFFERP (readcharfun
))
210 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
212 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
214 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
217 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
219 /* Fetch the character code from the buffer. */
220 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
221 BUF_INC_POS (inbuffer
, pt_byte
);
228 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
229 if (! ASCII_BYTE_P (c
))
230 c
= BYTE8_TO_CHAR (c
);
233 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
237 if (MARKERP (readcharfun
))
239 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
241 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
243 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
246 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
248 /* Fetch the character code from the buffer. */
249 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
250 BUF_INC_POS (inbuffer
, bytepos
);
257 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
258 if (! ASCII_BYTE_P (c
))
259 c
= BYTE8_TO_CHAR (c
);
263 XMARKER (readcharfun
)->bytepos
= bytepos
;
264 XMARKER (readcharfun
)->charpos
++;
269 if (EQ (readcharfun
, Qlambda
))
271 readbyte
= readbyte_for_lambda
;
275 if (EQ (readcharfun
, Qget_file_char
))
277 readbyte
= readbyte_from_file
;
281 if (STRINGP (readcharfun
))
283 if (read_from_string_index
>= read_from_string_limit
)
285 else if (STRING_MULTIBYTE (readcharfun
))
289 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
290 read_from_string_index
,
291 read_from_string_index_byte
);
295 c
= SREF (readcharfun
, read_from_string_index_byte
);
296 read_from_string_index
++;
297 read_from_string_index_byte
++;
302 if (CONSP (readcharfun
))
304 /* This is the case that read_vector is reading from a unibyte
305 string that contains a byte sequence previously skipped
306 because of #@NUMBER. The car part of readcharfun is that
307 string, and the cdr part is a value of readcharfun given to
309 readbyte
= readbyte_from_string
;
310 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
311 emacs_mule_encoding
= 1;
315 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
317 readbyte
= readbyte_from_file
;
318 emacs_mule_encoding
= 1;
322 tem
= call0 (readcharfun
);
329 if (unread_char
>= 0)
335 c
= (*readbyte
) (-1, readcharfun
);
336 if (c
< 0 || load_each_byte
)
340 if (ASCII_BYTE_P (c
))
342 if (emacs_mule_encoding
)
343 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
346 len
= BYTES_BY_CHAR_HEAD (c
);
349 c
= (*readbyte
) (-1, readcharfun
);
350 if (c
< 0 || ! TRAILING_CODE_P (c
))
353 (*readbyte
) (buf
[i
], readcharfun
);
354 return BYTE8_TO_CHAR (buf
[0]);
358 return STRING_CHAR (buf
);
361 /* Unread the character C in the way appropriate for the stream READCHARFUN.
362 If the stream is a user function, call it with the char as argument. */
365 unreadchar (Lisp_Object readcharfun
, int c
)
369 /* Don't back up the pointer if we're unreading the end-of-input mark,
370 since readchar didn't advance it when we read it. */
372 else if (BUFFERP (readcharfun
))
374 struct buffer
*b
= XBUFFER (readcharfun
);
375 ptrdiff_t charpos
= BUF_PT (b
);
376 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
378 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
379 BUF_DEC_POS (b
, bytepos
);
383 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
385 else if (MARKERP (readcharfun
))
387 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
388 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
390 XMARKER (readcharfun
)->charpos
--;
391 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
392 BUF_DEC_POS (b
, bytepos
);
396 XMARKER (readcharfun
)->bytepos
= bytepos
;
398 else if (STRINGP (readcharfun
))
400 read_from_string_index
--;
401 read_from_string_index_byte
402 = string_char_to_byte (readcharfun
, read_from_string_index
);
404 else if (CONSP (readcharfun
))
408 else if (EQ (readcharfun
, Qlambda
))
412 else if (EQ (readcharfun
, Qget_file_char
)
413 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
418 ungetc (c
, instream
);
425 call1 (readcharfun
, make_number (c
));
429 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
431 return read_bytecode_char (c
>= 0);
436 readbyte_from_file (int c
, Lisp_Object readcharfun
)
441 ungetc (c
, instream
);
450 /* Interrupted reads have been observed while reading over the network */
451 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
463 return (c
== EOF
? -1 : c
);
467 readbyte_from_string (int c
, Lisp_Object readcharfun
)
469 Lisp_Object string
= XCAR (readcharfun
);
473 read_from_string_index
--;
474 read_from_string_index_byte
475 = string_char_to_byte (string
, read_from_string_index
);
478 if (read_from_string_index
>= read_from_string_limit
)
481 FETCH_STRING_CHAR_ADVANCE (c
, string
,
482 read_from_string_index
,
483 read_from_string_index_byte
);
488 /* Read one non-ASCII character from INSTREAM. The character is
489 encoded in `emacs-mule' and the first byte is already read in
493 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
495 /* Emacs-mule coding uses at most 4-byte for one character. */
496 unsigned char buf
[4];
497 int len
= emacs_mule_bytes
[c
];
498 struct charset
*charset
;
503 /* C is not a valid leading-code of `emacs-mule'. */
504 return BYTE8_TO_CHAR (c
);
510 c
= (*readbyte
) (-1, readcharfun
);
514 (*readbyte
) (buf
[i
], readcharfun
);
515 return BYTE8_TO_CHAR (buf
[0]);
522 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
523 code
= buf
[1] & 0x7F;
527 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
528 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
530 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
531 code
= buf
[2] & 0x7F;
535 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
536 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
541 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
542 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
544 c
= DECODE_CHAR (charset
, code
);
546 Fsignal (Qinvalid_read_syntax
,
547 Fcons (build_string ("invalid multibyte form"), Qnil
));
552 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
554 static Lisp_Object
read0 (Lisp_Object
);
555 static Lisp_Object
read1 (Lisp_Object
, int *, int);
557 static Lisp_Object
read_list (int, Lisp_Object
);
558 static Lisp_Object
read_vector (Lisp_Object
, int);
560 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
562 static void substitute_object_in_subtree (Lisp_Object
,
564 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
567 /* Get a character from the tty. */
569 /* Read input events until we get one that's acceptable for our purposes.
571 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
572 until we get a character we like, and then stuffed into
575 If ASCII_REQUIRED is non-zero, we check function key events to see
576 if the unmodified version of the symbol has a Qascii_character
577 property, and use that character, if present.
579 If ERROR_NONASCII is non-zero, we signal an error if the input we
580 get isn't an ASCII character with modifiers. If it's zero but
581 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
584 If INPUT_METHOD is nonzero, we invoke the current input method
585 if the character warrants that.
587 If SECONDS is a number, we wait that many seconds for input, and
588 return Qnil if no input arrives within that time. */
591 read_filtered_event (int no_switch_frame
, int ascii_required
,
592 int error_nonascii
, int input_method
, Lisp_Object seconds
)
594 Lisp_Object val
, delayed_switch_frame
;
597 #ifdef HAVE_WINDOW_SYSTEM
598 if (display_hourglass_p
)
602 delayed_switch_frame
= Qnil
;
604 /* Compute timeout. */
605 if (NUMBERP (seconds
))
607 EMACS_TIME wait_time
;
609 double duration
= extract_float (seconds
);
612 duration_to_sec_usec (duration
, &sec
, &usec
);
616 EMACS_GET_TIME (end_time
);
617 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
618 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
621 /* Read until we get an acceptable event. */
624 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
625 NUMBERP (seconds
) ? &end_time
: NULL
);
626 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
631 /* switch-frame events are put off until after the next ASCII
632 character. This is better than signaling an error just because
633 the last characters were typed to a separate minibuffer frame,
634 for example. Eventually, some code which can deal with
635 switch-frame events will read it and process it. */
637 && EVENT_HAS_PARAMETERS (val
)
638 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
640 delayed_switch_frame
= val
;
644 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
646 /* Convert certain symbols to their ASCII equivalents. */
649 Lisp_Object tem
, tem1
;
650 tem
= Fget (val
, Qevent_symbol_element_mask
);
653 tem1
= Fget (Fcar (tem
), Qascii_character
);
654 /* Merge this symbol's modifier bits
655 with the ASCII equivalent of its basic code. */
657 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
661 /* If we don't have a character now, deal with it appropriately. */
666 Vunread_command_events
= Fcons (val
, Qnil
);
667 error ("Non-character input-event");
674 if (! NILP (delayed_switch_frame
))
675 unread_switch_frame
= delayed_switch_frame
;
679 #ifdef HAVE_WINDOW_SYSTEM
680 if (display_hourglass_p
)
689 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
690 doc
: /* Read a character from the command input (keyboard or macro).
691 It is returned as a number.
692 If the character has modifiers, they are resolved and reflected to the
693 character code if possible (e.g. C-SPC -> 0).
695 If the user generates an event which is not a character (i.e. a mouse
696 click or function key event), `read-char' signals an error. As an
697 exception, switch-frame events are put off until non-character events
699 If you want to read non-character events, or ignore them, call
700 `read-event' or `read-char-exclusive' instead.
702 If the optional argument PROMPT is non-nil, display that as a prompt.
703 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
704 input method is turned on in the current buffer, that input method
705 is used for reading a character.
706 If the optional argument SECONDS is non-nil, it should be a number
707 specifying the maximum number of seconds to wait for input. If no
708 input arrives in that time, return nil. SECONDS may be a
709 floating-point value. */)
710 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
715 message_with_string ("%s", prompt
, 0);
716 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
718 return (NILP (val
) ? Qnil
719 : make_number (char_resolve_modifier_mask (XINT (val
))));
722 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
723 doc
: /* Read an event object from the input stream.
724 If the optional argument PROMPT is non-nil, display that as a prompt.
725 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
726 input method is turned on in the current buffer, that input method
727 is used for reading a character.
728 If the optional argument SECONDS is non-nil, it should be a number
729 specifying the maximum number of seconds to wait for input. If no
730 input arrives in that time, return nil. SECONDS may be a
731 floating-point value. */)
732 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
735 message_with_string ("%s", prompt
, 0);
736 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
739 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
740 doc
: /* Read a character from the command input (keyboard or macro).
741 It is returned as a number. Non-character events are ignored.
742 If the character has modifiers, they are resolved and reflected to the
743 character code if possible (e.g. C-SPC -> 0).
745 If the optional argument PROMPT is non-nil, display that as a prompt.
746 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
747 input method is turned on in the current buffer, that input method
748 is used for reading a character.
749 If the optional argument SECONDS is non-nil, it should be a number
750 specifying the maximum number of seconds to wait for input. If no
751 input arrives in that time, return nil. SECONDS may be a
752 floating-point value. */)
753 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
758 message_with_string ("%s", prompt
, 0);
760 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
762 return (NILP (val
) ? Qnil
763 : make_number (char_resolve_modifier_mask (XINT (val
))));
766 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
767 doc
: /* Don't use this yourself. */)
770 register Lisp_Object val
;
772 XSETINT (val
, getc (instream
));
780 /* Return true if the lisp code read using READCHARFUN defines a non-nil
781 `lexical-binding' file variable. After returning, the stream is
782 positioned following the first line, if it is a comment, otherwise
786 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
790 /* The first line isn't a comment, just give up. */
796 /* Look for an appropriate file-variable in the first line. */
800 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
801 } beg_end_state
= NOMINAL
;
802 int in_file_vars
= 0;
804 #define UPDATE_BEG_END_STATE(ch) \
805 if (beg_end_state == NOMINAL) \
806 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
807 else if (beg_end_state == AFTER_FIRST_DASH) \
808 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
809 else if (beg_end_state == AFTER_ASTERIX) \
812 in_file_vars = !in_file_vars; \
813 beg_end_state = NOMINAL; \
816 /* Skip until we get to the file vars, if any. */
820 UPDATE_BEG_END_STATE (ch
);
822 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
826 char var
[100], val
[100];
831 /* Read a variable name. */
832 while (ch
== ' ' || ch
== '\t')
836 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
838 if (i
< sizeof var
- 1)
840 UPDATE_BEG_END_STATE (ch
);
844 /* Stop scanning if no colon was found before end marker. */
848 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
854 /* Read a variable value. */
857 while (ch
== ' ' || ch
== '\t')
861 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
863 if (i
< sizeof val
- 1)
865 UPDATE_BEG_END_STATE (ch
);
869 /* The value was terminated by an end-marker, which
872 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
876 if (strcmp (var
, "lexical-binding") == 0)
879 rv
= (strcmp (val
, "nil") != 0);
885 while (ch
!= '\n' && ch
!= EOF
)
892 /* Value is a version number of byte compiled code if the file
893 associated with file descriptor FD is a compiled Lisp file that's
894 safe to load. Only files compiled with Emacs are safe to load.
895 Files compiled with XEmacs can lead to a crash in Fbyte_code
896 because of an incompatible change in the byte compiler. */
899 safe_to_load_p (int fd
)
906 /* Read the first few bytes from the file, and look for a line
907 specifying the byte compiler version used. */
908 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
913 /* Skip to the next newline, skipping over the initial `ELC'
914 with NUL bytes following it, but note the version. */
915 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
920 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
927 lseek (fd
, 0, SEEK_SET
);
932 /* Callback for record_unwind_protect. Restore the old load list OLD,
933 after loading a file successfully. */
936 record_load_unwind (Lisp_Object old
)
938 return Vloads_in_progress
= old
;
941 /* This handler function is used via internal_condition_case_1. */
944 load_error_handler (Lisp_Object data
)
950 load_warn_old_style_backquotes (Lisp_Object file
)
952 if (!NILP (Vold_style_backquotes
))
955 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
962 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
963 doc
: /* Return the suffixes that `load' should try if a suffix is \
965 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
968 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
969 while (CONSP (suffixes
))
971 Lisp_Object exts
= Vload_file_rep_suffixes
;
972 suffix
= XCAR (suffixes
);
973 suffixes
= XCDR (suffixes
);
978 lst
= Fcons (concat2 (suffix
, ext
), lst
);
981 return Fnreverse (lst
);
984 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
985 doc
: /* Execute a file of Lisp code named FILE.
986 First try FILE with `.elc' appended, then try with `.el',
987 then try FILE unmodified (the exact suffixes in the exact order are
988 determined by `load-suffixes'). Environment variable references in
989 FILE are replaced with their values by calling `substitute-in-file-name'.
990 This function searches the directories in `load-path'.
992 If optional second arg NOERROR is non-nil,
993 report no error if FILE doesn't exist.
994 Print messages at start and end of loading unless
995 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
997 If optional fourth arg NOSUFFIX is non-nil, don't try adding
998 suffixes `.elc' or `.el' to the specified name FILE.
999 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1000 the suffix `.elc' or `.el'; don't accept just FILE unless
1001 it ends in one of those suffixes or includes a directory name.
1003 If this function fails to find a file, it may look for different
1004 representations of that file before trying another file.
1005 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
1006 to the file name. Emacs uses this feature mainly to find compressed
1007 versions of files when Auto Compression mode is enabled.
1009 The exact suffixes that this function tries out, in the exact order,
1010 are given by the value of the variable `load-file-rep-suffixes' if
1011 NOSUFFIX is non-nil and by the return value of the function
1012 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1013 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1014 and then the former.
1016 Loading a file records its definitions, and its `provide' and
1017 `require' calls, in an element of `load-history' whose
1018 car is the file name loaded. See `load-history'.
1020 While the file is in the process of being loaded, the variable
1021 `load-in-progress' is non-nil and the variable `load-file-name'
1022 is bound to the file's name.
1024 Return t if the file exists and loads successfully. */)
1025 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1027 register FILE *stream
;
1028 register int fd
= -1;
1029 ptrdiff_t count
= SPECPDL_INDEX ();
1030 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1031 Lisp_Object found
, efound
, hist_file_name
;
1032 /* 1 means we printed the ".el is newer" message. */
1034 /* 1 means we are loading a compiled file. */
1036 Lisp_Object handler
;
1038 const char *fmode
= "r";
1046 CHECK_STRING (file
);
1048 /* If file name is magic, call the handler. */
1049 /* This shouldn't be necessary any more now that `openp' handles it right.
1050 handler = Ffind_file_name_handler (file, Qload);
1051 if (!NILP (handler))
1052 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1054 /* Do this after the handler to avoid
1055 the need to gcpro noerror, nomessage and nosuffix.
1056 (Below here, we care only whether they are nil or not.)
1057 The presence of this call is the result of a historical accident:
1058 it used to be in every file-operation and when it got removed
1059 everywhere, it accidentally stayed here. Since then, enough people
1060 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1061 that it seemed risky to remove. */
1062 if (! NILP (noerror
))
1064 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1065 Qt
, load_error_handler
);
1070 file
= Fsubstitute_in_file_name (file
);
1073 /* Avoid weird lossage with null string as arg,
1074 since it would try to load a directory as a Lisp file */
1075 if (SBYTES (file
) > 0)
1077 ptrdiff_t size
= SBYTES (file
);
1080 GCPRO2 (file
, found
);
1082 if (! NILP (must_suffix
))
1084 /* Don't insist on adding a suffix if FILE already ends with one. */
1086 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1089 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1091 /* Don't insist on adding a suffix
1092 if the argument includes a directory name. */
1093 else if (! NILP (Ffile_name_directory (file
)))
1097 fd
= openp (Vload_path
, file
,
1098 (!NILP (nosuffix
) ? Qnil
1099 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1100 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1101 tmp
[1] = Vload_file_rep_suffixes
,
1110 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1114 /* Tell startup.el whether or not we found the user's init file. */
1115 if (EQ (Qt
, Vuser_init_file
))
1116 Vuser_init_file
= found
;
1118 /* If FD is -2, that means openp found a magic file. */
1121 if (NILP (Fequal (found
, file
)))
1122 /* If FOUND is a different file name from FILE,
1123 find its handler even if we have already inhibited
1124 the `load' operation on FILE. */
1125 handler
= Ffind_file_name_handler (found
, Qt
);
1127 handler
= Ffind_file_name_handler (found
, Qload
);
1128 if (! NILP (handler
))
1129 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1131 /* Tramp has to deal with semi-broken packages that prepend
1132 drive letters to remote files. For that reason, Tramp
1133 catches file operations that test for file existence, which
1134 makes openp think X:/foo.elc files are remote. However,
1135 Tramp does not catch `load' operations for such files, so we
1136 end up with a nil as the `load' handler above. If we would
1137 continue with fd = -2, we will behave wrongly, and in
1138 particular try reading a .elc file in the "rt" mode instead
1139 of "rb". See bug #9311 for the results. To work around
1140 this, we try to open the file locally, and go with that if it
1142 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1148 /* Check if we're stuck in a recursive load cycle.
1150 2000-09-21: It's not possible to just check for the file loaded
1151 being a member of Vloads_in_progress. This fails because of the
1152 way the byte compiler currently works; `provide's are not
1153 evaluated, see font-lock.el/jit-lock.el as an example. This
1154 leads to a certain amount of ``normal'' recursion.
1156 Also, just loading a file recursively is not always an error in
1157 the general case; the second load may do something different. */
1161 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1162 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1166 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1168 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1169 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1172 /* All loads are by default dynamic, unless the file itself specifies
1173 otherwise using a file-variable in the first line. This is bound here
1174 so that it takes effect whether or not we use
1175 Vload_source_file_function. */
1176 specbind (Qlexical_binding
, Qnil
);
1178 /* Get the name for load-history. */
1179 hist_file_name
= (! NILP (Vpurify_flag
)
1180 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1181 tmp
[1] = Ffile_name_nondirectory (found
),
1187 /* Check for the presence of old-style quotes and warn about them. */
1188 specbind (Qold_style_backquotes
, Qnil
);
1189 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1191 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1192 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1193 /* Load .elc files directly, but not when they are
1194 remote and have no handler! */
1201 GCPRO3 (file
, found
, hist_file_name
);
1204 && ! (version
= safe_to_load_p (fd
)))
1207 if (!load_dangerous_libraries
)
1211 error ("File `%s' was not compiled in Emacs",
1214 else if (!NILP (nomessage
) && !force_load_messages
)
1215 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1220 efound
= ENCODE_FILE (found
);
1225 result
= stat (SSDATA (efound
), &s1
);
1228 SSET (efound
, SBYTES (efound
) - 1, 0);
1229 result
= stat (SSDATA (efound
), &s2
);
1230 SSET (efound
, SBYTES (efound
) - 1, 'c');
1233 if (result
== 0 && s1
.st_mtime
< s2
.st_mtime
)
1235 /* Make the progress messages mention that source is newer. */
1238 /* If we won't print another message, mention this anyway. */
1239 if (!NILP (nomessage
) && !force_load_messages
)
1241 Lisp_Object msg_file
;
1242 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1243 message_with_string ("Source file `%s' newer than byte-compiled file",
1252 /* We are loading a source file (*.el). */
1253 if (!NILP (Vload_source_file_function
))
1259 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1260 NILP (noerror
) ? Qnil
: Qt
,
1261 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1262 return unbind_to (count
, val
);
1266 GCPRO3 (file
, found
, hist_file_name
);
1269 efound
= ENCODE_FILE (found
);
1270 /* If we somehow got here with fd == -2, meaning the file is deemed
1271 to be remote, don't even try to reopen the file locally; just
1272 force a failure instead. */
1276 stream
= fopen (SSDATA (efound
), fmode
);
1280 #else /* not WINDOWSNT */
1281 stream
= fdopen (fd
, fmode
);
1282 #endif /* not WINDOWSNT */
1286 error ("Failure to create stdio stream for %s", SDATA (file
));
1289 if (! NILP (Vpurify_flag
))
1290 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1292 if (NILP (nomessage
) || force_load_messages
)
1295 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1298 message_with_string ("Loading %s (source)...", file
, 1);
1300 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1302 else /* The typical case; compiled file newer than source file. */
1303 message_with_string ("Loading %s...", file
, 1);
1306 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1307 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1308 specbind (Qload_file_name
, found
);
1309 specbind (Qinhibit_file_name_operation
, Qnil
);
1310 load_descriptor_list
1311 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1312 specbind (Qload_in_progress
, Qt
);
1315 if (lisp_file_lexically_bound_p (Qget_file_char
))
1316 Fset (Qlexical_binding
, Qt
);
1318 if (! version
|| version
>= 22)
1319 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1320 0, Qnil
, Qnil
, Qnil
, Qnil
);
1323 /* We can't handle a file which was compiled with
1324 byte-compile-dynamic by older version of Emacs. */
1325 specbind (Qload_force_doc_strings
, Qt
);
1326 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1327 0, Qnil
, Qnil
, Qnil
, Qnil
);
1329 unbind_to (count
, Qnil
);
1331 /* Run any eval-after-load forms for this file */
1332 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1333 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1337 xfree (saved_doc_string
);
1338 saved_doc_string
= 0;
1339 saved_doc_string_size
= 0;
1341 xfree (prev_saved_doc_string
);
1342 prev_saved_doc_string
= 0;
1343 prev_saved_doc_string_size
= 0;
1345 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1348 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1351 message_with_string ("Loading %s (source)...done", file
, 1);
1353 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1355 else /* The typical case; compiled file newer than source file. */
1356 message_with_string ("Loading %s...done", file
, 1);
1363 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1365 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1376 load_descriptor_unwind (Lisp_Object oldlist
)
1378 load_descriptor_list
= oldlist
;
1382 /* Close all descriptors in use for Floads.
1383 This is used when starting a subprocess. */
1386 close_load_descs (void)
1390 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1391 emacs_close (XFASTINT (XCAR (tail
)));
1396 complete_filename_p (Lisp_Object pathname
)
1398 register const unsigned char *s
= SDATA (pathname
);
1399 return (IS_DIRECTORY_SEP (s
[0])
1400 || (SCHARS (pathname
) > 2
1401 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1404 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1405 doc
: /* Search for FILENAME through PATH.
1406 Returns the file's name in absolute form, or nil if not found.
1407 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1408 file name when searching.
1409 If non-nil, PREDICATE is used instead of `file-readable-p'.
1410 PREDICATE can also be an integer to pass to the access(2) function,
1411 in which case file-name-handlers are ignored.
1412 This function will normally skip directories, so if you want it to find
1413 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1414 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1417 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1418 if (NILP (predicate
) && fd
> 0)
1423 static Lisp_Object Qdir_ok
;
1425 /* Search for a file whose name is STR, looking in directories
1426 in the Lisp list PATH, and trying suffixes from SUFFIX.
1427 On success, returns a file descriptor. On failure, returns -1.
1429 SUFFIXES is a list of strings containing possible suffixes.
1430 The empty suffix is automatically added if the list is empty.
1432 PREDICATE non-nil means don't open the files,
1433 just look for one that satisfies the predicate. In this case,
1434 returns 1 on success. The predicate can be a lisp function or
1435 an integer to pass to `access' (in which case file-name-handlers
1438 If STOREPTR is nonzero, it points to a slot where the name of
1439 the file actually found should be stored as a Lisp string.
1440 nil is stored there on failure.
1442 If the file we find is remote, return -2
1443 but store the found remote file name in *STOREPTR. */
1446 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1449 ptrdiff_t fn_size
= 100;
1451 register char *fn
= buf
;
1453 ptrdiff_t want_length
;
1454 Lisp_Object filename
;
1456 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1457 Lisp_Object string
, tail
, encoded_fn
;
1458 ptrdiff_t max_suffix_len
= 0;
1462 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1464 CHECK_STRING_CAR (tail
);
1465 max_suffix_len
= max (max_suffix_len
,
1466 SBYTES (XCAR (tail
)));
1469 string
= filename
= encoded_fn
= Qnil
;
1470 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1475 if (complete_filename_p (str
))
1478 for (; CONSP (path
); path
= XCDR (path
))
1480 filename
= Fexpand_file_name (str
, XCAR (path
));
1481 if (!complete_filename_p (filename
))
1482 /* If there are non-absolute elts in PATH (eg ".") */
1483 /* Of course, this could conceivably lose if luser sets
1484 default-directory to be something non-absolute... */
1486 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1487 if (!complete_filename_p (filename
))
1488 /* Give up on this path element! */
1492 /* Calculate maximum length of any filename made from
1493 this path element/specified file name and any possible suffix. */
1494 want_length
= max_suffix_len
+ SBYTES (filename
);
1495 if (fn_size
<= want_length
)
1496 fn
= (char *) alloca (fn_size
= 100 + want_length
);
1498 /* Loop over suffixes. */
1499 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1500 CONSP (tail
); tail
= XCDR (tail
))
1502 ptrdiff_t lsuffix
= SBYTES (XCAR (tail
));
1503 Lisp_Object handler
;
1506 /* Concatenate path element/specified name with the suffix.
1507 If the directory starts with /:, remove that. */
1508 if (SCHARS (filename
) > 2
1509 && SREF (filename
, 0) == '/'
1510 && SREF (filename
, 1) == ':')
1512 strncpy (fn
, SSDATA (filename
) + 2,
1513 SBYTES (filename
) - 2);
1514 fn
[SBYTES (filename
) - 2] = 0;
1518 strncpy (fn
, SSDATA (filename
),
1520 fn
[SBYTES (filename
)] = 0;
1523 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1524 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1526 /* Check that the file exists and is not a directory. */
1527 /* We used to only check for handlers on non-absolute file names:
1531 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1532 It's not clear why that was the case and it breaks things like
1533 (load "/bar.el") where the file is actually "/bar.el.gz". */
1534 string
= build_string (fn
);
1535 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1536 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1538 if (NILP (predicate
))
1539 exists
= !NILP (Ffile_readable_p (string
));
1542 Lisp_Object tmp
= call1 (predicate
, string
);
1543 exists
= !NILP (tmp
)
1544 && (EQ (tmp
, Qdir_ok
)
1545 || NILP (Ffile_directory_p (string
)));
1550 /* We succeeded; return this descriptor and filename. */
1561 encoded_fn
= ENCODE_FILE (string
);
1562 pfn
= SSDATA (encoded_fn
);
1563 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1566 /* Check that we can access or open it. */
1567 if (NATNUMP (predicate
))
1568 fd
= (((XFASTINT (predicate
) & ~INT_MAX
) == 0
1569 && access (pfn
, XFASTINT (predicate
)) == 0)
1572 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1576 /* We succeeded; return this descriptor and filename. */
1594 /* Merge the list we've accumulated of globals from the current input source
1595 into the load_history variable. The details depend on whether
1596 the source has an associated file name or not.
1598 FILENAME is the file name that we are loading from.
1599 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1602 build_load_history (Lisp_Object filename
, int entire
)
1604 register Lisp_Object tail
, prev
, newelt
;
1605 register Lisp_Object tem
, tem2
;
1606 register int foundit
= 0;
1608 tail
= Vload_history
;
1611 while (CONSP (tail
))
1615 /* Find the feature's previous assoc list... */
1616 if (!NILP (Fequal (filename
, Fcar (tem
))))
1620 /* If we're loading the entire file, remove old data. */
1624 Vload_history
= XCDR (tail
);
1626 Fsetcdr (prev
, XCDR (tail
));
1629 /* Otherwise, cons on new symbols that are not already members. */
1632 tem2
= Vcurrent_load_list
;
1634 while (CONSP (tem2
))
1636 newelt
= XCAR (tem2
);
1638 if (NILP (Fmember (newelt
, tem
)))
1639 Fsetcar (tail
, Fcons (XCAR (tem
),
1640 Fcons (newelt
, XCDR (tem
))));
1653 /* If we're loading an entire file, cons the new assoc onto the
1654 front of load-history, the most-recently-loaded position. Also
1655 do this if we didn't find an existing member for the file. */
1656 if (entire
|| !foundit
)
1657 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1662 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1669 readevalloop_1 (Lisp_Object old
)
1671 load_convert_to_unibyte
= ! NILP (old
);
1675 /* Signal an `end-of-file' error, if possible with file name
1679 end_of_file_error (void)
1681 if (STRINGP (Vload_file_name
))
1682 xsignal1 (Qend_of_file
, Vload_file_name
);
1684 xsignal0 (Qend_of_file
);
1687 /* UNIBYTE specifies how to set load_convert_to_unibyte
1688 for this invocation.
1689 READFUN, if non-nil, is used instead of `read'.
1691 START, END specify region to read in current buffer (from eval-region).
1692 If the input is not from a buffer, they must be nil. */
1695 readevalloop (Lisp_Object readcharfun
,
1697 Lisp_Object sourcename
,
1699 Lisp_Object unibyte
, Lisp_Object readfun
,
1700 Lisp_Object start
, Lisp_Object end
)
1703 register Lisp_Object val
;
1704 ptrdiff_t count
= SPECPDL_INDEX ();
1705 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1706 struct buffer
*b
= 0;
1707 int continue_reading_p
;
1708 Lisp_Object lex_bound
;
1709 /* Nonzero if reading an entire buffer. */
1710 int whole_buffer
= 0;
1711 /* 1 on the first time around. */
1714 if (MARKERP (readcharfun
))
1717 start
= readcharfun
;
1720 if (BUFFERP (readcharfun
))
1721 b
= XBUFFER (readcharfun
);
1722 else if (MARKERP (readcharfun
))
1723 b
= XMARKER (readcharfun
)->buffer
;
1725 /* We assume START is nil when input is not from a buffer. */
1726 if (! NILP (start
) && !b
)
1729 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1730 specbind (Qcurrent_load_list
, Qnil
);
1731 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1732 load_convert_to_unibyte
= !NILP (unibyte
);
1734 /* If lexical binding is active (either because it was specified in
1735 the file's header, or via a buffer-local variable), create an empty
1736 lexical environment, otherwise, turn off lexical binding. */
1737 lex_bound
= find_symbol_value (Qlexical_binding
);
1738 specbind (Qinternal_interpreter_environment
,
1739 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1740 ? Qnil
: Fcons (Qt
, Qnil
));
1742 GCPRO4 (sourcename
, readfun
, start
, end
);
1744 /* Try to ensure sourcename is a truename, except whilst preloading. */
1745 if (NILP (Vpurify_flag
)
1746 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1747 && !NILP (Ffboundp (Qfile_truename
)))
1748 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1750 LOADHIST_ATTACH (sourcename
);
1752 continue_reading_p
= 1;
1753 while (continue_reading_p
)
1755 ptrdiff_t count1
= SPECPDL_INDEX ();
1757 if (b
!= 0 && NILP (BVAR (b
, name
)))
1758 error ("Reading from killed buffer");
1762 /* Switch to the buffer we are reading from. */
1763 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1764 set_buffer_internal (b
);
1766 /* Save point in it. */
1767 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1768 /* Save ZV in it. */
1769 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1770 /* Those get unbound after we read one expression. */
1772 /* Set point and ZV around stuff to be read. */
1775 Fnarrow_to_region (make_number (BEGV
), end
);
1777 /* Just for cleanliness, convert END to a marker
1778 if it is an integer. */
1780 end
= Fpoint_max_marker ();
1783 /* On the first cycle, we can easily test here
1784 whether we are reading the whole buffer. */
1785 if (b
&& first_sexp
)
1786 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1793 while ((c
= READCHAR
) != '\n' && c
!= -1);
1798 unbind_to (count1
, Qnil
);
1802 /* Ignore whitespace here, so we can detect eof. */
1803 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1804 || c
== 0xa0) /* NBSP */
1807 if (!NILP (Vpurify_flag
) && c
== '(')
1809 record_unwind_protect (unreadpure
, Qnil
);
1810 val
= read_list (-1, readcharfun
);
1815 read_objects
= Qnil
;
1816 if (!NILP (readfun
))
1818 val
= call1 (readfun
, readcharfun
);
1820 /* If READCHARFUN has set point to ZV, we should
1821 stop reading, even if the form read sets point
1822 to a different value when evaluated. */
1823 if (BUFFERP (readcharfun
))
1825 struct buffer
*buf
= XBUFFER (readcharfun
);
1826 if (BUF_PT (buf
) == BUF_ZV (buf
))
1827 continue_reading_p
= 0;
1830 else if (! NILP (Vload_read_function
))
1831 val
= call1 (Vload_read_function
, readcharfun
);
1833 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1836 if (!NILP (start
) && continue_reading_p
)
1837 start
= Fpoint_marker ();
1839 /* Restore saved point and BEGV. */
1840 unbind_to (count1
, Qnil
);
1842 /* Now eval what we just read. */
1843 val
= eval_sub (val
);
1847 Vvalues
= Fcons (val
, Vvalues
);
1848 if (EQ (Vstandard_output
, Qt
))
1857 build_load_history (sourcename
,
1858 stream
|| whole_buffer
);
1862 unbind_to (count
, Qnil
);
1865 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1866 doc
: /* Execute the current buffer as Lisp code.
1867 When called from a Lisp program (i.e., not interactively), this
1868 function accepts up to five optional arguments:
1869 BUFFER is the buffer to evaluate (nil means use current buffer).
1870 PRINTFLAG controls printing of output:
1871 A value of nil means discard it; anything else is stream for print.
1872 FILENAME specifies the file name to use for `load-history'.
1873 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1875 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1876 functions should work normally even if PRINTFLAG is nil.
1878 This function preserves the position of point. */)
1879 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1881 ptrdiff_t count
= SPECPDL_INDEX ();
1882 Lisp_Object tem
, buf
;
1885 buf
= Fcurrent_buffer ();
1887 buf
= Fget_buffer (buffer
);
1889 error ("No such buffer");
1891 if (NILP (printflag
) && NILP (do_allow_print
))
1896 if (NILP (filename
))
1897 filename
= BVAR (XBUFFER (buf
), filename
);
1899 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1900 specbind (Qstandard_output
, tem
);
1901 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1902 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1903 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1904 readevalloop (buf
, 0, filename
,
1905 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1906 unbind_to (count
, Qnil
);
1911 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1912 doc
: /* Execute the region as Lisp code.
1913 When called from programs, expects two arguments,
1914 giving starting and ending indices in the current buffer
1915 of the text to be executed.
1916 Programs can pass third argument PRINTFLAG which controls output:
1917 A value of nil means discard it; anything else is stream for printing it.
1918 Also the fourth argument READ-FUNCTION, if non-nil, is used
1919 instead of `read' to read each expression. It gets one argument
1920 which is the input stream for reading characters.
1922 This function does not move point. */)
1923 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1925 /* FIXME: Do the eval-sexp-add-defvars danse! */
1926 ptrdiff_t count
= SPECPDL_INDEX ();
1927 Lisp_Object tem
, cbuf
;
1929 cbuf
= Fcurrent_buffer ();
1931 if (NILP (printflag
))
1935 specbind (Qstandard_output
, tem
);
1936 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1938 /* readevalloop calls functions which check the type of start and end. */
1939 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1940 !NILP (printflag
), Qnil
, read_function
,
1943 return unbind_to (count
, Qnil
);
1947 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1948 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1949 If STREAM is nil, use the value of `standard-input' (which see).
1950 STREAM or the value of `standard-input' may be:
1951 a buffer (read from point and advance it)
1952 a marker (read from where it points and advance it)
1953 a function (call it with no arguments for each character,
1954 call it with a char as argument to push a char back)
1955 a string (takes text from string, starting at the beginning)
1956 t (read text line using minibuffer and use it, or read from
1957 standard input in batch mode). */)
1958 (Lisp_Object stream
)
1961 stream
= Vstandard_input
;
1962 if (EQ (stream
, Qt
))
1963 stream
= Qread_char
;
1964 if (EQ (stream
, Qread_char
))
1965 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1967 return read_internal_start (stream
, Qnil
, Qnil
);
1970 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1971 doc
: /* Read one Lisp expression which is represented as text by STRING.
1972 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1973 FINAL-STRING-INDEX is an integer giving the position of the next
1974 remaining character in STRING.
1975 START and END optionally delimit a substring of STRING from which to read;
1976 they default to 0 and (length STRING) respectively. */)
1977 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1980 CHECK_STRING (string
);
1981 /* read_internal_start sets read_from_string_index. */
1982 ret
= read_internal_start (string
, start
, end
);
1983 return Fcons (ret
, make_number (read_from_string_index
));
1986 /* Function to set up the global context we need in toplevel read
1989 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1990 /* start, end only used when stream is a string. */
1995 new_backquote_flag
= 0;
1996 read_objects
= Qnil
;
1997 if (EQ (Vread_with_symbol_positions
, Qt
)
1998 || EQ (Vread_with_symbol_positions
, stream
))
1999 Vread_symbol_positions_list
= Qnil
;
2001 if (STRINGP (stream
)
2002 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2004 ptrdiff_t startval
, endval
;
2007 if (STRINGP (stream
))
2010 string
= XCAR (stream
);
2013 endval
= SCHARS (string
);
2017 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2018 args_out_of_range (string
, end
);
2019 endval
= XINT (end
);
2026 CHECK_NUMBER (start
);
2027 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2028 args_out_of_range (string
, start
);
2029 startval
= XINT (start
);
2031 read_from_string_index
= startval
;
2032 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2033 read_from_string_limit
= endval
;
2036 retval
= read0 (stream
);
2037 if (EQ (Vread_with_symbol_positions
, Qt
)
2038 || EQ (Vread_with_symbol_positions
, stream
))
2039 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2044 /* Signal Qinvalid_read_syntax error.
2045 S is error string of length N (if > 0) */
2048 invalid_syntax (const char *s
)
2050 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2054 /* Use this for recursive reads, in contexts where internal tokens
2058 read0 (Lisp_Object readcharfun
)
2060 register Lisp_Object val
;
2063 val
= read1 (readcharfun
, &c
, 0);
2067 xsignal1 (Qinvalid_read_syntax
,
2068 Fmake_string (make_number (1), make_number (c
)));
2071 static ptrdiff_t read_buffer_size
;
2072 static char *read_buffer
;
2074 /* Read a \-escape sequence, assuming we already read the `\'.
2075 If the escape sequence forces unibyte, return eight-bit char. */
2078 read_escape (Lisp_Object readcharfun
, int stringp
)
2080 register int c
= READCHAR
;
2081 /* \u allows up to four hex digits, \U up to eight. Default to the
2082 behavior for \u, and change this value in the case that \U is seen. */
2083 int unicode_hex_count
= 4;
2088 end_of_file_error ();
2118 error ("Invalid escape character syntax");
2121 c
= read_escape (readcharfun
, 0);
2122 return c
| meta_modifier
;
2127 error ("Invalid escape character syntax");
2130 c
= read_escape (readcharfun
, 0);
2131 return c
| shift_modifier
;
2136 error ("Invalid escape character syntax");
2139 c
= read_escape (readcharfun
, 0);
2140 return c
| hyper_modifier
;
2145 error ("Invalid escape character syntax");
2148 c
= read_escape (readcharfun
, 0);
2149 return c
| alt_modifier
;
2153 if (stringp
|| c
!= '-')
2160 c
= read_escape (readcharfun
, 0);
2161 return c
| super_modifier
;
2166 error ("Invalid escape character syntax");
2170 c
= read_escape (readcharfun
, 0);
2171 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2172 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2173 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2174 return c
| ctrl_modifier
;
2175 /* ASCII control chars are made from letters (both cases),
2176 as well as the non-letters within 0100...0137. */
2177 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2178 return (c
& (037 | ~0177));
2179 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2180 return (c
& (037 | ~0177));
2182 return c
| ctrl_modifier
;
2192 /* An octal escape, as in ANSI C. */
2194 register int i
= c
- '0';
2195 register int count
= 0;
2198 if ((c
= READCHAR
) >= '0' && c
<= '7')
2210 if (i
>= 0x80 && i
< 0x100)
2211 i
= BYTE8_TO_CHAR (i
);
2216 /* A hex escape, as in ANSI C. */
2223 if (c
>= '0' && c
<= '9')
2228 else if ((c
>= 'a' && c
<= 'f')
2229 || (c
>= 'A' && c
<= 'F'))
2232 if (c
>= 'a' && c
<= 'f')
2242 /* Allow hex escapes as large as ?\xfffffff, because some
2243 packages use them to denote characters with modifiers. */
2244 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2245 error ("Hex character out of range: \\x%x...", i
);
2249 if (count
< 3 && i
>= 0x80)
2250 return BYTE8_TO_CHAR (i
);
2255 /* Post-Unicode-2.0: Up to eight hex chars. */
2256 unicode_hex_count
= 8;
2259 /* A Unicode escape. We only permit them in strings and characters,
2260 not arbitrarily in the source code, as in some other languages. */
2265 while (++count
<= unicode_hex_count
)
2268 /* isdigit and isalpha may be locale-specific, which we don't
2270 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2271 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2272 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2274 error ("Non-hex digit used for Unicode escape");
2277 error ("Non-Unicode character: 0x%x", i
);
2286 /* Return the digit that CHARACTER stands for in the given BASE.
2287 Return -1 if CHARACTER is out of range for BASE,
2288 and -2 if CHARACTER is not valid for any supported BASE. */
2290 digit_to_number (int character
, int base
)
2294 if ('0' <= character
&& character
<= '9')
2295 digit
= character
- '0';
2296 else if ('a' <= character
&& character
<= 'z')
2297 digit
= character
- 'a' + 10;
2298 else if ('A' <= character
&& character
<= 'Z')
2299 digit
= character
- 'A' + 10;
2303 return digit
< base
? digit
: -1;
2306 /* Read an integer in radix RADIX using READCHARFUN to read
2307 characters. RADIX must be in the interval [2..36]; if it isn't, a
2308 read error is signaled . Value is the integer read. Signals an
2309 error if encountering invalid read syntax or if RADIX is out of
2313 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2315 /* Room for sign, leading 0, other digits, trailing null byte.
2316 Also, room for invalid syntax diagnostic. */
2317 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2318 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2320 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2322 if (radix
< 2 || radix
> 36)
2330 if (c
== '-' || c
== '+')
2341 /* Ignore redundant leading zeros, so the buffer doesn't
2342 fill up with them. */
2348 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2355 if (p
< buf
+ sizeof buf
- 1)
2369 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2370 invalid_syntax (buf
);
2373 return string_to_number (buf
, radix
, 0);
2377 /* If the next token is ')' or ']' or '.', we store that character
2378 in *PCH and the return value is not interesting. Else, we store
2379 zero in *PCH and we read and return one lisp object.
2381 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2384 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2387 unsigned uninterned_symbol
= 0;
2395 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2397 end_of_file_error ();
2402 return read_list (0, readcharfun
);
2405 return read_vector (readcharfun
, 0);
2421 /* Accept extended format for hashtables (extensible to
2423 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2424 Lisp_Object tmp
= read_list (0, readcharfun
);
2425 Lisp_Object head
= CAR_SAFE (tmp
);
2426 Lisp_Object data
= Qnil
;
2427 Lisp_Object val
= Qnil
;
2428 /* The size is 2 * number of allowed keywords to
2430 Lisp_Object params
[10];
2432 Lisp_Object key
= Qnil
;
2433 int param_count
= 0;
2435 if (!EQ (head
, Qhash_table
))
2436 error ("Invalid extended read marker at head of #s list "
2437 "(only hash-table allowed)");
2439 tmp
= CDR_SAFE (tmp
);
2441 /* This is repetitive but fast and simple. */
2442 params
[param_count
] = QCsize
;
2443 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2444 if (!NILP (params
[param_count
+ 1]))
2447 params
[param_count
] = QCtest
;
2448 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2449 if (!NILP (params
[param_count
+ 1]))
2452 params
[param_count
] = QCweakness
;
2453 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2454 if (!NILP (params
[param_count
+ 1]))
2457 params
[param_count
] = QCrehash_size
;
2458 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2459 if (!NILP (params
[param_count
+ 1]))
2462 params
[param_count
] = QCrehash_threshold
;
2463 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2464 if (!NILP (params
[param_count
+ 1]))
2467 /* This is the hashtable data. */
2468 data
= Fplist_get (tmp
, Qdata
);
2470 /* Now use params to make a new hashtable and fill it. */
2471 ht
= Fmake_hash_table (param_count
, params
);
2473 while (CONSP (data
))
2478 error ("Odd number of elements in hashtable data");
2481 Fputhash (key
, val
, ht
);
2487 invalid_syntax ("#");
2495 tmp
= read_vector (readcharfun
, 0);
2496 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2497 error ("Invalid size char-table");
2498 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2510 tmp
= read_vector (readcharfun
, 0);
2511 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2512 error ("Invalid depth in char-table");
2513 depth
= XINT (AREF (tmp
, 0));
2514 size
= ASIZE (tmp
) - 2;
2515 if (chartab_size
[depth
] != size
)
2516 error ("Invalid size char-table");
2517 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2520 invalid_syntax ("#^^");
2522 invalid_syntax ("#^");
2527 length
= read1 (readcharfun
, pch
, first_in_list
);
2531 Lisp_Object tmp
, val
;
2532 EMACS_INT size_in_chars
2533 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2534 / BOOL_VECTOR_BITS_PER_CHAR
);
2537 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2538 if (STRING_MULTIBYTE (tmp
)
2539 || (size_in_chars
!= SCHARS (tmp
)
2540 /* We used to print 1 char too many
2541 when the number of bits was a multiple of 8.
2542 Accept such input in case it came from an old
2544 && ! (XFASTINT (length
)
2545 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2546 invalid_syntax ("#&...");
2548 val
= Fmake_bool_vector (length
, Qnil
);
2549 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2550 /* Clear the extraneous bits in the last byte. */
2551 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2552 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2553 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2556 invalid_syntax ("#&...");
2560 /* Accept compiled functions at read-time so that we don't have to
2561 build them using function calls. */
2563 tmp
= read_vector (readcharfun
, 1);
2564 return Fmake_byte_code (ASIZE (tmp
),
2565 XVECTOR (tmp
)->contents
);
2570 struct gcpro gcpro1
;
2573 /* Read the string itself. */
2574 tmp
= read1 (readcharfun
, &ch
, 0);
2575 if (ch
!= 0 || !STRINGP (tmp
))
2576 invalid_syntax ("#");
2578 /* Read the intervals and their properties. */
2581 Lisp_Object beg
, end
, plist
;
2583 beg
= read1 (readcharfun
, &ch
, 0);
2588 end
= read1 (readcharfun
, &ch
, 0);
2590 plist
= read1 (readcharfun
, &ch
, 0);
2592 invalid_syntax ("Invalid string property list");
2593 Fset_text_properties (beg
, end
, plist
, tmp
);
2599 /* #@NUMBER is used to skip NUMBER following characters.
2600 That's used in .elc files to skip over doc strings
2601 and function definitions. */
2604 enum { extra
= 100 };
2605 ptrdiff_t i
, nskip
= 0;
2608 /* Read a decimal integer. */
2609 while ((c
= READCHAR
) >= 0
2610 && c
>= '0' && c
<= '9')
2612 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2619 if (load_force_doc_strings
2620 && (EQ (readcharfun
, Qget_file_char
)
2621 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2623 /* If we are supposed to force doc strings into core right now,
2624 record the last string that we skipped,
2625 and record where in the file it comes from. */
2627 /* But first exchange saved_doc_string
2628 with prev_saved_doc_string, so we save two strings. */
2630 char *temp
= saved_doc_string
;
2631 ptrdiff_t temp_size
= saved_doc_string_size
;
2632 file_offset temp_pos
= saved_doc_string_position
;
2633 ptrdiff_t temp_len
= saved_doc_string_length
;
2635 saved_doc_string
= prev_saved_doc_string
;
2636 saved_doc_string_size
= prev_saved_doc_string_size
;
2637 saved_doc_string_position
= prev_saved_doc_string_position
;
2638 saved_doc_string_length
= prev_saved_doc_string_length
;
2640 prev_saved_doc_string
= temp
;
2641 prev_saved_doc_string_size
= temp_size
;
2642 prev_saved_doc_string_position
= temp_pos
;
2643 prev_saved_doc_string_length
= temp_len
;
2646 if (saved_doc_string_size
== 0)
2648 saved_doc_string
= (char *) xmalloc (nskip
+ extra
);
2649 saved_doc_string_size
= nskip
+ extra
;
2651 if (nskip
> saved_doc_string_size
)
2653 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2655 saved_doc_string_size
= nskip
+ extra
;
2658 saved_doc_string_position
= file_tell (instream
);
2660 /* Copy that many characters into saved_doc_string. */
2661 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2662 saved_doc_string
[i
] = c
= READCHAR
;
2664 saved_doc_string_length
= i
;
2668 /* Skip that many characters. */
2669 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2678 /* #! appears at the beginning of an executable file.
2679 Skip the first line. */
2680 while (c
!= '\n' && c
>= 0)
2685 return Vload_file_name
;
2687 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2688 /* #:foo is the uninterned symbol named foo. */
2691 uninterned_symbol
= 1;
2694 && c
!= 0xa0 /* NBSP */
2696 || strchr ("\"';()[]#`,", c
) == NULL
)))
2698 /* No symbol character follows, this is the empty
2701 return Fmake_symbol (build_string (""));
2705 /* ## is the empty symbol. */
2707 return Fintern (build_string (""), Qnil
);
2708 /* Reader forms that can reuse previously read objects. */
2709 if (c
>= '0' && c
<= '9')
2714 /* Read a non-negative integer. */
2715 while (c
>= '0' && c
<= '9')
2717 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2718 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2719 n
= MOST_POSITIVE_FIXNUM
+ 1;
2721 n
= n
* 10 + c
- '0';
2725 if (n
<= MOST_POSITIVE_FIXNUM
)
2727 if (c
== 'r' || c
== 'R')
2728 return read_integer (readcharfun
, n
);
2730 if (! NILP (Vread_circle
))
2732 /* #n=object returns object, but associates it with
2736 /* Make a placeholder for #n# to use temporarily */
2737 Lisp_Object placeholder
;
2740 placeholder
= Fcons (Qnil
, Qnil
);
2741 cell
= Fcons (make_number (n
), placeholder
);
2742 read_objects
= Fcons (cell
, read_objects
);
2744 /* Read the object itself. */
2745 tem
= read0 (readcharfun
);
2747 /* Now put it everywhere the placeholder was... */
2748 substitute_object_in_subtree (tem
, placeholder
);
2750 /* ...and #n# will use the real value from now on. */
2751 Fsetcdr (cell
, tem
);
2756 /* #n# returns a previously read object. */
2759 tem
= Fassq (make_number (n
), read_objects
);
2765 /* Fall through to error message. */
2767 else if (c
== 'x' || c
== 'X')
2768 return read_integer (readcharfun
, 16);
2769 else if (c
== 'o' || c
== 'O')
2770 return read_integer (readcharfun
, 8);
2771 else if (c
== 'b' || c
== 'B')
2772 return read_integer (readcharfun
, 2);
2775 invalid_syntax ("#");
2778 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2783 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2788 int next_char
= READCHAR
;
2790 /* Transition from old-style to new-style:
2791 If we see "(`" it used to mean old-style, which usually works
2792 fine because ` should almost never appear in such a position
2793 for new-style. But occasionally we need "(`" to mean new
2794 style, so we try to distinguish the two by the fact that we
2795 can either write "( `foo" or "(` foo", where the first
2796 intends to use new-style whereas the second intends to use
2797 old-style. For Emacs-25, we should completely remove this
2798 first_in_list exception (old-style can still be obtained via
2800 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2802 Vold_style_backquotes
= Qt
;
2809 new_backquote_flag
++;
2810 value
= read0 (readcharfun
);
2811 new_backquote_flag
--;
2813 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2818 int next_char
= READCHAR
;
2820 /* Transition from old-style to new-style:
2821 It used to be impossible to have a new-style , other than within
2822 a new-style `. This is sufficient when ` and , are used in the
2823 normal way, but ` and , can also appear in args to macros that
2824 will not interpret them in the usual way, in which case , may be
2825 used without any ` anywhere near.
2826 So we now use the same heuristic as for backquote: old-style
2827 unquotes are only recognized when first on a list, and when
2828 followed by a space.
2829 Because it's more difficult to peak 2 chars ahead, a new-style
2830 ,@ can still not be used outside of a `, unless it's in the middle
2832 if (new_backquote_flag
2834 || (next_char
!= ' ' && next_char
!= '@'))
2836 Lisp_Object comma_type
= Qnil
;
2841 comma_type
= Qcomma_at
;
2843 comma_type
= Qcomma_dot
;
2846 if (ch
>= 0) UNREAD (ch
);
2847 comma_type
= Qcomma
;
2850 value
= read0 (readcharfun
);
2851 return Fcons (comma_type
, Fcons (value
, Qnil
));
2855 Vold_style_backquotes
= Qt
;
2867 end_of_file_error ();
2869 /* Accept `single space' syntax like (list ? x) where the
2870 whitespace character is SPC or TAB.
2871 Other literal whitespace like NL, CR, and FF are not accepted,
2872 as there are well-established escape sequences for these. */
2873 if (c
== ' ' || c
== '\t')
2874 return make_number (c
);
2877 c
= read_escape (readcharfun
, 0);
2878 modifiers
= c
& CHAR_MODIFIER_MASK
;
2879 c
&= ~CHAR_MODIFIER_MASK
;
2880 if (CHAR_BYTE8_P (c
))
2881 c
= CHAR_TO_BYTE8 (c
);
2884 next_char
= READCHAR
;
2885 ok
= (next_char
<= 040
2886 || (next_char
< 0200
2887 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2890 return make_number (c
);
2892 invalid_syntax ("?");
2897 char *p
= read_buffer
;
2898 char *end
= read_buffer
+ read_buffer_size
;
2900 /* Nonzero if we saw an escape sequence specifying
2901 a multibyte character. */
2902 int force_multibyte
= 0;
2903 /* Nonzero if we saw an escape sequence specifying
2904 a single-byte character. */
2905 int force_singlebyte
= 0;
2907 ptrdiff_t nchars
= 0;
2909 while ((ch
= READCHAR
) >= 0
2912 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2914 ptrdiff_t offset
= p
- read_buffer
;
2915 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2916 memory_full (SIZE_MAX
);
2917 read_buffer
= (char *) xrealloc (read_buffer
,
2918 read_buffer_size
* 2);
2919 read_buffer_size
*= 2;
2920 p
= read_buffer
+ offset
;
2921 end
= read_buffer
+ read_buffer_size
;
2928 ch
= read_escape (readcharfun
, 1);
2930 /* CH is -1 if \ newline has just been seen */
2933 if (p
== read_buffer
)
2938 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2939 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2941 if (CHAR_BYTE8_P (ch
))
2942 force_singlebyte
= 1;
2943 else if (! ASCII_CHAR_P (ch
))
2944 force_multibyte
= 1;
2945 else /* i.e. ASCII_CHAR_P (ch) */
2947 /* Allow `\C- ' and `\C-?'. */
2948 if (modifiers
== CHAR_CTL
)
2951 ch
= 0, modifiers
= 0;
2953 ch
= 127, modifiers
= 0;
2955 if (modifiers
& CHAR_SHIFT
)
2957 /* Shift modifier is valid only with [A-Za-z]. */
2958 if (ch
>= 'A' && ch
<= 'Z')
2959 modifiers
&= ~CHAR_SHIFT
;
2960 else if (ch
>= 'a' && ch
<= 'z')
2961 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2964 if (modifiers
& CHAR_META
)
2966 /* Move the meta bit to the right place for a
2968 modifiers
&= ~CHAR_META
;
2969 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2970 force_singlebyte
= 1;
2974 /* Any modifiers remaining are invalid. */
2976 error ("Invalid modifier in string");
2977 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2981 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2982 if (CHAR_BYTE8_P (ch
))
2983 force_singlebyte
= 1;
2984 else if (! ASCII_CHAR_P (ch
))
2985 force_multibyte
= 1;
2991 end_of_file_error ();
2993 /* If purifying, and string starts with \ newline,
2994 return zero instead. This is for doc strings
2995 that we are really going to find in etc/DOC.nn.nn */
2996 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2997 return make_number (0);
2999 if (force_multibyte
)
3000 /* READ_BUFFER already contains valid multibyte forms. */
3002 else if (force_singlebyte
)
3004 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3006 p
= read_buffer
+ nchars
;
3010 /* Otherwise, READ_BUFFER contains only ASCII. */
3014 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
3016 || (p
- read_buffer
!= nchars
)));
3017 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3019 || (p
- read_buffer
!= nchars
)));
3024 int next_char
= READCHAR
;
3027 if (next_char
<= 040
3028 || (next_char
< 0200
3029 && strchr ("\"';([#?`,", next_char
) != NULL
))
3035 /* Otherwise, we fall through! Note that the atom-reading loop
3036 below will now loop at least once, assuring that we will not
3037 try to UNREAD two characters in a row. */
3041 if (c
<= 040) goto retry
;
3042 if (c
== 0xa0) /* NBSP */
3047 char *p
= read_buffer
;
3049 EMACS_INT start_position
= readchar_count
- 1;
3052 char *end
= read_buffer
+ read_buffer_size
;
3056 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3058 ptrdiff_t offset
= p
- read_buffer
;
3059 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3060 memory_full (SIZE_MAX
);
3061 read_buffer
= (char *) xrealloc (read_buffer
,
3062 read_buffer_size
* 2);
3063 read_buffer_size
*= 2;
3064 p
= read_buffer
+ offset
;
3065 end
= read_buffer
+ read_buffer_size
;
3072 end_of_file_error ();
3077 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3083 && c
!= 0xa0 /* NBSP */
3085 || strchr ("\"';()[]#`,", c
) == NULL
));
3089 ptrdiff_t offset
= p
- read_buffer
;
3090 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3091 memory_full (SIZE_MAX
);
3092 read_buffer
= (char *) xrealloc (read_buffer
,
3093 read_buffer_size
* 2);
3094 read_buffer_size
*= 2;
3095 p
= read_buffer
+ offset
;
3096 end
= read_buffer
+ read_buffer_size
;
3102 if (!quoted
&& !uninterned_symbol
)
3104 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3105 if (! NILP (result
))
3109 Lisp_Object name
, result
;
3110 ptrdiff_t nbytes
= p
- read_buffer
;
3113 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3117 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3118 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3120 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3121 result
= (uninterned_symbol
? Fmake_symbol (name
)
3122 : Fintern (name
, Qnil
));
3124 if (EQ (Vread_with_symbol_positions
, Qt
)
3125 || EQ (Vread_with_symbol_positions
, readcharfun
))
3126 Vread_symbol_positions_list
=
3127 Fcons (Fcons (result
, make_number (start_position
)),
3128 Vread_symbol_positions_list
);
3136 /* List of nodes we've seen during substitute_object_in_subtree. */
3137 static Lisp_Object seen_list
;
3140 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3142 Lisp_Object check_object
;
3144 /* We haven't seen any objects when we start. */
3147 /* Make all the substitutions. */
3149 = substitute_object_recurse (object
, placeholder
, object
);
3151 /* Clear seen_list because we're done with it. */
3154 /* The returned object here is expected to always eq the
3156 if (!EQ (check_object
, object
))
3157 error ("Unexpected mutation error in reader");
3160 /* Feval doesn't get called from here, so no gc protection is needed. */
3161 #define SUBSTITUTE(get_val, set_val) \
3163 Lisp_Object old_value = get_val; \
3164 Lisp_Object true_value \
3165 = substitute_object_recurse (object, placeholder, \
3168 if (!EQ (old_value, true_value)) \
3175 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3177 /* If we find the placeholder, return the target object. */
3178 if (EQ (placeholder
, subtree
))
3181 /* If we've been to this node before, don't explore it again. */
3182 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3185 /* If this node can be the entry point to a cycle, remember that
3186 we've seen it. It can only be such an entry point if it was made
3187 by #n=, which means that we can find it as a value in
3189 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3190 seen_list
= Fcons (subtree
, seen_list
);
3192 /* Recurse according to subtree's type.
3193 Every branch must return a Lisp_Object. */
3194 switch (XTYPE (subtree
))
3196 case Lisp_Vectorlike
:
3198 ptrdiff_t i
, length
= 0;
3199 if (BOOL_VECTOR_P (subtree
))
3200 return subtree
; /* No sub-objects anyway. */
3201 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3202 || COMPILEDP (subtree
))
3203 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3204 else if (VECTORP (subtree
))
3205 length
= ASIZE (subtree
);
3207 /* An unknown pseudovector may contain non-Lisp fields, so we
3208 can't just blindly traverse all its fields. We used to call
3209 `Flength' which signaled `sequencep', so I just preserved this
3211 wrong_type_argument (Qsequencep
, subtree
);
3213 for (i
= 0; i
< length
; i
++)
3214 SUBSTITUTE (AREF (subtree
, i
),
3215 ASET (subtree
, i
, true_value
));
3221 SUBSTITUTE (XCAR (subtree
),
3222 XSETCAR (subtree
, true_value
));
3223 SUBSTITUTE (XCDR (subtree
),
3224 XSETCDR (subtree
, true_value
));
3230 /* Check for text properties in each interval.
3231 substitute_in_interval contains part of the logic. */
3233 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3234 Lisp_Object arg
= Fcons (object
, placeholder
);
3236 traverse_intervals_noorder (root_interval
,
3237 &substitute_in_interval
, arg
);
3242 /* Other types don't recurse any further. */
3248 /* Helper function for substitute_object_recurse. */
3250 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3252 Lisp_Object object
= Fcar (arg
);
3253 Lisp_Object placeholder
= Fcdr (arg
);
3255 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3265 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3266 integer syntax and fits in a fixnum, else return the nearest float if CP has
3267 either floating point or integer syntax and BASE is 10, else return nil. If
3268 IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
3269 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3270 number has integer syntax but does not fit. */
3273 string_to_number (char const *string
, int base
, int ignore_trailing
)
3276 char const *cp
= string
;
3278 int float_syntax
= 0;
3281 /* Compute NaN and infinities using a variable, to cope with compilers that
3282 think they are smarter than we are. */
3285 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3286 IEEE floating point hosts, and works around a formerly-common bug where
3287 atof ("-0.0") drops the sign. */
3288 int negative
= *cp
== '-';
3290 int signedp
= negative
|| *cp
== '+';
3295 leading_digit
= digit_to_number (*cp
, base
);
3296 if (0 <= leading_digit
)
3301 while (0 <= digit_to_number (*cp
, base
));
3311 if ('0' <= *cp
&& *cp
<= '9')
3316 while ('0' <= *cp
&& *cp
<= '9');
3318 if (*cp
== 'e' || *cp
== 'E')
3320 char const *ecp
= cp
;
3322 if (*cp
== '+' || *cp
== '-')
3324 if ('0' <= *cp
&& *cp
<= '9')
3329 while ('0' <= *cp
&& *cp
<= '9');
3331 else if (cp
[-1] == '+'
3332 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3338 else if (cp
[-1] == '+'
3339 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3343 value
= zero
/ zero
;
3345 /* If that made a "negative" NaN, negate it. */
3348 union { double d
; char c
[sizeof (double)]; }
3349 u_data
, u_minus_zero
;
3351 u_minus_zero
.d
= -0.0;
3352 for (i
= 0; i
< sizeof (double); i
++)
3353 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3359 /* Now VALUE is a positive NaN. */
3365 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3366 || state
== (LEAD_INT
|E_EXP
));
3369 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3370 any prefix that matches. Otherwise, the entire string must match. */
3371 if (! (ignore_trailing
3372 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3373 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3376 /* If the number uses integer and not float syntax, and is in C-language
3377 range, use its value, preferably as a fixnum. */
3378 if (0 <= leading_digit
&& ! float_syntax
)
3382 /* Fast special case for single-digit integers. This also avoids a
3383 glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
3384 case some versions of strtoumax accept numbers like "0x1" that Emacs
3386 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3387 return make_number (negative
? -leading_digit
: leading_digit
);
3390 n
= strtoumax (string
+ signedp
, NULL
, base
);
3391 if (errno
== ERANGE
)
3393 /* Unfortunately there's no simple and accurate way to convert
3394 non-base-10 numbers that are out of C-language range. */
3396 xsignal1 (Qoverflow_error
, build_string (string
));
3398 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3400 EMACS_INT signed_n
= n
;
3401 return make_number (negative
? -signed_n
: signed_n
);
3407 /* Either the number uses float syntax, or it does not fit into a fixnum.
3408 Convert it from string to floating point, unless the value is already
3409 known because it is an infinity, a NAN, or its absolute value fits in
3412 value
= atof (string
+ signedp
);
3414 return make_float (negative
? -value
: value
);
3419 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3422 register Lisp_Object
*ptr
;
3423 register Lisp_Object tem
, item
, vector
;
3424 register struct Lisp_Cons
*otem
;
3427 tem
= read_list (1, readcharfun
);
3428 len
= Flength (tem
);
3429 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3431 size
= ASIZE (vector
);
3432 ptr
= XVECTOR (vector
)->contents
;
3433 for (i
= 0; i
< size
; i
++)
3436 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3437 bytecode object, the docstring containing the bytecode and
3438 constants values must be treated as unibyte and passed to
3439 Fread, to get the actual bytecode string and constants vector. */
3440 if (bytecodeflag
&& load_force_doc_strings
)
3442 if (i
== COMPILED_BYTECODE
)
3444 if (!STRINGP (item
))
3445 error ("Invalid byte code");
3447 /* Delay handling the bytecode slot until we know whether
3448 it is lazily-loaded (we can tell by whether the
3449 constants slot is nil). */
3450 ptr
[COMPILED_CONSTANTS
] = item
;
3453 else if (i
== COMPILED_CONSTANTS
)
3455 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3459 /* Coerce string to unibyte (like string-as-unibyte,
3460 but without generating extra garbage and
3461 guaranteeing no change in the contents). */
3462 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3463 STRING_SET_UNIBYTE (bytestr
);
3465 item
= Fread (Fcons (bytestr
, readcharfun
));
3467 error ("Invalid byte code");
3469 otem
= XCONS (item
);
3470 bytestr
= XCAR (item
);
3475 /* Now handle the bytecode slot. */
3476 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3478 else if (i
== COMPILED_DOC_STRING
3480 && ! STRING_MULTIBYTE (item
))
3482 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3483 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3485 item
= Fstring_as_multibyte (item
);
3488 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3496 /* FLAG = 1 means check for ] to terminate rather than ) and .
3497 FLAG = -1 means check for starting with defun
3498 and make structure pure. */
3501 read_list (int flag
, register Lisp_Object readcharfun
)
3503 /* -1 means check next element for defun,
3504 0 means don't check,
3505 1 means already checked and found defun. */
3506 int defunflag
= flag
< 0 ? -1 : 0;
3507 Lisp_Object val
, tail
;
3508 register Lisp_Object elt
, tem
;
3509 struct gcpro gcpro1
, gcpro2
;
3510 /* 0 is the normal case.
3511 1 means this list is a doc reference; replace it with the number 0.
3512 2 means this list is a doc reference; replace it with the doc string. */
3513 int doc_reference
= 0;
3515 /* Initialize this to 1 if we are reading a list. */
3516 int first_in_list
= flag
<= 0;
3525 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3530 /* While building, if the list starts with #$, treat it specially. */
3531 if (EQ (elt
, Vload_file_name
)
3533 && !NILP (Vpurify_flag
))
3535 if (NILP (Vdoc_file_name
))
3536 /* We have not yet called Snarf-documentation, so assume
3537 this file is described in the DOC-MM.NN file
3538 and Snarf-documentation will fill in the right value later.
3539 For now, replace the whole list with 0. */
3542 /* We have already called Snarf-documentation, so make a relative
3543 file name for this file, so it can be found properly
3544 in the installed Lisp directory.
3545 We don't use Fexpand_file_name because that would make
3546 the directory absolute now. */
3547 elt
= concat2 (build_string ("../lisp/"),
3548 Ffile_name_nondirectory (elt
));
3550 else if (EQ (elt
, Vload_file_name
)
3552 && load_force_doc_strings
)
3561 invalid_syntax (") or . in a vector");
3569 XSETCDR (tail
, read0 (readcharfun
));
3571 val
= read0 (readcharfun
);
3572 read1 (readcharfun
, &ch
, 0);
3576 if (doc_reference
== 1)
3577 return make_number (0);
3578 if (doc_reference
== 2)
3580 /* Get a doc string from the file we are loading.
3581 If it's in saved_doc_string, get it from there.
3583 Here, we don't know if the string is a
3584 bytecode string or a doc string. As a
3585 bytecode string must be unibyte, we always
3586 return a unibyte string. If it is actually a
3587 doc string, caller must make it
3590 EMACS_INT pos
= XINT (XCDR (val
));
3591 /* Position is negative for user variables. */
3592 if (pos
< 0) pos
= -pos
;
3593 if (pos
>= saved_doc_string_position
3594 && pos
< (saved_doc_string_position
3595 + saved_doc_string_length
))
3597 ptrdiff_t start
= pos
- saved_doc_string_position
;
3600 /* Process quoting with ^A,
3601 and find the end of the string,
3602 which is marked with ^_ (037). */
3603 for (from
= start
, to
= start
;
3604 saved_doc_string
[from
] != 037;)
3606 int c
= saved_doc_string
[from
++];
3609 c
= saved_doc_string
[from
++];
3611 saved_doc_string
[to
++] = c
;
3613 saved_doc_string
[to
++] = 0;
3615 saved_doc_string
[to
++] = 037;
3618 saved_doc_string
[to
++] = c
;
3621 return make_unibyte_string (saved_doc_string
+ start
,
3624 /* Look in prev_saved_doc_string the same way. */
3625 else if (pos
>= prev_saved_doc_string_position
3626 && pos
< (prev_saved_doc_string_position
3627 + prev_saved_doc_string_length
))
3630 pos
- prev_saved_doc_string_position
;
3633 /* Process quoting with ^A,
3634 and find the end of the string,
3635 which is marked with ^_ (037). */
3636 for (from
= start
, to
= start
;
3637 prev_saved_doc_string
[from
] != 037;)
3639 int c
= prev_saved_doc_string
[from
++];
3642 c
= prev_saved_doc_string
[from
++];
3644 prev_saved_doc_string
[to
++] = c
;
3646 prev_saved_doc_string
[to
++] = 0;
3648 prev_saved_doc_string
[to
++] = 037;
3651 prev_saved_doc_string
[to
++] = c
;
3654 return make_unibyte_string (prev_saved_doc_string
3659 return get_doc_string (val
, 1, 0);
3664 invalid_syntax (". in wrong context");
3666 invalid_syntax ("] in a list");
3668 tem
= (read_pure
&& flag
<= 0
3669 ? pure_cons (elt
, Qnil
)
3670 : Fcons (elt
, Qnil
));
3672 XSETCDR (tail
, tem
);
3677 defunflag
= EQ (elt
, Qdefun
);
3678 else if (defunflag
> 0)
3683 static Lisp_Object initial_obarray
;
3685 /* oblookup stores the bucket number here, for the sake of Funintern. */
3687 static size_t oblookup_last_bucket_number
;
3689 /* Get an error if OBARRAY is not an obarray.
3690 If it is one, return it. */
3693 check_obarray (Lisp_Object obarray
)
3695 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3697 /* If Vobarray is now invalid, force it to be valid. */
3698 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3699 wrong_type_argument (Qvectorp
, obarray
);
3704 /* Intern the C string STR: return a symbol with that name,
3705 interned in the current obarray. */
3708 intern (const char *str
)
3711 ptrdiff_t len
= strlen (str
);
3712 Lisp_Object obarray
;
3715 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3716 obarray
= check_obarray (obarray
);
3717 tem
= oblookup (obarray
, str
, len
, len
);
3720 return Fintern (make_string (str
, len
), obarray
);
3724 intern_c_string (const char *str
)
3727 ptrdiff_t len
= strlen (str
);
3728 Lisp_Object obarray
;
3731 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3732 obarray
= check_obarray (obarray
);
3733 tem
= oblookup (obarray
, str
, len
, len
);
3737 if (NILP (Vpurify_flag
))
3738 /* Creating a non-pure string from a string literal not
3739 implemented yet. We could just use make_string here and live
3740 with the extra copy. */
3743 return Fintern (make_pure_c_string (str
), obarray
);
3746 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3747 doc
: /* Return the canonical symbol whose name is STRING.
3748 If there is none, one is created by this function and returned.
3749 A second optional argument specifies the obarray to use;
3750 it defaults to the value of `obarray'. */)
3751 (Lisp_Object string
, Lisp_Object obarray
)
3753 register Lisp_Object tem
, sym
, *ptr
;
3755 if (NILP (obarray
)) obarray
= Vobarray
;
3756 obarray
= check_obarray (obarray
);
3758 CHECK_STRING (string
);
3760 tem
= oblookup (obarray
, SSDATA (string
),
3763 if (!INTEGERP (tem
))
3766 if (!NILP (Vpurify_flag
))
3767 string
= Fpurecopy (string
);
3768 sym
= Fmake_symbol (string
);
3770 if (EQ (obarray
, initial_obarray
))
3771 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3773 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3775 if ((SREF (string
, 0) == ':')
3776 && EQ (obarray
, initial_obarray
))
3778 XSYMBOL (sym
)->constant
= 1;
3779 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3780 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3783 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3785 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3787 XSYMBOL (sym
)->next
= 0;
3792 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3793 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3794 NAME may be a string or a symbol. If it is a symbol, that exact
3795 symbol is searched for.
3796 A second optional argument specifies the obarray to use;
3797 it defaults to the value of `obarray'. */)
3798 (Lisp_Object name
, Lisp_Object obarray
)
3800 register Lisp_Object tem
, string
;
3802 if (NILP (obarray
)) obarray
= Vobarray
;
3803 obarray
= check_obarray (obarray
);
3805 if (!SYMBOLP (name
))
3807 CHECK_STRING (name
);
3811 string
= SYMBOL_NAME (name
);
3813 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3814 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3820 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3821 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3822 The value is t if a symbol was found and deleted, nil otherwise.
3823 NAME may be a string or a symbol. If it is a symbol, that symbol
3824 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3825 OBARRAY defaults to the value of the variable `obarray'. */)
3826 (Lisp_Object name
, Lisp_Object obarray
)
3828 register Lisp_Object string
, tem
;
3831 if (NILP (obarray
)) obarray
= Vobarray
;
3832 obarray
= check_obarray (obarray
);
3835 string
= SYMBOL_NAME (name
);
3838 CHECK_STRING (name
);
3842 tem
= oblookup (obarray
, SSDATA (string
),
3847 /* If arg was a symbol, don't delete anything but that symbol itself. */
3848 if (SYMBOLP (name
) && !EQ (name
, tem
))
3851 /* There are plenty of other symbols which will screw up the Emacs
3852 session if we unintern them, as well as even more ways to use
3853 `setq' or `fset' or whatnot to make the Emacs session
3854 unusable. Let's not go down this silly road. --Stef */
3855 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3856 error ("Attempt to unintern t or nil"); */
3858 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3860 hash
= oblookup_last_bucket_number
;
3862 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3864 if (XSYMBOL (tem
)->next
)
3865 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3867 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3871 Lisp_Object tail
, following
;
3873 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3874 XSYMBOL (tail
)->next
;
3877 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3878 if (EQ (following
, tem
))
3880 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3889 /* Return the symbol in OBARRAY whose names matches the string
3890 of SIZE characters (SIZE_BYTE bytes) at PTR.
3891 If there is no such symbol in OBARRAY, return nil.
3893 Also store the bucket number in oblookup_last_bucket_number. */
3896 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3900 register Lisp_Object tail
;
3901 Lisp_Object bucket
, tem
;
3903 if (!VECTORP (obarray
)
3904 || (obsize
= ASIZE (obarray
)) == 0)
3906 obarray
= check_obarray (obarray
);
3907 obsize
= ASIZE (obarray
);
3909 /* This is sometimes needed in the middle of GC. */
3910 obsize
&= ~ARRAY_MARK_FLAG
;
3911 hash
= hash_string (ptr
, size_byte
) % obsize
;
3912 bucket
= XVECTOR (obarray
)->contents
[hash
];
3913 oblookup_last_bucket_number
= hash
;
3914 if (EQ (bucket
, make_number (0)))
3916 else if (!SYMBOLP (bucket
))
3917 error ("Bad data in guts of obarray"); /* Like CADR error message */
3919 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3921 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3922 && SCHARS (SYMBOL_NAME (tail
)) == size
3923 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3925 else if (XSYMBOL (tail
)->next
== 0)
3928 XSETINT (tem
, hash
);
3933 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3936 register Lisp_Object tail
;
3937 CHECK_VECTOR (obarray
);
3938 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3940 tail
= XVECTOR (obarray
)->contents
[i
];
3945 if (XSYMBOL (tail
)->next
== 0)
3947 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3953 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3955 call1 (function
, sym
);
3958 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3959 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3960 OBARRAY defaults to the value of `obarray'. */)
3961 (Lisp_Object function
, Lisp_Object obarray
)
3963 if (NILP (obarray
)) obarray
= Vobarray
;
3964 obarray
= check_obarray (obarray
);
3966 map_obarray (obarray
, mapatoms_1
, function
);
3970 #define OBARRAY_SIZE 1511
3975 Lisp_Object oblength
;
3976 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3978 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3980 Vobarray
= Fmake_vector (oblength
, make_number (0));
3981 initial_obarray
= Vobarray
;
3982 staticpro (&initial_obarray
);
3984 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3985 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3986 NILP (Vpurify_flag) check in intern_c_string. */
3987 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3988 Qnil
= intern_c_string ("nil");
3990 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3991 so those two need to be fixed manally. */
3992 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3993 XSYMBOL (Qunbound
)->function
= Qunbound
;
3994 XSYMBOL (Qunbound
)->plist
= Qnil
;
3995 /* XSYMBOL (Qnil)->function = Qunbound; */
3996 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3997 XSYMBOL (Qnil
)->constant
= 1;
3998 XSYMBOL (Qnil
)->plist
= Qnil
;
4000 Qt
= intern_c_string ("t");
4001 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4002 XSYMBOL (Qt
)->constant
= 1;
4004 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4007 DEFSYM (Qvariable_documentation
, "variable-documentation");
4009 read_buffer
= (char *) xmalloc (size
);
4010 read_buffer_size
= size
;
4014 defsubr (struct Lisp_Subr
*sname
)
4017 sym
= intern_c_string (sname
->symbol_name
);
4018 XSETTYPED_PVECTYPE (sname
, size
, PVEC_SUBR
);
4019 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4022 #ifdef NOTDEF /* use fset in subr.el now */
4024 defalias (struct Lisp_Subr
*sname
, char *string
)
4027 sym
= intern (string
);
4028 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4032 /* Define an "integer variable"; a symbol whose value is forwarded to a
4033 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4034 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4036 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4037 const char *namestring
, EMACS_INT
*address
)
4040 sym
= intern_c_string (namestring
);
4041 i_fwd
->type
= Lisp_Fwd_Int
;
4042 i_fwd
->intvar
= address
;
4043 XSYMBOL (sym
)->declared_special
= 1;
4044 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4045 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4048 /* Similar but define a variable whose value is t if address contains 1,
4049 nil if address contains 0. */
4051 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4052 const char *namestring
, int *address
)
4055 sym
= intern_c_string (namestring
);
4056 b_fwd
->type
= Lisp_Fwd_Bool
;
4057 b_fwd
->boolvar
= address
;
4058 XSYMBOL (sym
)->declared_special
= 1;
4059 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4060 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4061 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4064 /* Similar but define a variable whose value is the Lisp Object stored
4065 at address. Two versions: with and without gc-marking of the C
4066 variable. The nopro version is used when that variable will be
4067 gc-marked for some other reason, since marking the same slot twice
4068 can cause trouble with strings. */
4070 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4071 const char *namestring
, Lisp_Object
*address
)
4074 sym
= intern_c_string (namestring
);
4075 o_fwd
->type
= Lisp_Fwd_Obj
;
4076 o_fwd
->objvar
= address
;
4077 XSYMBOL (sym
)->declared_special
= 1;
4078 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4079 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4083 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4084 const char *namestring
, Lisp_Object
*address
)
4086 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4087 staticpro (address
);
4090 /* Similar but define a variable whose value is the Lisp Object stored
4091 at a particular offset in the current kboard object. */
4094 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4095 const char *namestring
, int offset
)
4098 sym
= intern_c_string (namestring
);
4099 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4100 ko_fwd
->offset
= offset
;
4101 XSYMBOL (sym
)->declared_special
= 1;
4102 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4103 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4106 /* Record the value of load-path used at the start of dumping
4107 so we can see if the site changed it later during dumping. */
4108 static Lisp_Object dump_path
;
4114 int turn_off_warning
= 0;
4116 /* Compute the default load-path. */
4118 normal
= PATH_LOADSEARCH
;
4119 Vload_path
= decode_env_path (0, normal
);
4121 if (NILP (Vpurify_flag
))
4122 normal
= PATH_LOADSEARCH
;
4124 normal
= PATH_DUMPLOADSEARCH
;
4126 /* In a dumped Emacs, we normally have to reset the value of
4127 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4128 uses ../lisp, instead of the path of the installed elisp
4129 libraries. However, if it appears that Vload_path was changed
4130 from the default before dumping, don't override that value. */
4133 if (! NILP (Fequal (dump_path
, Vload_path
)))
4135 Vload_path
= decode_env_path (0, normal
);
4136 if (!NILP (Vinstallation_directory
))
4138 Lisp_Object tem
, tem1
, sitelisp
;
4140 /* Remove site-lisp dirs from path temporarily and store
4141 them in sitelisp, then conc them on at the end so
4142 they're always first in path. */
4146 tem
= Fcar (Vload_path
);
4147 tem1
= Fstring_match (build_string ("site-lisp"),
4151 Vload_path
= Fcdr (Vload_path
);
4152 sitelisp
= Fcons (tem
, sitelisp
);
4158 /* Add to the path the lisp subdir of the
4159 installation dir, if it exists. */
4160 tem
= Fexpand_file_name (build_string ("lisp"),
4161 Vinstallation_directory
);
4162 tem1
= Ffile_exists_p (tem
);
4165 if (NILP (Fmember (tem
, Vload_path
)))
4167 turn_off_warning
= 1;
4168 Vload_path
= Fcons (tem
, Vload_path
);
4172 /* That dir doesn't exist, so add the build-time
4173 Lisp dirs instead. */
4174 Vload_path
= nconc2 (Vload_path
, dump_path
);
4176 /* Add leim under the installation dir, if it exists. */
4177 tem
= Fexpand_file_name (build_string ("leim"),
4178 Vinstallation_directory
);
4179 tem1
= Ffile_exists_p (tem
);
4182 if (NILP (Fmember (tem
, Vload_path
)))
4183 Vload_path
= Fcons (tem
, Vload_path
);
4186 /* Add site-lisp under the installation dir, if it exists. */
4187 tem
= Fexpand_file_name (build_string ("site-lisp"),
4188 Vinstallation_directory
);
4189 tem1
= Ffile_exists_p (tem
);
4192 if (NILP (Fmember (tem
, Vload_path
)))
4193 Vload_path
= Fcons (tem
, Vload_path
);
4196 /* If Emacs was not built in the source directory,
4197 and it is run from where it was built, add to load-path
4198 the lisp, leim and site-lisp dirs under that directory. */
4200 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4204 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4205 Vinstallation_directory
);
4206 tem1
= Ffile_exists_p (tem
);
4208 /* Don't be fooled if they moved the entire source tree
4209 AFTER dumping Emacs. If the build directory is indeed
4210 different from the source dir, src/Makefile.in and
4211 src/Makefile will not be found together. */
4212 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4213 Vinstallation_directory
);
4214 tem2
= Ffile_exists_p (tem
);
4215 if (!NILP (tem1
) && NILP (tem2
))
4217 tem
= Fexpand_file_name (build_string ("lisp"),
4220 if (NILP (Fmember (tem
, Vload_path
)))
4221 Vload_path
= Fcons (tem
, Vload_path
);
4223 tem
= Fexpand_file_name (build_string ("leim"),
4226 if (NILP (Fmember (tem
, Vload_path
)))
4227 Vload_path
= Fcons (tem
, Vload_path
);
4229 tem
= Fexpand_file_name (build_string ("site-lisp"),
4232 if (NILP (Fmember (tem
, Vload_path
)))
4233 Vload_path
= Fcons (tem
, Vload_path
);
4236 if (!NILP (sitelisp
) && !no_site_lisp
)
4237 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4243 /* NORMAL refers to the lisp dir in the source directory. */
4244 /* We used to add ../lisp at the front here, but
4245 that caused trouble because it was copied from dump_path
4246 into Vload_path, above, when Vinstallation_directory was non-nil.
4247 It should be unnecessary. */
4248 Vload_path
= decode_env_path (0, normal
);
4249 dump_path
= Vload_path
;
4253 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4254 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4255 almost never correct, thereby causing a warning to be printed out that
4256 confuses users. Since PATH_LOADSEARCH is always overridden by the
4257 EMACSLOADPATH environment variable below, disable the warning on NT. */
4259 /* Warn if dirs in the *standard* path don't exist. */
4260 if (!turn_off_warning
)
4262 Lisp_Object path_tail
;
4264 for (path_tail
= Vload_path
;
4266 path_tail
= XCDR (path_tail
))
4268 Lisp_Object dirfile
;
4269 dirfile
= Fcar (path_tail
);
4270 if (STRINGP (dirfile
))
4272 dirfile
= Fdirectory_file_name (dirfile
);
4273 if (access (SSDATA (dirfile
), 0) < 0)
4274 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4279 #endif /* !(WINDOWSNT || HAVE_NS) */
4281 /* If the EMACSLOADPATH environment variable is set, use its value.
4282 This doesn't apply if we're dumping. */
4284 if (NILP (Vpurify_flag
)
4285 && egetenv ("EMACSLOADPATH"))
4287 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4291 load_in_progress
= 0;
4292 Vload_file_name
= Qnil
;
4294 load_descriptor_list
= Qnil
;
4296 Vstandard_input
= Qt
;
4297 Vloads_in_progress
= Qnil
;
4300 /* Print a warning, using format string FORMAT, that directory DIRNAME
4301 does not exist. Print it on stderr and put it in *Messages*. */
4304 dir_warning (const char *format
, Lisp_Object dirname
)
4306 fprintf (stderr
, format
, SDATA (dirname
));
4308 /* Don't log the warning before we've initialized!! */
4312 ptrdiff_t message_len
;
4314 SAFE_ALLOCA (buffer
, char *,
4315 SBYTES (dirname
) + strlen (format
) - (sizeof "%s" - 1) + 1);
4316 message_len
= esprintf (buffer
, format
, SDATA (dirname
));
4317 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4323 syms_of_lread (void)
4326 defsubr (&Sread_from_string
);
4328 defsubr (&Sintern_soft
);
4329 defsubr (&Sunintern
);
4330 defsubr (&Sget_load_suffixes
);
4332 defsubr (&Seval_buffer
);
4333 defsubr (&Seval_region
);
4334 defsubr (&Sread_char
);
4335 defsubr (&Sread_char_exclusive
);
4336 defsubr (&Sread_event
);
4337 defsubr (&Sget_file_char
);
4338 defsubr (&Smapatoms
);
4339 defsubr (&Slocate_file_internal
);
4341 DEFVAR_LISP ("obarray", Vobarray
,
4342 doc
: /* Symbol table for use by `intern' and `read'.
4343 It is a vector whose length ought to be prime for best results.
4344 The vector's contents don't make sense if examined from Lisp programs;
4345 to find all the symbols in an obarray, use `mapatoms'. */);
4347 DEFVAR_LISP ("values", Vvalues
,
4348 doc
: /* List of values of all expressions which were read, evaluated and printed.
4349 Order is reverse chronological. */);
4351 DEFVAR_LISP ("standard-input", Vstandard_input
,
4352 doc
: /* Stream for read to get input from.
4353 See documentation of `read' for possible values. */);
4354 Vstandard_input
= Qt
;
4356 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4357 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4359 If this variable is a buffer, then only forms read from that buffer
4360 will be added to `read-symbol-positions-list'.
4361 If this variable is t, then all read forms will be added.
4362 The effect of all other values other than nil are not currently
4363 defined, although they may be in the future.
4365 The positions are relative to the last call to `read' or
4366 `read-from-string'. It is probably a bad idea to set this variable at
4367 the toplevel; bind it instead. */);
4368 Vread_with_symbol_positions
= Qnil
;
4370 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4371 doc
: /* A list mapping read symbols to their positions.
4372 This variable is modified during calls to `read' or
4373 `read-from-string', but only when `read-with-symbol-positions' is
4376 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4377 CHAR-POSITION is an integer giving the offset of that occurrence of the
4378 symbol from the position where `read' or `read-from-string' started.
4380 Note that a symbol will appear multiple times in this list, if it was
4381 read multiple times. The list is in the same order as the symbols
4383 Vread_symbol_positions_list
= Qnil
;
4385 DEFVAR_LISP ("read-circle", Vread_circle
,
4386 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4389 DEFVAR_LISP ("load-path", Vload_path
,
4390 doc
: /* *List of directories to search for files to load.
4391 Each element is a string (directory name) or nil (try default directory).
4392 Initialized based on EMACSLOADPATH environment variable, if any,
4393 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4395 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4396 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4397 This list should not include the empty string.
4398 `load' and related functions try to append these suffixes, in order,
4399 to the specified file name if a Lisp suffix is allowed or required. */);
4400 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4401 Fcons (make_pure_c_string (".el"), Qnil
));
4402 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4403 doc
: /* List of suffixes that indicate representations of \
4405 This list should normally start with the empty string.
4407 Enabling Auto Compression mode appends the suffixes in
4408 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4409 mode removes them again. `load' and related functions use this list to
4410 determine whether they should look for compressed versions of a file
4411 and, if so, which suffixes they should try to append to the file name
4412 in order to do so. However, if you want to customize which suffixes
4413 the loading functions recognize as compression suffixes, you should
4414 customize `jka-compr-load-suffixes' rather than the present variable. */);
4415 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4417 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4418 doc
: /* Non-nil if inside of `load'. */);
4419 DEFSYM (Qload_in_progress
, "load-in-progress");
4421 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4422 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4423 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4425 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4426 a symbol \(a feature name).
4428 When `load' is run and the file-name argument matches an element's
4429 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4430 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4432 An error in FORMS does not undo the load, but does prevent execution of
4433 the rest of the FORMS. */);
4434 Vafter_load_alist
= Qnil
;
4436 DEFVAR_LISP ("load-history", Vload_history
,
4437 doc
: /* Alist mapping loaded file names to symbols and features.
4438 Each alist element should be a list (FILE-NAME ENTRIES...), where
4439 FILE-NAME is the name of a file that has been loaded into Emacs.
4440 The file name is absolute and true (i.e. it doesn't contain symlinks).
4441 As an exception, one of the alist elements may have FILE-NAME nil,
4442 for symbols and features not associated with any file.
4444 The remaining ENTRIES in the alist element describe the functions and
4445 variables defined in that file, the features provided, and the
4446 features required. Each entry has the form `(provide . FEATURE)',
4447 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4448 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4449 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4450 autoload before this file redefined it as a function. In addition,
4451 entries may also be single symbols, which means that SYMBOL was
4452 defined by `defvar' or `defconst'.
4454 During preloading, the file name recorded is relative to the main Lisp
4455 directory. These file names are converted to absolute at startup. */);
4456 Vload_history
= Qnil
;
4458 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4459 doc
: /* Full name of file being loaded by `load'. */);
4460 Vload_file_name
= Qnil
;
4462 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4463 doc
: /* File name, including directory, of user's initialization file.
4464 If the file loaded had extension `.elc', and the corresponding source file
4465 exists, this variable contains the name of source file, suitable for use
4466 by functions like `custom-save-all' which edit the init file.
4467 While Emacs loads and evaluates the init file, value is the real name
4468 of the file, regardless of whether or not it has the `.elc' extension. */);
4469 Vuser_init_file
= Qnil
;
4471 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4472 doc
: /* Used for internal purposes by `load'. */);
4473 Vcurrent_load_list
= Qnil
;
4475 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4476 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4477 The default is nil, which means use the function `read'. */);
4478 Vload_read_function
= Qnil
;
4480 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4481 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4482 This function is for doing code conversion before reading the source file.
4483 If nil, loading is done without any code conversion.
4484 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4485 FULLNAME is the full name of FILE.
4486 See `load' for the meaning of the remaining arguments. */);
4487 Vload_source_file_function
= Qnil
;
4489 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4490 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4491 This is useful when the file being loaded is a temporary copy. */);
4492 load_force_doc_strings
= 0;
4494 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4495 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4496 This is normally bound by `load' and `eval-buffer' to control `read',
4497 and is not meant for users to change. */);
4498 load_convert_to_unibyte
= 0;
4500 DEFVAR_LISP ("source-directory", Vsource_directory
,
4501 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4502 You cannot count on them to still be there! */);
4504 = Fexpand_file_name (build_string ("../"),
4505 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4507 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4508 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4509 Vpreloaded_file_list
= Qnil
;
4511 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4512 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4513 Vbyte_boolean_vars
= Qnil
;
4515 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4516 doc
: /* Non-nil means load dangerous compiled Lisp files.
4517 Some versions of XEmacs use different byte codes than Emacs. These
4518 incompatible byte codes can make Emacs crash when it tries to execute
4520 load_dangerous_libraries
= 0;
4522 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4523 doc
: /* Non-nil means force printing messages when loading Lisp files.
4524 This overrides the value of the NOMESSAGE argument to `load'. */);
4525 force_load_messages
= 0;
4527 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4528 doc
: /* Regular expression matching safe to load compiled Lisp files.
4529 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4530 from the file, and matches them against this regular expression.
4531 When the regular expression matches, the file is considered to be safe
4532 to load. See also `load-dangerous-libraries'. */);
4533 Vbytecomp_version_regexp
4534 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4536 Qlexical_binding
= intern ("lexical-binding");
4537 staticpro (&Qlexical_binding
);
4538 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4539 doc
: /* Whether to use lexical binding when evaluating code.
4540 Non-nil means that the code in the current buffer should be evaluated
4541 with lexical binding.
4542 This variable is automatically set from the file variables of an
4543 interpreted Lisp file read using `load'. */);
4544 Fmake_variable_buffer_local (Qlexical_binding
);
4546 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4547 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4548 Veval_buffer_list
= Qnil
;
4550 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4551 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4552 Vold_style_backquotes
= Qnil
;
4553 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4555 /* Vsource_directory was initialized in init_lread. */
4557 load_descriptor_list
= Qnil
;
4558 staticpro (&load_descriptor_list
);
4560 DEFSYM (Qcurrent_load_list
, "current-load-list");
4561 DEFSYM (Qstandard_input
, "standard-input");
4562 DEFSYM (Qread_char
, "read-char");
4563 DEFSYM (Qget_file_char
, "get-file-char");
4564 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4565 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4567 DEFSYM (Qbackquote
, "`");
4568 DEFSYM (Qcomma
, ",");
4569 DEFSYM (Qcomma_at
, ",@");
4570 DEFSYM (Qcomma_dot
, ",.");
4572 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4573 DEFSYM (Qascii_character
, "ascii-character");
4574 DEFSYM (Qfunction
, "function");
4575 DEFSYM (Qload
, "load");
4576 DEFSYM (Qload_file_name
, "load-file-name");
4577 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4578 DEFSYM (Qfile_truename
, "file-truename");
4579 DEFSYM (Qdir_ok
, "dir-ok");
4580 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4582 staticpro (&dump_path
);
4584 staticpro (&read_objects
);
4585 read_objects
= Qnil
;
4586 staticpro (&seen_list
);
4589 Vloads_in_progress
= Qnil
;
4590 staticpro (&Vloads_in_progress
);
4592 DEFSYM (Qhash_table
, "hash-table");
4593 DEFSYM (Qdata
, "data");
4594 DEFSYM (Qtest
, "test");
4595 DEFSYM (Qsize
, "size");
4596 DEFSYM (Qweakness
, "weakness");
4597 DEFSYM (Qrehash_size
, "rehash-size");
4598 DEFSYM (Qrehash_threshold
, "rehash-threshold");