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
);
611 sec
= (int) duration
;
612 usec
= (duration
- sec
) * 1000000;
613 EMACS_GET_TIME (end_time
);
614 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
615 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
618 /* Read until we get an acceptable event. */
621 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
622 NUMBERP (seconds
) ? &end_time
: NULL
);
623 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
628 /* switch-frame events are put off until after the next ASCII
629 character. This is better than signaling an error just because
630 the last characters were typed to a separate minibuffer frame,
631 for example. Eventually, some code which can deal with
632 switch-frame events will read it and process it. */
634 && EVENT_HAS_PARAMETERS (val
)
635 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
637 delayed_switch_frame
= val
;
641 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
643 /* Convert certain symbols to their ASCII equivalents. */
646 Lisp_Object tem
, tem1
;
647 tem
= Fget (val
, Qevent_symbol_element_mask
);
650 tem1
= Fget (Fcar (tem
), Qascii_character
);
651 /* Merge this symbol's modifier bits
652 with the ASCII equivalent of its basic code. */
654 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
658 /* If we don't have a character now, deal with it appropriately. */
663 Vunread_command_events
= Fcons (val
, Qnil
);
664 error ("Non-character input-event");
671 if (! NILP (delayed_switch_frame
))
672 unread_switch_frame
= delayed_switch_frame
;
676 #ifdef HAVE_WINDOW_SYSTEM
677 if (display_hourglass_p
)
686 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
687 doc
: /* Read a character from the command input (keyboard or macro).
688 It is returned as a number.
689 If the character has modifiers, they are resolved and reflected to the
690 character code if possible (e.g. C-SPC -> 0).
692 If the user generates an event which is not a character (i.e. a mouse
693 click or function key event), `read-char' signals an error. As an
694 exception, switch-frame events are put off until non-character events
696 If you want to read non-character events, or ignore them, call
697 `read-event' or `read-char-exclusive' instead.
699 If the optional argument PROMPT is non-nil, display that as a prompt.
700 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
701 input method is turned on in the current buffer, that input method
702 is used for reading a character.
703 If the optional argument SECONDS is non-nil, it should be a number
704 specifying the maximum number of seconds to wait for input. If no
705 input arrives in that time, return nil. SECONDS may be a
706 floating-point value. */)
707 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
712 message_with_string ("%s", prompt
, 0);
713 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
715 return (NILP (val
) ? Qnil
716 : make_number (char_resolve_modifier_mask (XINT (val
))));
719 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
720 doc
: /* Read an event object from the input stream.
721 If the optional argument PROMPT is non-nil, display that as a prompt.
722 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
723 input method is turned on in the current buffer, that input method
724 is used for reading a character.
725 If the optional argument SECONDS is non-nil, it should be a number
726 specifying the maximum number of seconds to wait for input. If no
727 input arrives in that time, return nil. SECONDS may be a
728 floating-point value. */)
729 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
732 message_with_string ("%s", prompt
, 0);
733 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
736 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
737 doc
: /* Read a character from the command input (keyboard or macro).
738 It is returned as a number. Non-character events are ignored.
739 If the character has modifiers, they are resolved and reflected to the
740 character code if possible (e.g. C-SPC -> 0).
742 If the optional argument PROMPT is non-nil, display that as a prompt.
743 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
744 input method is turned on in the current buffer, that input method
745 is used for reading a character.
746 If the optional argument SECONDS is non-nil, it should be a number
747 specifying the maximum number of seconds to wait for input. If no
748 input arrives in that time, return nil. SECONDS may be a
749 floating-point value. */)
750 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
755 message_with_string ("%s", prompt
, 0);
757 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
759 return (NILP (val
) ? Qnil
760 : make_number (char_resolve_modifier_mask (XINT (val
))));
763 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
764 doc
: /* Don't use this yourself. */)
767 register Lisp_Object val
;
769 XSETINT (val
, getc (instream
));
777 /* Return true if the lisp code read using READCHARFUN defines a non-nil
778 `lexical-binding' file variable. After returning, the stream is
779 positioned following the first line, if it is a comment, otherwise
783 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
787 /* The first line isn't a comment, just give up. */
793 /* Look for an appropriate file-variable in the first line. */
797 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
798 } beg_end_state
= NOMINAL
;
799 int in_file_vars
= 0;
801 #define UPDATE_BEG_END_STATE(ch) \
802 if (beg_end_state == NOMINAL) \
803 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
804 else if (beg_end_state == AFTER_FIRST_DASH) \
805 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
806 else if (beg_end_state == AFTER_ASTERIX) \
809 in_file_vars = !in_file_vars; \
810 beg_end_state = NOMINAL; \
813 /* Skip until we get to the file vars, if any. */
817 UPDATE_BEG_END_STATE (ch
);
819 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
823 char var
[100], val
[100];
828 /* Read a variable name. */
829 while (ch
== ' ' || ch
== '\t')
833 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
835 if (i
< sizeof var
- 1)
837 UPDATE_BEG_END_STATE (ch
);
841 /* Stop scanning if no colon was found before end marker. */
845 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
851 /* Read a variable value. */
854 while (ch
== ' ' || ch
== '\t')
858 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
860 if (i
< sizeof val
- 1)
862 UPDATE_BEG_END_STATE (ch
);
866 /* The value was terminated by an end-marker, which
869 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
873 if (strcmp (var
, "lexical-binding") == 0)
876 rv
= (strcmp (val
, "nil") != 0);
882 while (ch
!= '\n' && ch
!= EOF
)
889 /* Value is a version number of byte compiled code if the file
890 associated with file descriptor FD is a compiled Lisp file that's
891 safe to load. Only files compiled with Emacs are safe to load.
892 Files compiled with XEmacs can lead to a crash in Fbyte_code
893 because of an incompatible change in the byte compiler. */
896 safe_to_load_p (int fd
)
903 /* Read the first few bytes from the file, and look for a line
904 specifying the byte compiler version used. */
905 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
910 /* Skip to the next newline, skipping over the initial `ELC'
911 with NUL bytes following it, but note the version. */
912 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
917 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
924 lseek (fd
, 0, SEEK_SET
);
929 /* Callback for record_unwind_protect. Restore the old load list OLD,
930 after loading a file successfully. */
933 record_load_unwind (Lisp_Object old
)
935 return Vloads_in_progress
= old
;
938 /* This handler function is used via internal_condition_case_1. */
941 load_error_handler (Lisp_Object data
)
947 load_warn_old_style_backquotes (Lisp_Object file
)
949 if (!NILP (Vold_style_backquotes
))
952 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
959 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
960 doc
: /* Return the suffixes that `load' should try if a suffix is \
962 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
965 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
966 while (CONSP (suffixes
))
968 Lisp_Object exts
= Vload_file_rep_suffixes
;
969 suffix
= XCAR (suffixes
);
970 suffixes
= XCDR (suffixes
);
975 lst
= Fcons (concat2 (suffix
, ext
), lst
);
978 return Fnreverse (lst
);
981 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
982 doc
: /* Execute a file of Lisp code named FILE.
983 First try FILE with `.elc' appended, then try with `.el',
984 then try FILE unmodified (the exact suffixes in the exact order are
985 determined by `load-suffixes'). Environment variable references in
986 FILE are replaced with their values by calling `substitute-in-file-name'.
987 This function searches the directories in `load-path'.
989 If optional second arg NOERROR is non-nil,
990 report no error if FILE doesn't exist.
991 Print messages at start and end of loading unless
992 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
994 If optional fourth arg NOSUFFIX is non-nil, don't try adding
995 suffixes `.elc' or `.el' to the specified name FILE.
996 If optional fifth arg MUST-SUFFIX is non-nil, insist on
997 the suffix `.elc' or `.el'; don't accept just FILE unless
998 it ends in one of those suffixes or includes a directory name.
1000 If this function fails to find a file, it may look for different
1001 representations of that file before trying another file.
1002 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
1003 to the file name. Emacs uses this feature mainly to find compressed
1004 versions of files when Auto Compression mode is enabled.
1006 The exact suffixes that this function tries out, in the exact order,
1007 are given by the value of the variable `load-file-rep-suffixes' if
1008 NOSUFFIX is non-nil and by the return value of the function
1009 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1010 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1011 and then the former.
1013 Loading a file records its definitions, and its `provide' and
1014 `require' calls, in an element of `load-history' whose
1015 car is the file name loaded. See `load-history'.
1017 While the file is in the process of being loaded, the variable
1018 `load-in-progress' is non-nil and the variable `load-file-name'
1019 is bound to the file's name.
1021 Return t if the file exists and loads successfully. */)
1022 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1024 register FILE *stream
;
1025 register int fd
= -1;
1026 ptrdiff_t count
= SPECPDL_INDEX ();
1027 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1028 Lisp_Object found
, efound
, hist_file_name
;
1029 /* 1 means we printed the ".el is newer" message. */
1031 /* 1 means we are loading a compiled file. */
1033 Lisp_Object handler
;
1035 const char *fmode
= "r";
1043 CHECK_STRING (file
);
1045 /* If file name is magic, call the handler. */
1046 /* This shouldn't be necessary any more now that `openp' handles it right.
1047 handler = Ffind_file_name_handler (file, Qload);
1048 if (!NILP (handler))
1049 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1051 /* Do this after the handler to avoid
1052 the need to gcpro noerror, nomessage and nosuffix.
1053 (Below here, we care only whether they are nil or not.)
1054 The presence of this call is the result of a historical accident:
1055 it used to be in every file-operation and when it got removed
1056 everywhere, it accidentally stayed here. Since then, enough people
1057 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1058 that it seemed risky to remove. */
1059 if (! NILP (noerror
))
1061 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1062 Qt
, load_error_handler
);
1067 file
= Fsubstitute_in_file_name (file
);
1070 /* Avoid weird lossage with null string as arg,
1071 since it would try to load a directory as a Lisp file */
1072 if (SBYTES (file
) > 0)
1074 ptrdiff_t size
= SBYTES (file
);
1077 GCPRO2 (file
, found
);
1079 if (! NILP (must_suffix
))
1081 /* Don't insist on adding a suffix if FILE already ends with one. */
1083 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1086 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1088 /* Don't insist on adding a suffix
1089 if the argument includes a directory name. */
1090 else if (! NILP (Ffile_name_directory (file
)))
1094 fd
= openp (Vload_path
, file
,
1095 (!NILP (nosuffix
) ? Qnil
1096 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1097 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1098 tmp
[1] = Vload_file_rep_suffixes
,
1107 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1111 /* Tell startup.el whether or not we found the user's init file. */
1112 if (EQ (Qt
, Vuser_init_file
))
1113 Vuser_init_file
= found
;
1115 /* If FD is -2, that means openp found a magic file. */
1118 if (NILP (Fequal (found
, file
)))
1119 /* If FOUND is a different file name from FILE,
1120 find its handler even if we have already inhibited
1121 the `load' operation on FILE. */
1122 handler
= Ffind_file_name_handler (found
, Qt
);
1124 handler
= Ffind_file_name_handler (found
, Qload
);
1125 if (! NILP (handler
))
1126 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1128 /* Tramp has to deal with semi-broken packages that prepend
1129 drive letters to remote files. For that reason, Tramp
1130 catches file operations that test for file existence, which
1131 makes openp think X:/foo.elc files are remote. However,
1132 Tramp does not catch `load' operations for such files, so we
1133 end up with a nil as the `load' handler above. If we would
1134 continue with fd = -2, we will behave wrongly, and in
1135 particular try reading a .elc file in the "rt" mode instead
1136 of "rb". See bug #9311 for the results. To work around
1137 this, we try to open the file locally, and go with that if it
1139 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1145 /* Check if we're stuck in a recursive load cycle.
1147 2000-09-21: It's not possible to just check for the file loaded
1148 being a member of Vloads_in_progress. This fails because of the
1149 way the byte compiler currently works; `provide's are not
1150 evaluated, see font-lock.el/jit-lock.el as an example. This
1151 leads to a certain amount of ``normal'' recursion.
1153 Also, just loading a file recursively is not always an error in
1154 the general case; the second load may do something different. */
1158 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1159 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1163 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1165 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1166 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1169 /* All loads are by default dynamic, unless the file itself specifies
1170 otherwise using a file-variable in the first line. This is bound here
1171 so that it takes effect whether or not we use
1172 Vload_source_file_function. */
1173 specbind (Qlexical_binding
, Qnil
);
1175 /* Get the name for load-history. */
1176 hist_file_name
= (! NILP (Vpurify_flag
)
1177 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1178 tmp
[1] = Ffile_name_nondirectory (found
),
1184 /* Check for the presence of old-style quotes and warn about them. */
1185 specbind (Qold_style_backquotes
, Qnil
);
1186 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1188 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1189 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1190 /* Load .elc files directly, but not when they are
1191 remote and have no handler! */
1198 GCPRO3 (file
, found
, hist_file_name
);
1201 && ! (version
= safe_to_load_p (fd
)))
1204 if (!load_dangerous_libraries
)
1208 error ("File `%s' was not compiled in Emacs",
1211 else if (!NILP (nomessage
) && !force_load_messages
)
1212 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1217 efound
= ENCODE_FILE (found
);
1222 result
= stat (SSDATA (efound
), &s1
);
1225 SSET (efound
, SBYTES (efound
) - 1, 0);
1226 result
= stat (SSDATA (efound
), &s2
);
1227 SSET (efound
, SBYTES (efound
) - 1, 'c');
1230 if (result
== 0 && s1
.st_mtime
< s2
.st_mtime
)
1232 /* Make the progress messages mention that source is newer. */
1235 /* If we won't print another message, mention this anyway. */
1236 if (!NILP (nomessage
) && !force_load_messages
)
1238 Lisp_Object msg_file
;
1239 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1240 message_with_string ("Source file `%s' newer than byte-compiled file",
1249 /* We are loading a source file (*.el). */
1250 if (!NILP (Vload_source_file_function
))
1256 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1257 NILP (noerror
) ? Qnil
: Qt
,
1258 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1259 return unbind_to (count
, val
);
1263 GCPRO3 (file
, found
, hist_file_name
);
1266 efound
= ENCODE_FILE (found
);
1267 /* If we somehow got here with fd == -2, meaning the file is deemed
1268 to be remote, don't even try to reopen the file locally; just
1269 force a failure instead. */
1273 stream
= fopen (SSDATA (efound
), fmode
);
1277 #else /* not WINDOWSNT */
1278 stream
= fdopen (fd
, fmode
);
1279 #endif /* not WINDOWSNT */
1283 error ("Failure to create stdio stream for %s", SDATA (file
));
1286 if (! NILP (Vpurify_flag
))
1287 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1289 if (NILP (nomessage
) || force_load_messages
)
1292 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1295 message_with_string ("Loading %s (source)...", file
, 1);
1297 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1299 else /* The typical case; compiled file newer than source file. */
1300 message_with_string ("Loading %s...", file
, 1);
1303 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1304 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1305 specbind (Qload_file_name
, found
);
1306 specbind (Qinhibit_file_name_operation
, Qnil
);
1307 load_descriptor_list
1308 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1309 specbind (Qload_in_progress
, Qt
);
1312 if (lisp_file_lexically_bound_p (Qget_file_char
))
1313 Fset (Qlexical_binding
, Qt
);
1315 if (! version
|| version
>= 22)
1316 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1317 0, Qnil
, Qnil
, Qnil
, Qnil
);
1320 /* We can't handle a file which was compiled with
1321 byte-compile-dynamic by older version of Emacs. */
1322 specbind (Qload_force_doc_strings
, Qt
);
1323 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1324 0, Qnil
, Qnil
, Qnil
, Qnil
);
1326 unbind_to (count
, Qnil
);
1328 /* Run any eval-after-load forms for this file */
1329 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1330 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1334 xfree (saved_doc_string
);
1335 saved_doc_string
= 0;
1336 saved_doc_string_size
= 0;
1338 xfree (prev_saved_doc_string
);
1339 prev_saved_doc_string
= 0;
1340 prev_saved_doc_string_size
= 0;
1342 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1345 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1348 message_with_string ("Loading %s (source)...done", file
, 1);
1350 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1352 else /* The typical case; compiled file newer than source file. */
1353 message_with_string ("Loading %s...done", file
, 1);
1360 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1362 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1373 load_descriptor_unwind (Lisp_Object oldlist
)
1375 load_descriptor_list
= oldlist
;
1379 /* Close all descriptors in use for Floads.
1380 This is used when starting a subprocess. */
1383 close_load_descs (void)
1387 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1388 emacs_close (XFASTINT (XCAR (tail
)));
1393 complete_filename_p (Lisp_Object pathname
)
1395 register const unsigned char *s
= SDATA (pathname
);
1396 return (IS_DIRECTORY_SEP (s
[0])
1397 || (SCHARS (pathname
) > 2
1398 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1401 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1402 doc
: /* Search for FILENAME through PATH.
1403 Returns the file's name in absolute form, or nil if not found.
1404 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1405 file name when searching.
1406 If non-nil, PREDICATE is used instead of `file-readable-p'.
1407 PREDICATE can also be an integer to pass to the access(2) function,
1408 in which case file-name-handlers are ignored.
1409 This function will normally skip directories, so if you want it to find
1410 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1411 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1414 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1415 if (NILP (predicate
) && fd
> 0)
1420 static Lisp_Object Qdir_ok
;
1422 /* Search for a file whose name is STR, looking in directories
1423 in the Lisp list PATH, and trying suffixes from SUFFIX.
1424 On success, returns a file descriptor. On failure, returns -1.
1426 SUFFIXES is a list of strings containing possible suffixes.
1427 The empty suffix is automatically added if the list is empty.
1429 PREDICATE non-nil means don't open the files,
1430 just look for one that satisfies the predicate. In this case,
1431 returns 1 on success. The predicate can be a lisp function or
1432 an integer to pass to `access' (in which case file-name-handlers
1435 If STOREPTR is nonzero, it points to a slot where the name of
1436 the file actually found should be stored as a Lisp string.
1437 nil is stored there on failure.
1439 If the file we find is remote, return -2
1440 but store the found remote file name in *STOREPTR. */
1443 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1446 ptrdiff_t fn_size
= 100;
1448 register char *fn
= buf
;
1450 ptrdiff_t want_length
;
1451 Lisp_Object filename
;
1453 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1454 Lisp_Object string
, tail
, encoded_fn
;
1455 ptrdiff_t max_suffix_len
= 0;
1459 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1461 CHECK_STRING_CAR (tail
);
1462 max_suffix_len
= max (max_suffix_len
,
1463 SBYTES (XCAR (tail
)));
1466 string
= filename
= encoded_fn
= Qnil
;
1467 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1472 if (complete_filename_p (str
))
1475 for (; CONSP (path
); path
= XCDR (path
))
1477 filename
= Fexpand_file_name (str
, XCAR (path
));
1478 if (!complete_filename_p (filename
))
1479 /* If there are non-absolute elts in PATH (eg ".") */
1480 /* Of course, this could conceivably lose if luser sets
1481 default-directory to be something non-absolute... */
1483 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1484 if (!complete_filename_p (filename
))
1485 /* Give up on this path element! */
1489 /* Calculate maximum length of any filename made from
1490 this path element/specified file name and any possible suffix. */
1491 want_length
= max_suffix_len
+ SBYTES (filename
);
1492 if (fn_size
<= want_length
)
1493 fn
= (char *) alloca (fn_size
= 100 + want_length
);
1495 /* Loop over suffixes. */
1496 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1497 CONSP (tail
); tail
= XCDR (tail
))
1499 ptrdiff_t lsuffix
= SBYTES (XCAR (tail
));
1500 Lisp_Object handler
;
1503 /* Concatenate path element/specified name with the suffix.
1504 If the directory starts with /:, remove that. */
1505 if (SCHARS (filename
) > 2
1506 && SREF (filename
, 0) == '/'
1507 && SREF (filename
, 1) == ':')
1509 strncpy (fn
, SSDATA (filename
) + 2,
1510 SBYTES (filename
) - 2);
1511 fn
[SBYTES (filename
) - 2] = 0;
1515 strncpy (fn
, SSDATA (filename
),
1517 fn
[SBYTES (filename
)] = 0;
1520 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1521 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1523 /* Check that the file exists and is not a directory. */
1524 /* We used to only check for handlers on non-absolute file names:
1528 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1529 It's not clear why that was the case and it breaks things like
1530 (load "/bar.el") where the file is actually "/bar.el.gz". */
1531 string
= build_string (fn
);
1532 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1533 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1535 if (NILP (predicate
))
1536 exists
= !NILP (Ffile_readable_p (string
));
1539 Lisp_Object tmp
= call1 (predicate
, string
);
1540 exists
= !NILP (tmp
)
1541 && (EQ (tmp
, Qdir_ok
)
1542 || NILP (Ffile_directory_p (string
)));
1547 /* We succeeded; return this descriptor and filename. */
1558 encoded_fn
= ENCODE_FILE (string
);
1559 pfn
= SSDATA (encoded_fn
);
1560 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1563 /* Check that we can access or open it. */
1564 if (NATNUMP (predicate
))
1565 fd
= (((XFASTINT (predicate
) & ~INT_MAX
) == 0
1566 && access (pfn
, XFASTINT (predicate
)) == 0)
1569 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1573 /* We succeeded; return this descriptor and filename. */
1591 /* Merge the list we've accumulated of globals from the current input source
1592 into the load_history variable. The details depend on whether
1593 the source has an associated file name or not.
1595 FILENAME is the file name that we are loading from.
1596 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1599 build_load_history (Lisp_Object filename
, int entire
)
1601 register Lisp_Object tail
, prev
, newelt
;
1602 register Lisp_Object tem
, tem2
;
1603 register int foundit
= 0;
1605 tail
= Vload_history
;
1608 while (CONSP (tail
))
1612 /* Find the feature's previous assoc list... */
1613 if (!NILP (Fequal (filename
, Fcar (tem
))))
1617 /* If we're loading the entire file, remove old data. */
1621 Vload_history
= XCDR (tail
);
1623 Fsetcdr (prev
, XCDR (tail
));
1626 /* Otherwise, cons on new symbols that are not already members. */
1629 tem2
= Vcurrent_load_list
;
1631 while (CONSP (tem2
))
1633 newelt
= XCAR (tem2
);
1635 if (NILP (Fmember (newelt
, tem
)))
1636 Fsetcar (tail
, Fcons (XCAR (tem
),
1637 Fcons (newelt
, XCDR (tem
))));
1650 /* If we're loading an entire file, cons the new assoc onto the
1651 front of load-history, the most-recently-loaded position. Also
1652 do this if we didn't find an existing member for the file. */
1653 if (entire
|| !foundit
)
1654 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1659 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1666 readevalloop_1 (Lisp_Object old
)
1668 load_convert_to_unibyte
= ! NILP (old
);
1672 /* Signal an `end-of-file' error, if possible with file name
1676 end_of_file_error (void)
1678 if (STRINGP (Vload_file_name
))
1679 xsignal1 (Qend_of_file
, Vload_file_name
);
1681 xsignal0 (Qend_of_file
);
1684 /* UNIBYTE specifies how to set load_convert_to_unibyte
1685 for this invocation.
1686 READFUN, if non-nil, is used instead of `read'.
1688 START, END specify region to read in current buffer (from eval-region).
1689 If the input is not from a buffer, they must be nil. */
1692 readevalloop (Lisp_Object readcharfun
,
1694 Lisp_Object sourcename
,
1696 Lisp_Object unibyte
, Lisp_Object readfun
,
1697 Lisp_Object start
, Lisp_Object end
)
1700 register Lisp_Object val
;
1701 ptrdiff_t count
= SPECPDL_INDEX ();
1702 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1703 struct buffer
*b
= 0;
1704 int continue_reading_p
;
1705 Lisp_Object lex_bound
;
1706 /* Nonzero if reading an entire buffer. */
1707 int whole_buffer
= 0;
1708 /* 1 on the first time around. */
1711 if (MARKERP (readcharfun
))
1714 start
= readcharfun
;
1717 if (BUFFERP (readcharfun
))
1718 b
= XBUFFER (readcharfun
);
1719 else if (MARKERP (readcharfun
))
1720 b
= XMARKER (readcharfun
)->buffer
;
1722 /* We assume START is nil when input is not from a buffer. */
1723 if (! NILP (start
) && !b
)
1726 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1727 specbind (Qcurrent_load_list
, Qnil
);
1728 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1729 load_convert_to_unibyte
= !NILP (unibyte
);
1731 /* If lexical binding is active (either because it was specified in
1732 the file's header, or via a buffer-local variable), create an empty
1733 lexical environment, otherwise, turn off lexical binding. */
1734 lex_bound
= find_symbol_value (Qlexical_binding
);
1735 specbind (Qinternal_interpreter_environment
,
1736 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1737 ? Qnil
: Fcons (Qt
, Qnil
));
1739 GCPRO4 (sourcename
, readfun
, start
, end
);
1741 /* Try to ensure sourcename is a truename, except whilst preloading. */
1742 if (NILP (Vpurify_flag
)
1743 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1744 && !NILP (Ffboundp (Qfile_truename
)))
1745 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1747 LOADHIST_ATTACH (sourcename
);
1749 continue_reading_p
= 1;
1750 while (continue_reading_p
)
1752 ptrdiff_t count1
= SPECPDL_INDEX ();
1754 if (b
!= 0 && NILP (BVAR (b
, name
)))
1755 error ("Reading from killed buffer");
1759 /* Switch to the buffer we are reading from. */
1760 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1761 set_buffer_internal (b
);
1763 /* Save point in it. */
1764 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1765 /* Save ZV in it. */
1766 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1767 /* Those get unbound after we read one expression. */
1769 /* Set point and ZV around stuff to be read. */
1772 Fnarrow_to_region (make_number (BEGV
), end
);
1774 /* Just for cleanliness, convert END to a marker
1775 if it is an integer. */
1777 end
= Fpoint_max_marker ();
1780 /* On the first cycle, we can easily test here
1781 whether we are reading the whole buffer. */
1782 if (b
&& first_sexp
)
1783 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1790 while ((c
= READCHAR
) != '\n' && c
!= -1);
1795 unbind_to (count1
, Qnil
);
1799 /* Ignore whitespace here, so we can detect eof. */
1800 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1801 || c
== 0x8a0) /* NBSP */
1804 if (!NILP (Vpurify_flag
) && c
== '(')
1806 record_unwind_protect (unreadpure
, Qnil
);
1807 val
= read_list (-1, readcharfun
);
1812 read_objects
= Qnil
;
1813 if (!NILP (readfun
))
1815 val
= call1 (readfun
, readcharfun
);
1817 /* If READCHARFUN has set point to ZV, we should
1818 stop reading, even if the form read sets point
1819 to a different value when evaluated. */
1820 if (BUFFERP (readcharfun
))
1822 struct buffer
*buf
= XBUFFER (readcharfun
);
1823 if (BUF_PT (buf
) == BUF_ZV (buf
))
1824 continue_reading_p
= 0;
1827 else if (! NILP (Vload_read_function
))
1828 val
= call1 (Vload_read_function
, readcharfun
);
1830 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1833 if (!NILP (start
) && continue_reading_p
)
1834 start
= Fpoint_marker ();
1836 /* Restore saved point and BEGV. */
1837 unbind_to (count1
, Qnil
);
1839 /* Now eval what we just read. */
1840 val
= eval_sub (val
);
1844 Vvalues
= Fcons (val
, Vvalues
);
1845 if (EQ (Vstandard_output
, Qt
))
1854 build_load_history (sourcename
,
1855 stream
|| whole_buffer
);
1859 unbind_to (count
, Qnil
);
1862 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1863 doc
: /* Execute the current buffer as Lisp code.
1864 When called from a Lisp program (i.e., not interactively), this
1865 function accepts up to five optional arguments:
1866 BUFFER is the buffer to evaluate (nil means use current buffer).
1867 PRINTFLAG controls printing of output:
1868 A value of nil means discard it; anything else is stream for print.
1869 FILENAME specifies the file name to use for `load-history'.
1870 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1872 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1873 functions should work normally even if PRINTFLAG is nil.
1875 This function preserves the position of point. */)
1876 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1878 ptrdiff_t count
= SPECPDL_INDEX ();
1879 Lisp_Object tem
, buf
;
1882 buf
= Fcurrent_buffer ();
1884 buf
= Fget_buffer (buffer
);
1886 error ("No such buffer");
1888 if (NILP (printflag
) && NILP (do_allow_print
))
1893 if (NILP (filename
))
1894 filename
= BVAR (XBUFFER (buf
), filename
);
1896 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1897 specbind (Qstandard_output
, tem
);
1898 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1899 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1900 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1901 readevalloop (buf
, 0, filename
,
1902 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1903 unbind_to (count
, Qnil
);
1908 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1909 doc
: /* Execute the region as Lisp code.
1910 When called from programs, expects two arguments,
1911 giving starting and ending indices in the current buffer
1912 of the text to be executed.
1913 Programs can pass third argument PRINTFLAG which controls output:
1914 A value of nil means discard it; anything else is stream for printing it.
1915 Also the fourth argument READ-FUNCTION, if non-nil, is used
1916 instead of `read' to read each expression. It gets one argument
1917 which is the input stream for reading characters.
1919 This function does not move point. */)
1920 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1922 /* FIXME: Do the eval-sexp-add-defvars danse! */
1923 ptrdiff_t count
= SPECPDL_INDEX ();
1924 Lisp_Object tem
, cbuf
;
1926 cbuf
= Fcurrent_buffer ();
1928 if (NILP (printflag
))
1932 specbind (Qstandard_output
, tem
);
1933 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1935 /* readevalloop calls functions which check the type of start and end. */
1936 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1937 !NILP (printflag
), Qnil
, read_function
,
1940 return unbind_to (count
, Qnil
);
1944 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1945 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1946 If STREAM is nil, use the value of `standard-input' (which see).
1947 STREAM or the value of `standard-input' may be:
1948 a buffer (read from point and advance it)
1949 a marker (read from where it points and advance it)
1950 a function (call it with no arguments for each character,
1951 call it with a char as argument to push a char back)
1952 a string (takes text from string, starting at the beginning)
1953 t (read text line using minibuffer and use it, or read from
1954 standard input in batch mode). */)
1955 (Lisp_Object stream
)
1958 stream
= Vstandard_input
;
1959 if (EQ (stream
, Qt
))
1960 stream
= Qread_char
;
1961 if (EQ (stream
, Qread_char
))
1962 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1964 return read_internal_start (stream
, Qnil
, Qnil
);
1967 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1968 doc
: /* Read one Lisp expression which is represented as text by STRING.
1969 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1970 FINAL-STRING-INDEX is an integer giving the position of the next
1971 remaining chararacter in STRING.
1972 START and END optionally delimit a substring of STRING from which to read;
1973 they default to 0 and (length STRING) respectively. */)
1974 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1977 CHECK_STRING (string
);
1978 /* read_internal_start sets read_from_string_index. */
1979 ret
= read_internal_start (string
, start
, end
);
1980 return Fcons (ret
, make_number (read_from_string_index
));
1983 /* Function to set up the global context we need in toplevel read
1986 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1987 /* start, end only used when stream is a string. */
1992 new_backquote_flag
= 0;
1993 read_objects
= Qnil
;
1994 if (EQ (Vread_with_symbol_positions
, Qt
)
1995 || EQ (Vread_with_symbol_positions
, stream
))
1996 Vread_symbol_positions_list
= Qnil
;
1998 if (STRINGP (stream
)
1999 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2001 ptrdiff_t startval
, endval
;
2004 if (STRINGP (stream
))
2007 string
= XCAR (stream
);
2010 endval
= SCHARS (string
);
2014 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2015 args_out_of_range (string
, end
);
2016 endval
= XINT (end
);
2023 CHECK_NUMBER (start
);
2024 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2025 args_out_of_range (string
, start
);
2026 startval
= XINT (start
);
2028 read_from_string_index
= startval
;
2029 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2030 read_from_string_limit
= endval
;
2033 retval
= read0 (stream
);
2034 if (EQ (Vread_with_symbol_positions
, Qt
)
2035 || EQ (Vread_with_symbol_positions
, stream
))
2036 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2041 /* Signal Qinvalid_read_syntax error.
2042 S is error string of length N (if > 0) */
2045 invalid_syntax (const char *s
)
2047 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2051 /* Use this for recursive reads, in contexts where internal tokens
2055 read0 (Lisp_Object readcharfun
)
2057 register Lisp_Object val
;
2060 val
= read1 (readcharfun
, &c
, 0);
2064 xsignal1 (Qinvalid_read_syntax
,
2065 Fmake_string (make_number (1), make_number (c
)));
2068 static ptrdiff_t read_buffer_size
;
2069 static char *read_buffer
;
2071 /* Read a \-escape sequence, assuming we already read the `\'.
2072 If the escape sequence forces unibyte, return eight-bit char. */
2075 read_escape (Lisp_Object readcharfun
, int stringp
)
2077 register int c
= READCHAR
;
2078 /* \u allows up to four hex digits, \U up to eight. Default to the
2079 behavior for \u, and change this value in the case that \U is seen. */
2080 int unicode_hex_count
= 4;
2085 end_of_file_error ();
2115 error ("Invalid escape character syntax");
2118 c
= read_escape (readcharfun
, 0);
2119 return c
| meta_modifier
;
2124 error ("Invalid escape character syntax");
2127 c
= read_escape (readcharfun
, 0);
2128 return c
| shift_modifier
;
2133 error ("Invalid escape character syntax");
2136 c
= read_escape (readcharfun
, 0);
2137 return c
| hyper_modifier
;
2142 error ("Invalid escape character syntax");
2145 c
= read_escape (readcharfun
, 0);
2146 return c
| alt_modifier
;
2150 if (stringp
|| c
!= '-')
2157 c
= read_escape (readcharfun
, 0);
2158 return c
| super_modifier
;
2163 error ("Invalid escape character syntax");
2167 c
= read_escape (readcharfun
, 0);
2168 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2169 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2170 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2171 return c
| ctrl_modifier
;
2172 /* ASCII control chars are made from letters (both cases),
2173 as well as the non-letters within 0100...0137. */
2174 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2175 return (c
& (037 | ~0177));
2176 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2177 return (c
& (037 | ~0177));
2179 return c
| ctrl_modifier
;
2189 /* An octal escape, as in ANSI C. */
2191 register int i
= c
- '0';
2192 register int count
= 0;
2195 if ((c
= READCHAR
) >= '0' && c
<= '7')
2207 if (i
>= 0x80 && i
< 0x100)
2208 i
= BYTE8_TO_CHAR (i
);
2213 /* A hex escape, as in ANSI C. */
2220 if (c
>= '0' && c
<= '9')
2225 else if ((c
>= 'a' && c
<= 'f')
2226 || (c
>= 'A' && c
<= 'F'))
2229 if (c
>= 'a' && c
<= 'f')
2240 error ("Hex character out of range: \\x%x...", i
);
2244 if (count
< 3 && i
>= 0x80)
2245 return BYTE8_TO_CHAR (i
);
2250 /* Post-Unicode-2.0: Up to eight hex chars. */
2251 unicode_hex_count
= 8;
2254 /* A Unicode escape. We only permit them in strings and characters,
2255 not arbitrarily in the source code, as in some other languages. */
2260 while (++count
<= unicode_hex_count
)
2263 /* isdigit and isalpha may be locale-specific, which we don't
2265 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2266 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2267 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2269 error ("Non-hex digit used for Unicode escape");
2272 error ("Non-Unicode character: 0x%x", i
);
2281 /* Return the digit that CHARACTER stands for in the given BASE.
2282 Return -1 if CHARACTER is out of range for BASE,
2283 and -2 if CHARACTER is not valid for any supported BASE. */
2285 digit_to_number (int character
, int base
)
2289 if ('0' <= character
&& character
<= '9')
2290 digit
= character
- '0';
2291 else if ('a' <= character
&& character
<= 'z')
2292 digit
= character
- 'a' + 10;
2293 else if ('A' <= character
&& character
<= 'Z')
2294 digit
= character
- 'A' + 10;
2298 return digit
< base
? digit
: -1;
2301 /* Read an integer in radix RADIX using READCHARFUN to read
2302 characters. RADIX must be in the interval [2..36]; if it isn't, a
2303 read error is signaled . Value is the integer read. Signals an
2304 error if encountering invalid read syntax or if RADIX is out of
2308 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2310 /* Room for sign, leading 0, other digits, trailing null byte.
2311 Also, room for invalid syntax diagnostic. */
2312 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2313 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2315 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2317 if (radix
< 2 || radix
> 36)
2325 if (c
== '-' || c
== '+')
2336 /* Ignore redundant leading zeros, so the buffer doesn't
2337 fill up with them. */
2343 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2350 if (p
< buf
+ sizeof buf
- 1)
2364 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2365 invalid_syntax (buf
);
2368 return string_to_number (buf
, radix
, 0);
2372 /* If the next token is ')' or ']' or '.', we store that character
2373 in *PCH and the return value is not interesting. Else, we store
2374 zero in *PCH and we read and return one lisp object.
2376 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2379 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2382 unsigned uninterned_symbol
= 0;
2390 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2392 end_of_file_error ();
2397 return read_list (0, readcharfun
);
2400 return read_vector (readcharfun
, 0);
2416 /* Accept extended format for hashtables (extensible to
2418 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2419 Lisp_Object tmp
= read_list (0, readcharfun
);
2420 Lisp_Object head
= CAR_SAFE (tmp
);
2421 Lisp_Object data
= Qnil
;
2422 Lisp_Object val
= Qnil
;
2423 /* The size is 2 * number of allowed keywords to
2425 Lisp_Object params
[10];
2427 Lisp_Object key
= Qnil
;
2428 int param_count
= 0;
2430 if (!EQ (head
, Qhash_table
))
2431 error ("Invalid extended read marker at head of #s list "
2432 "(only hash-table allowed)");
2434 tmp
= CDR_SAFE (tmp
);
2436 /* This is repetitive but fast and simple. */
2437 params
[param_count
] = QCsize
;
2438 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2439 if (!NILP (params
[param_count
+ 1]))
2442 params
[param_count
] = QCtest
;
2443 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2444 if (!NILP (params
[param_count
+ 1]))
2447 params
[param_count
] = QCweakness
;
2448 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2449 if (!NILP (params
[param_count
+ 1]))
2452 params
[param_count
] = QCrehash_size
;
2453 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2454 if (!NILP (params
[param_count
+ 1]))
2457 params
[param_count
] = QCrehash_threshold
;
2458 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2459 if (!NILP (params
[param_count
+ 1]))
2462 /* This is the hashtable data. */
2463 data
= Fplist_get (tmp
, Qdata
);
2465 /* Now use params to make a new hashtable and fill it. */
2466 ht
= Fmake_hash_table (param_count
, params
);
2468 while (CONSP (data
))
2473 error ("Odd number of elements in hashtable data");
2476 Fputhash (key
, val
, ht
);
2482 invalid_syntax ("#");
2490 tmp
= read_vector (readcharfun
, 0);
2491 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2492 error ("Invalid size char-table");
2493 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2505 tmp
= read_vector (readcharfun
, 0);
2506 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2507 error ("Invalid depth in char-table");
2508 depth
= XINT (AREF (tmp
, 0));
2509 size
= ASIZE (tmp
) - 2;
2510 if (chartab_size
[depth
] != size
)
2511 error ("Invalid size char-table");
2512 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2515 invalid_syntax ("#^^");
2517 invalid_syntax ("#^");
2522 length
= read1 (readcharfun
, pch
, first_in_list
);
2526 Lisp_Object tmp
, val
;
2527 EMACS_INT size_in_chars
2528 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2529 / BOOL_VECTOR_BITS_PER_CHAR
);
2532 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2533 if (STRING_MULTIBYTE (tmp
)
2534 || (size_in_chars
!= SCHARS (tmp
)
2535 /* We used to print 1 char too many
2536 when the number of bits was a multiple of 8.
2537 Accept such input in case it came from an old
2539 && ! (XFASTINT (length
)
2540 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2541 invalid_syntax ("#&...");
2543 val
= Fmake_bool_vector (length
, Qnil
);
2544 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2545 /* Clear the extraneous bits in the last byte. */
2546 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2547 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2548 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2551 invalid_syntax ("#&...");
2555 /* Accept compiled functions at read-time so that we don't have to
2556 build them using function calls. */
2558 tmp
= read_vector (readcharfun
, 1);
2559 return Fmake_byte_code (ASIZE (tmp
),
2560 XVECTOR (tmp
)->contents
);
2565 struct gcpro gcpro1
;
2568 /* Read the string itself. */
2569 tmp
= read1 (readcharfun
, &ch
, 0);
2570 if (ch
!= 0 || !STRINGP (tmp
))
2571 invalid_syntax ("#");
2573 /* Read the intervals and their properties. */
2576 Lisp_Object beg
, end
, plist
;
2578 beg
= read1 (readcharfun
, &ch
, 0);
2583 end
= read1 (readcharfun
, &ch
, 0);
2585 plist
= read1 (readcharfun
, &ch
, 0);
2587 invalid_syntax ("Invalid string property list");
2588 Fset_text_properties (beg
, end
, plist
, tmp
);
2594 /* #@NUMBER is used to skip NUMBER following characters.
2595 That's used in .elc files to skip over doc strings
2596 and function definitions. */
2599 enum { extra
= 100 };
2600 ptrdiff_t i
, nskip
= 0;
2603 /* Read a decimal integer. */
2604 while ((c
= READCHAR
) >= 0
2605 && c
>= '0' && c
<= '9')
2607 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2614 if (load_force_doc_strings
2615 && (EQ (readcharfun
, Qget_file_char
)
2616 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2618 /* If we are supposed to force doc strings into core right now,
2619 record the last string that we skipped,
2620 and record where in the file it comes from. */
2622 /* But first exchange saved_doc_string
2623 with prev_saved_doc_string, so we save two strings. */
2625 char *temp
= saved_doc_string
;
2626 ptrdiff_t temp_size
= saved_doc_string_size
;
2627 file_offset temp_pos
= saved_doc_string_position
;
2628 ptrdiff_t temp_len
= saved_doc_string_length
;
2630 saved_doc_string
= prev_saved_doc_string
;
2631 saved_doc_string_size
= prev_saved_doc_string_size
;
2632 saved_doc_string_position
= prev_saved_doc_string_position
;
2633 saved_doc_string_length
= prev_saved_doc_string_length
;
2635 prev_saved_doc_string
= temp
;
2636 prev_saved_doc_string_size
= temp_size
;
2637 prev_saved_doc_string_position
= temp_pos
;
2638 prev_saved_doc_string_length
= temp_len
;
2641 if (saved_doc_string_size
== 0)
2643 saved_doc_string
= (char *) xmalloc (nskip
+ extra
);
2644 saved_doc_string_size
= nskip
+ extra
;
2646 if (nskip
> saved_doc_string_size
)
2648 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2650 saved_doc_string_size
= nskip
+ extra
;
2653 saved_doc_string_position
= file_tell (instream
);
2655 /* Copy that many characters into saved_doc_string. */
2656 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2657 saved_doc_string
[i
] = c
= READCHAR
;
2659 saved_doc_string_length
= i
;
2663 /* Skip that many characters. */
2664 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2673 /* #! appears at the beginning of an executable file.
2674 Skip the first line. */
2675 while (c
!= '\n' && c
>= 0)
2680 return Vload_file_name
;
2682 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2683 /* #:foo is the uninterned symbol named foo. */
2686 uninterned_symbol
= 1;
2691 || strchr ("\"';()[]#`,", c
) == NULL
)))
2693 /* No symbol character follows, this is the empty
2696 return Fmake_symbol (build_string (""));
2700 /* ## is the empty symbol. */
2702 return Fintern (build_string (""), Qnil
);
2703 /* Reader forms that can reuse previously read objects. */
2704 if (c
>= '0' && c
<= '9')
2709 /* Read a non-negative integer. */
2710 while (c
>= '0' && c
<= '9')
2712 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2713 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2714 n
= MOST_POSITIVE_FIXNUM
+ 1;
2716 n
= n
* 10 + c
- '0';
2720 if (n
<= MOST_POSITIVE_FIXNUM
)
2722 if (c
== 'r' || c
== 'R')
2723 return read_integer (readcharfun
, n
);
2725 if (! NILP (Vread_circle
))
2727 /* #n=object returns object, but associates it with
2731 /* Make a placeholder for #n# to use temporarily */
2732 Lisp_Object placeholder
;
2735 placeholder
= Fcons (Qnil
, Qnil
);
2736 cell
= Fcons (make_number (n
), placeholder
);
2737 read_objects
= Fcons (cell
, read_objects
);
2739 /* Read the object itself. */
2740 tem
= read0 (readcharfun
);
2742 /* Now put it everywhere the placeholder was... */
2743 substitute_object_in_subtree (tem
, placeholder
);
2745 /* ...and #n# will use the real value from now on. */
2746 Fsetcdr (cell
, tem
);
2751 /* #n# returns a previously read object. */
2754 tem
= Fassq (make_number (n
), read_objects
);
2760 /* Fall through to error message. */
2762 else if (c
== 'x' || c
== 'X')
2763 return read_integer (readcharfun
, 16);
2764 else if (c
== 'o' || c
== 'O')
2765 return read_integer (readcharfun
, 8);
2766 else if (c
== 'b' || c
== 'B')
2767 return read_integer (readcharfun
, 2);
2770 invalid_syntax ("#");
2773 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2778 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2783 int next_char
= READCHAR
;
2785 /* Transition from old-style to new-style:
2786 If we see "(`" it used to mean old-style, which usually works
2787 fine because ` should almost never appear in such a position
2788 for new-style. But occasionally we need "(`" to mean new
2789 style, so we try to distinguish the two by the fact that we
2790 can either write "( `foo" or "(` foo", where the first
2791 intends to use new-style whereas the second intends to use
2792 old-style. For Emacs-25, we should completely remove this
2793 first_in_list exception (old-style can still be obtained via
2795 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2797 Vold_style_backquotes
= Qt
;
2804 new_backquote_flag
++;
2805 value
= read0 (readcharfun
);
2806 new_backquote_flag
--;
2808 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2813 int next_char
= READCHAR
;
2815 /* Transition from old-style to new-style:
2816 It used to be impossible to have a new-style , other than within
2817 a new-style `. This is sufficient when ` and , are used in the
2818 normal way, but ` and , can also appear in args to macros that
2819 will not interpret them in the usual way, in which case , may be
2820 used without any ` anywhere near.
2821 So we now use the same heuristic as for backquote: old-style
2822 unquotes are only recognized when first on a list, and when
2823 followed by a space.
2824 Because it's more difficult to peak 2 chars ahead, a new-style
2825 ,@ can still not be used outside of a `, unless it's in the middle
2827 if (new_backquote_flag
2829 || (next_char
!= ' ' && next_char
!= '@'))
2831 Lisp_Object comma_type
= Qnil
;
2836 comma_type
= Qcomma_at
;
2838 comma_type
= Qcomma_dot
;
2841 if (ch
>= 0) UNREAD (ch
);
2842 comma_type
= Qcomma
;
2845 value
= read0 (readcharfun
);
2846 return Fcons (comma_type
, Fcons (value
, Qnil
));
2850 Vold_style_backquotes
= Qt
;
2862 end_of_file_error ();
2864 /* Accept `single space' syntax like (list ? x) where the
2865 whitespace character is SPC or TAB.
2866 Other literal whitespace like NL, CR, and FF are not accepted,
2867 as there are well-established escape sequences for these. */
2868 if (c
== ' ' || c
== '\t')
2869 return make_number (c
);
2872 c
= read_escape (readcharfun
, 0);
2873 modifiers
= c
& CHAR_MODIFIER_MASK
;
2874 c
&= ~CHAR_MODIFIER_MASK
;
2875 if (CHAR_BYTE8_P (c
))
2876 c
= CHAR_TO_BYTE8 (c
);
2879 next_char
= READCHAR
;
2880 ok
= (next_char
<= 040
2881 || (next_char
< 0200
2882 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2885 return make_number (c
);
2887 invalid_syntax ("?");
2892 char *p
= read_buffer
;
2893 char *end
= read_buffer
+ read_buffer_size
;
2895 /* Nonzero if we saw an escape sequence specifying
2896 a multibyte character. */
2897 int force_multibyte
= 0;
2898 /* Nonzero if we saw an escape sequence specifying
2899 a single-byte character. */
2900 int force_singlebyte
= 0;
2902 ptrdiff_t nchars
= 0;
2904 while ((ch
= READCHAR
) >= 0
2907 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2909 ptrdiff_t offset
= p
- read_buffer
;
2910 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2911 memory_full (SIZE_MAX
);
2912 read_buffer
= (char *) xrealloc (read_buffer
,
2913 read_buffer_size
* 2);
2914 read_buffer_size
*= 2;
2915 p
= read_buffer
+ offset
;
2916 end
= read_buffer
+ read_buffer_size
;
2923 ch
= read_escape (readcharfun
, 1);
2925 /* CH is -1 if \ newline has just been seen */
2928 if (p
== read_buffer
)
2933 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2934 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2936 if (CHAR_BYTE8_P (ch
))
2937 force_singlebyte
= 1;
2938 else if (! ASCII_CHAR_P (ch
))
2939 force_multibyte
= 1;
2940 else /* i.e. ASCII_CHAR_P (ch) */
2942 /* Allow `\C- ' and `\C-?'. */
2943 if (modifiers
== CHAR_CTL
)
2946 ch
= 0, modifiers
= 0;
2948 ch
= 127, modifiers
= 0;
2950 if (modifiers
& CHAR_SHIFT
)
2952 /* Shift modifier is valid only with [A-Za-z]. */
2953 if (ch
>= 'A' && ch
<= 'Z')
2954 modifiers
&= ~CHAR_SHIFT
;
2955 else if (ch
>= 'a' && ch
<= 'z')
2956 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2959 if (modifiers
& CHAR_META
)
2961 /* Move the meta bit to the right place for a
2963 modifiers
&= ~CHAR_META
;
2964 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2965 force_singlebyte
= 1;
2969 /* Any modifiers remaining are invalid. */
2971 error ("Invalid modifier in string");
2972 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2976 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2977 if (CHAR_BYTE8_P (ch
))
2978 force_singlebyte
= 1;
2979 else if (! ASCII_CHAR_P (ch
))
2980 force_multibyte
= 1;
2986 end_of_file_error ();
2988 /* If purifying, and string starts with \ newline,
2989 return zero instead. This is for doc strings
2990 that we are really going to find in etc/DOC.nn.nn */
2991 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2992 return make_number (0);
2994 if (force_multibyte
)
2995 /* READ_BUFFER already contains valid multibyte forms. */
2997 else if (force_singlebyte
)
2999 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3001 p
= read_buffer
+ nchars
;
3005 /* Otherwise, READ_BUFFER contains only ASCII. */
3009 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
3011 || (p
- read_buffer
!= nchars
)));
3012 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3014 || (p
- read_buffer
!= nchars
)));
3019 int next_char
= READCHAR
;
3022 if (next_char
<= 040
3023 || (next_char
< 0200
3024 && strchr ("\"';([#?`,", next_char
) != NULL
))
3030 /* Otherwise, we fall through! Note that the atom-reading loop
3031 below will now loop at least once, assuring that we will not
3032 try to UNREAD two characters in a row. */
3036 if (c
<= 040) goto retry
;
3037 if (c
== 0x8a0) /* NBSP */
3042 char *p
= read_buffer
;
3044 EMACS_INT start_position
= readchar_count
- 1;
3047 char *end
= read_buffer
+ read_buffer_size
;
3051 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3053 ptrdiff_t offset
= p
- read_buffer
;
3054 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3055 memory_full (SIZE_MAX
);
3056 read_buffer
= (char *) xrealloc (read_buffer
,
3057 read_buffer_size
* 2);
3058 read_buffer_size
*= 2;
3059 p
= read_buffer
+ offset
;
3060 end
= read_buffer
+ read_buffer_size
;
3067 end_of_file_error ();
3072 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3078 && c
!= 0x8a0 /* NBSP */
3080 || strchr ("\"';()[]#`,", c
) == NULL
));
3084 ptrdiff_t offset
= p
- read_buffer
;
3085 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3086 memory_full (SIZE_MAX
);
3087 read_buffer
= (char *) xrealloc (read_buffer
,
3088 read_buffer_size
* 2);
3089 read_buffer_size
*= 2;
3090 p
= read_buffer
+ offset
;
3091 end
= read_buffer
+ read_buffer_size
;
3097 if (!quoted
&& !uninterned_symbol
)
3099 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3100 if (! NILP (result
))
3104 Lisp_Object name
, result
;
3105 ptrdiff_t nbytes
= p
- read_buffer
;
3108 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3112 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3113 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3115 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3116 result
= (uninterned_symbol
? Fmake_symbol (name
)
3117 : Fintern (name
, Qnil
));
3119 if (EQ (Vread_with_symbol_positions
, Qt
)
3120 || EQ (Vread_with_symbol_positions
, readcharfun
))
3121 Vread_symbol_positions_list
=
3122 Fcons (Fcons (result
, make_number (start_position
)),
3123 Vread_symbol_positions_list
);
3131 /* List of nodes we've seen during substitute_object_in_subtree. */
3132 static Lisp_Object seen_list
;
3135 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3137 Lisp_Object check_object
;
3139 /* We haven't seen any objects when we start. */
3142 /* Make all the substitutions. */
3144 = substitute_object_recurse (object
, placeholder
, object
);
3146 /* Clear seen_list because we're done with it. */
3149 /* The returned object here is expected to always eq the
3151 if (!EQ (check_object
, object
))
3152 error ("Unexpected mutation error in reader");
3155 /* Feval doesn't get called from here, so no gc protection is needed. */
3156 #define SUBSTITUTE(get_val, set_val) \
3158 Lisp_Object old_value = get_val; \
3159 Lisp_Object true_value \
3160 = substitute_object_recurse (object, placeholder, \
3163 if (!EQ (old_value, true_value)) \
3170 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3172 /* If we find the placeholder, return the target object. */
3173 if (EQ (placeholder
, subtree
))
3176 /* If we've been to this node before, don't explore it again. */
3177 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3180 /* If this node can be the entry point to a cycle, remember that
3181 we've seen it. It can only be such an entry point if it was made
3182 by #n=, which means that we can find it as a value in
3184 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3185 seen_list
= Fcons (subtree
, seen_list
);
3187 /* Recurse according to subtree's type.
3188 Every branch must return a Lisp_Object. */
3189 switch (XTYPE (subtree
))
3191 case Lisp_Vectorlike
:
3193 ptrdiff_t i
, length
= 0;
3194 if (BOOL_VECTOR_P (subtree
))
3195 return subtree
; /* No sub-objects anyway. */
3196 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3197 || COMPILEDP (subtree
))
3198 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3199 else if (VECTORP (subtree
))
3200 length
= ASIZE (subtree
);
3202 /* An unknown pseudovector may contain non-Lisp fields, so we
3203 can't just blindly traverse all its fields. We used to call
3204 `Flength' which signaled `sequencep', so I just preserved this
3206 wrong_type_argument (Qsequencep
, subtree
);
3208 for (i
= 0; i
< length
; i
++)
3209 SUBSTITUTE (AREF (subtree
, i
),
3210 ASET (subtree
, i
, true_value
));
3216 SUBSTITUTE (XCAR (subtree
),
3217 XSETCAR (subtree
, true_value
));
3218 SUBSTITUTE (XCDR (subtree
),
3219 XSETCDR (subtree
, true_value
));
3225 /* Check for text properties in each interval.
3226 substitute_in_interval contains part of the logic. */
3228 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3229 Lisp_Object arg
= Fcons (object
, placeholder
);
3231 traverse_intervals_noorder (root_interval
,
3232 &substitute_in_interval
, arg
);
3237 /* Other types don't recurse any further. */
3243 /* Helper function for substitute_object_recurse. */
3245 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3247 Lisp_Object object
= Fcar (arg
);
3248 Lisp_Object placeholder
= Fcdr (arg
);
3250 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3260 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3261 integer syntax and fits in a fixnum, else return the nearest float if CP has
3262 either floating point or integer syntax and BASE is 10, else return nil. If
3263 IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
3264 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3265 number has integer syntax but does not fit. */
3268 string_to_number (char const *string
, int base
, int ignore_trailing
)
3271 char const *cp
= string
;
3273 int float_syntax
= 0;
3276 /* Compute NaN and infinities using a variable, to cope with compilers that
3277 think they are smarter than we are. */
3280 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3281 IEEE floating point hosts, and works around a formerly-common bug where
3282 atof ("-0.0") drops the sign. */
3283 int negative
= *cp
== '-';
3285 int signedp
= negative
|| *cp
== '+';
3290 leading_digit
= digit_to_number (*cp
, base
);
3291 if (0 <= leading_digit
)
3296 while (0 <= digit_to_number (*cp
, base
));
3306 if ('0' <= *cp
&& *cp
<= '9')
3311 while ('0' <= *cp
&& *cp
<= '9');
3313 if (*cp
== 'e' || *cp
== 'E')
3315 char const *ecp
= cp
;
3317 if (*cp
== '+' || *cp
== '-')
3319 if ('0' <= *cp
&& *cp
<= '9')
3324 while ('0' <= *cp
&& *cp
<= '9');
3326 else if (cp
[-1] == '+'
3327 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3333 else if (cp
[-1] == '+'
3334 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3338 value
= zero
/ zero
;
3340 /* If that made a "negative" NaN, negate it. */
3343 union { double d
; char c
[sizeof (double)]; }
3344 u_data
, u_minus_zero
;
3346 u_minus_zero
.d
= -0.0;
3347 for (i
= 0; i
< sizeof (double); i
++)
3348 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3354 /* Now VALUE is a positive NaN. */
3360 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3361 || state
== (LEAD_INT
|E_EXP
));
3364 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3365 any prefix that matches. Otherwise, the entire string must match. */
3366 if (! (ignore_trailing
3367 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3368 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3371 /* If the number uses integer and not float syntax, and is in C-language
3372 range, use its value, preferably as a fixnum. */
3373 if (0 <= leading_digit
&& ! float_syntax
)
3377 /* Fast special case for single-digit integers. This also avoids a
3378 glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
3379 case some versions of strtoumax accept numbers like "0x1" that Emacs
3381 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3382 return make_number (negative
? -leading_digit
: leading_digit
);
3385 n
= strtoumax (string
+ signedp
, NULL
, base
);
3386 if (errno
== ERANGE
)
3388 /* Unfortunately there's no simple and accurate way to convert
3389 non-base-10 numbers that are out of C-language range. */
3391 xsignal1 (Qoverflow_error
, build_string (string
));
3393 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3395 EMACS_INT signed_n
= n
;
3396 return make_number (negative
? -signed_n
: signed_n
);
3402 /* Either the number uses float syntax, or it does not fit into a fixnum.
3403 Convert it from string to floating point, unless the value is already
3404 known because it is an infinity, a NAN, or its absolute value fits in
3407 value
= atof (string
+ signedp
);
3409 return make_float (negative
? -value
: value
);
3414 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3417 register Lisp_Object
*ptr
;
3418 register Lisp_Object tem
, item
, vector
;
3419 register struct Lisp_Cons
*otem
;
3422 tem
= read_list (1, readcharfun
);
3423 len
= Flength (tem
);
3424 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3426 size
= ASIZE (vector
);
3427 ptr
= XVECTOR (vector
)->contents
;
3428 for (i
= 0; i
< size
; i
++)
3431 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3432 bytecode object, the docstring containing the bytecode and
3433 constants values must be treated as unibyte and passed to
3434 Fread, to get the actual bytecode string and constants vector. */
3435 if (bytecodeflag
&& load_force_doc_strings
)
3437 if (i
== COMPILED_BYTECODE
)
3439 if (!STRINGP (item
))
3440 error ("Invalid byte code");
3442 /* Delay handling the bytecode slot until we know whether
3443 it is lazily-loaded (we can tell by whether the
3444 constants slot is nil). */
3445 ptr
[COMPILED_CONSTANTS
] = item
;
3448 else if (i
== COMPILED_CONSTANTS
)
3450 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3454 /* Coerce string to unibyte (like string-as-unibyte,
3455 but without generating extra garbage and
3456 guaranteeing no change in the contents). */
3457 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3458 STRING_SET_UNIBYTE (bytestr
);
3460 item
= Fread (Fcons (bytestr
, readcharfun
));
3462 error ("Invalid byte code");
3464 otem
= XCONS (item
);
3465 bytestr
= XCAR (item
);
3470 /* Now handle the bytecode slot. */
3471 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3473 else if (i
== COMPILED_DOC_STRING
3475 && ! STRING_MULTIBYTE (item
))
3477 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3478 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3480 item
= Fstring_as_multibyte (item
);
3483 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3491 /* FLAG = 1 means check for ] to terminate rather than ) and .
3492 FLAG = -1 means check for starting with defun
3493 and make structure pure. */
3496 read_list (int flag
, register Lisp_Object readcharfun
)
3498 /* -1 means check next element for defun,
3499 0 means don't check,
3500 1 means already checked and found defun. */
3501 int defunflag
= flag
< 0 ? -1 : 0;
3502 Lisp_Object val
, tail
;
3503 register Lisp_Object elt
, tem
;
3504 struct gcpro gcpro1
, gcpro2
;
3505 /* 0 is the normal case.
3506 1 means this list is a doc reference; replace it with the number 0.
3507 2 means this list is a doc reference; replace it with the doc string. */
3508 int doc_reference
= 0;
3510 /* Initialize this to 1 if we are reading a list. */
3511 int first_in_list
= flag
<= 0;
3520 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3525 /* While building, if the list starts with #$, treat it specially. */
3526 if (EQ (elt
, Vload_file_name
)
3528 && !NILP (Vpurify_flag
))
3530 if (NILP (Vdoc_file_name
))
3531 /* We have not yet called Snarf-documentation, so assume
3532 this file is described in the DOC-MM.NN file
3533 and Snarf-documentation will fill in the right value later.
3534 For now, replace the whole list with 0. */
3537 /* We have already called Snarf-documentation, so make a relative
3538 file name for this file, so it can be found properly
3539 in the installed Lisp directory.
3540 We don't use Fexpand_file_name because that would make
3541 the directory absolute now. */
3542 elt
= concat2 (build_string ("../lisp/"),
3543 Ffile_name_nondirectory (elt
));
3545 else if (EQ (elt
, Vload_file_name
)
3547 && load_force_doc_strings
)
3556 invalid_syntax (") or . in a vector");
3564 XSETCDR (tail
, read0 (readcharfun
));
3566 val
= read0 (readcharfun
);
3567 read1 (readcharfun
, &ch
, 0);
3571 if (doc_reference
== 1)
3572 return make_number (0);
3573 if (doc_reference
== 2)
3575 /* Get a doc string from the file we are loading.
3576 If it's in saved_doc_string, get it from there.
3578 Here, we don't know if the string is a
3579 bytecode string or a doc string. As a
3580 bytecode string must be unibyte, we always
3581 return a unibyte string. If it is actually a
3582 doc string, caller must make it
3585 EMACS_INT pos
= XINT (XCDR (val
));
3586 /* Position is negative for user variables. */
3587 if (pos
< 0) pos
= -pos
;
3588 if (pos
>= saved_doc_string_position
3589 && pos
< (saved_doc_string_position
3590 + saved_doc_string_length
))
3592 ptrdiff_t start
= pos
- saved_doc_string_position
;
3595 /* Process quoting with ^A,
3596 and find the end of the string,
3597 which is marked with ^_ (037). */
3598 for (from
= start
, to
= start
;
3599 saved_doc_string
[from
] != 037;)
3601 int c
= saved_doc_string
[from
++];
3604 c
= saved_doc_string
[from
++];
3606 saved_doc_string
[to
++] = c
;
3608 saved_doc_string
[to
++] = 0;
3610 saved_doc_string
[to
++] = 037;
3613 saved_doc_string
[to
++] = c
;
3616 return make_unibyte_string (saved_doc_string
+ start
,
3619 /* Look in prev_saved_doc_string the same way. */
3620 else if (pos
>= prev_saved_doc_string_position
3621 && pos
< (prev_saved_doc_string_position
3622 + prev_saved_doc_string_length
))
3625 pos
- prev_saved_doc_string_position
;
3628 /* Process quoting with ^A,
3629 and find the end of the string,
3630 which is marked with ^_ (037). */
3631 for (from
= start
, to
= start
;
3632 prev_saved_doc_string
[from
] != 037;)
3634 int c
= prev_saved_doc_string
[from
++];
3637 c
= prev_saved_doc_string
[from
++];
3639 prev_saved_doc_string
[to
++] = c
;
3641 prev_saved_doc_string
[to
++] = 0;
3643 prev_saved_doc_string
[to
++] = 037;
3646 prev_saved_doc_string
[to
++] = c
;
3649 return make_unibyte_string (prev_saved_doc_string
3654 return get_doc_string (val
, 1, 0);
3659 invalid_syntax (". in wrong context");
3661 invalid_syntax ("] in a list");
3663 tem
= (read_pure
&& flag
<= 0
3664 ? pure_cons (elt
, Qnil
)
3665 : Fcons (elt
, Qnil
));
3667 XSETCDR (tail
, tem
);
3672 defunflag
= EQ (elt
, Qdefun
);
3673 else if (defunflag
> 0)
3678 static Lisp_Object initial_obarray
;
3680 /* oblookup stores the bucket number here, for the sake of Funintern. */
3682 static size_t oblookup_last_bucket_number
;
3684 /* Get an error if OBARRAY is not an obarray.
3685 If it is one, return it. */
3688 check_obarray (Lisp_Object obarray
)
3690 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3692 /* If Vobarray is now invalid, force it to be valid. */
3693 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3694 wrong_type_argument (Qvectorp
, obarray
);
3699 /* Intern the C string STR: return a symbol with that name,
3700 interned in the current obarray. */
3703 intern (const char *str
)
3706 ptrdiff_t len
= strlen (str
);
3707 Lisp_Object obarray
;
3710 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3711 obarray
= check_obarray (obarray
);
3712 tem
= oblookup (obarray
, str
, len
, len
);
3715 return Fintern (make_string (str
, len
), obarray
);
3719 intern_c_string (const char *str
)
3722 ptrdiff_t len
= strlen (str
);
3723 Lisp_Object obarray
;
3726 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3727 obarray
= check_obarray (obarray
);
3728 tem
= oblookup (obarray
, str
, len
, len
);
3732 if (NILP (Vpurify_flag
))
3733 /* Creating a non-pure string from a string literal not
3734 implemented yet. We could just use make_string here and live
3735 with the extra copy. */
3738 return Fintern (make_pure_c_string (str
), obarray
);
3741 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3742 doc
: /* Return the canonical symbol whose name is STRING.
3743 If there is none, one is created by this function and returned.
3744 A second optional argument specifies the obarray to use;
3745 it defaults to the value of `obarray'. */)
3746 (Lisp_Object string
, Lisp_Object obarray
)
3748 register Lisp_Object tem
, sym
, *ptr
;
3750 if (NILP (obarray
)) obarray
= Vobarray
;
3751 obarray
= check_obarray (obarray
);
3753 CHECK_STRING (string
);
3755 tem
= oblookup (obarray
, SSDATA (string
),
3758 if (!INTEGERP (tem
))
3761 if (!NILP (Vpurify_flag
))
3762 string
= Fpurecopy (string
);
3763 sym
= Fmake_symbol (string
);
3765 if (EQ (obarray
, initial_obarray
))
3766 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3768 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3770 if ((SREF (string
, 0) == ':')
3771 && EQ (obarray
, initial_obarray
))
3773 XSYMBOL (sym
)->constant
= 1;
3774 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3775 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3778 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3780 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3782 XSYMBOL (sym
)->next
= 0;
3787 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3788 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3789 NAME may be a string or a symbol. If it is a symbol, that exact
3790 symbol is searched for.
3791 A second optional argument specifies the obarray to use;
3792 it defaults to the value of `obarray'. */)
3793 (Lisp_Object name
, Lisp_Object obarray
)
3795 register Lisp_Object tem
, string
;
3797 if (NILP (obarray
)) obarray
= Vobarray
;
3798 obarray
= check_obarray (obarray
);
3800 if (!SYMBOLP (name
))
3802 CHECK_STRING (name
);
3806 string
= SYMBOL_NAME (name
);
3808 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3809 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3815 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3816 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3817 The value is t if a symbol was found and deleted, nil otherwise.
3818 NAME may be a string or a symbol. If it is a symbol, that symbol
3819 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3820 OBARRAY defaults to the value of the variable `obarray'. */)
3821 (Lisp_Object name
, Lisp_Object obarray
)
3823 register Lisp_Object string
, tem
;
3826 if (NILP (obarray
)) obarray
= Vobarray
;
3827 obarray
= check_obarray (obarray
);
3830 string
= SYMBOL_NAME (name
);
3833 CHECK_STRING (name
);
3837 tem
= oblookup (obarray
, SSDATA (string
),
3842 /* If arg was a symbol, don't delete anything but that symbol itself. */
3843 if (SYMBOLP (name
) && !EQ (name
, tem
))
3846 /* There are plenty of other symbols which will screw up the Emacs
3847 session if we unintern them, as well as even more ways to use
3848 `setq' or `fset' or whatnot to make the Emacs session
3849 unusable. Let's not go down this silly road. --Stef */
3850 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3851 error ("Attempt to unintern t or nil"); */
3853 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3855 hash
= oblookup_last_bucket_number
;
3857 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3859 if (XSYMBOL (tem
)->next
)
3860 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3862 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3866 Lisp_Object tail
, following
;
3868 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3869 XSYMBOL (tail
)->next
;
3872 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3873 if (EQ (following
, tem
))
3875 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3884 /* Return the symbol in OBARRAY whose names matches the string
3885 of SIZE characters (SIZE_BYTE bytes) at PTR.
3886 If there is no such symbol in OBARRAY, return nil.
3888 Also store the bucket number in oblookup_last_bucket_number. */
3891 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3895 register Lisp_Object tail
;
3896 Lisp_Object bucket
, tem
;
3898 if (!VECTORP (obarray
)
3899 || (obsize
= ASIZE (obarray
)) == 0)
3901 obarray
= check_obarray (obarray
);
3902 obsize
= ASIZE (obarray
);
3904 /* This is sometimes needed in the middle of GC. */
3905 obsize
&= ~ARRAY_MARK_FLAG
;
3906 hash
= hash_string (ptr
, size_byte
) % obsize
;
3907 bucket
= XVECTOR (obarray
)->contents
[hash
];
3908 oblookup_last_bucket_number
= hash
;
3909 if (EQ (bucket
, make_number (0)))
3911 else if (!SYMBOLP (bucket
))
3912 error ("Bad data in guts of obarray"); /* Like CADR error message */
3914 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3916 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3917 && SCHARS (SYMBOL_NAME (tail
)) == size
3918 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3920 else if (XSYMBOL (tail
)->next
== 0)
3923 XSETINT (tem
, hash
);
3928 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3931 register Lisp_Object tail
;
3932 CHECK_VECTOR (obarray
);
3933 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3935 tail
= XVECTOR (obarray
)->contents
[i
];
3940 if (XSYMBOL (tail
)->next
== 0)
3942 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3948 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3950 call1 (function
, sym
);
3953 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3954 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3955 OBARRAY defaults to the value of `obarray'. */)
3956 (Lisp_Object function
, Lisp_Object obarray
)
3958 if (NILP (obarray
)) obarray
= Vobarray
;
3959 obarray
= check_obarray (obarray
);
3961 map_obarray (obarray
, mapatoms_1
, function
);
3965 #define OBARRAY_SIZE 1511
3970 Lisp_Object oblength
;
3971 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3973 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3975 Vobarray
= Fmake_vector (oblength
, make_number (0));
3976 initial_obarray
= Vobarray
;
3977 staticpro (&initial_obarray
);
3979 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3980 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3981 NILP (Vpurify_flag) check in intern_c_string. */
3982 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3983 Qnil
= intern_c_string ("nil");
3985 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3986 so those two need to be fixed manally. */
3987 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3988 XSYMBOL (Qunbound
)->function
= Qunbound
;
3989 XSYMBOL (Qunbound
)->plist
= Qnil
;
3990 /* XSYMBOL (Qnil)->function = Qunbound; */
3991 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3992 XSYMBOL (Qnil
)->constant
= 1;
3993 XSYMBOL (Qnil
)->plist
= Qnil
;
3995 Qt
= intern_c_string ("t");
3996 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3997 XSYMBOL (Qt
)->constant
= 1;
3999 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4002 DEFSYM (Qvariable_documentation
, "variable-documentation");
4004 read_buffer
= (char *) xmalloc (size
);
4005 read_buffer_size
= size
;
4009 defsubr (struct Lisp_Subr
*sname
)
4012 sym
= intern_c_string (sname
->symbol_name
);
4013 XSETTYPED_PVECTYPE (sname
, size
, PVEC_SUBR
);
4014 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4017 #ifdef NOTDEF /* use fset in subr.el now */
4019 defalias (struct Lisp_Subr
*sname
, char *string
)
4022 sym
= intern (string
);
4023 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4027 /* Define an "integer variable"; a symbol whose value is forwarded to a
4028 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4029 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4031 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4032 const char *namestring
, EMACS_INT
*address
)
4035 sym
= intern_c_string (namestring
);
4036 i_fwd
->type
= Lisp_Fwd_Int
;
4037 i_fwd
->intvar
= address
;
4038 XSYMBOL (sym
)->declared_special
= 1;
4039 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4040 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4043 /* Similar but define a variable whose value is t if address contains 1,
4044 nil if address contains 0. */
4046 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4047 const char *namestring
, int *address
)
4050 sym
= intern_c_string (namestring
);
4051 b_fwd
->type
= Lisp_Fwd_Bool
;
4052 b_fwd
->boolvar
= address
;
4053 XSYMBOL (sym
)->declared_special
= 1;
4054 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4055 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4056 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4059 /* Similar but define a variable whose value is the Lisp Object stored
4060 at address. Two versions: with and without gc-marking of the C
4061 variable. The nopro version is used when that variable will be
4062 gc-marked for some other reason, since marking the same slot twice
4063 can cause trouble with strings. */
4065 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4066 const char *namestring
, Lisp_Object
*address
)
4069 sym
= intern_c_string (namestring
);
4070 o_fwd
->type
= Lisp_Fwd_Obj
;
4071 o_fwd
->objvar
= address
;
4072 XSYMBOL (sym
)->declared_special
= 1;
4073 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4074 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4078 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4079 const char *namestring
, Lisp_Object
*address
)
4081 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4082 staticpro (address
);
4085 /* Similar but define a variable whose value is the Lisp Object stored
4086 at a particular offset in the current kboard object. */
4089 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4090 const char *namestring
, int offset
)
4093 sym
= intern_c_string (namestring
);
4094 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4095 ko_fwd
->offset
= offset
;
4096 XSYMBOL (sym
)->declared_special
= 1;
4097 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4098 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4101 /* Record the value of load-path used at the start of dumping
4102 so we can see if the site changed it later during dumping. */
4103 static Lisp_Object dump_path
;
4109 int turn_off_warning
= 0;
4111 /* Compute the default load-path. */
4113 normal
= PATH_LOADSEARCH
;
4114 Vload_path
= decode_env_path (0, normal
);
4116 if (NILP (Vpurify_flag
))
4117 normal
= PATH_LOADSEARCH
;
4119 normal
= PATH_DUMPLOADSEARCH
;
4121 /* In a dumped Emacs, we normally have to reset the value of
4122 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4123 uses ../lisp, instead of the path of the installed elisp
4124 libraries. However, if it appears that Vload_path was changed
4125 from the default before dumping, don't override that value. */
4128 if (! NILP (Fequal (dump_path
, Vload_path
)))
4130 Vload_path
= decode_env_path (0, normal
);
4131 if (!NILP (Vinstallation_directory
))
4133 Lisp_Object tem
, tem1
, sitelisp
;
4135 /* Remove site-lisp dirs from path temporarily and store
4136 them in sitelisp, then conc them on at the end so
4137 they're always first in path. */
4141 tem
= Fcar (Vload_path
);
4142 tem1
= Fstring_match (build_string ("site-lisp"),
4146 Vload_path
= Fcdr (Vload_path
);
4147 sitelisp
= Fcons (tem
, sitelisp
);
4153 /* Add to the path the lisp subdir of the
4154 installation dir, if it exists. */
4155 tem
= Fexpand_file_name (build_string ("lisp"),
4156 Vinstallation_directory
);
4157 tem1
= Ffile_exists_p (tem
);
4160 if (NILP (Fmember (tem
, Vload_path
)))
4162 turn_off_warning
= 1;
4163 Vload_path
= Fcons (tem
, Vload_path
);
4167 /* That dir doesn't exist, so add the build-time
4168 Lisp dirs instead. */
4169 Vload_path
= nconc2 (Vload_path
, dump_path
);
4171 /* Add leim under the installation dir, if it exists. */
4172 tem
= Fexpand_file_name (build_string ("leim"),
4173 Vinstallation_directory
);
4174 tem1
= Ffile_exists_p (tem
);
4177 if (NILP (Fmember (tem
, Vload_path
)))
4178 Vload_path
= Fcons (tem
, Vload_path
);
4181 /* Add site-lisp under the installation dir, if it exists. */
4182 tem
= Fexpand_file_name (build_string ("site-lisp"),
4183 Vinstallation_directory
);
4184 tem1
= Ffile_exists_p (tem
);
4187 if (NILP (Fmember (tem
, Vload_path
)))
4188 Vload_path
= Fcons (tem
, Vload_path
);
4191 /* If Emacs was not built in the source directory,
4192 and it is run from where it was built, add to load-path
4193 the lisp, leim and site-lisp dirs under that directory. */
4195 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4199 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4200 Vinstallation_directory
);
4201 tem1
= Ffile_exists_p (tem
);
4203 /* Don't be fooled if they moved the entire source tree
4204 AFTER dumping Emacs. If the build directory is indeed
4205 different from the source dir, src/Makefile.in and
4206 src/Makefile will not be found together. */
4207 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4208 Vinstallation_directory
);
4209 tem2
= Ffile_exists_p (tem
);
4210 if (!NILP (tem1
) && NILP (tem2
))
4212 tem
= Fexpand_file_name (build_string ("lisp"),
4215 if (NILP (Fmember (tem
, Vload_path
)))
4216 Vload_path
= Fcons (tem
, Vload_path
);
4218 tem
= Fexpand_file_name (build_string ("leim"),
4221 if (NILP (Fmember (tem
, Vload_path
)))
4222 Vload_path
= Fcons (tem
, Vload_path
);
4224 tem
= Fexpand_file_name (build_string ("site-lisp"),
4227 if (NILP (Fmember (tem
, Vload_path
)))
4228 Vload_path
= Fcons (tem
, Vload_path
);
4231 if (!NILP (sitelisp
) && !no_site_lisp
)
4232 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4238 /* NORMAL refers to the lisp dir in the source directory. */
4239 /* We used to add ../lisp at the front here, but
4240 that caused trouble because it was copied from dump_path
4241 into Vload_path, above, when Vinstallation_directory was non-nil.
4242 It should be unnecessary. */
4243 Vload_path
= decode_env_path (0, normal
);
4244 dump_path
= Vload_path
;
4248 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4249 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4250 almost never correct, thereby causing a warning to be printed out that
4251 confuses users. Since PATH_LOADSEARCH is always overridden by the
4252 EMACSLOADPATH environment variable below, disable the warning on NT. */
4254 /* Warn if dirs in the *standard* path don't exist. */
4255 if (!turn_off_warning
)
4257 Lisp_Object path_tail
;
4259 for (path_tail
= Vload_path
;
4261 path_tail
= XCDR (path_tail
))
4263 Lisp_Object dirfile
;
4264 dirfile
= Fcar (path_tail
);
4265 if (STRINGP (dirfile
))
4267 dirfile
= Fdirectory_file_name (dirfile
);
4268 if (access (SSDATA (dirfile
), 0) < 0)
4269 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4274 #endif /* !(WINDOWSNT || HAVE_NS) */
4276 /* If the EMACSLOADPATH environment variable is set, use its value.
4277 This doesn't apply if we're dumping. */
4279 if (NILP (Vpurify_flag
)
4280 && egetenv ("EMACSLOADPATH"))
4282 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4286 load_in_progress
= 0;
4287 Vload_file_name
= Qnil
;
4289 load_descriptor_list
= Qnil
;
4291 Vstandard_input
= Qt
;
4292 Vloads_in_progress
= Qnil
;
4295 /* Print a warning, using format string FORMAT, that directory DIRNAME
4296 does not exist. Print it on stderr and put it in *Messages*. */
4299 dir_warning (const char *format
, Lisp_Object dirname
)
4301 fprintf (stderr
, format
, SDATA (dirname
));
4303 /* Don't log the warning before we've initialized!! */
4307 ptrdiff_t message_len
;
4309 SAFE_ALLOCA (buffer
, char *,
4310 SBYTES (dirname
) + strlen (format
) - (sizeof "%s" - 1) + 1);
4311 message_len
= esprintf (buffer
, format
, SDATA (dirname
));
4312 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4318 syms_of_lread (void)
4321 defsubr (&Sread_from_string
);
4323 defsubr (&Sintern_soft
);
4324 defsubr (&Sunintern
);
4325 defsubr (&Sget_load_suffixes
);
4327 defsubr (&Seval_buffer
);
4328 defsubr (&Seval_region
);
4329 defsubr (&Sread_char
);
4330 defsubr (&Sread_char_exclusive
);
4331 defsubr (&Sread_event
);
4332 defsubr (&Sget_file_char
);
4333 defsubr (&Smapatoms
);
4334 defsubr (&Slocate_file_internal
);
4336 DEFVAR_LISP ("obarray", Vobarray
,
4337 doc
: /* Symbol table for use by `intern' and `read'.
4338 It is a vector whose length ought to be prime for best results.
4339 The vector's contents don't make sense if examined from Lisp programs;
4340 to find all the symbols in an obarray, use `mapatoms'. */);
4342 DEFVAR_LISP ("values", Vvalues
,
4343 doc
: /* List of values of all expressions which were read, evaluated and printed.
4344 Order is reverse chronological. */);
4346 DEFVAR_LISP ("standard-input", Vstandard_input
,
4347 doc
: /* Stream for read to get input from.
4348 See documentation of `read' for possible values. */);
4349 Vstandard_input
= Qt
;
4351 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4352 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4354 If this variable is a buffer, then only forms read from that buffer
4355 will be added to `read-symbol-positions-list'.
4356 If this variable is t, then all read forms will be added.
4357 The effect of all other values other than nil are not currently
4358 defined, although they may be in the future.
4360 The positions are relative to the last call to `read' or
4361 `read-from-string'. It is probably a bad idea to set this variable at
4362 the toplevel; bind it instead. */);
4363 Vread_with_symbol_positions
= Qnil
;
4365 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4366 doc
: /* A list mapping read symbols to their positions.
4367 This variable is modified during calls to `read' or
4368 `read-from-string', but only when `read-with-symbol-positions' is
4371 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4372 CHAR-POSITION is an integer giving the offset of that occurrence of the
4373 symbol from the position where `read' or `read-from-string' started.
4375 Note that a symbol will appear multiple times in this list, if it was
4376 read multiple times. The list is in the same order as the symbols
4378 Vread_symbol_positions_list
= Qnil
;
4380 DEFVAR_LISP ("read-circle", Vread_circle
,
4381 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4384 DEFVAR_LISP ("load-path", Vload_path
,
4385 doc
: /* *List of directories to search for files to load.
4386 Each element is a string (directory name) or nil (try default directory).
4387 Initialized based on EMACSLOADPATH environment variable, if any,
4388 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4390 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4391 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4392 This list should not include the empty string.
4393 `load' and related functions try to append these suffixes, in order,
4394 to the specified file name if a Lisp suffix is allowed or required. */);
4395 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4396 Fcons (make_pure_c_string (".el"), Qnil
));
4397 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4398 doc
: /* List of suffixes that indicate representations of \
4400 This list should normally start with the empty string.
4402 Enabling Auto Compression mode appends the suffixes in
4403 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4404 mode removes them again. `load' and related functions use this list to
4405 determine whether they should look for compressed versions of a file
4406 and, if so, which suffixes they should try to append to the file name
4407 in order to do so. However, if you want to customize which suffixes
4408 the loading functions recognize as compression suffixes, you should
4409 customize `jka-compr-load-suffixes' rather than the present variable. */);
4410 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4412 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4413 doc
: /* Non-nil if inside of `load'. */);
4414 DEFSYM (Qload_in_progress
, "load-in-progress");
4416 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4417 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4418 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4420 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4421 a symbol \(a feature name).
4423 When `load' is run and the file-name argument matches an element's
4424 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4425 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4427 An error in FORMS does not undo the load, but does prevent execution of
4428 the rest of the FORMS. */);
4429 Vafter_load_alist
= Qnil
;
4431 DEFVAR_LISP ("load-history", Vload_history
,
4432 doc
: /* Alist mapping loaded file names to symbols and features.
4433 Each alist element should be a list (FILE-NAME ENTRIES...), where
4434 FILE-NAME is the name of a file that has been loaded into Emacs.
4435 The file name is absolute and true (i.e. it doesn't contain symlinks).
4436 As an exception, one of the alist elements may have FILE-NAME nil,
4437 for symbols and features not associated with any file.
4439 The remaining ENTRIES in the alist element describe the functions and
4440 variables defined in that file, the features provided, and the
4441 features required. Each entry has the form `(provide . FEATURE)',
4442 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4443 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4444 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4445 autoload before this file redefined it as a function. In addition,
4446 entries may also be single symbols, which means that SYMBOL was
4447 defined by `defvar' or `defconst'.
4449 During preloading, the file name recorded is relative to the main Lisp
4450 directory. These file names are converted to absolute at startup. */);
4451 Vload_history
= Qnil
;
4453 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4454 doc
: /* Full name of file being loaded by `load'. */);
4455 Vload_file_name
= Qnil
;
4457 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4458 doc
: /* File name, including directory, of user's initialization file.
4459 If the file loaded had extension `.elc', and the corresponding source file
4460 exists, this variable contains the name of source file, suitable for use
4461 by functions like `custom-save-all' which edit the init file.
4462 While Emacs loads and evaluates the init file, value is the real name
4463 of the file, regardless of whether or not it has the `.elc' extension. */);
4464 Vuser_init_file
= Qnil
;
4466 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4467 doc
: /* Used for internal purposes by `load'. */);
4468 Vcurrent_load_list
= Qnil
;
4470 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4471 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4472 The default is nil, which means use the function `read'. */);
4473 Vload_read_function
= Qnil
;
4475 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4476 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4477 This function is for doing code conversion before reading the source file.
4478 If nil, loading is done without any code conversion.
4479 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4480 FULLNAME is the full name of FILE.
4481 See `load' for the meaning of the remaining arguments. */);
4482 Vload_source_file_function
= Qnil
;
4484 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4485 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4486 This is useful when the file being loaded is a temporary copy. */);
4487 load_force_doc_strings
= 0;
4489 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4490 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4491 This is normally bound by `load' and `eval-buffer' to control `read',
4492 and is not meant for users to change. */);
4493 load_convert_to_unibyte
= 0;
4495 DEFVAR_LISP ("source-directory", Vsource_directory
,
4496 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4497 You cannot count on them to still be there! */);
4499 = Fexpand_file_name (build_string ("../"),
4500 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4502 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4503 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4504 Vpreloaded_file_list
= Qnil
;
4506 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4507 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4508 Vbyte_boolean_vars
= Qnil
;
4510 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4511 doc
: /* Non-nil means load dangerous compiled Lisp files.
4512 Some versions of XEmacs use different byte codes than Emacs. These
4513 incompatible byte codes can make Emacs crash when it tries to execute
4515 load_dangerous_libraries
= 0;
4517 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4518 doc
: /* Non-nil means force printing messages when loading Lisp files.
4519 This overrides the value of the NOMESSAGE argument to `load'. */);
4520 force_load_messages
= 0;
4522 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4523 doc
: /* Regular expression matching safe to load compiled Lisp files.
4524 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4525 from the file, and matches them against this regular expression.
4526 When the regular expression matches, the file is considered to be safe
4527 to load. See also `load-dangerous-libraries'. */);
4528 Vbytecomp_version_regexp
4529 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4531 Qlexical_binding
= intern ("lexical-binding");
4532 staticpro (&Qlexical_binding
);
4533 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4534 doc
: /* Whether to use lexical binding when evaluating code.
4535 Non-nil means that the code in the current buffer should be evaluated
4536 with lexical binding.
4537 This variable is automatically set from the file variables of an
4538 interpreted Lisp file read using `load'. */);
4539 Fmake_variable_buffer_local (Qlexical_binding
);
4541 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4542 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4543 Veval_buffer_list
= Qnil
;
4545 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4546 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4547 Vold_style_backquotes
= Qnil
;
4548 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4550 /* Vsource_directory was initialized in init_lread. */
4552 load_descriptor_list
= Qnil
;
4553 staticpro (&load_descriptor_list
);
4555 DEFSYM (Qcurrent_load_list
, "current-load-list");
4556 DEFSYM (Qstandard_input
, "standard-input");
4557 DEFSYM (Qread_char
, "read-char");
4558 DEFSYM (Qget_file_char
, "get-file-char");
4559 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4560 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4562 DEFSYM (Qbackquote
, "`");
4563 DEFSYM (Qcomma
, ",");
4564 DEFSYM (Qcomma_at
, ",@");
4565 DEFSYM (Qcomma_dot
, ",.");
4567 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4568 DEFSYM (Qascii_character
, "ascii-character");
4569 DEFSYM (Qfunction
, "function");
4570 DEFSYM (Qload
, "load");
4571 DEFSYM (Qload_file_name
, "load-file-name");
4572 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4573 DEFSYM (Qfile_truename
, "file-truename");
4574 DEFSYM (Qdir_ok
, "dir-ok");
4575 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4577 staticpro (&dump_path
);
4579 staticpro (&read_objects
);
4580 read_objects
= Qnil
;
4581 staticpro (&seen_list
);
4584 Vloads_in_progress
= Qnil
;
4585 staticpro (&Vloads_in_progress
);
4587 DEFSYM (Qhash_table
, "hash-table");
4588 DEFSYM (Qdata
, "data");
4589 DEFSYM (Qtest
, "test");
4590 DEFSYM (Qsize
, "size");
4591 DEFSYM (Qweakness
, "weakness");
4592 DEFSYM (Qrehash_size
, "rehash-size");
4593 DEFSYM (Qrehash_threshold
, "rehash-threshold");