1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2012 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
27 #include <limits.h> /* for CHAR_BIT */
30 #include "intervals.h"
32 #include "character.h"
39 #include "termhooks.h"
41 #include "blockinput.h"
52 #endif /* HAVE_SETLOCALE */
57 #define file_offset off_t
58 #define file_tell ftello
60 #define file_offset long
61 #define file_tell ftell
64 /* hash table read constants */
65 static Lisp_Object Qhash_table
, Qdata
;
66 static Lisp_Object Qtest
, Qsize
;
67 static Lisp_Object Qweakness
;
68 static Lisp_Object Qrehash_size
;
69 static Lisp_Object Qrehash_threshold
;
71 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
72 Lisp_Object Qstandard_input
;
73 Lisp_Object Qvariable_documentation
;
74 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
75 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
76 static Lisp_Object Qinhibit_file_name_operation
;
77 static Lisp_Object Qeval_buffer_list
;
78 static Lisp_Object Qlexical_binding
;
79 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
81 /* Used instead of Qget_file_char while loading *.elc files compiled
82 by Emacs 21 or older. */
83 static Lisp_Object Qget_emacs_mule_file_char
;
85 static Lisp_Object Qload_force_doc_strings
;
87 extern Lisp_Object Qinternal_interpreter_environment
;
89 static Lisp_Object Qload_in_progress
;
91 /* The association list of objects read with the #n=object form.
92 Each member of the list has the form (n . object), and is used to
93 look up the object for the corresponding #n# construct.
94 It must be set to nil before all top-level calls to read0. */
95 static Lisp_Object read_objects
;
97 /* Nonzero means READCHAR should read bytes one by one (not character)
98 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
99 This is set to 1 by read1 temporarily while handling #@NUMBER. */
100 static int load_each_byte
;
102 /* List of descriptors now open for Fload. */
103 static Lisp_Object load_descriptor_list
;
105 /* File for get_file_char to read from. Use by load. */
106 static FILE *instream
;
108 /* When nonzero, read conses in pure space */
109 static int read_pure
;
111 /* For use within read-from-string (this reader is non-reentrant!!) */
112 static ptrdiff_t read_from_string_index
;
113 static ptrdiff_t read_from_string_index_byte
;
114 static ptrdiff_t read_from_string_limit
;
116 /* Number of characters read in the current call to Fread or
117 Fread_from_string. */
118 static EMACS_INT readchar_count
;
120 /* This contains the last string skipped with #@. */
121 static char *saved_doc_string
;
122 /* Length of buffer allocated in saved_doc_string. */
123 static ptrdiff_t saved_doc_string_size
;
124 /* Length of actual data in saved_doc_string. */
125 static ptrdiff_t saved_doc_string_length
;
126 /* This is the file position that string came from. */
127 static file_offset saved_doc_string_position
;
129 /* This contains the previous string skipped with #@.
130 We copy it from saved_doc_string when a new string
131 is put in saved_doc_string. */
132 static char *prev_saved_doc_string
;
133 /* Length of buffer allocated in prev_saved_doc_string. */
134 static ptrdiff_t prev_saved_doc_string_size
;
135 /* Length of actual data in prev_saved_doc_string. */
136 static ptrdiff_t prev_saved_doc_string_length
;
137 /* This is the file position that string came from. */
138 static file_offset prev_saved_doc_string_position
;
140 /* Nonzero means inside a new-style backquote
141 with no surrounding parentheses.
142 Fread initializes this to zero, so we need not specbind it
143 or worry about what happens to it when there is an error. */
144 static int new_backquote_flag
;
145 static Lisp_Object Qold_style_backquotes
;
147 /* A list of file names for files being loaded in Fload. Used to
148 check for recursive loads. */
150 static Lisp_Object Vloads_in_progress
;
152 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
155 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
, int,
156 Lisp_Object
, Lisp_Object
,
157 Lisp_Object
, Lisp_Object
);
158 static Lisp_Object
load_unwind (Lisp_Object
);
159 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
161 static void invalid_syntax (const char *) NO_RETURN
;
162 static void end_of_file_error (void) NO_RETURN
;
165 /* Functions that read one byte from the current source READCHARFUN
166 or unreads one byte. If the integer argument C is -1, it returns
167 one read byte, or -1 when there's no more byte in the source. If C
168 is 0 or positive, it unreads C, and the return value is not
171 static int readbyte_for_lambda (int, Lisp_Object
);
172 static int readbyte_from_file (int, Lisp_Object
);
173 static int readbyte_from_string (int, Lisp_Object
);
175 /* Handle unreading and rereading of characters.
176 Write READCHAR to read a character,
177 UNREAD(c) to unread c to be read again.
179 These macros correctly read/unread multibyte characters. */
181 #define READCHAR readchar (readcharfun, NULL)
182 #define UNREAD(c) unreadchar (readcharfun, c)
184 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
185 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
187 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
188 Qlambda, or a cons, we use this to keep an unread character because
189 a file stream can't handle multibyte-char unreading. The value -1
190 means that there's no unread character. */
191 static int unread_char
;
194 readchar (Lisp_Object readcharfun
, int *multibyte
)
198 int (*readbyte
) (int, Lisp_Object
);
199 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
201 int emacs_mule_encoding
= 0;
208 if (BUFFERP (readcharfun
))
210 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
212 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
214 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
217 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
219 /* Fetch the character code from the buffer. */
220 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
221 BUF_INC_POS (inbuffer
, pt_byte
);
228 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
229 if (! ASCII_BYTE_P (c
))
230 c
= BYTE8_TO_CHAR (c
);
233 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
237 if (MARKERP (readcharfun
))
239 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
241 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
243 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
246 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
248 /* Fetch the character code from the buffer. */
249 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
250 BUF_INC_POS (inbuffer
, bytepos
);
257 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
258 if (! ASCII_BYTE_P (c
))
259 c
= BYTE8_TO_CHAR (c
);
263 XMARKER (readcharfun
)->bytepos
= bytepos
;
264 XMARKER (readcharfun
)->charpos
++;
269 if (EQ (readcharfun
, Qlambda
))
271 readbyte
= readbyte_for_lambda
;
275 if (EQ (readcharfun
, Qget_file_char
))
277 readbyte
= readbyte_from_file
;
281 if (STRINGP (readcharfun
))
283 if (read_from_string_index
>= read_from_string_limit
)
285 else if (STRING_MULTIBYTE (readcharfun
))
289 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
290 read_from_string_index
,
291 read_from_string_index_byte
);
295 c
= SREF (readcharfun
, read_from_string_index_byte
);
296 read_from_string_index
++;
297 read_from_string_index_byte
++;
302 if (CONSP (readcharfun
))
304 /* This is the case that read_vector is reading from a unibyte
305 string that contains a byte sequence previously skipped
306 because of #@NUMBER. The car part of readcharfun is that
307 string, and the cdr part is a value of readcharfun given to
309 readbyte
= readbyte_from_string
;
310 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
311 emacs_mule_encoding
= 1;
315 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
317 readbyte
= readbyte_from_file
;
318 emacs_mule_encoding
= 1;
322 tem
= call0 (readcharfun
);
329 if (unread_char
>= 0)
335 c
= (*readbyte
) (-1, readcharfun
);
336 if (c
< 0 || load_each_byte
)
340 if (ASCII_BYTE_P (c
))
342 if (emacs_mule_encoding
)
343 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
346 len
= BYTES_BY_CHAR_HEAD (c
);
349 c
= (*readbyte
) (-1, readcharfun
);
350 if (c
< 0 || ! TRAILING_CODE_P (c
))
353 (*readbyte
) (buf
[i
], readcharfun
);
354 return BYTE8_TO_CHAR (buf
[0]);
358 return STRING_CHAR (buf
);
361 /* Unread the character C in the way appropriate for the stream READCHARFUN.
362 If the stream is a user function, call it with the char as argument. */
365 unreadchar (Lisp_Object readcharfun
, int c
)
369 /* Don't back up the pointer if we're unreading the end-of-input mark,
370 since readchar didn't advance it when we read it. */
372 else if (BUFFERP (readcharfun
))
374 struct buffer
*b
= XBUFFER (readcharfun
);
375 ptrdiff_t charpos
= BUF_PT (b
);
376 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
378 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
379 BUF_DEC_POS (b
, bytepos
);
383 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
385 else if (MARKERP (readcharfun
))
387 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
388 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
390 XMARKER (readcharfun
)->charpos
--;
391 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
392 BUF_DEC_POS (b
, bytepos
);
396 XMARKER (readcharfun
)->bytepos
= bytepos
;
398 else if (STRINGP (readcharfun
))
400 read_from_string_index
--;
401 read_from_string_index_byte
402 = string_char_to_byte (readcharfun
, read_from_string_index
);
404 else if (CONSP (readcharfun
))
408 else if (EQ (readcharfun
, Qlambda
))
412 else if (EQ (readcharfun
, Qget_file_char
)
413 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
418 ungetc (c
, instream
);
425 call1 (readcharfun
, make_number (c
));
429 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
431 return read_bytecode_char (c
>= 0);
436 readbyte_from_file (int c
, Lisp_Object readcharfun
)
441 ungetc (c
, instream
);
450 /* Interrupted reads have been observed while reading over the network */
451 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
463 return (c
== EOF
? -1 : c
);
467 readbyte_from_string (int c
, Lisp_Object readcharfun
)
469 Lisp_Object string
= XCAR (readcharfun
);
473 read_from_string_index
--;
474 read_from_string_index_byte
475 = string_char_to_byte (string
, read_from_string_index
);
478 if (read_from_string_index
>= read_from_string_limit
)
481 FETCH_STRING_CHAR_ADVANCE (c
, string
,
482 read_from_string_index
,
483 read_from_string_index_byte
);
488 /* Read one non-ASCII character from INSTREAM. The character is
489 encoded in `emacs-mule' and the first byte is already read in
493 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
495 /* Emacs-mule coding uses at most 4-byte for one character. */
496 unsigned char buf
[4];
497 int len
= emacs_mule_bytes
[c
];
498 struct charset
*charset
;
503 /* C is not a valid leading-code of `emacs-mule'. */
504 return BYTE8_TO_CHAR (c
);
510 c
= (*readbyte
) (-1, readcharfun
);
514 (*readbyte
) (buf
[i
], readcharfun
);
515 return BYTE8_TO_CHAR (buf
[0]);
522 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
523 code
= buf
[1] & 0x7F;
527 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
528 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
530 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
531 code
= buf
[2] & 0x7F;
535 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
536 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
541 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
542 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
544 c
= DECODE_CHAR (charset
, code
);
546 Fsignal (Qinvalid_read_syntax
,
547 Fcons (build_string ("invalid multibyte form"), Qnil
));
552 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
554 static Lisp_Object
read0 (Lisp_Object
);
555 static Lisp_Object
read1 (Lisp_Object
, int *, int);
557 static Lisp_Object
read_list (int, Lisp_Object
);
558 static Lisp_Object
read_vector (Lisp_Object
, int);
560 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
562 static void substitute_object_in_subtree (Lisp_Object
,
564 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
567 /* Get a character from the tty. */
569 /* Read input events until we get one that's acceptable for our purposes.
571 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
572 until we get a character we like, and then stuffed into
575 If ASCII_REQUIRED is non-zero, we check function key events to see
576 if the unmodified version of the symbol has a Qascii_character
577 property, and use that character, if present.
579 If ERROR_NONASCII is non-zero, we signal an error if the input we
580 get isn't an ASCII character with modifiers. If it's zero but
581 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
584 If INPUT_METHOD is nonzero, we invoke the current input method
585 if the character warrants that.
587 If SECONDS is a number, we wait that many seconds for input, and
588 return Qnil if no input arrives within that time. */
591 read_filtered_event (int no_switch_frame
, int ascii_required
,
592 int error_nonascii
, int input_method
, Lisp_Object seconds
)
594 Lisp_Object val
, delayed_switch_frame
;
597 #ifdef HAVE_WINDOW_SYSTEM
598 if (display_hourglass_p
)
602 delayed_switch_frame
= Qnil
;
604 /* Compute timeout. */
605 if (NUMBERP (seconds
))
607 EMACS_TIME wait_time
;
609 double duration
= extract_float (seconds
);
612 duration_to_sec_usec (duration
, &sec
, &usec
);
616 EMACS_GET_TIME (end_time
);
617 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
618 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
621 /* Read until we get an acceptable event. */
624 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
625 NUMBERP (seconds
) ? &end_time
: NULL
);
626 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
631 /* switch-frame events are put off until after the next ASCII
632 character. This is better than signaling an error just because
633 the last characters were typed to a separate minibuffer frame,
634 for example. Eventually, some code which can deal with
635 switch-frame events will read it and process it. */
637 && EVENT_HAS_PARAMETERS (val
)
638 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
640 delayed_switch_frame
= val
;
644 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
646 /* Convert certain symbols to their ASCII equivalents. */
649 Lisp_Object tem
, tem1
;
650 tem
= Fget (val
, Qevent_symbol_element_mask
);
653 tem1
= Fget (Fcar (tem
), Qascii_character
);
654 /* Merge this symbol's modifier bits
655 with the ASCII equivalent of its basic code. */
657 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
661 /* If we don't have a character now, deal with it appropriately. */
666 Vunread_command_events
= Fcons (val
, Qnil
);
667 error ("Non-character input-event");
674 if (! NILP (delayed_switch_frame
))
675 unread_switch_frame
= delayed_switch_frame
;
679 #ifdef HAVE_WINDOW_SYSTEM
680 if (display_hourglass_p
)
689 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
690 doc
: /* Read a character from the command input (keyboard or macro).
691 It is returned as a number.
692 If the character has modifiers, they are resolved and reflected to the
693 character code if possible (e.g. C-SPC -> 0).
695 If the user generates an event which is not a character (i.e. a mouse
696 click or function key event), `read-char' signals an error. As an
697 exception, switch-frame events are put off until non-character events
699 If you want to read non-character events, or ignore them, call
700 `read-event' or `read-char-exclusive' instead.
702 If the optional argument PROMPT is non-nil, display that as a prompt.
703 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
704 input method is turned on in the current buffer, that input method
705 is used for reading a character.
706 If the optional argument SECONDS is non-nil, it should be a number
707 specifying the maximum number of seconds to wait for input. If no
708 input arrives in that time, return nil. SECONDS may be a
709 floating-point value. */)
710 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
715 message_with_string ("%s", prompt
, 0);
716 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
718 return (NILP (val
) ? Qnil
719 : make_number (char_resolve_modifier_mask (XINT (val
))));
722 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
723 doc
: /* Read an event object from the input stream.
724 If the optional argument PROMPT is non-nil, display that as a prompt.
725 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
726 input method is turned on in the current buffer, that input method
727 is used for reading a character.
728 If the optional argument SECONDS is non-nil, it should be a number
729 specifying the maximum number of seconds to wait for input. If no
730 input arrives in that time, return nil. SECONDS may be a
731 floating-point value. */)
732 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
735 message_with_string ("%s", prompt
, 0);
736 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
739 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
740 doc
: /* Read a character from the command input (keyboard or macro).
741 It is returned as a number. Non-character events are ignored.
742 If the character has modifiers, they are resolved and reflected to the
743 character code if possible (e.g. C-SPC -> 0).
745 If the optional argument PROMPT is non-nil, display that as a prompt.
746 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
747 input method is turned on in the current buffer, that input method
748 is used for reading a character.
749 If the optional argument SECONDS is non-nil, it should be a number
750 specifying the maximum number of seconds to wait for input. If no
751 input arrives in that time, return nil. SECONDS may be a
752 floating-point value. */)
753 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
758 message_with_string ("%s", prompt
, 0);
760 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
762 return (NILP (val
) ? Qnil
763 : make_number (char_resolve_modifier_mask (XINT (val
))));
766 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
767 doc
: /* Don't use this yourself. */)
770 register Lisp_Object val
;
772 XSETINT (val
, getc (instream
));
780 /* Return true if the lisp code read using READCHARFUN defines a non-nil
781 `lexical-binding' file variable. After returning, the stream is
782 positioned following the first line, if it is a comment, otherwise
786 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
790 /* The first line isn't a comment, just give up. */
796 /* Look for an appropriate file-variable in the first line. */
800 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
801 } beg_end_state
= NOMINAL
;
802 int in_file_vars
= 0;
804 #define UPDATE_BEG_END_STATE(ch) \
805 if (beg_end_state == NOMINAL) \
806 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
807 else if (beg_end_state == AFTER_FIRST_DASH) \
808 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
809 else if (beg_end_state == AFTER_ASTERIX) \
812 in_file_vars = !in_file_vars; \
813 beg_end_state = NOMINAL; \
816 /* Skip until we get to the file vars, if any. */
820 UPDATE_BEG_END_STATE (ch
);
822 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
826 char var
[100], val
[100];
831 /* Read a variable name. */
832 while (ch
== ' ' || ch
== '\t')
836 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
838 if (i
< sizeof var
- 1)
840 UPDATE_BEG_END_STATE (ch
);
844 /* Stop scanning if no colon was found before end marker. */
845 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
848 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
854 /* Read a variable value. */
857 while (ch
== ' ' || ch
== '\t')
861 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
863 if (i
< sizeof val
- 1)
865 UPDATE_BEG_END_STATE (ch
);
869 /* The value was terminated by an end-marker, which remove. */
871 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
875 if (strcmp (var
, "lexical-binding") == 0)
878 rv
= (strcmp (val
, "nil") != 0);
884 while (ch
!= '\n' && ch
!= EOF
)
891 /* Value is a version number of byte compiled code if the file
892 associated with file descriptor FD is a compiled Lisp file that's
893 safe to load. Only files compiled with Emacs are safe to load.
894 Files compiled with XEmacs can lead to a crash in Fbyte_code
895 because of an incompatible change in the byte compiler. */
898 safe_to_load_p (int fd
)
905 /* Read the first few bytes from the file, and look for a line
906 specifying the byte compiler version used. */
907 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
912 /* Skip to the next newline, skipping over the initial `ELC'
913 with NUL bytes following it, but note the version. */
914 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
919 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
926 lseek (fd
, 0, SEEK_SET
);
931 /* Callback for record_unwind_protect. Restore the old load list OLD,
932 after loading a file successfully. */
935 record_load_unwind (Lisp_Object old
)
937 return Vloads_in_progress
= old
;
940 /* This handler function is used via internal_condition_case_1. */
943 load_error_handler (Lisp_Object data
)
949 load_warn_old_style_backquotes (Lisp_Object file
)
951 if (!NILP (Vold_style_backquotes
))
954 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
961 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
962 doc
: /* Return the suffixes that `load' should try if a suffix is \
964 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
967 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
968 while (CONSP (suffixes
))
970 Lisp_Object exts
= Vload_file_rep_suffixes
;
971 suffix
= XCAR (suffixes
);
972 suffixes
= XCDR (suffixes
);
977 lst
= Fcons (concat2 (suffix
, ext
), lst
);
980 return Fnreverse (lst
);
983 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
984 doc
: /* Execute a file of Lisp code named FILE.
985 First try FILE with `.elc' appended, then try with `.el',
986 then try FILE unmodified (the exact suffixes in the exact order are
987 determined by `load-suffixes'). Environment variable references in
988 FILE are replaced with their values by calling `substitute-in-file-name'.
989 This function searches the directories in `load-path'.
991 If optional second arg NOERROR is non-nil,
992 report no error if FILE doesn't exist.
993 Print messages at start and end of loading unless
994 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
996 If optional fourth arg NOSUFFIX is non-nil, don't try adding
997 suffixes `.elc' or `.el' to the specified name FILE.
998 If optional fifth arg MUST-SUFFIX is non-nil, insist on
999 the suffix `.elc' or `.el'; don't accept just FILE unless
1000 it ends in one of those suffixes or includes a directory name.
1002 If this function fails to find a file, it may look for different
1003 representations of that file before trying another file.
1004 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
1005 to the file name. Emacs uses this feature mainly to find compressed
1006 versions of files when Auto Compression mode is enabled.
1008 The exact suffixes that this function tries out, in the exact order,
1009 are given by the value of the variable `load-file-rep-suffixes' if
1010 NOSUFFIX is non-nil and by the return value of the function
1011 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1012 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1013 and then the former.
1015 Loading a file records its definitions, and its `provide' and
1016 `require' calls, in an element of `load-history' whose
1017 car is the file name loaded. See `load-history'.
1019 While the file is in the process of being loaded, the variable
1020 `load-in-progress' is non-nil and the variable `load-file-name'
1021 is bound to the file's name.
1023 Return t if the file exists and loads successfully. */)
1024 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1026 register FILE *stream
;
1027 register int fd
= -1;
1028 ptrdiff_t count
= SPECPDL_INDEX ();
1029 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1030 Lisp_Object found
, efound
, hist_file_name
;
1031 /* 1 means we printed the ".el is newer" message. */
1033 /* 1 means we are loading a compiled file. */
1035 Lisp_Object handler
;
1037 const char *fmode
= "r";
1045 CHECK_STRING (file
);
1047 /* If file name is magic, call the handler. */
1048 /* This shouldn't be necessary any more now that `openp' handles it right.
1049 handler = Ffind_file_name_handler (file, Qload);
1050 if (!NILP (handler))
1051 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1053 /* Do this after the handler to avoid
1054 the need to gcpro noerror, nomessage and nosuffix.
1055 (Below here, we care only whether they are nil or not.)
1056 The presence of this call is the result of a historical accident:
1057 it used to be in every file-operation and when it got removed
1058 everywhere, it accidentally stayed here. Since then, enough people
1059 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1060 that it seemed risky to remove. */
1061 if (! NILP (noerror
))
1063 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1064 Qt
, load_error_handler
);
1069 file
= Fsubstitute_in_file_name (file
);
1072 /* Avoid weird lossage with null string as arg,
1073 since it would try to load a directory as a Lisp file */
1074 if (SBYTES (file
) > 0)
1076 ptrdiff_t size
= SBYTES (file
);
1079 GCPRO2 (file
, found
);
1081 if (! NILP (must_suffix
))
1083 /* Don't insist on adding a suffix if FILE already ends with one. */
1085 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1088 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1090 /* Don't insist on adding a suffix
1091 if the argument includes a directory name. */
1092 else if (! NILP (Ffile_name_directory (file
)))
1096 fd
= openp (Vload_path
, file
,
1097 (!NILP (nosuffix
) ? Qnil
1098 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1099 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1100 tmp
[1] = Vload_file_rep_suffixes
,
1109 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1113 /* Tell startup.el whether or not we found the user's init file. */
1114 if (EQ (Qt
, Vuser_init_file
))
1115 Vuser_init_file
= found
;
1117 /* If FD is -2, that means openp found a magic file. */
1120 if (NILP (Fequal (found
, file
)))
1121 /* If FOUND is a different file name from FILE,
1122 find its handler even if we have already inhibited
1123 the `load' operation on FILE. */
1124 handler
= Ffind_file_name_handler (found
, Qt
);
1126 handler
= Ffind_file_name_handler (found
, Qload
);
1127 if (! NILP (handler
))
1128 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1130 /* Tramp has to deal with semi-broken packages that prepend
1131 drive letters to remote files. For that reason, Tramp
1132 catches file operations that test for file existence, which
1133 makes openp think X:/foo.elc files are remote. However,
1134 Tramp does not catch `load' operations for such files, so we
1135 end up with a nil as the `load' handler above. If we would
1136 continue with fd = -2, we will behave wrongly, and in
1137 particular try reading a .elc file in the "rt" mode instead
1138 of "rb". See bug #9311 for the results. To work around
1139 this, we try to open the file locally, and go with that if it
1141 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1147 /* Check if we're stuck in a recursive load cycle.
1149 2000-09-21: It's not possible to just check for the file loaded
1150 being a member of Vloads_in_progress. This fails because of the
1151 way the byte compiler currently works; `provide's are not
1152 evaluated, see font-lock.el/jit-lock.el as an example. This
1153 leads to a certain amount of ``normal'' recursion.
1155 Also, just loading a file recursively is not always an error in
1156 the general case; the second load may do something different. */
1160 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1161 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1165 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1167 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1168 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1171 /* All loads are by default dynamic, unless the file itself specifies
1172 otherwise using a file-variable in the first line. This is bound here
1173 so that it takes effect whether or not we use
1174 Vload_source_file_function. */
1175 specbind (Qlexical_binding
, Qnil
);
1177 /* Get the name for load-history. */
1178 hist_file_name
= (! NILP (Vpurify_flag
)
1179 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1180 tmp
[1] = Ffile_name_nondirectory (found
),
1186 /* Check for the presence of old-style quotes and warn about them. */
1187 specbind (Qold_style_backquotes
, Qnil
);
1188 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1190 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1191 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1192 /* Load .elc files directly, but not when they are
1193 remote and have no handler! */
1200 GCPRO3 (file
, found
, hist_file_name
);
1203 && ! (version
= safe_to_load_p (fd
)))
1206 if (!load_dangerous_libraries
)
1210 error ("File `%s' was not compiled in Emacs",
1213 else if (!NILP (nomessage
) && !force_load_messages
)
1214 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1219 efound
= ENCODE_FILE (found
);
1224 result
= stat (SSDATA (efound
), &s1
);
1227 SSET (efound
, SBYTES (efound
) - 1, 0);
1228 result
= stat (SSDATA (efound
), &s2
);
1229 SSET (efound
, SBYTES (efound
) - 1, 'c');
1232 if (result
== 0 && s1
.st_mtime
< s2
.st_mtime
)
1234 /* Make the progress messages mention that source is newer. */
1237 /* If we won't print another message, mention this anyway. */
1238 if (!NILP (nomessage
) && !force_load_messages
)
1240 Lisp_Object msg_file
;
1241 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1242 message_with_string ("Source file `%s' newer than byte-compiled file",
1251 /* We are loading a source file (*.el). */
1252 if (!NILP (Vload_source_file_function
))
1258 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1259 NILP (noerror
) ? Qnil
: Qt
,
1260 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1261 return unbind_to (count
, val
);
1265 GCPRO3 (file
, found
, hist_file_name
);
1268 efound
= ENCODE_FILE (found
);
1269 /* If we somehow got here with fd == -2, meaning the file is deemed
1270 to be remote, don't even try to reopen the file locally; just
1271 force a failure instead. */
1275 stream
= fopen (SSDATA (efound
), fmode
);
1279 #else /* not WINDOWSNT */
1280 stream
= fdopen (fd
, fmode
);
1281 #endif /* not WINDOWSNT */
1285 error ("Failure to create stdio stream for %s", SDATA (file
));
1288 if (! NILP (Vpurify_flag
))
1289 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1291 if (NILP (nomessage
) || force_load_messages
)
1294 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1297 message_with_string ("Loading %s (source)...", file
, 1);
1299 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1301 else /* The typical case; compiled file newer than source file. */
1302 message_with_string ("Loading %s...", file
, 1);
1305 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1306 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1307 specbind (Qload_file_name
, found
);
1308 specbind (Qinhibit_file_name_operation
, Qnil
);
1309 load_descriptor_list
1310 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1311 specbind (Qload_in_progress
, Qt
);
1314 if (lisp_file_lexically_bound_p (Qget_file_char
))
1315 Fset (Qlexical_binding
, Qt
);
1317 if (! version
|| version
>= 22)
1318 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1319 0, Qnil
, Qnil
, Qnil
, Qnil
);
1322 /* We can't handle a file which was compiled with
1323 byte-compile-dynamic by older version of Emacs. */
1324 specbind (Qload_force_doc_strings
, Qt
);
1325 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1326 0, Qnil
, Qnil
, Qnil
, Qnil
);
1328 unbind_to (count
, Qnil
);
1330 /* Run any eval-after-load forms for this file */
1331 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1332 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1336 xfree (saved_doc_string
);
1337 saved_doc_string
= 0;
1338 saved_doc_string_size
= 0;
1340 xfree (prev_saved_doc_string
);
1341 prev_saved_doc_string
= 0;
1342 prev_saved_doc_string_size
= 0;
1344 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1347 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1350 message_with_string ("Loading %s (source)...done", file
, 1);
1352 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1354 else /* The typical case; compiled file newer than source file. */
1355 message_with_string ("Loading %s...done", file
, 1);
1362 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1364 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1375 load_descriptor_unwind (Lisp_Object oldlist
)
1377 load_descriptor_list
= oldlist
;
1381 /* Close all descriptors in use for Floads.
1382 This is used when starting a subprocess. */
1385 close_load_descs (void)
1389 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1390 emacs_close (XFASTINT (XCAR (tail
)));
1395 complete_filename_p (Lisp_Object pathname
)
1397 register const unsigned char *s
= SDATA (pathname
);
1398 return (IS_DIRECTORY_SEP (s
[0])
1399 || (SCHARS (pathname
) > 2
1400 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1403 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1404 doc
: /* Search for FILENAME through PATH.
1405 Returns the file's name in absolute form, or nil if not found.
1406 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1407 file name when searching.
1408 If non-nil, PREDICATE is used instead of `file-readable-p'.
1409 PREDICATE can also be an integer to pass to the access(2) function,
1410 in which case file-name-handlers are ignored.
1411 This function will normally skip directories, so if you want it to find
1412 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1413 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1416 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1417 if (NILP (predicate
) && fd
> 0)
1422 static Lisp_Object Qdir_ok
;
1424 /* Search for a file whose name is STR, looking in directories
1425 in the Lisp list PATH, and trying suffixes from SUFFIX.
1426 On success, returns a file descriptor. On failure, returns -1.
1428 SUFFIXES is a list of strings containing possible suffixes.
1429 The empty suffix is automatically added if the list is empty.
1431 PREDICATE non-nil means don't open the files,
1432 just look for one that satisfies the predicate. In this case,
1433 returns 1 on success. The predicate can be a lisp function or
1434 an integer to pass to `access' (in which case file-name-handlers
1437 If STOREPTR is nonzero, it points to a slot where the name of
1438 the file actually found should be stored as a Lisp string.
1439 nil is stored there on failure.
1441 If the file we find is remote, return -2
1442 but store the found remote file name in *STOREPTR. */
1445 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1448 ptrdiff_t fn_size
= 100;
1450 register char *fn
= buf
;
1452 ptrdiff_t want_length
;
1453 Lisp_Object filename
;
1455 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1456 Lisp_Object string
, tail
, encoded_fn
;
1457 ptrdiff_t max_suffix_len
= 0;
1461 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1463 CHECK_STRING_CAR (tail
);
1464 max_suffix_len
= max (max_suffix_len
,
1465 SBYTES (XCAR (tail
)));
1468 string
= filename
= encoded_fn
= Qnil
;
1469 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1474 if (complete_filename_p (str
))
1477 for (; CONSP (path
); path
= XCDR (path
))
1479 filename
= Fexpand_file_name (str
, XCAR (path
));
1480 if (!complete_filename_p (filename
))
1481 /* If there are non-absolute elts in PATH (eg ".") */
1482 /* Of course, this could conceivably lose if luser sets
1483 default-directory to be something non-absolute... */
1485 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1486 if (!complete_filename_p (filename
))
1487 /* Give up on this path element! */
1491 /* Calculate maximum length of any filename made from
1492 this path element/specified file name and any possible suffix. */
1493 want_length
= max_suffix_len
+ SBYTES (filename
);
1494 if (fn_size
<= want_length
)
1495 fn
= (char *) alloca (fn_size
= 100 + want_length
);
1497 /* Loop over suffixes. */
1498 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1499 CONSP (tail
); tail
= XCDR (tail
))
1501 ptrdiff_t lsuffix
= SBYTES (XCAR (tail
));
1502 Lisp_Object handler
;
1505 /* Concatenate path element/specified name with the suffix.
1506 If the directory starts with /:, remove that. */
1507 if (SCHARS (filename
) > 2
1508 && SREF (filename
, 0) == '/'
1509 && SREF (filename
, 1) == ':')
1511 strncpy (fn
, SSDATA (filename
) + 2,
1512 SBYTES (filename
) - 2);
1513 fn
[SBYTES (filename
) - 2] = 0;
1517 strncpy (fn
, SSDATA (filename
),
1519 fn
[SBYTES (filename
)] = 0;
1522 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1523 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1525 /* Check that the file exists and is not a directory. */
1526 /* We used to only check for handlers on non-absolute file names:
1530 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1531 It's not clear why that was the case and it breaks things like
1532 (load "/bar.el") where the file is actually "/bar.el.gz". */
1533 string
= build_string (fn
);
1534 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1535 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1537 if (NILP (predicate
))
1538 exists
= !NILP (Ffile_readable_p (string
));
1541 Lisp_Object tmp
= call1 (predicate
, string
);
1542 exists
= !NILP (tmp
)
1543 && (EQ (tmp
, Qdir_ok
)
1544 || NILP (Ffile_directory_p (string
)));
1549 /* We succeeded; return this descriptor and filename. */
1560 encoded_fn
= ENCODE_FILE (string
);
1561 pfn
= SSDATA (encoded_fn
);
1562 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1565 /* Check that we can access or open it. */
1566 if (NATNUMP (predicate
))
1567 fd
= (((XFASTINT (predicate
) & ~INT_MAX
) == 0
1568 && access (pfn
, XFASTINT (predicate
)) == 0)
1571 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1575 /* We succeeded; return this descriptor and filename. */
1593 /* Merge the list we've accumulated of globals from the current input source
1594 into the load_history variable. The details depend on whether
1595 the source has an associated file name or not.
1597 FILENAME is the file name that we are loading from.
1598 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1601 build_load_history (Lisp_Object filename
, int entire
)
1603 register Lisp_Object tail
, prev
, newelt
;
1604 register Lisp_Object tem
, tem2
;
1605 register int foundit
= 0;
1607 tail
= Vload_history
;
1610 while (CONSP (tail
))
1614 /* Find the feature's previous assoc list... */
1615 if (!NILP (Fequal (filename
, Fcar (tem
))))
1619 /* If we're loading the entire file, remove old data. */
1623 Vload_history
= XCDR (tail
);
1625 Fsetcdr (prev
, XCDR (tail
));
1628 /* Otherwise, cons on new symbols that are not already members. */
1631 tem2
= Vcurrent_load_list
;
1633 while (CONSP (tem2
))
1635 newelt
= XCAR (tem2
);
1637 if (NILP (Fmember (newelt
, tem
)))
1638 Fsetcar (tail
, Fcons (XCAR (tem
),
1639 Fcons (newelt
, XCDR (tem
))));
1652 /* If we're loading an entire file, cons the new assoc onto the
1653 front of load-history, the most-recently-loaded position. Also
1654 do this if we didn't find an existing member for the file. */
1655 if (entire
|| !foundit
)
1656 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1661 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1668 readevalloop_1 (Lisp_Object old
)
1670 load_convert_to_unibyte
= ! NILP (old
);
1674 /* Signal an `end-of-file' error, if possible with file name
1678 end_of_file_error (void)
1680 if (STRINGP (Vload_file_name
))
1681 xsignal1 (Qend_of_file
, Vload_file_name
);
1683 xsignal0 (Qend_of_file
);
1686 /* UNIBYTE specifies how to set load_convert_to_unibyte
1687 for this invocation.
1688 READFUN, if non-nil, is used instead of `read'.
1690 START, END specify region to read in current buffer (from eval-region).
1691 If the input is not from a buffer, they must be nil. */
1694 readevalloop (Lisp_Object readcharfun
,
1696 Lisp_Object sourcename
,
1698 Lisp_Object unibyte
, Lisp_Object readfun
,
1699 Lisp_Object start
, Lisp_Object end
)
1702 register Lisp_Object val
;
1703 ptrdiff_t count
= SPECPDL_INDEX ();
1704 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1705 struct buffer
*b
= 0;
1706 int continue_reading_p
;
1707 Lisp_Object lex_bound
;
1708 /* Nonzero if reading an entire buffer. */
1709 int whole_buffer
= 0;
1710 /* 1 on the first time around. */
1713 if (MARKERP (readcharfun
))
1716 start
= readcharfun
;
1719 if (BUFFERP (readcharfun
))
1720 b
= XBUFFER (readcharfun
);
1721 else if (MARKERP (readcharfun
))
1722 b
= XMARKER (readcharfun
)->buffer
;
1724 /* We assume START is nil when input is not from a buffer. */
1725 if (! NILP (start
) && !b
)
1728 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1729 specbind (Qcurrent_load_list
, Qnil
);
1730 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1731 load_convert_to_unibyte
= !NILP (unibyte
);
1733 /* If lexical binding is active (either because it was specified in
1734 the file's header, or via a buffer-local variable), create an empty
1735 lexical environment, otherwise, turn off lexical binding. */
1736 lex_bound
= find_symbol_value (Qlexical_binding
);
1737 specbind (Qinternal_interpreter_environment
,
1738 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1739 ? Qnil
: Fcons (Qt
, Qnil
));
1741 GCPRO4 (sourcename
, readfun
, start
, end
);
1743 /* Try to ensure sourcename is a truename, except whilst preloading. */
1744 if (NILP (Vpurify_flag
)
1745 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1746 && !NILP (Ffboundp (Qfile_truename
)))
1747 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1749 LOADHIST_ATTACH (sourcename
);
1751 continue_reading_p
= 1;
1752 while (continue_reading_p
)
1754 ptrdiff_t count1
= SPECPDL_INDEX ();
1756 if (b
!= 0 && NILP (BVAR (b
, name
)))
1757 error ("Reading from killed buffer");
1761 /* Switch to the buffer we are reading from. */
1762 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1763 set_buffer_internal (b
);
1765 /* Save point in it. */
1766 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1767 /* Save ZV in it. */
1768 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1769 /* Those get unbound after we read one expression. */
1771 /* Set point and ZV around stuff to be read. */
1774 Fnarrow_to_region (make_number (BEGV
), end
);
1776 /* Just for cleanliness, convert END to a marker
1777 if it is an integer. */
1779 end
= Fpoint_max_marker ();
1782 /* On the first cycle, we can easily test here
1783 whether we are reading the whole buffer. */
1784 if (b
&& first_sexp
)
1785 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1792 while ((c
= READCHAR
) != '\n' && c
!= -1);
1797 unbind_to (count1
, Qnil
);
1801 /* Ignore whitespace here, so we can detect eof. */
1802 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1803 || c
== 0xa0) /* NBSP */
1806 if (!NILP (Vpurify_flag
) && c
== '(')
1808 record_unwind_protect (unreadpure
, Qnil
);
1809 val
= read_list (-1, readcharfun
);
1814 read_objects
= Qnil
;
1815 if (!NILP (readfun
))
1817 val
= call1 (readfun
, readcharfun
);
1819 /* If READCHARFUN has set point to ZV, we should
1820 stop reading, even if the form read sets point
1821 to a different value when evaluated. */
1822 if (BUFFERP (readcharfun
))
1824 struct buffer
*buf
= XBUFFER (readcharfun
);
1825 if (BUF_PT (buf
) == BUF_ZV (buf
))
1826 continue_reading_p
= 0;
1829 else if (! NILP (Vload_read_function
))
1830 val
= call1 (Vload_read_function
, readcharfun
);
1832 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1835 if (!NILP (start
) && continue_reading_p
)
1836 start
= Fpoint_marker ();
1838 /* Restore saved point and BEGV. */
1839 unbind_to (count1
, Qnil
);
1841 /* Now eval what we just read. */
1842 val
= eval_sub (val
);
1846 Vvalues
= Fcons (val
, Vvalues
);
1847 if (EQ (Vstandard_output
, Qt
))
1856 build_load_history (sourcename
,
1857 stream
|| whole_buffer
);
1861 unbind_to (count
, Qnil
);
1864 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1865 doc
: /* Execute the current buffer as Lisp code.
1866 When called from a Lisp program (i.e., not interactively), this
1867 function accepts up to five optional arguments:
1868 BUFFER is the buffer to evaluate (nil means use current buffer).
1869 PRINTFLAG controls printing of output:
1870 A value of nil means discard it; anything else is stream for print.
1871 FILENAME specifies the file name to use for `load-history'.
1872 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1874 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1875 functions should work normally even if PRINTFLAG is nil.
1877 This function preserves the position of point. */)
1878 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1880 ptrdiff_t count
= SPECPDL_INDEX ();
1881 Lisp_Object tem
, buf
;
1884 buf
= Fcurrent_buffer ();
1886 buf
= Fget_buffer (buffer
);
1888 error ("No such buffer");
1890 if (NILP (printflag
) && NILP (do_allow_print
))
1895 if (NILP (filename
))
1896 filename
= BVAR (XBUFFER (buf
), filename
);
1898 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1899 specbind (Qstandard_output
, tem
);
1900 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1901 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1902 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1903 readevalloop (buf
, 0, filename
,
1904 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1905 unbind_to (count
, Qnil
);
1910 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1911 doc
: /* Execute the region as Lisp code.
1912 When called from programs, expects two arguments,
1913 giving starting and ending indices in the current buffer
1914 of the text to be executed.
1915 Programs can pass third argument PRINTFLAG which controls output:
1916 A value of nil means discard it; anything else is stream for printing it.
1917 Also the fourth argument READ-FUNCTION, if non-nil, is used
1918 instead of `read' to read each expression. It gets one argument
1919 which is the input stream for reading characters.
1921 This function does not move point. */)
1922 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1924 /* FIXME: Do the eval-sexp-add-defvars dance! */
1925 ptrdiff_t count
= SPECPDL_INDEX ();
1926 Lisp_Object tem
, cbuf
;
1928 cbuf
= Fcurrent_buffer ();
1930 if (NILP (printflag
))
1934 specbind (Qstandard_output
, tem
);
1935 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1937 /* readevalloop calls functions which check the type of start and end. */
1938 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1939 !NILP (printflag
), Qnil
, read_function
,
1942 return unbind_to (count
, Qnil
);
1946 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1947 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1948 If STREAM is nil, use the value of `standard-input' (which see).
1949 STREAM or the value of `standard-input' may be:
1950 a buffer (read from point and advance it)
1951 a marker (read from where it points and advance it)
1952 a function (call it with no arguments for each character,
1953 call it with a char as argument to push a char back)
1954 a string (takes text from string, starting at the beginning)
1955 t (read text line using minibuffer and use it, or read from
1956 standard input in batch mode). */)
1957 (Lisp_Object stream
)
1960 stream
= Vstandard_input
;
1961 if (EQ (stream
, Qt
))
1962 stream
= Qread_char
;
1963 if (EQ (stream
, Qread_char
))
1964 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1966 return read_internal_start (stream
, Qnil
, Qnil
);
1969 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1970 doc
: /* Read one Lisp expression which is represented as text by STRING.
1971 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1972 FINAL-STRING-INDEX is an integer giving the position of the next
1973 remaining character in STRING.
1974 START and END optionally delimit a substring of STRING from which to read;
1975 they default to 0 and (length STRING) respectively. */)
1976 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1979 CHECK_STRING (string
);
1980 /* read_internal_start sets read_from_string_index. */
1981 ret
= read_internal_start (string
, start
, end
);
1982 return Fcons (ret
, make_number (read_from_string_index
));
1985 /* Function to set up the global context we need in toplevel read
1988 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1989 /* start, end only used when stream is a string. */
1994 new_backquote_flag
= 0;
1995 read_objects
= Qnil
;
1996 if (EQ (Vread_with_symbol_positions
, Qt
)
1997 || EQ (Vread_with_symbol_positions
, stream
))
1998 Vread_symbol_positions_list
= Qnil
;
2000 if (STRINGP (stream
)
2001 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2003 ptrdiff_t startval
, endval
;
2006 if (STRINGP (stream
))
2009 string
= XCAR (stream
);
2012 endval
= SCHARS (string
);
2016 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2017 args_out_of_range (string
, end
);
2018 endval
= XINT (end
);
2025 CHECK_NUMBER (start
);
2026 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2027 args_out_of_range (string
, start
);
2028 startval
= XINT (start
);
2030 read_from_string_index
= startval
;
2031 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2032 read_from_string_limit
= endval
;
2035 retval
= read0 (stream
);
2036 if (EQ (Vread_with_symbol_positions
, Qt
)
2037 || EQ (Vread_with_symbol_positions
, stream
))
2038 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2043 /* Signal Qinvalid_read_syntax error.
2044 S is error string of length N (if > 0) */
2047 invalid_syntax (const char *s
)
2049 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2053 /* Use this for recursive reads, in contexts where internal tokens
2057 read0 (Lisp_Object readcharfun
)
2059 register Lisp_Object val
;
2062 val
= read1 (readcharfun
, &c
, 0);
2066 xsignal1 (Qinvalid_read_syntax
,
2067 Fmake_string (make_number (1), make_number (c
)));
2070 static ptrdiff_t read_buffer_size
;
2071 static char *read_buffer
;
2073 /* Read a \-escape sequence, assuming we already read the `\'.
2074 If the escape sequence forces unibyte, return eight-bit char. */
2077 read_escape (Lisp_Object readcharfun
, int stringp
)
2079 register int c
= READCHAR
;
2080 /* \u allows up to four hex digits, \U up to eight. Default to the
2081 behavior for \u, and change this value in the case that \U is seen. */
2082 int unicode_hex_count
= 4;
2087 end_of_file_error ();
2117 error ("Invalid escape character syntax");
2120 c
= read_escape (readcharfun
, 0);
2121 return c
| meta_modifier
;
2126 error ("Invalid escape character syntax");
2129 c
= read_escape (readcharfun
, 0);
2130 return c
| shift_modifier
;
2135 error ("Invalid escape character syntax");
2138 c
= read_escape (readcharfun
, 0);
2139 return c
| hyper_modifier
;
2144 error ("Invalid escape character syntax");
2147 c
= read_escape (readcharfun
, 0);
2148 return c
| alt_modifier
;
2152 if (stringp
|| c
!= '-')
2159 c
= read_escape (readcharfun
, 0);
2160 return c
| super_modifier
;
2165 error ("Invalid escape character syntax");
2169 c
= read_escape (readcharfun
, 0);
2170 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2171 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2172 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2173 return c
| ctrl_modifier
;
2174 /* ASCII control chars are made from letters (both cases),
2175 as well as the non-letters within 0100...0137. */
2176 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2177 return (c
& (037 | ~0177));
2178 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2179 return (c
& (037 | ~0177));
2181 return c
| ctrl_modifier
;
2191 /* An octal escape, as in ANSI C. */
2193 register int i
= c
- '0';
2194 register int count
= 0;
2197 if ((c
= READCHAR
) >= '0' && c
<= '7')
2209 if (i
>= 0x80 && i
< 0x100)
2210 i
= BYTE8_TO_CHAR (i
);
2215 /* A hex escape, as in ANSI C. */
2222 if (c
>= '0' && c
<= '9')
2227 else if ((c
>= 'a' && c
<= 'f')
2228 || (c
>= 'A' && c
<= 'F'))
2231 if (c
>= 'a' && c
<= 'f')
2241 /* Allow hex escapes as large as ?\xfffffff, because some
2242 packages use them to denote characters with modifiers. */
2243 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2244 error ("Hex character out of range: \\x%x...", i
);
2248 if (count
< 3 && i
>= 0x80)
2249 return BYTE8_TO_CHAR (i
);
2254 /* Post-Unicode-2.0: Up to eight hex chars. */
2255 unicode_hex_count
= 8;
2258 /* A Unicode escape. We only permit them in strings and characters,
2259 not arbitrarily in the source code, as in some other languages. */
2264 while (++count
<= unicode_hex_count
)
2267 /* isdigit and isalpha may be locale-specific, which we don't
2269 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2270 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2271 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2273 error ("Non-hex digit used for Unicode escape");
2276 error ("Non-Unicode character: 0x%x", i
);
2285 /* Return the digit that CHARACTER stands for in the given BASE.
2286 Return -1 if CHARACTER is out of range for BASE,
2287 and -2 if CHARACTER is not valid for any supported BASE. */
2289 digit_to_number (int character
, int base
)
2293 if ('0' <= character
&& character
<= '9')
2294 digit
= character
- '0';
2295 else if ('a' <= character
&& character
<= 'z')
2296 digit
= character
- 'a' + 10;
2297 else if ('A' <= character
&& character
<= 'Z')
2298 digit
= character
- 'A' + 10;
2302 return digit
< base
? digit
: -1;
2305 /* Read an integer in radix RADIX using READCHARFUN to read
2306 characters. RADIX must be in the interval [2..36]; if it isn't, a
2307 read error is signaled . Value is the integer read. Signals an
2308 error if encountering invalid read syntax or if RADIX is out of
2312 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2314 /* Room for sign, leading 0, other digits, trailing null byte.
2315 Also, room for invalid syntax diagnostic. */
2316 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2317 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2319 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2321 if (radix
< 2 || radix
> 36)
2329 if (c
== '-' || c
== '+')
2340 /* Ignore redundant leading zeros, so the buffer doesn't
2341 fill up with them. */
2347 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2354 if (p
< buf
+ sizeof buf
- 1)
2368 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2369 invalid_syntax (buf
);
2372 return string_to_number (buf
, radix
, 0);
2376 /* If the next token is ')' or ']' or '.', we store that character
2377 in *PCH and the return value is not interesting. Else, we store
2378 zero in *PCH and we read and return one lisp object.
2380 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2383 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2386 unsigned uninterned_symbol
= 0;
2394 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2396 end_of_file_error ();
2401 return read_list (0, readcharfun
);
2404 return read_vector (readcharfun
, 0);
2420 /* Accept extended format for hashtables (extensible to
2422 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2423 Lisp_Object tmp
= read_list (0, readcharfun
);
2424 Lisp_Object head
= CAR_SAFE (tmp
);
2425 Lisp_Object data
= Qnil
;
2426 Lisp_Object val
= Qnil
;
2427 /* The size is 2 * number of allowed keywords to
2429 Lisp_Object params
[10];
2431 Lisp_Object key
= Qnil
;
2432 int param_count
= 0;
2434 if (!EQ (head
, Qhash_table
))
2435 error ("Invalid extended read marker at head of #s list "
2436 "(only hash-table allowed)");
2438 tmp
= CDR_SAFE (tmp
);
2440 /* This is repetitive but fast and simple. */
2441 params
[param_count
] = QCsize
;
2442 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2443 if (!NILP (params
[param_count
+ 1]))
2446 params
[param_count
] = QCtest
;
2447 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2448 if (!NILP (params
[param_count
+ 1]))
2451 params
[param_count
] = QCweakness
;
2452 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2453 if (!NILP (params
[param_count
+ 1]))
2456 params
[param_count
] = QCrehash_size
;
2457 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2458 if (!NILP (params
[param_count
+ 1]))
2461 params
[param_count
] = QCrehash_threshold
;
2462 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2463 if (!NILP (params
[param_count
+ 1]))
2466 /* This is the hashtable data. */
2467 data
= Fplist_get (tmp
, Qdata
);
2469 /* Now use params to make a new hashtable and fill it. */
2470 ht
= Fmake_hash_table (param_count
, params
);
2472 while (CONSP (data
))
2477 error ("Odd number of elements in hashtable data");
2480 Fputhash (key
, val
, ht
);
2486 invalid_syntax ("#");
2494 tmp
= read_vector (readcharfun
, 0);
2495 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2496 error ("Invalid size char-table");
2497 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2509 tmp
= read_vector (readcharfun
, 0);
2512 error ("Invalid size char-table");
2513 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2514 error ("Invalid depth in char-table");
2515 depth
= XINT (AREF (tmp
, 0));
2516 if (chartab_size
[depth
] != size
- 2)
2517 error ("Invalid size char-table");
2518 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2521 invalid_syntax ("#^^");
2523 invalid_syntax ("#^");
2528 length
= read1 (readcharfun
, pch
, first_in_list
);
2532 Lisp_Object tmp
, val
;
2533 EMACS_INT size_in_chars
2534 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2535 / BOOL_VECTOR_BITS_PER_CHAR
);
2538 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2539 if (STRING_MULTIBYTE (tmp
)
2540 || (size_in_chars
!= SCHARS (tmp
)
2541 /* We used to print 1 char too many
2542 when the number of bits was a multiple of 8.
2543 Accept such input in case it came from an old
2545 && ! (XFASTINT (length
)
2546 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2547 invalid_syntax ("#&...");
2549 val
= Fmake_bool_vector (length
, Qnil
);
2550 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2551 /* Clear the extraneous bits in the last byte. */
2552 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2553 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2554 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2557 invalid_syntax ("#&...");
2561 /* Accept compiled functions at read-time so that we don't have to
2562 build them using function calls. */
2564 tmp
= read_vector (readcharfun
, 1);
2565 return Fmake_byte_code (ASIZE (tmp
),
2566 XVECTOR (tmp
)->contents
);
2571 struct gcpro gcpro1
;
2574 /* Read the string itself. */
2575 tmp
= read1 (readcharfun
, &ch
, 0);
2576 if (ch
!= 0 || !STRINGP (tmp
))
2577 invalid_syntax ("#");
2579 /* Read the intervals and their properties. */
2582 Lisp_Object beg
, end
, plist
;
2584 beg
= read1 (readcharfun
, &ch
, 0);
2589 end
= read1 (readcharfun
, &ch
, 0);
2591 plist
= read1 (readcharfun
, &ch
, 0);
2593 invalid_syntax ("Invalid string property list");
2594 Fset_text_properties (beg
, end
, plist
, tmp
);
2600 /* #@NUMBER is used to skip NUMBER following characters.
2601 That's used in .elc files to skip over doc strings
2602 and function definitions. */
2605 enum { extra
= 100 };
2606 ptrdiff_t i
, nskip
= 0;
2609 /* Read a decimal integer. */
2610 while ((c
= READCHAR
) >= 0
2611 && c
>= '0' && c
<= '9')
2613 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2620 if (load_force_doc_strings
2621 && (EQ (readcharfun
, Qget_file_char
)
2622 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2624 /* If we are supposed to force doc strings into core right now,
2625 record the last string that we skipped,
2626 and record where in the file it comes from. */
2628 /* But first exchange saved_doc_string
2629 with prev_saved_doc_string, so we save two strings. */
2631 char *temp
= saved_doc_string
;
2632 ptrdiff_t temp_size
= saved_doc_string_size
;
2633 file_offset temp_pos
= saved_doc_string_position
;
2634 ptrdiff_t temp_len
= saved_doc_string_length
;
2636 saved_doc_string
= prev_saved_doc_string
;
2637 saved_doc_string_size
= prev_saved_doc_string_size
;
2638 saved_doc_string_position
= prev_saved_doc_string_position
;
2639 saved_doc_string_length
= prev_saved_doc_string_length
;
2641 prev_saved_doc_string
= temp
;
2642 prev_saved_doc_string_size
= temp_size
;
2643 prev_saved_doc_string_position
= temp_pos
;
2644 prev_saved_doc_string_length
= temp_len
;
2647 if (saved_doc_string_size
== 0)
2649 saved_doc_string
= (char *) xmalloc (nskip
+ extra
);
2650 saved_doc_string_size
= nskip
+ extra
;
2652 if (nskip
> saved_doc_string_size
)
2654 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2656 saved_doc_string_size
= nskip
+ extra
;
2659 saved_doc_string_position
= file_tell (instream
);
2661 /* Copy that many characters into saved_doc_string. */
2662 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2663 saved_doc_string
[i
] = c
= READCHAR
;
2665 saved_doc_string_length
= i
;
2669 /* Skip that many characters. */
2670 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2679 /* #! appears at the beginning of an executable file.
2680 Skip the first line. */
2681 while (c
!= '\n' && c
>= 0)
2686 return Vload_file_name
;
2688 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2689 /* #:foo is the uninterned symbol named foo. */
2692 uninterned_symbol
= 1;
2695 && c
!= 0xa0 /* NBSP */
2697 || strchr ("\"';()[]#`,", c
) == NULL
)))
2699 /* No symbol character follows, this is the empty
2702 return Fmake_symbol (build_string (""));
2706 /* ## is the empty symbol. */
2708 return Fintern (build_string (""), Qnil
);
2709 /* Reader forms that can reuse previously read objects. */
2710 if (c
>= '0' && c
<= '9')
2715 /* Read a non-negative integer. */
2716 while (c
>= '0' && c
<= '9')
2718 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2719 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2720 n
= MOST_POSITIVE_FIXNUM
+ 1;
2722 n
= n
* 10 + c
- '0';
2726 if (n
<= MOST_POSITIVE_FIXNUM
)
2728 if (c
== 'r' || c
== 'R')
2729 return read_integer (readcharfun
, n
);
2731 if (! NILP (Vread_circle
))
2733 /* #n=object returns object, but associates it with
2737 /* Make a placeholder for #n# to use temporarily */
2738 Lisp_Object placeholder
;
2741 placeholder
= Fcons (Qnil
, Qnil
);
2742 cell
= Fcons (make_number (n
), placeholder
);
2743 read_objects
= Fcons (cell
, read_objects
);
2745 /* Read the object itself. */
2746 tem
= read0 (readcharfun
);
2748 /* Now put it everywhere the placeholder was... */
2749 substitute_object_in_subtree (tem
, placeholder
);
2751 /* ...and #n# will use the real value from now on. */
2752 Fsetcdr (cell
, tem
);
2757 /* #n# returns a previously read object. */
2760 tem
= Fassq (make_number (n
), read_objects
);
2766 /* Fall through to error message. */
2768 else if (c
== 'x' || c
== 'X')
2769 return read_integer (readcharfun
, 16);
2770 else if (c
== 'o' || c
== 'O')
2771 return read_integer (readcharfun
, 8);
2772 else if (c
== 'b' || c
== 'B')
2773 return read_integer (readcharfun
, 2);
2776 invalid_syntax ("#");
2779 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2784 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2789 int next_char
= READCHAR
;
2791 /* Transition from old-style to new-style:
2792 If we see "(`" it used to mean old-style, which usually works
2793 fine because ` should almost never appear in such a position
2794 for new-style. But occasionally we need "(`" to mean new
2795 style, so we try to distinguish the two by the fact that we
2796 can either write "( `foo" or "(` foo", where the first
2797 intends to use new-style whereas the second intends to use
2798 old-style. For Emacs-25, we should completely remove this
2799 first_in_list exception (old-style can still be obtained via
2801 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2803 Vold_style_backquotes
= Qt
;
2810 new_backquote_flag
++;
2811 value
= read0 (readcharfun
);
2812 new_backquote_flag
--;
2814 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2819 int next_char
= READCHAR
;
2821 /* Transition from old-style to new-style:
2822 It used to be impossible to have a new-style , other than within
2823 a new-style `. This is sufficient when ` and , are used in the
2824 normal way, but ` and , can also appear in args to macros that
2825 will not interpret them in the usual way, in which case , may be
2826 used without any ` anywhere near.
2827 So we now use the same heuristic as for backquote: old-style
2828 unquotes are only recognized when first on a list, and when
2829 followed by a space.
2830 Because it's more difficult to peek 2 chars ahead, a new-style
2831 ,@ can still not be used outside of a `, unless it's in the middle
2833 if (new_backquote_flag
2835 || (next_char
!= ' ' && next_char
!= '@'))
2837 Lisp_Object comma_type
= Qnil
;
2842 comma_type
= Qcomma_at
;
2844 comma_type
= Qcomma_dot
;
2847 if (ch
>= 0) UNREAD (ch
);
2848 comma_type
= Qcomma
;
2851 value
= read0 (readcharfun
);
2852 return Fcons (comma_type
, Fcons (value
, Qnil
));
2856 Vold_style_backquotes
= Qt
;
2868 end_of_file_error ();
2870 /* Accept `single space' syntax like (list ? x) where the
2871 whitespace character is SPC or TAB.
2872 Other literal whitespace like NL, CR, and FF are not accepted,
2873 as there are well-established escape sequences for these. */
2874 if (c
== ' ' || c
== '\t')
2875 return make_number (c
);
2878 c
= read_escape (readcharfun
, 0);
2879 modifiers
= c
& CHAR_MODIFIER_MASK
;
2880 c
&= ~CHAR_MODIFIER_MASK
;
2881 if (CHAR_BYTE8_P (c
))
2882 c
= CHAR_TO_BYTE8 (c
);
2885 next_char
= READCHAR
;
2886 ok
= (next_char
<= 040
2887 || (next_char
< 0200
2888 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2891 return make_number (c
);
2893 invalid_syntax ("?");
2898 char *p
= read_buffer
;
2899 char *end
= read_buffer
+ read_buffer_size
;
2901 /* Nonzero if we saw an escape sequence specifying
2902 a multibyte character. */
2903 int force_multibyte
= 0;
2904 /* Nonzero if we saw an escape sequence specifying
2905 a single-byte character. */
2906 int force_singlebyte
= 0;
2908 ptrdiff_t nchars
= 0;
2910 while ((ch
= READCHAR
) >= 0
2913 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2915 ptrdiff_t offset
= p
- read_buffer
;
2916 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2917 memory_full (SIZE_MAX
);
2918 read_buffer
= (char *) xrealloc (read_buffer
,
2919 read_buffer_size
* 2);
2920 read_buffer_size
*= 2;
2921 p
= read_buffer
+ offset
;
2922 end
= read_buffer
+ read_buffer_size
;
2929 ch
= read_escape (readcharfun
, 1);
2931 /* CH is -1 if \ newline has just been seen */
2934 if (p
== read_buffer
)
2939 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2940 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2942 if (CHAR_BYTE8_P (ch
))
2943 force_singlebyte
= 1;
2944 else if (! ASCII_CHAR_P (ch
))
2945 force_multibyte
= 1;
2946 else /* i.e. ASCII_CHAR_P (ch) */
2948 /* Allow `\C- ' and `\C-?'. */
2949 if (modifiers
== CHAR_CTL
)
2952 ch
= 0, modifiers
= 0;
2954 ch
= 127, modifiers
= 0;
2956 if (modifiers
& CHAR_SHIFT
)
2958 /* Shift modifier is valid only with [A-Za-z]. */
2959 if (ch
>= 'A' && ch
<= 'Z')
2960 modifiers
&= ~CHAR_SHIFT
;
2961 else if (ch
>= 'a' && ch
<= 'z')
2962 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2965 if (modifiers
& CHAR_META
)
2967 /* Move the meta bit to the right place for a
2969 modifiers
&= ~CHAR_META
;
2970 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2971 force_singlebyte
= 1;
2975 /* Any modifiers remaining are invalid. */
2977 error ("Invalid modifier in string");
2978 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2982 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2983 if (CHAR_BYTE8_P (ch
))
2984 force_singlebyte
= 1;
2985 else if (! ASCII_CHAR_P (ch
))
2986 force_multibyte
= 1;
2992 end_of_file_error ();
2994 /* If purifying, and string starts with \ newline,
2995 return zero instead. This is for doc strings
2996 that we are really going to find in etc/DOC.nn.nn */
2997 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2998 return make_number (0);
3000 if (force_multibyte
)
3001 /* READ_BUFFER already contains valid multibyte forms. */
3003 else if (force_singlebyte
)
3005 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3007 p
= read_buffer
+ nchars
;
3011 /* Otherwise, READ_BUFFER contains only ASCII. */
3015 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
3017 || (p
- read_buffer
!= nchars
)));
3018 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3020 || (p
- read_buffer
!= nchars
)));
3025 int next_char
= READCHAR
;
3028 if (next_char
<= 040
3029 || (next_char
< 0200
3030 && strchr ("\"';([#?`,", next_char
) != NULL
))
3036 /* Otherwise, we fall through! Note that the atom-reading loop
3037 below will now loop at least once, assuring that we will not
3038 try to UNREAD two characters in a row. */
3042 if (c
<= 040) goto retry
;
3043 if (c
== 0xa0) /* NBSP */
3048 char *p
= read_buffer
;
3050 EMACS_INT start_position
= readchar_count
- 1;
3053 char *end
= read_buffer
+ read_buffer_size
;
3057 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3059 ptrdiff_t offset
= p
- read_buffer
;
3060 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3061 memory_full (SIZE_MAX
);
3062 read_buffer
= (char *) xrealloc (read_buffer
,
3063 read_buffer_size
* 2);
3064 read_buffer_size
*= 2;
3065 p
= read_buffer
+ offset
;
3066 end
= read_buffer
+ read_buffer_size
;
3073 end_of_file_error ();
3078 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3084 && c
!= 0xa0 /* NBSP */
3086 || strchr ("\"';()[]#`,", c
) == NULL
));
3090 ptrdiff_t offset
= p
- read_buffer
;
3091 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3092 memory_full (SIZE_MAX
);
3093 read_buffer
= (char *) xrealloc (read_buffer
,
3094 read_buffer_size
* 2);
3095 read_buffer_size
*= 2;
3096 p
= read_buffer
+ offset
;
3097 end
= read_buffer
+ read_buffer_size
;
3103 if (!quoted
&& !uninterned_symbol
)
3105 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3106 if (! NILP (result
))
3110 Lisp_Object name
, result
;
3111 ptrdiff_t nbytes
= p
- read_buffer
;
3114 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3118 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3119 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3121 name
= make_specified_string (read_buffer
, nchars
, nbytes
, multibyte
);
3122 result
= (uninterned_symbol
? Fmake_symbol (name
)
3123 : Fintern (name
, Qnil
));
3125 if (EQ (Vread_with_symbol_positions
, Qt
)
3126 || EQ (Vread_with_symbol_positions
, readcharfun
))
3127 Vread_symbol_positions_list
=
3128 Fcons (Fcons (result
, make_number (start_position
)),
3129 Vread_symbol_positions_list
);
3137 /* List of nodes we've seen during substitute_object_in_subtree. */
3138 static Lisp_Object seen_list
;
3141 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3143 Lisp_Object check_object
;
3145 /* We haven't seen any objects when we start. */
3148 /* Make all the substitutions. */
3150 = substitute_object_recurse (object
, placeholder
, object
);
3152 /* Clear seen_list because we're done with it. */
3155 /* The returned object here is expected to always eq the
3157 if (!EQ (check_object
, object
))
3158 error ("Unexpected mutation error in reader");
3161 /* Feval doesn't get called from here, so no gc protection is needed. */
3162 #define SUBSTITUTE(get_val, set_val) \
3164 Lisp_Object old_value = get_val; \
3165 Lisp_Object true_value \
3166 = substitute_object_recurse (object, placeholder, \
3169 if (!EQ (old_value, true_value)) \
3176 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3178 /* If we find the placeholder, return the target object. */
3179 if (EQ (placeholder
, subtree
))
3182 /* If we've been to this node before, don't explore it again. */
3183 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3186 /* If this node can be the entry point to a cycle, remember that
3187 we've seen it. It can only be such an entry point if it was made
3188 by #n=, which means that we can find it as a value in
3190 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3191 seen_list
= Fcons (subtree
, seen_list
);
3193 /* Recurse according to subtree's type.
3194 Every branch must return a Lisp_Object. */
3195 switch (XTYPE (subtree
))
3197 case Lisp_Vectorlike
:
3199 ptrdiff_t i
, length
= 0;
3200 if (BOOL_VECTOR_P (subtree
))
3201 return subtree
; /* No sub-objects anyway. */
3202 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3203 || COMPILEDP (subtree
))
3204 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3205 else if (VECTORP (subtree
))
3206 length
= ASIZE (subtree
);
3208 /* An unknown pseudovector may contain non-Lisp fields, so we
3209 can't just blindly traverse all its fields. We used to call
3210 `Flength' which signaled `sequencep', so I just preserved this
3212 wrong_type_argument (Qsequencep
, subtree
);
3214 for (i
= 0; i
< length
; i
++)
3215 SUBSTITUTE (AREF (subtree
, i
),
3216 ASET (subtree
, i
, true_value
));
3222 SUBSTITUTE (XCAR (subtree
),
3223 XSETCAR (subtree
, true_value
));
3224 SUBSTITUTE (XCDR (subtree
),
3225 XSETCDR (subtree
, true_value
));
3231 /* Check for text properties in each interval.
3232 substitute_in_interval contains part of the logic. */
3234 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3235 Lisp_Object arg
= Fcons (object
, placeholder
);
3237 traverse_intervals_noorder (root_interval
,
3238 &substitute_in_interval
, arg
);
3243 /* Other types don't recurse any further. */
3249 /* Helper function for substitute_object_recurse. */
3251 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3253 Lisp_Object object
= Fcar (arg
);
3254 Lisp_Object placeholder
= Fcdr (arg
);
3256 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3266 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3267 integer syntax and fits in a fixnum, else return the nearest float if CP has
3268 either floating point or integer syntax and BASE is 10, else return nil. If
3269 IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
3270 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3271 number has integer syntax but does not fit. */
3274 string_to_number (char const *string
, int base
, int ignore_trailing
)
3277 char const *cp
= string
;
3279 int float_syntax
= 0;
3282 /* Compute NaN and infinities using a variable, to cope with compilers that
3283 think they are smarter than we are. */
3286 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3287 IEEE floating point hosts, and works around a formerly-common bug where
3288 atof ("-0.0") drops the sign. */
3289 int negative
= *cp
== '-';
3291 int signedp
= negative
|| *cp
== '+';
3296 leading_digit
= digit_to_number (*cp
, base
);
3297 if (0 <= leading_digit
)
3302 while (0 <= digit_to_number (*cp
, base
));
3312 if ('0' <= *cp
&& *cp
<= '9')
3317 while ('0' <= *cp
&& *cp
<= '9');
3319 if (*cp
== 'e' || *cp
== 'E')
3321 char const *ecp
= cp
;
3323 if (*cp
== '+' || *cp
== '-')
3325 if ('0' <= *cp
&& *cp
<= '9')
3330 while ('0' <= *cp
&& *cp
<= '9');
3332 else if (cp
[-1] == '+'
3333 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3339 else if (cp
[-1] == '+'
3340 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3344 value
= zero
/ zero
;
3346 /* If that made a "negative" NaN, negate it. */
3349 union { double d
; char c
[sizeof (double)]; }
3350 u_data
, u_minus_zero
;
3352 u_minus_zero
.d
= -0.0;
3353 for (i
= 0; i
< sizeof (double); i
++)
3354 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3360 /* Now VALUE is a positive NaN. */
3366 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3367 || state
== (LEAD_INT
|E_EXP
));
3370 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3371 any prefix that matches. Otherwise, the entire string must match. */
3372 if (! (ignore_trailing
3373 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3374 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3377 /* If the number uses integer and not float syntax, and is in C-language
3378 range, use its value, preferably as a fixnum. */
3379 if (0 <= leading_digit
&& ! float_syntax
)
3383 /* Fast special case for single-digit integers. This also avoids a
3384 glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
3385 case some versions of strtoumax accept numbers like "0x1" that Emacs
3387 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3388 return make_number (negative
? -leading_digit
: leading_digit
);
3391 n
= strtoumax (string
+ signedp
, NULL
, base
);
3392 if (errno
== ERANGE
)
3394 /* Unfortunately there's no simple and accurate way to convert
3395 non-base-10 numbers that are out of C-language range. */
3397 xsignal1 (Qoverflow_error
, build_string (string
));
3399 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3401 EMACS_INT signed_n
= n
;
3402 return make_number (negative
? -signed_n
: signed_n
);
3408 /* Either the number uses float syntax, or it does not fit into a fixnum.
3409 Convert it from string to floating point, unless the value is already
3410 known because it is an infinity, a NAN, or its absolute value fits in
3413 value
= atof (string
+ signedp
);
3415 return make_float (negative
? -value
: value
);
3420 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3423 register Lisp_Object
*ptr
;
3424 register Lisp_Object tem
, item
, vector
;
3425 register struct Lisp_Cons
*otem
;
3428 tem
= read_list (1, readcharfun
);
3429 len
= Flength (tem
);
3430 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3432 size
= ASIZE (vector
);
3433 ptr
= XVECTOR (vector
)->contents
;
3434 for (i
= 0; i
< size
; i
++)
3437 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3438 bytecode object, the docstring containing the bytecode and
3439 constants values must be treated as unibyte and passed to
3440 Fread, to get the actual bytecode string and constants vector. */
3441 if (bytecodeflag
&& load_force_doc_strings
)
3443 if (i
== COMPILED_BYTECODE
)
3445 if (!STRINGP (item
))
3446 error ("Invalid byte code");
3448 /* Delay handling the bytecode slot until we know whether
3449 it is lazily-loaded (we can tell by whether the
3450 constants slot is nil). */
3451 ptr
[COMPILED_CONSTANTS
] = item
;
3454 else if (i
== COMPILED_CONSTANTS
)
3456 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3460 /* Coerce string to unibyte (like string-as-unibyte,
3461 but without generating extra garbage and
3462 guaranteeing no change in the contents). */
3463 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3464 STRING_SET_UNIBYTE (bytestr
);
3466 item
= Fread (Fcons (bytestr
, readcharfun
));
3468 error ("Invalid byte code");
3470 otem
= XCONS (item
);
3471 bytestr
= XCAR (item
);
3476 /* Now handle the bytecode slot. */
3477 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3479 else if (i
== COMPILED_DOC_STRING
3481 && ! STRING_MULTIBYTE (item
))
3483 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3484 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3486 item
= Fstring_as_multibyte (item
);
3489 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3497 /* FLAG = 1 means check for ] to terminate rather than ) and .
3498 FLAG = -1 means check for starting with defun
3499 and make structure pure. */
3502 read_list (int flag
, register Lisp_Object readcharfun
)
3504 /* -1 means check next element for defun,
3505 0 means don't check,
3506 1 means already checked and found defun. */
3507 int defunflag
= flag
< 0 ? -1 : 0;
3508 Lisp_Object val
, tail
;
3509 register Lisp_Object elt
, tem
;
3510 struct gcpro gcpro1
, gcpro2
;
3511 /* 0 is the normal case.
3512 1 means this list is a doc reference; replace it with the number 0.
3513 2 means this list is a doc reference; replace it with the doc string. */
3514 int doc_reference
= 0;
3516 /* Initialize this to 1 if we are reading a list. */
3517 int first_in_list
= flag
<= 0;
3526 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3531 /* While building, if the list starts with #$, treat it specially. */
3532 if (EQ (elt
, Vload_file_name
)
3534 && !NILP (Vpurify_flag
))
3536 if (NILP (Vdoc_file_name
))
3537 /* We have not yet called Snarf-documentation, so assume
3538 this file is described in the DOC-MM.NN file
3539 and Snarf-documentation will fill in the right value later.
3540 For now, replace the whole list with 0. */
3543 /* We have already called Snarf-documentation, so make a relative
3544 file name for this file, so it can be found properly
3545 in the installed Lisp directory.
3546 We don't use Fexpand_file_name because that would make
3547 the directory absolute now. */
3548 elt
= concat2 (build_string ("../lisp/"),
3549 Ffile_name_nondirectory (elt
));
3551 else if (EQ (elt
, Vload_file_name
)
3553 && load_force_doc_strings
)
3562 invalid_syntax (") or . in a vector");
3570 XSETCDR (tail
, read0 (readcharfun
));
3572 val
= read0 (readcharfun
);
3573 read1 (readcharfun
, &ch
, 0);
3577 if (doc_reference
== 1)
3578 return make_number (0);
3579 if (doc_reference
== 2)
3581 /* Get a doc string from the file we are loading.
3582 If it's in saved_doc_string, get it from there.
3584 Here, we don't know if the string is a
3585 bytecode string or a doc string. As a
3586 bytecode string must be unibyte, we always
3587 return a unibyte string. If it is actually a
3588 doc string, caller must make it
3591 EMACS_INT pos
= XINT (XCDR (val
));
3592 /* Position is negative for user variables. */
3593 if (pos
< 0) pos
= -pos
;
3594 if (pos
>= saved_doc_string_position
3595 && pos
< (saved_doc_string_position
3596 + saved_doc_string_length
))
3598 ptrdiff_t start
= pos
- saved_doc_string_position
;
3601 /* Process quoting with ^A,
3602 and find the end of the string,
3603 which is marked with ^_ (037). */
3604 for (from
= start
, to
= start
;
3605 saved_doc_string
[from
] != 037;)
3607 int c
= saved_doc_string
[from
++];
3610 c
= saved_doc_string
[from
++];
3612 saved_doc_string
[to
++] = c
;
3614 saved_doc_string
[to
++] = 0;
3616 saved_doc_string
[to
++] = 037;
3619 saved_doc_string
[to
++] = c
;
3622 return make_unibyte_string (saved_doc_string
+ start
,
3625 /* Look in prev_saved_doc_string the same way. */
3626 else if (pos
>= prev_saved_doc_string_position
3627 && pos
< (prev_saved_doc_string_position
3628 + prev_saved_doc_string_length
))
3631 pos
- prev_saved_doc_string_position
;
3634 /* Process quoting with ^A,
3635 and find the end of the string,
3636 which is marked with ^_ (037). */
3637 for (from
= start
, to
= start
;
3638 prev_saved_doc_string
[from
] != 037;)
3640 int c
= prev_saved_doc_string
[from
++];
3643 c
= prev_saved_doc_string
[from
++];
3645 prev_saved_doc_string
[to
++] = c
;
3647 prev_saved_doc_string
[to
++] = 0;
3649 prev_saved_doc_string
[to
++] = 037;
3652 prev_saved_doc_string
[to
++] = c
;
3655 return make_unibyte_string (prev_saved_doc_string
3660 return get_doc_string (val
, 1, 0);
3665 invalid_syntax (". in wrong context");
3667 invalid_syntax ("] in a list");
3669 tem
= (read_pure
&& flag
<= 0
3670 ? pure_cons (elt
, Qnil
)
3671 : Fcons (elt
, Qnil
));
3673 XSETCDR (tail
, tem
);
3678 defunflag
= EQ (elt
, Qdefun
);
3679 else if (defunflag
> 0)
3684 static Lisp_Object initial_obarray
;
3686 /* oblookup stores the bucket number here, for the sake of Funintern. */
3688 static size_t oblookup_last_bucket_number
;
3690 /* Get an error if OBARRAY is not an obarray.
3691 If it is one, return it. */
3694 check_obarray (Lisp_Object obarray
)
3696 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3698 /* If Vobarray is now invalid, force it to be valid. */
3699 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3700 wrong_type_argument (Qvectorp
, obarray
);
3705 /* Intern the C string STR: return a symbol with that name,
3706 interned in the current obarray. */
3709 intern (const char *str
)
3712 ptrdiff_t len
= strlen (str
);
3713 Lisp_Object obarray
;
3716 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3717 obarray
= check_obarray (obarray
);
3718 tem
= oblookup (obarray
, str
, len
, len
);
3721 return Fintern (make_string (str
, len
), obarray
);
3725 intern_c_string (const char *str
)
3728 ptrdiff_t len
= strlen (str
);
3729 Lisp_Object obarray
;
3732 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3733 obarray
= check_obarray (obarray
);
3734 tem
= oblookup (obarray
, str
, len
, len
);
3738 if (NILP (Vpurify_flag
))
3739 /* Creating a non-pure string from a string literal not
3740 implemented yet. We could just use make_string here and live
3741 with the extra copy. */
3744 return Fintern (make_pure_c_string (str
), obarray
);
3747 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3748 doc
: /* Return the canonical symbol whose name is STRING.
3749 If there is none, one is created by this function and returned.
3750 A second optional argument specifies the obarray to use;
3751 it defaults to the value of `obarray'. */)
3752 (Lisp_Object string
, Lisp_Object obarray
)
3754 register Lisp_Object tem
, sym
, *ptr
;
3756 if (NILP (obarray
)) obarray
= Vobarray
;
3757 obarray
= check_obarray (obarray
);
3759 CHECK_STRING (string
);
3761 tem
= oblookup (obarray
, SSDATA (string
),
3764 if (!INTEGERP (tem
))
3767 if (!NILP (Vpurify_flag
))
3768 string
= Fpurecopy (string
);
3769 sym
= Fmake_symbol (string
);
3771 if (EQ (obarray
, initial_obarray
))
3772 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3774 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3776 if ((SREF (string
, 0) == ':')
3777 && EQ (obarray
, initial_obarray
))
3779 XSYMBOL (sym
)->constant
= 1;
3780 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3781 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3784 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3786 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3788 XSYMBOL (sym
)->next
= 0;
3793 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3794 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3795 NAME may be a string or a symbol. If it is a symbol, that exact
3796 symbol is searched for.
3797 A second optional argument specifies the obarray to use;
3798 it defaults to the value of `obarray'. */)
3799 (Lisp_Object name
, Lisp_Object obarray
)
3801 register Lisp_Object tem
, string
;
3803 if (NILP (obarray
)) obarray
= Vobarray
;
3804 obarray
= check_obarray (obarray
);
3806 if (!SYMBOLP (name
))
3808 CHECK_STRING (name
);
3812 string
= SYMBOL_NAME (name
);
3814 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3815 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3821 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3822 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3823 The value is t if a symbol was found and deleted, nil otherwise.
3824 NAME may be a string or a symbol. If it is a symbol, that symbol
3825 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3826 OBARRAY defaults to the value of the variable `obarray'. */)
3827 (Lisp_Object name
, Lisp_Object obarray
)
3829 register Lisp_Object string
, tem
;
3832 if (NILP (obarray
)) obarray
= Vobarray
;
3833 obarray
= check_obarray (obarray
);
3836 string
= SYMBOL_NAME (name
);
3839 CHECK_STRING (name
);
3843 tem
= oblookup (obarray
, SSDATA (string
),
3848 /* If arg was a symbol, don't delete anything but that symbol itself. */
3849 if (SYMBOLP (name
) && !EQ (name
, tem
))
3852 /* There are plenty of other symbols which will screw up the Emacs
3853 session if we unintern them, as well as even more ways to use
3854 `setq' or `fset' or whatnot to make the Emacs session
3855 unusable. Let's not go down this silly road. --Stef */
3856 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3857 error ("Attempt to unintern t or nil"); */
3859 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3861 hash
= oblookup_last_bucket_number
;
3863 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3865 if (XSYMBOL (tem
)->next
)
3866 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3868 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3872 Lisp_Object tail
, following
;
3874 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3875 XSYMBOL (tail
)->next
;
3878 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3879 if (EQ (following
, tem
))
3881 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3890 /* Return the symbol in OBARRAY whose names matches the string
3891 of SIZE characters (SIZE_BYTE bytes) at PTR.
3892 If there is no such symbol in OBARRAY, return nil.
3894 Also store the bucket number in oblookup_last_bucket_number. */
3897 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3901 register Lisp_Object tail
;
3902 Lisp_Object bucket
, tem
;
3904 if (!VECTORP (obarray
)
3905 || (obsize
= ASIZE (obarray
)) == 0)
3907 obarray
= check_obarray (obarray
);
3908 obsize
= ASIZE (obarray
);
3910 /* This is sometimes needed in the middle of GC. */
3911 obsize
&= ~ARRAY_MARK_FLAG
;
3912 hash
= hash_string (ptr
, size_byte
) % obsize
;
3913 bucket
= XVECTOR (obarray
)->contents
[hash
];
3914 oblookup_last_bucket_number
= hash
;
3915 if (EQ (bucket
, make_number (0)))
3917 else if (!SYMBOLP (bucket
))
3918 error ("Bad data in guts of obarray"); /* Like CADR error message */
3920 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3922 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3923 && SCHARS (SYMBOL_NAME (tail
)) == size
3924 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3926 else if (XSYMBOL (tail
)->next
== 0)
3929 XSETINT (tem
, hash
);
3934 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3937 register Lisp_Object tail
;
3938 CHECK_VECTOR (obarray
);
3939 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3941 tail
= XVECTOR (obarray
)->contents
[i
];
3946 if (XSYMBOL (tail
)->next
== 0)
3948 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3954 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3956 call1 (function
, sym
);
3959 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3960 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3961 OBARRAY defaults to the value of `obarray'. */)
3962 (Lisp_Object function
, Lisp_Object obarray
)
3964 if (NILP (obarray
)) obarray
= Vobarray
;
3965 obarray
= check_obarray (obarray
);
3967 map_obarray (obarray
, mapatoms_1
, function
);
3971 #define OBARRAY_SIZE 1511
3976 Lisp_Object oblength
;
3977 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3979 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3981 Vobarray
= Fmake_vector (oblength
, make_number (0));
3982 initial_obarray
= Vobarray
;
3983 staticpro (&initial_obarray
);
3985 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3986 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3987 NILP (Vpurify_flag) check in intern_c_string. */
3988 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3989 Qnil
= intern_c_string ("nil");
3991 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3992 so those two need to be fixed manually. */
3993 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3994 XSYMBOL (Qunbound
)->function
= Qunbound
;
3995 XSYMBOL (Qunbound
)->plist
= Qnil
;
3996 /* XSYMBOL (Qnil)->function = Qunbound; */
3997 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3998 XSYMBOL (Qnil
)->constant
= 1;
3999 XSYMBOL (Qnil
)->plist
= Qnil
;
4001 Qt
= intern_c_string ("t");
4002 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4003 XSYMBOL (Qt
)->constant
= 1;
4005 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4008 DEFSYM (Qvariable_documentation
, "variable-documentation");
4010 read_buffer
= (char *) xmalloc (size
);
4011 read_buffer_size
= size
;
4015 defsubr (struct Lisp_Subr
*sname
)
4018 sym
= intern_c_string (sname
->symbol_name
);
4019 XSETTYPED_PVECTYPE (sname
, size
, PVEC_SUBR
);
4020 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4023 #ifdef NOTDEF /* use fset in subr.el now */
4025 defalias (struct Lisp_Subr
*sname
, char *string
)
4028 sym
= intern (string
);
4029 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4033 /* Define an "integer variable"; a symbol whose value is forwarded to a
4034 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4035 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4037 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4038 const char *namestring
, EMACS_INT
*address
)
4041 sym
= intern_c_string (namestring
);
4042 i_fwd
->type
= Lisp_Fwd_Int
;
4043 i_fwd
->intvar
= address
;
4044 XSYMBOL (sym
)->declared_special
= 1;
4045 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4046 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4049 /* Similar but define a variable whose value is t if address contains 1,
4050 nil if address contains 0. */
4052 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4053 const char *namestring
, int *address
)
4056 sym
= intern_c_string (namestring
);
4057 b_fwd
->type
= Lisp_Fwd_Bool
;
4058 b_fwd
->boolvar
= address
;
4059 XSYMBOL (sym
)->declared_special
= 1;
4060 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4061 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4062 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4065 /* Similar but define a variable whose value is the Lisp Object stored
4066 at address. Two versions: with and without gc-marking of the C
4067 variable. The nopro version is used when that variable will be
4068 gc-marked for some other reason, since marking the same slot twice
4069 can cause trouble with strings. */
4071 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4072 const char *namestring
, Lisp_Object
*address
)
4075 sym
= intern_c_string (namestring
);
4076 o_fwd
->type
= Lisp_Fwd_Obj
;
4077 o_fwd
->objvar
= address
;
4078 XSYMBOL (sym
)->declared_special
= 1;
4079 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4080 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4084 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4085 const char *namestring
, Lisp_Object
*address
)
4087 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4088 staticpro (address
);
4091 /* Similar but define a variable whose value is the Lisp Object stored
4092 at a particular offset in the current kboard object. */
4095 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4096 const char *namestring
, int offset
)
4099 sym
= intern_c_string (namestring
);
4100 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4101 ko_fwd
->offset
= offset
;
4102 XSYMBOL (sym
)->declared_special
= 1;
4103 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4104 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4107 /* Record the value of load-path used at the start of dumping
4108 so we can see if the site changed it later during dumping. */
4109 static Lisp_Object dump_path
;
4115 int turn_off_warning
= 0;
4117 /* Compute the default Vload-path, with the following logic:
4118 If CANNOT_DUMP just use PATH_LOADSEARCH.
4119 Else if purify-flag (ie dumping) start from PATH_DUMPLOADSEARCH;
4120 otherwise start from PATH_LOADSEARCH.
4121 If !initialized, then just set both Vload_path and dump_path.
4122 If initialized, then if Vload_path != dump_path, do nothing.
4123 (Presumably the load-path has already been changed by something.)
4124 Also do nothing if Vinstallation_directory is nil.
4126 Remove site-lisp directories from the front of load-path.
4127 Add installation-dir/lisp (if exists and not already a member),
4128 at the front, and turn off warnings about missing directories
4129 (because we are presumably running uninstalled).
4130 If it does not exist, add dump_path at the end instead.
4131 Add installation-dir/leim (if exists and not already a member)
4133 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4134 and not already a member) at the front.
4135 If installation-dir != source-dir (ie running an uninstalled,
4136 out-of-tree build) AND install-dir/src/Makefile exists BUT
4137 install-dir/src/Makefile.in does NOT exist (this is a sanity
4138 check), then repeat the above steps for source-dir/lisp,
4140 Finally, add the previously removed site-lisp directories back
4141 at the front (if !no_site_lisp).
4143 We then warn about any of the load-path elements that do not
4144 exist. The only ones that might not exist are those from
4145 PATH_LOADSEARCH, and perhaps dump_path.
4147 Having done all this, we then throw it all away if purify-flag is
4148 nil (ie, not dumping) and EMACSLOADPATH is set, and just
4149 unconditionally use the latter value instead.
4150 So AFAICS the only net results of all the previous steps will be
4151 possibly to issue some irrelevant warnings.
4153 FIXME? There's a case for saying that if we are running
4154 uninstalled, the eventual installation directories should not yet
4155 be included in load-path.
4158 normal
= PATH_LOADSEARCH
;
4159 Vload_path
= decode_env_path (0, normal
);
4161 if (NILP (Vpurify_flag
))
4162 normal
= PATH_LOADSEARCH
;
4164 normal
= PATH_DUMPLOADSEARCH
;
4166 /* In a dumped Emacs, we normally reset the value of Vload_path using
4167 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4168 the source directory, instead of the path of the installed elisp
4169 libraries. However, if it appears that Vload_path has already been
4170 changed from the default that was saved before dumping, don't
4171 change it further. */
4174 if (! NILP (Fequal (dump_path
, Vload_path
)))
4176 Vload_path
= decode_env_path (0, normal
);
4177 if (no_site_lisp
|| !NILP (Vinstallation_directory
))
4179 Lisp_Object tem
, tem1
, sitelisp
;
4181 /* Remove "site-lisp" dirs from front of path temporarily
4182 and store them in sitelisp, then conc them on at the
4183 end so they're always first in path.
4184 Note that this won't work if you used a
4185 --enable-locallisppath element that does not happen
4186 to contain "site-lisp" in its name.
4191 tem
= Fcar (Vload_path
);
4192 tem1
= Fstring_match (build_string ("site-lisp"),
4196 Vload_path
= Fcdr (Vload_path
);
4197 sitelisp
= Fcons (tem
, sitelisp
);
4203 if (!NILP (Vinstallation_directory
))
4205 /* Add to the path the lisp subdir of the
4206 installation dir, if it exists. */
4207 tem
= Fexpand_file_name (build_string ("lisp"),
4208 Vinstallation_directory
);
4209 tem1
= Ffile_exists_p (tem
);
4212 if (NILP (Fmember (tem
, Vload_path
)))
4214 turn_off_warning
= 1;
4215 Vload_path
= Fcons (tem
, Vload_path
);
4219 /* That dir doesn't exist, so add the build-time
4220 Lisp dirs instead. */
4221 Vload_path
= nconc2 (Vload_path
, dump_path
);
4223 /* Add leim under the installation dir, if it exists. */
4224 tem
= Fexpand_file_name (build_string ("leim"),
4225 Vinstallation_directory
);
4226 tem1
= Ffile_exists_p (tem
);
4229 if (NILP (Fmember (tem
, Vload_path
)))
4230 Vload_path
= Fcons (tem
, Vload_path
);
4233 /* Add site-lisp under the installation dir, if it exists. */
4236 tem
= Fexpand_file_name (build_string ("site-lisp"),
4237 Vinstallation_directory
);
4238 tem1
= Ffile_exists_p (tem
);
4241 if (NILP (Fmember (tem
, Vload_path
)))
4242 Vload_path
= Fcons (tem
, Vload_path
);
4246 /* If Emacs was not built in the source directory,
4247 and it is run from where it was built, add to load-path
4248 the lisp, leim and site-lisp dirs under that directory. */
4250 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4254 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4255 Vinstallation_directory
);
4256 tem1
= Ffile_exists_p (tem
);
4258 /* Don't be fooled if they moved the entire source tree
4259 AFTER dumping Emacs. If the build directory is indeed
4260 different from the source dir, src/Makefile.in and
4261 src/Makefile will not be found together. */
4262 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4263 Vinstallation_directory
);
4264 tem2
= Ffile_exists_p (tem
);
4265 if (!NILP (tem1
) && NILP (tem2
))
4267 tem
= Fexpand_file_name (build_string ("lisp"),
4270 if (NILP (Fmember (tem
, Vload_path
)))
4271 Vload_path
= Fcons (tem
, Vload_path
);
4273 tem
= Fexpand_file_name (build_string ("leim"),
4276 if (NILP (Fmember (tem
, Vload_path
)))
4277 Vload_path
= Fcons (tem
, Vload_path
);
4281 tem
= Fexpand_file_name (build_string ("site-lisp"),
4284 if (NILP (Fmember (tem
, Vload_path
)))
4285 Vload_path
= Fcons (tem
, Vload_path
);
4288 } /* Vinstallation_directory != Vsource_directory */
4289 } /* if Vinstallation_directory */
4290 if (!NILP (sitelisp
) && !no_site_lisp
)
4291 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4292 } /* if Vinstallation_directory || no_site_lisp */
4293 } /* if dump_path == Vload_path */
4295 else /* !initialized */
4297 /* NORMAL refers to the lisp dir in the source directory. */
4298 /* We used to add ../lisp at the front here, but
4299 that caused trouble because it was copied from dump_path
4300 into Vload_path, above, when Vinstallation_directory was non-nil.
4301 It should be unnecessary. */
4302 Vload_path
= decode_env_path (0, normal
);
4303 dump_path
= Vload_path
;
4305 #endif /* CANNOT_DUMP */
4307 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4308 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4309 almost never correct, thereby causing a warning to be printed out that
4310 confuses users. Since PATH_LOADSEARCH is always overridden by the
4311 EMACSLOADPATH environment variable below, disable the warning on NT. */
4313 /* HAVE_NS also uses EMACSLOADPATH. */
4315 /* Warn if dirs in the *standard* path don't exist. */
4316 if (!turn_off_warning
)
4318 Lisp_Object path_tail
;
4320 for (path_tail
= Vload_path
;
4322 path_tail
= XCDR (path_tail
))
4324 Lisp_Object dirfile
;
4325 dirfile
= Fcar (path_tail
);
4326 if (STRINGP (dirfile
))
4328 dirfile
= Fdirectory_file_name (dirfile
);
4329 /* Do we really need to warn about missing site-lisp dirs?
4330 It's true that the installation should have created
4331 them and added subdirs.el, but it's harmless if they
4333 if (access (SSDATA (dirfile
), 0) < 0)
4334 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4339 #endif /* !(WINDOWSNT || HAVE_NS) */
4341 /* If the EMACSLOADPATH environment variable is set, use its value.
4342 This doesn't apply if we're dumping. */
4344 if (NILP (Vpurify_flag
)
4345 && egetenv ("EMACSLOADPATH"))
4347 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4351 load_in_progress
= 0;
4352 Vload_file_name
= Qnil
;
4354 load_descriptor_list
= Qnil
;
4356 Vstandard_input
= Qt
;
4357 Vloads_in_progress
= Qnil
;
4360 /* Print a warning, using format string FORMAT, that directory DIRNAME
4361 does not exist. Print it on stderr and put it in *Messages*. */
4364 dir_warning (const char *format
, Lisp_Object dirname
)
4366 fprintf (stderr
, format
, SDATA (dirname
));
4368 /* Don't log the warning before we've initialized!! */
4372 ptrdiff_t message_len
;
4374 SAFE_ALLOCA (buffer
, char *,
4375 SBYTES (dirname
) + strlen (format
) - (sizeof "%s" - 1) + 1);
4376 message_len
= esprintf (buffer
, format
, SDATA (dirname
));
4377 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4383 syms_of_lread (void)
4386 defsubr (&Sread_from_string
);
4388 defsubr (&Sintern_soft
);
4389 defsubr (&Sunintern
);
4390 defsubr (&Sget_load_suffixes
);
4392 defsubr (&Seval_buffer
);
4393 defsubr (&Seval_region
);
4394 defsubr (&Sread_char
);
4395 defsubr (&Sread_char_exclusive
);
4396 defsubr (&Sread_event
);
4397 defsubr (&Sget_file_char
);
4398 defsubr (&Smapatoms
);
4399 defsubr (&Slocate_file_internal
);
4401 DEFVAR_LISP ("obarray", Vobarray
,
4402 doc
: /* Symbol table for use by `intern' and `read'.
4403 It is a vector whose length ought to be prime for best results.
4404 The vector's contents don't make sense if examined from Lisp programs;
4405 to find all the symbols in an obarray, use `mapatoms'. */);
4407 DEFVAR_LISP ("values", Vvalues
,
4408 doc
: /* List of values of all expressions which were read, evaluated and printed.
4409 Order is reverse chronological. */);
4411 DEFVAR_LISP ("standard-input", Vstandard_input
,
4412 doc
: /* Stream for read to get input from.
4413 See documentation of `read' for possible values. */);
4414 Vstandard_input
= Qt
;
4416 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4417 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4419 If this variable is a buffer, then only forms read from that buffer
4420 will be added to `read-symbol-positions-list'.
4421 If this variable is t, then all read forms will be added.
4422 The effect of all other values other than nil are not currently
4423 defined, although they may be in the future.
4425 The positions are relative to the last call to `read' or
4426 `read-from-string'. It is probably a bad idea to set this variable at
4427 the toplevel; bind it instead. */);
4428 Vread_with_symbol_positions
= Qnil
;
4430 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4431 doc
: /* A list mapping read symbols to their positions.
4432 This variable is modified during calls to `read' or
4433 `read-from-string', but only when `read-with-symbol-positions' is
4436 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4437 CHAR-POSITION is an integer giving the offset of that occurrence of the
4438 symbol from the position where `read' or `read-from-string' started.
4440 Note that a symbol will appear multiple times in this list, if it was
4441 read multiple times. The list is in the same order as the symbols
4443 Vread_symbol_positions_list
= Qnil
;
4445 DEFVAR_LISP ("read-circle", Vread_circle
,
4446 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4449 DEFVAR_LISP ("load-path", Vload_path
,
4450 doc
: /* List of directories to search for files to load.
4451 Each element is a string (directory name) or nil (try default directory).
4452 Initialized based on EMACSLOADPATH environment variable, if any,
4453 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4455 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4456 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4457 This list should not include the empty string.
4458 `load' and related functions try to append these suffixes, in order,
4459 to the specified file name if a Lisp suffix is allowed or required. */);
4460 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4461 Fcons (make_pure_c_string (".el"), Qnil
));
4462 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4463 doc
: /* List of suffixes that indicate representations of \
4465 This list should normally start with the empty string.
4467 Enabling Auto Compression mode appends the suffixes in
4468 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4469 mode removes them again. `load' and related functions use this list to
4470 determine whether they should look for compressed versions of a file
4471 and, if so, which suffixes they should try to append to the file name
4472 in order to do so. However, if you want to customize which suffixes
4473 the loading functions recognize as compression suffixes, you should
4474 customize `jka-compr-load-suffixes' rather than the present variable. */);
4475 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4477 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4478 doc
: /* Non-nil if inside of `load'. */);
4479 DEFSYM (Qload_in_progress
, "load-in-progress");
4481 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4482 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4483 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4485 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4486 a symbol \(a feature name).
4488 When `load' is run and the file-name argument matches an element's
4489 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4490 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4492 An error in FORMS does not undo the load, but does prevent execution of
4493 the rest of the FORMS. */);
4494 Vafter_load_alist
= Qnil
;
4496 DEFVAR_LISP ("load-history", Vload_history
,
4497 doc
: /* Alist mapping loaded file names to symbols and features.
4498 Each alist element should be a list (FILE-NAME ENTRIES...), where
4499 FILE-NAME is the name of a file that has been loaded into Emacs.
4500 The file name is absolute and true (i.e. it doesn't contain symlinks).
4501 As an exception, one of the alist elements may have FILE-NAME nil,
4502 for symbols and features not associated with any file.
4504 The remaining ENTRIES in the alist element describe the functions and
4505 variables defined in that file, the features provided, and the
4506 features required. Each entry has the form `(provide . FEATURE)',
4507 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4508 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4509 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4510 autoload before this file redefined it as a function. In addition,
4511 entries may also be single symbols, which means that SYMBOL was
4512 defined by `defvar' or `defconst'.
4514 During preloading, the file name recorded is relative to the main Lisp
4515 directory. These file names are converted to absolute at startup. */);
4516 Vload_history
= Qnil
;
4518 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4519 doc
: /* Full name of file being loaded by `load'. */);
4520 Vload_file_name
= Qnil
;
4522 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4523 doc
: /* File name, including directory, of user's initialization file.
4524 If the file loaded had extension `.elc', and the corresponding source file
4525 exists, this variable contains the name of source file, suitable for use
4526 by functions like `custom-save-all' which edit the init file.
4527 While Emacs loads and evaluates the init file, value is the real name
4528 of the file, regardless of whether or not it has the `.elc' extension. */);
4529 Vuser_init_file
= Qnil
;
4531 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4532 doc
: /* Used for internal purposes by `load'. */);
4533 Vcurrent_load_list
= Qnil
;
4535 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4536 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4537 The default is nil, which means use the function `read'. */);
4538 Vload_read_function
= Qnil
;
4540 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4541 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4542 This function is for doing code conversion before reading the source file.
4543 If nil, loading is done without any code conversion.
4544 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4545 FULLNAME is the full name of FILE.
4546 See `load' for the meaning of the remaining arguments. */);
4547 Vload_source_file_function
= Qnil
;
4549 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4550 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4551 This is useful when the file being loaded is a temporary copy. */);
4552 load_force_doc_strings
= 0;
4554 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4555 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4556 This is normally bound by `load' and `eval-buffer' to control `read',
4557 and is not meant for users to change. */);
4558 load_convert_to_unibyte
= 0;
4560 DEFVAR_LISP ("source-directory", Vsource_directory
,
4561 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4562 You cannot count on them to still be there! */);
4564 = Fexpand_file_name (build_string ("../"),
4565 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4567 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4568 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4569 Vpreloaded_file_list
= Qnil
;
4571 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4572 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4573 Vbyte_boolean_vars
= Qnil
;
4575 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4576 doc
: /* Non-nil means load dangerous compiled Lisp files.
4577 Some versions of XEmacs use different byte codes than Emacs. These
4578 incompatible byte codes can make Emacs crash when it tries to execute
4580 load_dangerous_libraries
= 0;
4582 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4583 doc
: /* Non-nil means force printing messages when loading Lisp files.
4584 This overrides the value of the NOMESSAGE argument to `load'. */);
4585 force_load_messages
= 0;
4587 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4588 doc
: /* Regular expression matching safe to load compiled Lisp files.
4589 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4590 from the file, and matches them against this regular expression.
4591 When the regular expression matches, the file is considered to be safe
4592 to load. See also `load-dangerous-libraries'. */);
4593 Vbytecomp_version_regexp
4594 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4596 Qlexical_binding
= intern ("lexical-binding");
4597 staticpro (&Qlexical_binding
);
4598 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4599 doc
: /* Whether to use lexical binding when evaluating code.
4600 Non-nil means that the code in the current buffer should be evaluated
4601 with lexical binding.
4602 This variable is automatically set from the file variables of an
4603 interpreted Lisp file read using `load'. Unlike other file local
4604 variables, this must be set in the first line of a file. */);
4605 Fmake_variable_buffer_local (Qlexical_binding
);
4607 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4608 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4609 Veval_buffer_list
= Qnil
;
4611 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4612 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4613 Vold_style_backquotes
= Qnil
;
4614 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4616 /* Vsource_directory was initialized in init_lread. */
4618 load_descriptor_list
= Qnil
;
4619 staticpro (&load_descriptor_list
);
4621 DEFSYM (Qcurrent_load_list
, "current-load-list");
4622 DEFSYM (Qstandard_input
, "standard-input");
4623 DEFSYM (Qread_char
, "read-char");
4624 DEFSYM (Qget_file_char
, "get-file-char");
4625 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4626 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4628 DEFSYM (Qbackquote
, "`");
4629 DEFSYM (Qcomma
, ",");
4630 DEFSYM (Qcomma_at
, ",@");
4631 DEFSYM (Qcomma_dot
, ",.");
4633 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4634 DEFSYM (Qascii_character
, "ascii-character");
4635 DEFSYM (Qfunction
, "function");
4636 DEFSYM (Qload
, "load");
4637 DEFSYM (Qload_file_name
, "load-file-name");
4638 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4639 DEFSYM (Qfile_truename
, "file-truename");
4640 DEFSYM (Qdir_ok
, "dir-ok");
4641 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4643 staticpro (&dump_path
);
4645 staticpro (&read_objects
);
4646 read_objects
= Qnil
;
4647 staticpro (&seen_list
);
4650 Vloads_in_progress
= Qnil
;
4651 staticpro (&Vloads_in_progress
);
4653 DEFSYM (Qhash_table
, "hash-table");
4654 DEFSYM (Qdata
, "data");
4655 DEFSYM (Qtest
, "test");
4656 DEFSYM (Qsize
, "size");
4657 DEFSYM (Qweakness
, "weakness");
4658 DEFSYM (Qrehash_size
, "rehash-size");
4659 DEFSYM (Qrehash_threshold
, "rehash-threshold");