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. */
29 #include <stat-time.h>
31 #include "intervals.h"
32 #include "character.h"
40 #include "termhooks.h"
42 #include "blockinput.h"
53 #endif /* HAVE_SETLOCALE */
58 #define file_offset off_t
59 #define file_tell ftello
61 #define file_offset long
62 #define file_tell ftell
65 /* Hash table read constants. */
66 static Lisp_Object Qhash_table
, Qdata
;
67 static Lisp_Object Qtest
, Qsize
;
68 static Lisp_Object Qweakness
;
69 static Lisp_Object Qrehash_size
;
70 static Lisp_Object Qrehash_threshold
;
72 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
73 Lisp_Object Qstandard_input
;
74 Lisp_Object Qvariable_documentation
;
75 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
76 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
77 static Lisp_Object Qinhibit_file_name_operation
;
78 static Lisp_Object Qeval_buffer_list
;
79 static Lisp_Object Qlexical_binding
;
80 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
82 /* Used instead of Qget_file_char while loading *.elc files compiled
83 by Emacs 21 or older. */
84 static Lisp_Object Qget_emacs_mule_file_char
;
86 static Lisp_Object Qload_force_doc_strings
;
88 extern Lisp_Object Qinternal_interpreter_environment
;
90 static Lisp_Object Qload_in_progress
;
92 /* The association list of objects read with the #n=object form.
93 Each member of the list has the form (n . object), and is used to
94 look up the object for the corresponding #n# construct.
95 It must be set to nil before all top-level calls to read0. */
96 static Lisp_Object read_objects
;
98 /* Nonzero means READCHAR should read bytes one by one (not character)
99 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
100 This is set to 1 by read1 temporarily while handling #@NUMBER. */
101 static int load_each_byte
;
103 /* List of descriptors now open for Fload. */
104 static Lisp_Object load_descriptor_list
;
106 /* File for get_file_char to read from. Use by load. */
107 static FILE *instream
;
109 /* For use within read-from-string (this reader is non-reentrant!!) */
110 static ptrdiff_t read_from_string_index
;
111 static ptrdiff_t read_from_string_index_byte
;
112 static ptrdiff_t read_from_string_limit
;
114 /* Number of characters read in the current call to Fread or
115 Fread_from_string. */
116 static EMACS_INT readchar_count
;
118 /* This contains the last string skipped with #@. */
119 static char *saved_doc_string
;
120 /* Length of buffer allocated in saved_doc_string. */
121 static ptrdiff_t saved_doc_string_size
;
122 /* Length of actual data in saved_doc_string. */
123 static ptrdiff_t saved_doc_string_length
;
124 /* This is the file position that string came from. */
125 static file_offset saved_doc_string_position
;
127 /* This contains the previous string skipped with #@.
128 We copy it from saved_doc_string when a new string
129 is put in saved_doc_string. */
130 static char *prev_saved_doc_string
;
131 /* Length of buffer allocated in prev_saved_doc_string. */
132 static ptrdiff_t prev_saved_doc_string_size
;
133 /* Length of actual data in prev_saved_doc_string. */
134 static ptrdiff_t prev_saved_doc_string_length
;
135 /* This is the file position that string came from. */
136 static file_offset prev_saved_doc_string_position
;
138 /* Nonzero means inside a new-style backquote
139 with no surrounding parentheses.
140 Fread initializes this to zero, so we need not specbind it
141 or worry about what happens to it when there is an error. */
142 static int new_backquote_flag
;
143 static Lisp_Object Qold_style_backquotes
;
145 /* A list of file names for files being loaded in Fload. Used to
146 check for recursive loads. */
148 static Lisp_Object Vloads_in_progress
;
150 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
153 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
, int,
154 Lisp_Object
, Lisp_Object
,
155 Lisp_Object
, Lisp_Object
);
156 static Lisp_Object
load_unwind (Lisp_Object
);
157 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
159 /* Functions that read one byte from the current source READCHARFUN
160 or unreads one byte. If the integer argument C is -1, it returns
161 one read byte, or -1 when there's no more byte in the source. If C
162 is 0 or positive, it unreads C, and the return value is not
165 static int readbyte_for_lambda (int, Lisp_Object
);
166 static int readbyte_from_file (int, Lisp_Object
);
167 static int readbyte_from_string (int, Lisp_Object
);
169 /* Handle unreading and rereading of characters.
170 Write READCHAR to read a character,
171 UNREAD(c) to unread c to be read again.
173 These macros correctly read/unread multibyte characters. */
175 #define READCHAR readchar (readcharfun, NULL)
176 #define UNREAD(c) unreadchar (readcharfun, c)
178 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
179 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
181 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
182 Qlambda, or a cons, we use this to keep an unread character because
183 a file stream can't handle multibyte-char unreading. The value -1
184 means that there's no unread character. */
185 static int unread_char
;
188 readchar (Lisp_Object readcharfun
, int *multibyte
)
192 int (*readbyte
) (int, Lisp_Object
);
193 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
195 int emacs_mule_encoding
= 0;
202 if (BUFFERP (readcharfun
))
204 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
206 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
208 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
211 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
213 /* Fetch the character code from the buffer. */
214 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
215 BUF_INC_POS (inbuffer
, pt_byte
);
222 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
223 if (! ASCII_BYTE_P (c
))
224 c
= BYTE8_TO_CHAR (c
);
227 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
231 if (MARKERP (readcharfun
))
233 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
235 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
237 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
240 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
242 /* Fetch the character code from the buffer. */
243 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
244 BUF_INC_POS (inbuffer
, bytepos
);
251 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
252 if (! ASCII_BYTE_P (c
))
253 c
= BYTE8_TO_CHAR (c
);
257 XMARKER (readcharfun
)->bytepos
= bytepos
;
258 XMARKER (readcharfun
)->charpos
++;
263 if (EQ (readcharfun
, Qlambda
))
265 readbyte
= readbyte_for_lambda
;
269 if (EQ (readcharfun
, Qget_file_char
))
271 readbyte
= readbyte_from_file
;
275 if (STRINGP (readcharfun
))
277 if (read_from_string_index
>= read_from_string_limit
)
279 else if (STRING_MULTIBYTE (readcharfun
))
283 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
284 read_from_string_index
,
285 read_from_string_index_byte
);
289 c
= SREF (readcharfun
, read_from_string_index_byte
);
290 read_from_string_index
++;
291 read_from_string_index_byte
++;
296 if (CONSP (readcharfun
))
298 /* This is the case that read_vector is reading from a unibyte
299 string that contains a byte sequence previously skipped
300 because of #@NUMBER. The car part of readcharfun is that
301 string, and the cdr part is a value of readcharfun given to
303 readbyte
= readbyte_from_string
;
304 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
305 emacs_mule_encoding
= 1;
309 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
311 readbyte
= readbyte_from_file
;
312 emacs_mule_encoding
= 1;
316 tem
= call0 (readcharfun
);
323 if (unread_char
>= 0)
329 c
= (*readbyte
) (-1, readcharfun
);
330 if (c
< 0 || load_each_byte
)
334 if (ASCII_BYTE_P (c
))
336 if (emacs_mule_encoding
)
337 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
340 len
= BYTES_BY_CHAR_HEAD (c
);
343 c
= (*readbyte
) (-1, readcharfun
);
344 if (c
< 0 || ! TRAILING_CODE_P (c
))
347 (*readbyte
) (buf
[i
], readcharfun
);
348 return BYTE8_TO_CHAR (buf
[0]);
352 return STRING_CHAR (buf
);
355 /* Unread the character C in the way appropriate for the stream READCHARFUN.
356 If the stream is a user function, call it with the char as argument. */
359 unreadchar (Lisp_Object readcharfun
, int c
)
363 /* Don't back up the pointer if we're unreading the end-of-input mark,
364 since readchar didn't advance it when we read it. */
366 else if (BUFFERP (readcharfun
))
368 struct buffer
*b
= XBUFFER (readcharfun
);
369 ptrdiff_t charpos
= BUF_PT (b
);
370 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
372 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
373 BUF_DEC_POS (b
, bytepos
);
377 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
379 else if (MARKERP (readcharfun
))
381 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
382 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
384 XMARKER (readcharfun
)->charpos
--;
385 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
386 BUF_DEC_POS (b
, bytepos
);
390 XMARKER (readcharfun
)->bytepos
= bytepos
;
392 else if (STRINGP (readcharfun
))
394 read_from_string_index
--;
395 read_from_string_index_byte
396 = string_char_to_byte (readcharfun
, read_from_string_index
);
398 else if (CONSP (readcharfun
))
402 else if (EQ (readcharfun
, Qlambda
))
406 else if (EQ (readcharfun
, Qget_file_char
)
407 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
412 ungetc (c
, instream
);
419 call1 (readcharfun
, make_number (c
));
423 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
425 return read_bytecode_char (c
>= 0);
430 readbyte_from_file (int c
, Lisp_Object readcharfun
)
435 ungetc (c
, instream
);
444 /* Interrupted reads have been observed while reading over the network. */
445 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
457 return (c
== EOF
? -1 : c
);
461 readbyte_from_string (int c
, Lisp_Object readcharfun
)
463 Lisp_Object string
= XCAR (readcharfun
);
467 read_from_string_index
--;
468 read_from_string_index_byte
469 = string_char_to_byte (string
, read_from_string_index
);
472 if (read_from_string_index
>= read_from_string_limit
)
475 FETCH_STRING_CHAR_ADVANCE (c
, string
,
476 read_from_string_index
,
477 read_from_string_index_byte
);
482 /* Read one non-ASCII character from INSTREAM. The character is
483 encoded in `emacs-mule' and the first byte is already read in
487 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
489 /* Emacs-mule coding uses at most 4-byte for one character. */
490 unsigned char buf
[4];
491 int len
= emacs_mule_bytes
[c
];
492 struct charset
*charset
;
497 /* C is not a valid leading-code of `emacs-mule'. */
498 return BYTE8_TO_CHAR (c
);
504 c
= (*readbyte
) (-1, readcharfun
);
508 (*readbyte
) (buf
[i
], readcharfun
);
509 return BYTE8_TO_CHAR (buf
[0]);
516 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
517 code
= buf
[1] & 0x7F;
521 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
522 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
524 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
525 code
= buf
[2] & 0x7F;
529 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
530 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
535 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
536 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
538 c
= DECODE_CHAR (charset
, code
);
540 Fsignal (Qinvalid_read_syntax
,
541 Fcons (build_string ("invalid multibyte form"), Qnil
));
546 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
548 static Lisp_Object
read0 (Lisp_Object
);
549 static Lisp_Object
read1 (Lisp_Object
, int *, int);
551 static Lisp_Object
read_list (int, Lisp_Object
);
552 static Lisp_Object
read_vector (Lisp_Object
, int);
554 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
556 static void substitute_object_in_subtree (Lisp_Object
,
558 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
561 /* Get a character from the tty. */
563 /* Read input events until we get one that's acceptable for our purposes.
565 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
566 until we get a character we like, and then stuffed into
569 If ASCII_REQUIRED is non-zero, we check function key events to see
570 if the unmodified version of the symbol has a Qascii_character
571 property, and use that character, if present.
573 If ERROR_NONASCII is non-zero, we signal an error if the input we
574 get isn't an ASCII character with modifiers. If it's zero but
575 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
578 If INPUT_METHOD is nonzero, we invoke the current input method
579 if the character warrants that.
581 If SECONDS is a number, we wait that many seconds for input, and
582 return Qnil if no input arrives within that time. */
585 read_filtered_event (int no_switch_frame
, int ascii_required
,
586 int error_nonascii
, int input_method
, Lisp_Object seconds
)
588 Lisp_Object val
, delayed_switch_frame
;
591 #ifdef HAVE_WINDOW_SYSTEM
592 if (display_hourglass_p
)
596 delayed_switch_frame
= Qnil
;
598 /* Compute timeout. */
599 if (NUMBERP (seconds
))
601 double duration
= extract_float (seconds
);
602 EMACS_TIME wait_time
= EMACS_TIME_FROM_DOUBLE (duration
);
603 EMACS_GET_TIME (end_time
);
604 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
607 /* Read until we get an acceptable event. */
610 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
611 NUMBERP (seconds
) ? &end_time
: NULL
);
612 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
617 /* switch-frame events are put off until after the next ASCII
618 character. This is better than signaling an error just because
619 the last characters were typed to a separate minibuffer frame,
620 for example. Eventually, some code which can deal with
621 switch-frame events will read it and process it. */
623 && EVENT_HAS_PARAMETERS (val
)
624 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
626 delayed_switch_frame
= val
;
630 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
632 /* Convert certain symbols to their ASCII equivalents. */
635 Lisp_Object tem
, tem1
;
636 tem
= Fget (val
, Qevent_symbol_element_mask
);
639 tem1
= Fget (Fcar (tem
), Qascii_character
);
640 /* Merge this symbol's modifier bits
641 with the ASCII equivalent of its basic code. */
643 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
647 /* If we don't have a character now, deal with it appropriately. */
652 Vunread_command_events
= Fcons (val
, Qnil
);
653 error ("Non-character input-event");
660 if (! NILP (delayed_switch_frame
))
661 unread_switch_frame
= delayed_switch_frame
;
665 #ifdef HAVE_WINDOW_SYSTEM
666 if (display_hourglass_p
)
675 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
676 doc
: /* Read a character from the command input (keyboard or macro).
677 It is returned as a number.
678 If the character has modifiers, they are resolved and reflected to the
679 character code if possible (e.g. C-SPC -> 0).
681 If the user generates an event which is not a character (i.e. a mouse
682 click or function key event), `read-char' signals an error. As an
683 exception, switch-frame events are put off until non-character events
685 If you want to read non-character events, or ignore them, call
686 `read-event' or `read-char-exclusive' instead.
688 If the optional argument PROMPT is non-nil, display that as a prompt.
689 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
690 input method is turned on in the current buffer, that input method
691 is used for reading a character.
692 If the optional argument SECONDS is non-nil, it should be a number
693 specifying the maximum number of seconds to wait for input. If no
694 input arrives in that time, return nil. SECONDS may be a
695 floating-point value. */)
696 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
701 message_with_string ("%s", prompt
, 0);
702 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
704 return (NILP (val
) ? Qnil
705 : make_number (char_resolve_modifier_mask (XINT (val
))));
708 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
709 doc
: /* Read an event object from the input stream.
710 If the optional argument PROMPT is non-nil, display that as a prompt.
711 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
712 input method is turned on in the current buffer, that input method
713 is used for reading a character.
714 If the optional argument SECONDS is non-nil, it should be a number
715 specifying the maximum number of seconds to wait for input. If no
716 input arrives in that time, return nil. SECONDS may be a
717 floating-point value. */)
718 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
721 message_with_string ("%s", prompt
, 0);
722 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
725 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
726 doc
: /* Read a character from the command input (keyboard or macro).
727 It is returned as a number. Non-character events are ignored.
728 If the character has modifiers, they are resolved and reflected to the
729 character code if possible (e.g. C-SPC -> 0).
731 If the optional argument PROMPT is non-nil, display that as a prompt.
732 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
733 input method is turned on in the current buffer, that input method
734 is used for reading a character.
735 If the optional argument SECONDS is non-nil, it should be a number
736 specifying the maximum number of seconds to wait for input. If no
737 input arrives in that time, return nil. SECONDS may be a
738 floating-point value. */)
739 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
744 message_with_string ("%s", prompt
, 0);
746 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
748 return (NILP (val
) ? Qnil
749 : make_number (char_resolve_modifier_mask (XINT (val
))));
752 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
753 doc
: /* Don't use this yourself. */)
756 register Lisp_Object val
;
758 XSETINT (val
, getc (instream
));
766 /* Return true if the lisp code read using READCHARFUN defines a non-nil
767 `lexical-binding' file variable. After returning, the stream is
768 positioned following the first line, if it is a comment, otherwise
772 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
776 /* The first line isn't a comment, just give up. */
782 /* Look for an appropriate file-variable in the first line. */
786 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
787 } beg_end_state
= NOMINAL
;
788 int in_file_vars
= 0;
790 #define UPDATE_BEG_END_STATE(ch) \
791 if (beg_end_state == NOMINAL) \
792 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
793 else if (beg_end_state == AFTER_FIRST_DASH) \
794 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
795 else if (beg_end_state == AFTER_ASTERIX) \
798 in_file_vars = !in_file_vars; \
799 beg_end_state = NOMINAL; \
802 /* Skip until we get to the file vars, if any. */
806 UPDATE_BEG_END_STATE (ch
);
808 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
812 char var
[100], val
[100];
817 /* Read a variable name. */
818 while (ch
== ' ' || ch
== '\t')
822 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
824 if (i
< sizeof var
- 1)
826 UPDATE_BEG_END_STATE (ch
);
830 /* Stop scanning if no colon was found before end marker. */
831 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
834 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
840 /* Read a variable value. */
843 while (ch
== ' ' || ch
== '\t')
847 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
849 if (i
< sizeof val
- 1)
851 UPDATE_BEG_END_STATE (ch
);
855 /* The value was terminated by an end-marker, which remove. */
857 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
861 if (strcmp (var
, "lexical-binding") == 0)
864 rv
= (strcmp (val
, "nil") != 0);
870 while (ch
!= '\n' && ch
!= EOF
)
877 /* Value is a version number of byte compiled code if the file
878 associated with file descriptor FD is a compiled Lisp file that's
879 safe to load. Only files compiled with Emacs are safe to load.
880 Files compiled with XEmacs can lead to a crash in Fbyte_code
881 because of an incompatible change in the byte compiler. */
884 safe_to_load_p (int fd
)
891 /* Read the first few bytes from the file, and look for a line
892 specifying the byte compiler version used. */
893 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
898 /* Skip to the next newline, skipping over the initial `ELC'
899 with NUL bytes following it, but note the version. */
900 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
905 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
912 lseek (fd
, 0, SEEK_SET
);
917 /* Callback for record_unwind_protect. Restore the old load list OLD,
918 after loading a file successfully. */
921 record_load_unwind (Lisp_Object old
)
923 return Vloads_in_progress
= old
;
926 /* This handler function is used via internal_condition_case_1. */
929 load_error_handler (Lisp_Object data
)
935 load_warn_old_style_backquotes (Lisp_Object file
)
937 if (!NILP (Vold_style_backquotes
))
940 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
947 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
948 doc
: /* Return the suffixes that `load' should try if a suffix is \
950 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
953 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
954 while (CONSP (suffixes
))
956 Lisp_Object exts
= Vload_file_rep_suffixes
;
957 suffix
= XCAR (suffixes
);
958 suffixes
= XCDR (suffixes
);
963 lst
= Fcons (concat2 (suffix
, ext
), lst
);
966 return Fnreverse (lst
);
969 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
970 doc
: /* Execute a file of Lisp code named FILE.
971 First try FILE with `.elc' appended, then try with `.el',
972 then try FILE unmodified (the exact suffixes in the exact order are
973 determined by `load-suffixes'). Environment variable references in
974 FILE are replaced with their values by calling `substitute-in-file-name'.
975 This function searches the directories in `load-path'.
977 If optional second arg NOERROR is non-nil,
978 report no error if FILE doesn't exist.
979 Print messages at start and end of loading unless
980 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
982 If optional fourth arg NOSUFFIX is non-nil, don't try adding
983 suffixes `.elc' or `.el' to the specified name FILE.
984 If optional fifth arg MUST-SUFFIX is non-nil, insist on
985 the suffix `.elc' or `.el'; don't accept just FILE unless
986 it ends in one of those suffixes or includes a directory name.
988 If this function fails to find a file, it may look for different
989 representations of that file before trying another file.
990 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
991 to the file name. Emacs uses this feature mainly to find compressed
992 versions of files when Auto Compression mode is enabled.
994 The exact suffixes that this function tries out, in the exact order,
995 are given by the value of the variable `load-file-rep-suffixes' if
996 NOSUFFIX is non-nil and by the return value of the function
997 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
998 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1001 Loading a file records its definitions, and its `provide' and
1002 `require' calls, in an element of `load-history' whose
1003 car is the file name loaded. See `load-history'.
1005 While the file is in the process of being loaded, the variable
1006 `load-in-progress' is non-nil and the variable `load-file-name'
1007 is bound to the file's name.
1009 Return t if the file exists and loads successfully. */)
1010 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1012 register FILE *stream
;
1013 register int fd
= -1;
1014 ptrdiff_t count
= SPECPDL_INDEX ();
1015 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1016 Lisp_Object found
, efound
, hist_file_name
;
1017 /* 1 means we printed the ".el is newer" message. */
1019 /* 1 means we are loading a compiled file. */
1021 Lisp_Object handler
;
1023 const char *fmode
= "r";
1031 CHECK_STRING (file
);
1033 /* If file name is magic, call the handler. */
1034 /* This shouldn't be necessary any more now that `openp' handles it right.
1035 handler = Ffind_file_name_handler (file, Qload);
1036 if (!NILP (handler))
1037 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1039 /* Do this after the handler to avoid
1040 the need to gcpro noerror, nomessage and nosuffix.
1041 (Below here, we care only whether they are nil or not.)
1042 The presence of this call is the result of a historical accident:
1043 it used to be in every file-operation and when it got removed
1044 everywhere, it accidentally stayed here. Since then, enough people
1045 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1046 that it seemed risky to remove. */
1047 if (! NILP (noerror
))
1049 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1050 Qt
, load_error_handler
);
1055 file
= Fsubstitute_in_file_name (file
);
1058 /* Avoid weird lossage with null string as arg,
1059 since it would try to load a directory as a Lisp file. */
1060 if (SBYTES (file
) > 0)
1062 ptrdiff_t size
= SBYTES (file
);
1065 GCPRO2 (file
, found
);
1067 if (! NILP (must_suffix
))
1069 /* Don't insist on adding a suffix if FILE already ends with one. */
1071 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1074 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1076 /* Don't insist on adding a suffix
1077 if the argument includes a directory name. */
1078 else if (! NILP (Ffile_name_directory (file
)))
1082 fd
= openp (Vload_path
, file
,
1083 (!NILP (nosuffix
) ? Qnil
1084 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1085 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1086 tmp
[1] = Vload_file_rep_suffixes
,
1095 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1099 /* Tell startup.el whether or not we found the user's init file. */
1100 if (EQ (Qt
, Vuser_init_file
))
1101 Vuser_init_file
= found
;
1103 /* If FD is -2, that means openp found a magic file. */
1106 if (NILP (Fequal (found
, file
)))
1107 /* If FOUND is a different file name from FILE,
1108 find its handler even if we have already inhibited
1109 the `load' operation on FILE. */
1110 handler
= Ffind_file_name_handler (found
, Qt
);
1112 handler
= Ffind_file_name_handler (found
, Qload
);
1113 if (! NILP (handler
))
1114 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1116 /* Tramp has to deal with semi-broken packages that prepend
1117 drive letters to remote files. For that reason, Tramp
1118 catches file operations that test for file existence, which
1119 makes openp think X:/foo.elc files are remote. However,
1120 Tramp does not catch `load' operations for such files, so we
1121 end up with a nil as the `load' handler above. If we would
1122 continue with fd = -2, we will behave wrongly, and in
1123 particular try reading a .elc file in the "rt" mode instead
1124 of "rb". See bug #9311 for the results. To work around
1125 this, we try to open the file locally, and go with that if it
1127 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1133 /* Check if we're stuck in a recursive load cycle.
1135 2000-09-21: It's not possible to just check for the file loaded
1136 being a member of Vloads_in_progress. This fails because of the
1137 way the byte compiler currently works; `provide's are not
1138 evaluated, see font-lock.el/jit-lock.el as an example. This
1139 leads to a certain amount of ``normal'' recursion.
1141 Also, just loading a file recursively is not always an error in
1142 the general case; the second load may do something different. */
1146 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1147 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1151 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1153 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1154 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1157 /* All loads are by default dynamic, unless the file itself specifies
1158 otherwise using a file-variable in the first line. This is bound here
1159 so that it takes effect whether or not we use
1160 Vload_source_file_function. */
1161 specbind (Qlexical_binding
, Qnil
);
1163 /* Get the name for load-history. */
1164 hist_file_name
= (! NILP (Vpurify_flag
)
1165 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1166 tmp
[1] = Ffile_name_nondirectory (found
),
1172 /* Check for the presence of old-style quotes and warn about them. */
1173 specbind (Qold_style_backquotes
, Qnil
);
1174 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1176 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1177 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1178 /* Load .elc files directly, but not when they are
1179 remote and have no handler! */
1186 GCPRO3 (file
, found
, hist_file_name
);
1189 && ! (version
= safe_to_load_p (fd
)))
1192 if (!load_dangerous_libraries
)
1196 error ("File `%s' was not compiled in Emacs",
1199 else if (!NILP (nomessage
) && !force_load_messages
)
1200 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1205 efound
= ENCODE_FILE (found
);
1210 result
= stat (SSDATA (efound
), &s1
);
1213 SSET (efound
, SBYTES (efound
) - 1, 0);
1214 result
= stat (SSDATA (efound
), &s2
);
1215 SSET (efound
, SBYTES (efound
) - 1, 'c');
1219 && EMACS_TIME_LT (get_stat_mtime (&s1
), get_stat_mtime (&s2
)))
1221 /* Make the progress messages mention that source is newer. */
1224 /* If we won't print another message, mention this anyway. */
1225 if (!NILP (nomessage
) && !force_load_messages
)
1227 Lisp_Object msg_file
;
1228 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1229 message_with_string ("Source file `%s' newer than byte-compiled file",
1238 /* We are loading a source file (*.el). */
1239 if (!NILP (Vload_source_file_function
))
1245 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1246 NILP (noerror
) ? Qnil
: Qt
,
1247 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1248 return unbind_to (count
, val
);
1252 GCPRO3 (file
, found
, hist_file_name
);
1255 efound
= ENCODE_FILE (found
);
1256 /* If we somehow got here with fd == -2, meaning the file is deemed
1257 to be remote, don't even try to reopen the file locally; just
1258 force a failure instead. */
1262 stream
= fopen (SSDATA (efound
), fmode
);
1266 #else /* not WINDOWSNT */
1267 stream
= fdopen (fd
, fmode
);
1268 #endif /* not WINDOWSNT */
1272 error ("Failure to create stdio stream for %s", SDATA (file
));
1275 if (! NILP (Vpurify_flag
))
1276 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1278 if (NILP (nomessage
) || force_load_messages
)
1281 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1284 message_with_string ("Loading %s (source)...", file
, 1);
1286 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1288 else /* The typical case; compiled file newer than source file. */
1289 message_with_string ("Loading %s...", file
, 1);
1292 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1293 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1294 specbind (Qload_file_name
, found
);
1295 specbind (Qinhibit_file_name_operation
, Qnil
);
1296 load_descriptor_list
1297 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1298 specbind (Qload_in_progress
, Qt
);
1301 if (lisp_file_lexically_bound_p (Qget_file_char
))
1302 Fset (Qlexical_binding
, Qt
);
1304 if (! version
|| version
>= 22)
1305 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1306 0, Qnil
, Qnil
, Qnil
, Qnil
);
1309 /* We can't handle a file which was compiled with
1310 byte-compile-dynamic by older version of Emacs. */
1311 specbind (Qload_force_doc_strings
, Qt
);
1312 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1313 0, Qnil
, Qnil
, Qnil
, Qnil
);
1315 unbind_to (count
, Qnil
);
1317 /* Run any eval-after-load forms for this file. */
1318 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1319 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1323 xfree (saved_doc_string
);
1324 saved_doc_string
= 0;
1325 saved_doc_string_size
= 0;
1327 xfree (prev_saved_doc_string
);
1328 prev_saved_doc_string
= 0;
1329 prev_saved_doc_string_size
= 0;
1331 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1334 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1337 message_with_string ("Loading %s (source)...done", file
, 1);
1339 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1341 else /* The typical case; compiled file newer than source file. */
1342 message_with_string ("Loading %s...done", file
, 1);
1349 load_unwind (Lisp_Object arg
) /* Used as unwind-protect function in load. */
1351 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1362 load_descriptor_unwind (Lisp_Object oldlist
)
1364 load_descriptor_list
= oldlist
;
1368 /* Close all descriptors in use for Floads.
1369 This is used when starting a subprocess. */
1372 close_load_descs (void)
1376 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1377 emacs_close (XFASTINT (XCAR (tail
)));
1382 complete_filename_p (Lisp_Object pathname
)
1384 register const unsigned char *s
= SDATA (pathname
);
1385 return (IS_DIRECTORY_SEP (s
[0])
1386 || (SCHARS (pathname
) > 2
1387 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1390 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1391 doc
: /* Search for FILENAME through PATH.
1392 Returns the file's name in absolute form, or nil if not found.
1393 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1394 file name when searching.
1395 If non-nil, PREDICATE is used instead of `file-readable-p'.
1396 PREDICATE can also be an integer to pass to the access(2) function,
1397 in which case file-name-handlers are ignored.
1398 This function will normally skip directories, so if you want it to find
1399 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1400 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1403 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1404 if (NILP (predicate
) && fd
> 0)
1409 static Lisp_Object Qdir_ok
;
1411 /* Search for a file whose name is STR, looking in directories
1412 in the Lisp list PATH, and trying suffixes from SUFFIX.
1413 On success, returns a file descriptor. On failure, returns -1.
1415 SUFFIXES is a list of strings containing possible suffixes.
1416 The empty suffix is automatically added if the list is empty.
1418 PREDICATE non-nil means don't open the files,
1419 just look for one that satisfies the predicate. In this case,
1420 returns 1 on success. The predicate can be a lisp function or
1421 an integer to pass to `access' (in which case file-name-handlers
1424 If STOREPTR is nonzero, it points to a slot where the name of
1425 the file actually found should be stored as a Lisp string.
1426 nil is stored there on failure.
1428 If the file we find is remote, return -2
1429 but store the found remote file name in *STOREPTR. */
1432 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1435 ptrdiff_t fn_size
= 100;
1437 register char *fn
= buf
;
1439 ptrdiff_t want_length
;
1440 Lisp_Object filename
;
1442 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1443 Lisp_Object string
, tail
, encoded_fn
;
1444 ptrdiff_t max_suffix_len
= 0;
1448 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1450 CHECK_STRING_CAR (tail
);
1451 max_suffix_len
= max (max_suffix_len
,
1452 SBYTES (XCAR (tail
)));
1455 string
= filename
= encoded_fn
= Qnil
;
1456 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1461 if (complete_filename_p (str
))
1464 for (; CONSP (path
); path
= XCDR (path
))
1466 filename
= Fexpand_file_name (str
, XCAR (path
));
1467 if (!complete_filename_p (filename
))
1468 /* If there are non-absolute elts in PATH (eg "."). */
1469 /* Of course, this could conceivably lose if luser sets
1470 default-directory to be something non-absolute... */
1472 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1473 if (!complete_filename_p (filename
))
1474 /* Give up on this path element! */
1478 /* Calculate maximum length of any filename made from
1479 this path element/specified file name and any possible suffix. */
1480 want_length
= max_suffix_len
+ SBYTES (filename
);
1481 if (fn_size
<= want_length
)
1482 fn
= (char *) alloca (fn_size
= 100 + want_length
);
1484 /* Loop over suffixes. */
1485 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1486 CONSP (tail
); tail
= XCDR (tail
))
1488 ptrdiff_t lsuffix
= SBYTES (XCAR (tail
));
1489 Lisp_Object handler
;
1492 /* Concatenate path element/specified name with the suffix.
1493 If the directory starts with /:, remove that. */
1494 if (SCHARS (filename
) > 2
1495 && SREF (filename
, 0) == '/'
1496 && SREF (filename
, 1) == ':')
1498 strncpy (fn
, SSDATA (filename
) + 2,
1499 SBYTES (filename
) - 2);
1500 fn
[SBYTES (filename
) - 2] = 0;
1504 strncpy (fn
, SSDATA (filename
),
1506 fn
[SBYTES (filename
)] = 0;
1509 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1510 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1512 /* Check that the file exists and is not a directory. */
1513 /* We used to only check for handlers on non-absolute file names:
1517 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1518 It's not clear why that was the case and it breaks things like
1519 (load "/bar.el") where the file is actually "/bar.el.gz". */
1520 string
= build_string (fn
);
1521 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1522 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1524 if (NILP (predicate
))
1525 exists
= !NILP (Ffile_readable_p (string
));
1528 Lisp_Object tmp
= call1 (predicate
, string
);
1529 exists
= !NILP (tmp
)
1530 && (EQ (tmp
, Qdir_ok
)
1531 || NILP (Ffile_directory_p (string
)));
1536 /* We succeeded; return this descriptor and filename. */
1547 encoded_fn
= ENCODE_FILE (string
);
1548 pfn
= SSDATA (encoded_fn
);
1549 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1552 /* Check that we can access or open it. */
1553 if (NATNUMP (predicate
))
1554 fd
= (((XFASTINT (predicate
) & ~INT_MAX
) == 0
1555 && access (pfn
, XFASTINT (predicate
)) == 0)
1558 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1562 /* We succeeded; return this descriptor and filename. */
1580 /* Merge the list we've accumulated of globals from the current input source
1581 into the load_history variable. The details depend on whether
1582 the source has an associated file name or not.
1584 FILENAME is the file name that we are loading from.
1585 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1588 build_load_history (Lisp_Object filename
, int entire
)
1590 register Lisp_Object tail
, prev
, newelt
;
1591 register Lisp_Object tem
, tem2
;
1592 register int foundit
= 0;
1594 tail
= Vload_history
;
1597 while (CONSP (tail
))
1601 /* Find the feature's previous assoc list... */
1602 if (!NILP (Fequal (filename
, Fcar (tem
))))
1606 /* If we're loading the entire file, remove old data. */
1610 Vload_history
= XCDR (tail
);
1612 Fsetcdr (prev
, XCDR (tail
));
1615 /* Otherwise, cons on new symbols that are not already members. */
1618 tem2
= Vcurrent_load_list
;
1620 while (CONSP (tem2
))
1622 newelt
= XCAR (tem2
);
1624 if (NILP (Fmember (newelt
, tem
)))
1625 Fsetcar (tail
, Fcons (XCAR (tem
),
1626 Fcons (newelt
, XCDR (tem
))));
1639 /* If we're loading an entire file, cons the new assoc onto the
1640 front of load-history, the most-recently-loaded position. Also
1641 do this if we didn't find an existing member for the file. */
1642 if (entire
|| !foundit
)
1643 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1648 readevalloop_1 (Lisp_Object old
)
1650 load_convert_to_unibyte
= ! NILP (old
);
1654 /* Signal an `end-of-file' error, if possible with file name
1657 static _Noreturn
void
1658 end_of_file_error (void)
1660 if (STRINGP (Vload_file_name
))
1661 xsignal1 (Qend_of_file
, Vload_file_name
);
1663 xsignal0 (Qend_of_file
);
1666 /* UNIBYTE specifies how to set load_convert_to_unibyte
1667 for this invocation.
1668 READFUN, if non-nil, is used instead of `read'.
1670 START, END specify region to read in current buffer (from eval-region).
1671 If the input is not from a buffer, they must be nil. */
1674 readevalloop (Lisp_Object readcharfun
,
1676 Lisp_Object sourcename
,
1678 Lisp_Object unibyte
, Lisp_Object readfun
,
1679 Lisp_Object start
, Lisp_Object end
)
1682 register Lisp_Object val
;
1683 ptrdiff_t count
= SPECPDL_INDEX ();
1684 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1685 struct buffer
*b
= 0;
1686 int continue_reading_p
;
1687 Lisp_Object lex_bound
;
1688 /* Nonzero if reading an entire buffer. */
1689 int whole_buffer
= 0;
1690 /* 1 on the first time around. */
1693 if (MARKERP (readcharfun
))
1696 start
= readcharfun
;
1699 if (BUFFERP (readcharfun
))
1700 b
= XBUFFER (readcharfun
);
1701 else if (MARKERP (readcharfun
))
1702 b
= XMARKER (readcharfun
)->buffer
;
1704 /* We assume START is nil when input is not from a buffer. */
1705 if (! NILP (start
) && !b
)
1708 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1709 specbind (Qcurrent_load_list
, Qnil
);
1710 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1711 load_convert_to_unibyte
= !NILP (unibyte
);
1713 /* If lexical binding is active (either because it was specified in
1714 the file's header, or via a buffer-local variable), create an empty
1715 lexical environment, otherwise, turn off lexical binding. */
1716 lex_bound
= find_symbol_value (Qlexical_binding
);
1717 specbind (Qinternal_interpreter_environment
,
1718 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1719 ? Qnil
: Fcons (Qt
, Qnil
));
1721 GCPRO4 (sourcename
, readfun
, start
, end
);
1723 /* Try to ensure sourcename is a truename, except whilst preloading. */
1724 if (NILP (Vpurify_flag
)
1725 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1726 && !NILP (Ffboundp (Qfile_truename
)))
1727 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1729 LOADHIST_ATTACH (sourcename
);
1731 continue_reading_p
= 1;
1732 while (continue_reading_p
)
1734 ptrdiff_t count1
= SPECPDL_INDEX ();
1736 if (b
!= 0 && NILP (BVAR (b
, name
)))
1737 error ("Reading from killed buffer");
1741 /* Switch to the buffer we are reading from. */
1742 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1743 set_buffer_internal (b
);
1745 /* Save point in it. */
1746 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1747 /* Save ZV in it. */
1748 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1749 /* Those get unbound after we read one expression. */
1751 /* Set point and ZV around stuff to be read. */
1754 Fnarrow_to_region (make_number (BEGV
), end
);
1756 /* Just for cleanliness, convert END to a marker
1757 if it is an integer. */
1759 end
= Fpoint_max_marker ();
1762 /* On the first cycle, we can easily test here
1763 whether we are reading the whole buffer. */
1764 if (b
&& first_sexp
)
1765 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1772 while ((c
= READCHAR
) != '\n' && c
!= -1);
1777 unbind_to (count1
, Qnil
);
1781 /* Ignore whitespace here, so we can detect eof. */
1782 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1783 || c
== 0xa0) /* NBSP */
1786 if (!NILP (Vpurify_flag
) && c
== '(')
1788 val
= read_list (0, readcharfun
);
1793 read_objects
= Qnil
;
1794 if (!NILP (readfun
))
1796 val
= call1 (readfun
, readcharfun
);
1798 /* If READCHARFUN has set point to ZV, we should
1799 stop reading, even if the form read sets point
1800 to a different value when evaluated. */
1801 if (BUFFERP (readcharfun
))
1803 struct buffer
*buf
= XBUFFER (readcharfun
);
1804 if (BUF_PT (buf
) == BUF_ZV (buf
))
1805 continue_reading_p
= 0;
1808 else if (! NILP (Vload_read_function
))
1809 val
= call1 (Vload_read_function
, readcharfun
);
1811 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1814 if (!NILP (start
) && continue_reading_p
)
1815 start
= Fpoint_marker ();
1817 /* Restore saved point and BEGV. */
1818 unbind_to (count1
, Qnil
);
1820 /* Now eval what we just read. */
1821 val
= eval_sub (val
);
1825 Vvalues
= Fcons (val
, Vvalues
);
1826 if (EQ (Vstandard_output
, Qt
))
1835 build_load_history (sourcename
,
1836 stream
|| whole_buffer
);
1840 unbind_to (count
, Qnil
);
1843 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1844 doc
: /* Execute the current buffer as Lisp code.
1845 When called from a Lisp program (i.e., not interactively), this
1846 function accepts up to five optional arguments:
1847 BUFFER is the buffer to evaluate (nil means use current buffer).
1848 PRINTFLAG controls printing of output:
1849 A value of nil means discard it; anything else is stream for print.
1850 FILENAME specifies the file name to use for `load-history'.
1851 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1853 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1854 functions should work normally even if PRINTFLAG is nil.
1856 This function preserves the position of point. */)
1857 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1859 ptrdiff_t count
= SPECPDL_INDEX ();
1860 Lisp_Object tem
, buf
;
1863 buf
= Fcurrent_buffer ();
1865 buf
= Fget_buffer (buffer
);
1867 error ("No such buffer");
1869 if (NILP (printflag
) && NILP (do_allow_print
))
1874 if (NILP (filename
))
1875 filename
= BVAR (XBUFFER (buf
), filename
);
1877 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1878 specbind (Qstandard_output
, tem
);
1879 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1880 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1881 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1882 readevalloop (buf
, 0, filename
,
1883 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1884 unbind_to (count
, Qnil
);
1889 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1890 doc
: /* Execute the region as Lisp code.
1891 When called from programs, expects two arguments,
1892 giving starting and ending indices in the current buffer
1893 of the text to be executed.
1894 Programs can pass third argument PRINTFLAG which controls output:
1895 A value of nil means discard it; anything else is stream for printing it.
1896 Also the fourth argument READ-FUNCTION, if non-nil, is used
1897 instead of `read' to read each expression. It gets one argument
1898 which is the input stream for reading characters.
1900 This function does not move point. */)
1901 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1903 /* FIXME: Do the eval-sexp-add-defvars dance! */
1904 ptrdiff_t count
= SPECPDL_INDEX ();
1905 Lisp_Object tem
, cbuf
;
1907 cbuf
= Fcurrent_buffer ();
1909 if (NILP (printflag
))
1913 specbind (Qstandard_output
, tem
);
1914 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1916 /* `readevalloop' calls functions which check the type of start and end. */
1917 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1918 !NILP (printflag
), Qnil
, read_function
,
1921 return unbind_to (count
, Qnil
);
1925 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1926 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1927 If STREAM is nil, use the value of `standard-input' (which see).
1928 STREAM or the value of `standard-input' may be:
1929 a buffer (read from point and advance it)
1930 a marker (read from where it points and advance it)
1931 a function (call it with no arguments for each character,
1932 call it with a char as argument to push a char back)
1933 a string (takes text from string, starting at the beginning)
1934 t (read text line using minibuffer and use it, or read from
1935 standard input in batch mode). */)
1936 (Lisp_Object stream
)
1939 stream
= Vstandard_input
;
1940 if (EQ (stream
, Qt
))
1941 stream
= Qread_char
;
1942 if (EQ (stream
, Qread_char
))
1943 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1945 return read_internal_start (stream
, Qnil
, Qnil
);
1948 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1949 doc
: /* Read one Lisp expression which is represented as text by STRING.
1950 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1951 FINAL-STRING-INDEX is an integer giving the position of the next
1952 remaining character in STRING.
1953 START and END optionally delimit a substring of STRING from which to read;
1954 they default to 0 and (length STRING) respectively. */)
1955 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1958 CHECK_STRING (string
);
1959 /* `read_internal_start' sets `read_from_string_index'. */
1960 ret
= read_internal_start (string
, start
, end
);
1961 return Fcons (ret
, make_number (read_from_string_index
));
1964 /* Function to set up the global context we need in toplevel read
1967 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1968 /* `start', `end' only used when stream is a string. */
1973 new_backquote_flag
= 0;
1974 read_objects
= Qnil
;
1975 if (EQ (Vread_with_symbol_positions
, Qt
)
1976 || EQ (Vread_with_symbol_positions
, stream
))
1977 Vread_symbol_positions_list
= Qnil
;
1979 if (STRINGP (stream
)
1980 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1982 ptrdiff_t startval
, endval
;
1985 if (STRINGP (stream
))
1988 string
= XCAR (stream
);
1991 endval
= SCHARS (string
);
1995 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
1996 args_out_of_range (string
, end
);
1997 endval
= XINT (end
);
2004 CHECK_NUMBER (start
);
2005 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2006 args_out_of_range (string
, start
);
2007 startval
= XINT (start
);
2009 read_from_string_index
= startval
;
2010 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2011 read_from_string_limit
= endval
;
2014 retval
= read0 (stream
);
2015 if (EQ (Vread_with_symbol_positions
, Qt
)
2016 || EQ (Vread_with_symbol_positions
, stream
))
2017 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2022 /* Signal Qinvalid_read_syntax error.
2023 S is error string of length N (if > 0) */
2025 static _Noreturn
void
2026 invalid_syntax (const char *s
)
2028 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2032 /* Use this for recursive reads, in contexts where internal tokens
2036 read0 (Lisp_Object readcharfun
)
2038 register Lisp_Object val
;
2041 val
= read1 (readcharfun
, &c
, 0);
2045 xsignal1 (Qinvalid_read_syntax
,
2046 Fmake_string (make_number (1), make_number (c
)));
2049 static ptrdiff_t read_buffer_size
;
2050 static char *read_buffer
;
2052 /* Read a \-escape sequence, assuming we already read the `\'.
2053 If the escape sequence forces unibyte, return eight-bit char. */
2056 read_escape (Lisp_Object readcharfun
, int stringp
)
2058 register int c
= READCHAR
;
2059 /* \u allows up to four hex digits, \U up to eight. Default to the
2060 behavior for \u, and change this value in the case that \U is seen. */
2061 int unicode_hex_count
= 4;
2066 end_of_file_error ();
2096 error ("Invalid escape character syntax");
2099 c
= read_escape (readcharfun
, 0);
2100 return c
| meta_modifier
;
2105 error ("Invalid escape character syntax");
2108 c
= read_escape (readcharfun
, 0);
2109 return c
| shift_modifier
;
2114 error ("Invalid escape character syntax");
2117 c
= read_escape (readcharfun
, 0);
2118 return c
| hyper_modifier
;
2123 error ("Invalid escape character syntax");
2126 c
= read_escape (readcharfun
, 0);
2127 return c
| alt_modifier
;
2131 if (stringp
|| c
!= '-')
2138 c
= read_escape (readcharfun
, 0);
2139 return c
| super_modifier
;
2144 error ("Invalid escape character syntax");
2148 c
= read_escape (readcharfun
, 0);
2149 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2150 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2151 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2152 return c
| ctrl_modifier
;
2153 /* ASCII control chars are made from letters (both cases),
2154 as well as the non-letters within 0100...0137. */
2155 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2156 return (c
& (037 | ~0177));
2157 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2158 return (c
& (037 | ~0177));
2160 return c
| ctrl_modifier
;
2170 /* An octal escape, as in ANSI C. */
2172 register int i
= c
- '0';
2173 register int count
= 0;
2176 if ((c
= READCHAR
) >= '0' && c
<= '7')
2188 if (i
>= 0x80 && i
< 0x100)
2189 i
= BYTE8_TO_CHAR (i
);
2194 /* A hex escape, as in ANSI C. */
2201 if (c
>= '0' && c
<= '9')
2206 else if ((c
>= 'a' && c
<= 'f')
2207 || (c
>= 'A' && c
<= 'F'))
2210 if (c
>= 'a' && c
<= 'f')
2220 /* Allow hex escapes as large as ?\xfffffff, because some
2221 packages use them to denote characters with modifiers. */
2222 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2223 error ("Hex character out of range: \\x%x...", i
);
2227 if (count
< 3 && i
>= 0x80)
2228 return BYTE8_TO_CHAR (i
);
2233 /* Post-Unicode-2.0: Up to eight hex chars. */
2234 unicode_hex_count
= 8;
2237 /* A Unicode escape. We only permit them in strings and characters,
2238 not arbitrarily in the source code, as in some other languages. */
2243 while (++count
<= unicode_hex_count
)
2246 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2248 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2249 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2250 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2252 error ("Non-hex digit used for Unicode escape");
2255 error ("Non-Unicode character: 0x%x", i
);
2264 /* Return the digit that CHARACTER stands for in the given BASE.
2265 Return -1 if CHARACTER is out of range for BASE,
2266 and -2 if CHARACTER is not valid for any supported BASE. */
2268 digit_to_number (int character
, int base
)
2272 if ('0' <= character
&& character
<= '9')
2273 digit
= character
- '0';
2274 else if ('a' <= character
&& character
<= 'z')
2275 digit
= character
- 'a' + 10;
2276 else if ('A' <= character
&& character
<= 'Z')
2277 digit
= character
- 'A' + 10;
2281 return digit
< base
? digit
: -1;
2284 /* Read an integer in radix RADIX using READCHARFUN to read
2285 characters. RADIX must be in the interval [2..36]; if it isn't, a
2286 read error is signaled . Value is the integer read. Signals an
2287 error if encountering invalid read syntax or if RADIX is out of
2291 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2293 /* Room for sign, leading 0, other digits, trailing null byte.
2294 Also, room for invalid syntax diagnostic. */
2295 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2296 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2298 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2300 if (radix
< 2 || radix
> 36)
2308 if (c
== '-' || c
== '+')
2319 /* Ignore redundant leading zeros, so the buffer doesn't
2320 fill up with them. */
2326 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2333 if (p
< buf
+ sizeof buf
- 1)
2347 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2348 invalid_syntax (buf
);
2351 return string_to_number (buf
, radix
, 0);
2355 /* If the next token is ')' or ']' or '.', we store that character
2356 in *PCH and the return value is not interesting. Else, we store
2357 zero in *PCH and we read and return one lisp object.
2359 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2362 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2365 unsigned uninterned_symbol
= 0;
2373 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2375 end_of_file_error ();
2380 return read_list (0, readcharfun
);
2383 return read_vector (readcharfun
, 0);
2399 /* Accept extended format for hashtables (extensible to
2401 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2402 Lisp_Object tmp
= read_list (0, readcharfun
);
2403 Lisp_Object head
= CAR_SAFE (tmp
);
2404 Lisp_Object data
= Qnil
;
2405 Lisp_Object val
= Qnil
;
2406 /* The size is 2 * number of allowed keywords to
2408 Lisp_Object params
[10];
2410 Lisp_Object key
= Qnil
;
2411 int param_count
= 0;
2413 if (!EQ (head
, Qhash_table
))
2414 error ("Invalid extended read marker at head of #s list "
2415 "(only hash-table allowed)");
2417 tmp
= CDR_SAFE (tmp
);
2419 /* This is repetitive but fast and simple. */
2420 params
[param_count
] = QCsize
;
2421 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2422 if (!NILP (params
[param_count
+ 1]))
2425 params
[param_count
] = QCtest
;
2426 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2427 if (!NILP (params
[param_count
+ 1]))
2430 params
[param_count
] = QCweakness
;
2431 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2432 if (!NILP (params
[param_count
+ 1]))
2435 params
[param_count
] = QCrehash_size
;
2436 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2437 if (!NILP (params
[param_count
+ 1]))
2440 params
[param_count
] = QCrehash_threshold
;
2441 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2442 if (!NILP (params
[param_count
+ 1]))
2445 /* This is the hashtable data. */
2446 data
= Fplist_get (tmp
, Qdata
);
2448 /* Now use params to make a new hashtable and fill it. */
2449 ht
= Fmake_hash_table (param_count
, params
);
2451 while (CONSP (data
))
2456 error ("Odd number of elements in hashtable data");
2459 Fputhash (key
, val
, ht
);
2465 invalid_syntax ("#");
2473 tmp
= read_vector (readcharfun
, 0);
2474 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2475 error ("Invalid size char-table");
2476 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2488 tmp
= read_vector (readcharfun
, 0);
2491 error ("Invalid size char-table");
2492 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2493 error ("Invalid depth in char-table");
2494 depth
= XINT (AREF (tmp
, 0));
2495 if (chartab_size
[depth
] != size
- 2)
2496 error ("Invalid size char-table");
2497 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2500 invalid_syntax ("#^^");
2502 invalid_syntax ("#^");
2507 length
= read1 (readcharfun
, pch
, first_in_list
);
2511 Lisp_Object tmp
, val
;
2512 EMACS_INT size_in_chars
2513 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2514 / BOOL_VECTOR_BITS_PER_CHAR
);
2517 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2518 if (STRING_MULTIBYTE (tmp
)
2519 || (size_in_chars
!= SCHARS (tmp
)
2520 /* We used to print 1 char too many
2521 when the number of bits was a multiple of 8.
2522 Accept such input in case it came from an old
2524 && ! (XFASTINT (length
)
2525 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2526 invalid_syntax ("#&...");
2528 val
= Fmake_bool_vector (length
, Qnil
);
2529 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2530 /* Clear the extraneous bits in the last byte. */
2531 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2532 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2533 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2536 invalid_syntax ("#&...");
2540 /* Accept compiled functions at read-time so that we don't have to
2541 build them using function calls. */
2543 tmp
= read_vector (readcharfun
, 1);
2544 make_byte_code (XVECTOR (tmp
));
2550 struct gcpro gcpro1
;
2553 /* Read the string itself. */
2554 tmp
= read1 (readcharfun
, &ch
, 0);
2555 if (ch
!= 0 || !STRINGP (tmp
))
2556 invalid_syntax ("#");
2558 /* Read the intervals and their properties. */
2561 Lisp_Object beg
, end
, plist
;
2563 beg
= read1 (readcharfun
, &ch
, 0);
2568 end
= read1 (readcharfun
, &ch
, 0);
2570 plist
= read1 (readcharfun
, &ch
, 0);
2572 invalid_syntax ("Invalid string property list");
2573 Fset_text_properties (beg
, end
, plist
, tmp
);
2579 /* #@NUMBER is used to skip NUMBER following characters.
2580 That's used in .elc files to skip over doc strings
2581 and function definitions. */
2584 enum { extra
= 100 };
2585 ptrdiff_t i
, nskip
= 0;
2588 /* Read a decimal integer. */
2589 while ((c
= READCHAR
) >= 0
2590 && c
>= '0' && c
<= '9')
2592 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2599 if (load_force_doc_strings
2600 && (EQ (readcharfun
, Qget_file_char
)
2601 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2603 /* If we are supposed to force doc strings into core right now,
2604 record the last string that we skipped,
2605 and record where in the file it comes from. */
2607 /* But first exchange saved_doc_string
2608 with prev_saved_doc_string, so we save two strings. */
2610 char *temp
= saved_doc_string
;
2611 ptrdiff_t temp_size
= saved_doc_string_size
;
2612 file_offset temp_pos
= saved_doc_string_position
;
2613 ptrdiff_t temp_len
= saved_doc_string_length
;
2615 saved_doc_string
= prev_saved_doc_string
;
2616 saved_doc_string_size
= prev_saved_doc_string_size
;
2617 saved_doc_string_position
= prev_saved_doc_string_position
;
2618 saved_doc_string_length
= prev_saved_doc_string_length
;
2620 prev_saved_doc_string
= temp
;
2621 prev_saved_doc_string_size
= temp_size
;
2622 prev_saved_doc_string_position
= temp_pos
;
2623 prev_saved_doc_string_length
= temp_len
;
2626 if (saved_doc_string_size
== 0)
2628 saved_doc_string
= xmalloc (nskip
+ extra
);
2629 saved_doc_string_size
= nskip
+ extra
;
2631 if (nskip
> saved_doc_string_size
)
2633 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2635 saved_doc_string_size
= nskip
+ extra
;
2638 saved_doc_string_position
= file_tell (instream
);
2640 /* Copy that many characters into saved_doc_string. */
2641 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2642 saved_doc_string
[i
] = c
= READCHAR
;
2644 saved_doc_string_length
= i
;
2648 /* Skip that many characters. */
2649 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2658 /* #! appears at the beginning of an executable file.
2659 Skip the first line. */
2660 while (c
!= '\n' && c
>= 0)
2665 return Vload_file_name
;
2667 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2668 /* #:foo is the uninterned symbol named foo. */
2671 uninterned_symbol
= 1;
2674 && c
!= 0xa0 /* NBSP */
2676 || strchr ("\"';()[]#`,", c
) == NULL
)))
2678 /* No symbol character follows, this is the empty
2681 return Fmake_symbol (build_string (""));
2685 /* ## is the empty symbol. */
2687 return Fintern (build_string (""), Qnil
);
2688 /* Reader forms that can reuse previously read objects. */
2689 if (c
>= '0' && c
<= '9')
2694 /* Read a non-negative integer. */
2695 while (c
>= '0' && c
<= '9')
2697 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2698 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2699 n
= MOST_POSITIVE_FIXNUM
+ 1;
2701 n
= n
* 10 + c
- '0';
2705 if (n
<= MOST_POSITIVE_FIXNUM
)
2707 if (c
== 'r' || c
== 'R')
2708 return read_integer (readcharfun
, n
);
2710 if (! NILP (Vread_circle
))
2712 /* #n=object returns object, but associates it with
2716 /* Make a placeholder for #n# to use temporarily. */
2717 Lisp_Object placeholder
;
2720 placeholder
= Fcons (Qnil
, Qnil
);
2721 cell
= Fcons (make_number (n
), placeholder
);
2722 read_objects
= Fcons (cell
, read_objects
);
2724 /* Read the object itself. */
2725 tem
= read0 (readcharfun
);
2727 /* Now put it everywhere the placeholder was... */
2728 substitute_object_in_subtree (tem
, placeholder
);
2730 /* ...and #n# will use the real value from now on. */
2731 Fsetcdr (cell
, tem
);
2736 /* #n# returns a previously read object. */
2739 tem
= Fassq (make_number (n
), read_objects
);
2745 /* Fall through to error message. */
2747 else if (c
== 'x' || c
== 'X')
2748 return read_integer (readcharfun
, 16);
2749 else if (c
== 'o' || c
== 'O')
2750 return read_integer (readcharfun
, 8);
2751 else if (c
== 'b' || c
== 'B')
2752 return read_integer (readcharfun
, 2);
2755 invalid_syntax ("#");
2758 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2763 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2768 int next_char
= READCHAR
;
2770 /* Transition from old-style to new-style:
2771 If we see "(`" it used to mean old-style, which usually works
2772 fine because ` should almost never appear in such a position
2773 for new-style. But occasionally we need "(`" to mean new
2774 style, so we try to distinguish the two by the fact that we
2775 can either write "( `foo" or "(` foo", where the first
2776 intends to use new-style whereas the second intends to use
2777 old-style. For Emacs-25, we should completely remove this
2778 first_in_list exception (old-style can still be obtained via
2780 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2782 Vold_style_backquotes
= Qt
;
2789 new_backquote_flag
++;
2790 value
= read0 (readcharfun
);
2791 new_backquote_flag
--;
2793 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2798 int next_char
= READCHAR
;
2800 /* Transition from old-style to new-style:
2801 It used to be impossible to have a new-style , other than within
2802 a new-style `. This is sufficient when ` and , are used in the
2803 normal way, but ` and , can also appear in args to macros that
2804 will not interpret them in the usual way, in which case , may be
2805 used without any ` anywhere near.
2806 So we now use the same heuristic as for backquote: old-style
2807 unquotes are only recognized when first on a list, and when
2808 followed by a space.
2809 Because it's more difficult to peek 2 chars ahead, a new-style
2810 ,@ can still not be used outside of a `, unless it's in the middle
2812 if (new_backquote_flag
2814 || (next_char
!= ' ' && next_char
!= '@'))
2816 Lisp_Object comma_type
= Qnil
;
2821 comma_type
= Qcomma_at
;
2823 comma_type
= Qcomma_dot
;
2826 if (ch
>= 0) UNREAD (ch
);
2827 comma_type
= Qcomma
;
2830 value
= read0 (readcharfun
);
2831 return Fcons (comma_type
, Fcons (value
, Qnil
));
2835 Vold_style_backquotes
= Qt
;
2847 end_of_file_error ();
2849 /* Accept `single space' syntax like (list ? x) where the
2850 whitespace character is SPC or TAB.
2851 Other literal whitespace like NL, CR, and FF are not accepted,
2852 as there are well-established escape sequences for these. */
2853 if (c
== ' ' || c
== '\t')
2854 return make_number (c
);
2857 c
= read_escape (readcharfun
, 0);
2858 modifiers
= c
& CHAR_MODIFIER_MASK
;
2859 c
&= ~CHAR_MODIFIER_MASK
;
2860 if (CHAR_BYTE8_P (c
))
2861 c
= CHAR_TO_BYTE8 (c
);
2864 next_char
= READCHAR
;
2865 ok
= (next_char
<= 040
2866 || (next_char
< 0200
2867 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2870 return make_number (c
);
2872 invalid_syntax ("?");
2877 char *p
= read_buffer
;
2878 char *end
= read_buffer
+ read_buffer_size
;
2880 /* Nonzero if we saw an escape sequence specifying
2881 a multibyte character. */
2882 int force_multibyte
= 0;
2883 /* Nonzero if we saw an escape sequence specifying
2884 a single-byte character. */
2885 int force_singlebyte
= 0;
2887 ptrdiff_t nchars
= 0;
2889 while ((ch
= READCHAR
) >= 0
2892 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2894 ptrdiff_t offset
= p
- read_buffer
;
2895 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2896 memory_full (SIZE_MAX
);
2897 read_buffer
= (char *) xrealloc (read_buffer
,
2898 read_buffer_size
* 2);
2899 read_buffer_size
*= 2;
2900 p
= read_buffer
+ offset
;
2901 end
= read_buffer
+ read_buffer_size
;
2908 ch
= read_escape (readcharfun
, 1);
2910 /* CH is -1 if \ newline has just been seen. */
2913 if (p
== read_buffer
)
2918 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2919 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2921 if (CHAR_BYTE8_P (ch
))
2922 force_singlebyte
= 1;
2923 else if (! ASCII_CHAR_P (ch
))
2924 force_multibyte
= 1;
2925 else /* I.e. ASCII_CHAR_P (ch). */
2927 /* Allow `\C- ' and `\C-?'. */
2928 if (modifiers
== CHAR_CTL
)
2931 ch
= 0, modifiers
= 0;
2933 ch
= 127, modifiers
= 0;
2935 if (modifiers
& CHAR_SHIFT
)
2937 /* Shift modifier is valid only with [A-Za-z]. */
2938 if (ch
>= 'A' && ch
<= 'Z')
2939 modifiers
&= ~CHAR_SHIFT
;
2940 else if (ch
>= 'a' && ch
<= 'z')
2941 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2944 if (modifiers
& CHAR_META
)
2946 /* Move the meta bit to the right place for a
2948 modifiers
&= ~CHAR_META
;
2949 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2950 force_singlebyte
= 1;
2954 /* Any modifiers remaining are invalid. */
2956 error ("Invalid modifier in string");
2957 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2961 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2962 if (CHAR_BYTE8_P (ch
))
2963 force_singlebyte
= 1;
2964 else if (! ASCII_CHAR_P (ch
))
2965 force_multibyte
= 1;
2971 end_of_file_error ();
2973 /* If purifying, and string starts with \ newline,
2974 return zero instead. This is for doc strings
2975 that we are really going to find in etc/DOC.nn.nn. */
2976 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2977 return make_number (0);
2979 if (! force_multibyte
&& force_singlebyte
)
2981 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
2982 forms. Convert it to unibyte. */
2983 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
2985 p
= read_buffer
+ nchars
;
2988 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2990 || (p
- read_buffer
!= nchars
)));
2995 int next_char
= READCHAR
;
2998 if (next_char
<= 040
2999 || (next_char
< 0200
3000 && strchr ("\"';([#?`,", next_char
) != NULL
))
3006 /* Otherwise, we fall through! Note that the atom-reading loop
3007 below will now loop at least once, assuring that we will not
3008 try to UNREAD two characters in a row. */
3012 if (c
<= 040) goto retry
;
3013 if (c
== 0xa0) /* NBSP */
3018 char *p
= read_buffer
;
3020 EMACS_INT start_position
= readchar_count
- 1;
3023 char *end
= read_buffer
+ read_buffer_size
;
3027 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3029 ptrdiff_t offset
= p
- read_buffer
;
3030 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3031 memory_full (SIZE_MAX
);
3032 read_buffer
= (char *) xrealloc (read_buffer
,
3033 read_buffer_size
* 2);
3034 read_buffer_size
*= 2;
3035 p
= read_buffer
+ offset
;
3036 end
= read_buffer
+ read_buffer_size
;
3043 end_of_file_error ();
3048 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3054 && c
!= 0xa0 /* NBSP */
3056 || strchr ("\"';()[]#`,", c
) == NULL
));
3060 ptrdiff_t offset
= p
- read_buffer
;
3061 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3062 memory_full (SIZE_MAX
);
3063 read_buffer
= (char *) xrealloc (read_buffer
,
3064 read_buffer_size
* 2);
3065 read_buffer_size
*= 2;
3066 p
= read_buffer
+ offset
;
3067 end
= read_buffer
+ read_buffer_size
;
3073 if (!quoted
&& !uninterned_symbol
)
3075 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3076 if (! NILP (result
))
3080 Lisp_Object name
, result
;
3081 ptrdiff_t nbytes
= p
- read_buffer
;
3084 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3088 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3089 ? make_pure_string
: make_specified_string
)
3090 (read_buffer
, nchars
, nbytes
, multibyte
));
3091 result
= (uninterned_symbol
? Fmake_symbol (name
)
3092 : Fintern (name
, Qnil
));
3094 if (EQ (Vread_with_symbol_positions
, Qt
)
3095 || EQ (Vread_with_symbol_positions
, readcharfun
))
3096 Vread_symbol_positions_list
3097 = Fcons (Fcons (result
, make_number (start_position
)),
3098 Vread_symbol_positions_list
);
3106 /* List of nodes we've seen during substitute_object_in_subtree. */
3107 static Lisp_Object seen_list
;
3110 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3112 Lisp_Object check_object
;
3114 /* We haven't seen any objects when we start. */
3117 /* Make all the substitutions. */
3119 = substitute_object_recurse (object
, placeholder
, object
);
3121 /* Clear seen_list because we're done with it. */
3124 /* The returned object here is expected to always eq the
3126 if (!EQ (check_object
, object
))
3127 error ("Unexpected mutation error in reader");
3130 /* Feval doesn't get called from here, so no gc protection is needed. */
3131 #define SUBSTITUTE(get_val, set_val) \
3133 Lisp_Object old_value = get_val; \
3134 Lisp_Object true_value \
3135 = substitute_object_recurse (object, placeholder, \
3138 if (!EQ (old_value, true_value)) \
3145 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3147 /* If we find the placeholder, return the target object. */
3148 if (EQ (placeholder
, subtree
))
3151 /* If we've been to this node before, don't explore it again. */
3152 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3155 /* If this node can be the entry point to a cycle, remember that
3156 we've seen it. It can only be such an entry point if it was made
3157 by #n=, which means that we can find it as a value in
3159 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3160 seen_list
= Fcons (subtree
, seen_list
);
3162 /* Recurse according to subtree's type.
3163 Every branch must return a Lisp_Object. */
3164 switch (XTYPE (subtree
))
3166 case Lisp_Vectorlike
:
3168 ptrdiff_t i
, length
= 0;
3169 if (BOOL_VECTOR_P (subtree
))
3170 return subtree
; /* No sub-objects anyway. */
3171 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3172 || COMPILEDP (subtree
))
3173 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3174 else if (VECTORP (subtree
))
3175 length
= ASIZE (subtree
);
3177 /* An unknown pseudovector may contain non-Lisp fields, so we
3178 can't just blindly traverse all its fields. We used to call
3179 `Flength' which signaled `sequencep', so I just preserved this
3181 wrong_type_argument (Qsequencep
, subtree
);
3183 for (i
= 0; i
< length
; i
++)
3184 SUBSTITUTE (AREF (subtree
, i
),
3185 ASET (subtree
, i
, true_value
));
3191 SUBSTITUTE (XCAR (subtree
),
3192 XSETCAR (subtree
, true_value
));
3193 SUBSTITUTE (XCDR (subtree
),
3194 XSETCDR (subtree
, true_value
));
3200 /* Check for text properties in each interval.
3201 substitute_in_interval contains part of the logic. */
3203 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3204 Lisp_Object arg
= Fcons (object
, placeholder
);
3206 traverse_intervals_noorder (root_interval
,
3207 &substitute_in_interval
, arg
);
3212 /* Other types don't recurse any further. */
3218 /* Helper function for substitute_object_recurse. */
3220 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3222 Lisp_Object object
= Fcar (arg
);
3223 Lisp_Object placeholder
= Fcdr (arg
);
3225 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3235 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3236 integer syntax and fits in a fixnum, else return the nearest float if CP has
3237 either floating point or integer syntax and BASE is 10, else return nil. If
3238 IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
3239 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3240 number has integer syntax but does not fit. */
3243 string_to_number (char const *string
, int base
, int ignore_trailing
)
3246 char const *cp
= string
;
3248 int float_syntax
= 0;
3251 /* Compute NaN and infinities using a variable, to cope with compilers that
3252 think they are smarter than we are. */
3255 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3256 IEEE floating point hosts, and works around a formerly-common bug where
3257 atof ("-0.0") drops the sign. */
3258 int negative
= *cp
== '-';
3260 int signedp
= negative
|| *cp
== '+';
3265 leading_digit
= digit_to_number (*cp
, base
);
3266 if (0 <= leading_digit
)
3271 while (0 <= digit_to_number (*cp
, base
));
3281 if ('0' <= *cp
&& *cp
<= '9')
3286 while ('0' <= *cp
&& *cp
<= '9');
3288 if (*cp
== 'e' || *cp
== 'E')
3290 char const *ecp
= cp
;
3292 if (*cp
== '+' || *cp
== '-')
3294 if ('0' <= *cp
&& *cp
<= '9')
3299 while ('0' <= *cp
&& *cp
<= '9');
3301 else if (cp
[-1] == '+'
3302 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3308 else if (cp
[-1] == '+'
3309 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3313 value
= zero
/ zero
;
3315 /* If that made a "negative" NaN, negate it. */
3318 union { double d
; char c
[sizeof (double)]; }
3319 u_data
, u_minus_zero
;
3321 u_minus_zero
.d
= -0.0;
3322 for (i
= 0; i
< sizeof (double); i
++)
3323 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3329 /* Now VALUE is a positive NaN. */
3335 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3336 || state
== (LEAD_INT
|E_EXP
));
3339 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3340 any prefix that matches. Otherwise, the entire string must match. */
3341 if (! (ignore_trailing
3342 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3343 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3346 /* If the number uses integer and not float syntax, and is in C-language
3347 range, use its value, preferably as a fixnum. */
3348 if (0 <= leading_digit
&& ! float_syntax
)
3352 /* Fast special case for single-digit integers. This also avoids a
3353 glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
3354 case some versions of strtoumax accept numbers like "0x1" that Emacs
3356 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3357 return make_number (negative
? -leading_digit
: leading_digit
);
3360 n
= strtoumax (string
+ signedp
, NULL
, base
);
3361 if (errno
== ERANGE
)
3363 /* Unfortunately there's no simple and accurate way to convert
3364 non-base-10 numbers that are out of C-language range. */
3366 xsignal1 (Qoverflow_error
, build_string (string
));
3368 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3370 EMACS_INT signed_n
= n
;
3371 return make_number (negative
? -signed_n
: signed_n
);
3377 /* Either the number uses float syntax, or it does not fit into a fixnum.
3378 Convert it from string to floating point, unless the value is already
3379 known because it is an infinity, a NAN, or its absolute value fits in
3382 value
= atof (string
+ signedp
);
3384 return make_float (negative
? -value
: value
);
3389 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3392 register Lisp_Object
*ptr
;
3393 register Lisp_Object tem
, item
, vector
;
3394 register struct Lisp_Cons
*otem
;
3397 tem
= read_list (1, readcharfun
);
3398 len
= Flength (tem
);
3399 vector
= Fmake_vector (len
, Qnil
);
3401 size
= ASIZE (vector
);
3402 ptr
= XVECTOR (vector
)->contents
;
3403 for (i
= 0; i
< size
; i
++)
3406 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3407 bytecode object, the docstring containing the bytecode and
3408 constants values must be treated as unibyte and passed to
3409 Fread, to get the actual bytecode string and constants vector. */
3410 if (bytecodeflag
&& load_force_doc_strings
)
3412 if (i
== COMPILED_BYTECODE
)
3414 if (!STRINGP (item
))
3415 error ("Invalid byte code");
3417 /* Delay handling the bytecode slot until we know whether
3418 it is lazily-loaded (we can tell by whether the
3419 constants slot is nil). */
3420 ptr
[COMPILED_CONSTANTS
] = item
;
3423 else if (i
== COMPILED_CONSTANTS
)
3425 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3429 /* Coerce string to unibyte (like string-as-unibyte,
3430 but without generating extra garbage and
3431 guaranteeing no change in the contents). */
3432 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3433 STRING_SET_UNIBYTE (bytestr
);
3435 item
= Fread (Fcons (bytestr
, readcharfun
));
3437 error ("Invalid byte code");
3439 otem
= XCONS (item
);
3440 bytestr
= XCAR (item
);
3445 /* Now handle the bytecode slot. */
3446 ptr
[COMPILED_BYTECODE
] = bytestr
;
3448 else if (i
== COMPILED_DOC_STRING
3450 && ! STRING_MULTIBYTE (item
))
3452 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3453 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3455 item
= Fstring_as_multibyte (item
);
3466 /* FLAG = 1 means check for ] to terminate rather than ) and . */
3469 read_list (int flag
, register Lisp_Object readcharfun
)
3471 Lisp_Object val
, tail
;
3472 register Lisp_Object elt
, tem
;
3473 struct gcpro gcpro1
, gcpro2
;
3474 /* 0 is the normal case.
3475 1 means this list is a doc reference; replace it with the number 0.
3476 2 means this list is a doc reference; replace it with the doc string. */
3477 int doc_reference
= 0;
3479 /* Initialize this to 1 if we are reading a list. */
3480 int first_in_list
= flag
<= 0;
3489 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3494 /* While building, if the list starts with #$, treat it specially. */
3495 if (EQ (elt
, Vload_file_name
)
3497 && !NILP (Vpurify_flag
))
3499 if (NILP (Vdoc_file_name
))
3500 /* We have not yet called Snarf-documentation, so assume
3501 this file is described in the DOC-MM.NN file
3502 and Snarf-documentation will fill in the right value later.
3503 For now, replace the whole list with 0. */
3506 /* We have already called Snarf-documentation, so make a relative
3507 file name for this file, so it can be found properly
3508 in the installed Lisp directory.
3509 We don't use Fexpand_file_name because that would make
3510 the directory absolute now. */
3511 elt
= concat2 (build_string ("../lisp/"),
3512 Ffile_name_nondirectory (elt
));
3514 else if (EQ (elt
, Vload_file_name
)
3516 && load_force_doc_strings
)
3525 invalid_syntax (") or . in a vector");
3533 XSETCDR (tail
, read0 (readcharfun
));
3535 val
= read0 (readcharfun
);
3536 read1 (readcharfun
, &ch
, 0);
3540 if (doc_reference
== 1)
3541 return make_number (0);
3542 if (doc_reference
== 2)
3544 /* Get a doc string from the file we are loading.
3545 If it's in saved_doc_string, get it from there.
3547 Here, we don't know if the string is a
3548 bytecode string or a doc string. As a
3549 bytecode string must be unibyte, we always
3550 return a unibyte string. If it is actually a
3551 doc string, caller must make it
3554 EMACS_INT pos
= XINT (XCDR (val
));
3555 /* Position is negative for user variables. */
3556 if (pos
< 0) pos
= -pos
;
3557 if (pos
>= saved_doc_string_position
3558 && pos
< (saved_doc_string_position
3559 + saved_doc_string_length
))
3561 ptrdiff_t start
= pos
- saved_doc_string_position
;
3564 /* Process quoting with ^A,
3565 and find the end of the string,
3566 which is marked with ^_ (037). */
3567 for (from
= start
, to
= start
;
3568 saved_doc_string
[from
] != 037;)
3570 int c
= saved_doc_string
[from
++];
3573 c
= saved_doc_string
[from
++];
3575 saved_doc_string
[to
++] = c
;
3577 saved_doc_string
[to
++] = 0;
3579 saved_doc_string
[to
++] = 037;
3582 saved_doc_string
[to
++] = c
;
3585 return make_unibyte_string (saved_doc_string
+ start
,
3588 /* Look in prev_saved_doc_string the same way. */
3589 else if (pos
>= prev_saved_doc_string_position
3590 && pos
< (prev_saved_doc_string_position
3591 + prev_saved_doc_string_length
))
3594 pos
- prev_saved_doc_string_position
;
3597 /* Process quoting with ^A,
3598 and find the end of the string,
3599 which is marked with ^_ (037). */
3600 for (from
= start
, to
= start
;
3601 prev_saved_doc_string
[from
] != 037;)
3603 int c
= prev_saved_doc_string
[from
++];
3606 c
= prev_saved_doc_string
[from
++];
3608 prev_saved_doc_string
[to
++] = c
;
3610 prev_saved_doc_string
[to
++] = 0;
3612 prev_saved_doc_string
[to
++] = 037;
3615 prev_saved_doc_string
[to
++] = c
;
3618 return make_unibyte_string (prev_saved_doc_string
3623 return get_doc_string (val
, 1, 0);
3628 invalid_syntax (". in wrong context");
3630 invalid_syntax ("] in a list");
3632 tem
= Fcons (elt
, Qnil
);
3634 XSETCDR (tail
, tem
);
3641 static Lisp_Object initial_obarray
;
3643 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3645 static size_t oblookup_last_bucket_number
;
3647 /* Get an error if OBARRAY is not an obarray.
3648 If it is one, return it. */
3651 check_obarray (Lisp_Object obarray
)
3653 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3655 /* If Vobarray is now invalid, force it to be valid. */
3656 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3657 wrong_type_argument (Qvectorp
, obarray
);
3662 /* Intern the C string STR: return a symbol with that name,
3663 interned in the current obarray. */
3666 intern (const char *str
)
3669 ptrdiff_t len
= strlen (str
);
3670 Lisp_Object obarray
;
3673 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3674 obarray
= check_obarray (obarray
);
3675 tem
= oblookup (obarray
, str
, len
, len
);
3678 return Fintern (make_string (str
, len
), obarray
);
3682 intern_c_string (const char *str
)
3685 ptrdiff_t len
= strlen (str
);
3686 Lisp_Object obarray
;
3689 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3690 obarray
= check_obarray (obarray
);
3691 tem
= oblookup (obarray
, str
, len
, len
);
3695 if (NILP (Vpurify_flag
))
3696 /* Creating a non-pure string from a string literal not
3697 implemented yet. We could just use make_string here and live
3698 with the extra copy. */
3701 return Fintern (make_pure_c_string (str
), obarray
);
3704 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3705 doc
: /* Return the canonical symbol whose name is STRING.
3706 If there is none, one is created by this function and returned.
3707 A second optional argument specifies the obarray to use;
3708 it defaults to the value of `obarray'. */)
3709 (Lisp_Object string
, Lisp_Object obarray
)
3711 register Lisp_Object tem
, sym
, *ptr
;
3713 if (NILP (obarray
)) obarray
= Vobarray
;
3714 obarray
= check_obarray (obarray
);
3716 CHECK_STRING (string
);
3718 tem
= oblookup (obarray
, SSDATA (string
),
3721 if (!INTEGERP (tem
))
3724 if (!NILP (Vpurify_flag
))
3725 string
= Fpurecopy (string
);
3726 sym
= Fmake_symbol (string
);
3728 if (EQ (obarray
, initial_obarray
))
3729 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3731 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3733 if ((SREF (string
, 0) == ':')
3734 && EQ (obarray
, initial_obarray
))
3736 XSYMBOL (sym
)->constant
= 1;
3737 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3738 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3741 ptr
= &AREF (obarray
, XINT(tem
));
3743 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3745 XSYMBOL (sym
)->next
= 0;
3750 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3751 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3752 NAME may be a string or a symbol. If it is a symbol, that exact
3753 symbol is searched for.
3754 A second optional argument specifies the obarray to use;
3755 it defaults to the value of `obarray'. */)
3756 (Lisp_Object name
, Lisp_Object obarray
)
3758 register Lisp_Object tem
, string
;
3760 if (NILP (obarray
)) obarray
= Vobarray
;
3761 obarray
= check_obarray (obarray
);
3763 if (!SYMBOLP (name
))
3765 CHECK_STRING (name
);
3769 string
= SYMBOL_NAME (name
);
3771 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3772 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3778 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3779 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3780 The value is t if a symbol was found and deleted, nil otherwise.
3781 NAME may be a string or a symbol. If it is a symbol, that symbol
3782 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3783 OBARRAY defaults to the value of the variable `obarray'. */)
3784 (Lisp_Object name
, Lisp_Object obarray
)
3786 register Lisp_Object string
, tem
;
3789 if (NILP (obarray
)) obarray
= Vobarray
;
3790 obarray
= check_obarray (obarray
);
3793 string
= SYMBOL_NAME (name
);
3796 CHECK_STRING (name
);
3800 tem
= oblookup (obarray
, SSDATA (string
),
3805 /* If arg was a symbol, don't delete anything but that symbol itself. */
3806 if (SYMBOLP (name
) && !EQ (name
, tem
))
3809 /* There are plenty of other symbols which will screw up the Emacs
3810 session if we unintern them, as well as even more ways to use
3811 `setq' or `fset' or whatnot to make the Emacs session
3812 unusable. Let's not go down this silly road. --Stef */
3813 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3814 error ("Attempt to unintern t or nil"); */
3816 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3818 hash
= oblookup_last_bucket_number
;
3820 if (EQ (AREF (obarray
, hash
), tem
))
3822 if (XSYMBOL (tem
)->next
)
3823 XSETSYMBOL (AREF (obarray
, hash
), XSYMBOL (tem
)->next
);
3825 XSETINT (AREF (obarray
, hash
), 0);
3829 Lisp_Object tail
, following
;
3831 for (tail
= AREF (obarray
, hash
);
3832 XSYMBOL (tail
)->next
;
3835 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3836 if (EQ (following
, tem
))
3838 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3847 /* Return the symbol in OBARRAY whose names matches the string
3848 of SIZE characters (SIZE_BYTE bytes) at PTR.
3849 If there is no such symbol in OBARRAY, return nil.
3851 Also store the bucket number in oblookup_last_bucket_number. */
3854 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3858 register Lisp_Object tail
;
3859 Lisp_Object bucket
, tem
;
3861 if (!VECTORP (obarray
)
3862 || (obsize
= ASIZE (obarray
)) == 0)
3864 obarray
= check_obarray (obarray
);
3865 obsize
= ASIZE (obarray
);
3867 /* This is sometimes needed in the middle of GC. */
3868 obsize
&= ~ARRAY_MARK_FLAG
;
3869 hash
= hash_string (ptr
, size_byte
) % obsize
;
3870 bucket
= AREF (obarray
, hash
);
3871 oblookup_last_bucket_number
= hash
;
3872 if (EQ (bucket
, make_number (0)))
3874 else if (!SYMBOLP (bucket
))
3875 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3877 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3879 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3880 && SCHARS (SYMBOL_NAME (tail
)) == size
3881 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3883 else if (XSYMBOL (tail
)->next
== 0)
3886 XSETINT (tem
, hash
);
3891 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3894 register Lisp_Object tail
;
3895 CHECK_VECTOR (obarray
);
3896 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3898 tail
= AREF (obarray
, i
);
3903 if (XSYMBOL (tail
)->next
== 0)
3905 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3911 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3913 call1 (function
, sym
);
3916 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3917 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3918 OBARRAY defaults to the value of `obarray'. */)
3919 (Lisp_Object function
, Lisp_Object obarray
)
3921 if (NILP (obarray
)) obarray
= Vobarray
;
3922 obarray
= check_obarray (obarray
);
3924 map_obarray (obarray
, mapatoms_1
, function
);
3928 #define OBARRAY_SIZE 1511
3933 Lisp_Object oblength
;
3934 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3936 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3938 Vobarray
= Fmake_vector (oblength
, make_number (0));
3939 initial_obarray
= Vobarray
;
3940 staticpro (&initial_obarray
);
3942 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3943 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3944 NILP (Vpurify_flag) check in intern_c_string. */
3945 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3946 Qnil
= intern_c_string ("nil");
3948 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3949 so those two need to be fixed manually. */
3950 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3951 XSYMBOL (Qunbound
)->function
= Qunbound
;
3952 XSYMBOL (Qunbound
)->plist
= Qnil
;
3953 /* XSYMBOL (Qnil)->function = Qunbound; */
3954 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3955 XSYMBOL (Qnil
)->constant
= 1;
3956 XSYMBOL (Qnil
)->declared_special
= 1;
3957 XSYMBOL (Qnil
)->plist
= Qnil
;
3959 Qt
= intern_c_string ("t");
3960 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3961 XSYMBOL (Qnil
)->declared_special
= 1;
3962 XSYMBOL (Qt
)->constant
= 1;
3964 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3967 DEFSYM (Qvariable_documentation
, "variable-documentation");
3969 read_buffer
= xmalloc (size
);
3970 read_buffer_size
= size
;
3974 defsubr (struct Lisp_Subr
*sname
)
3977 sym
= intern_c_string (sname
->symbol_name
);
3978 XSETTYPED_PVECTYPE (sname
, size
, PVEC_SUBR
);
3979 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3982 #ifdef NOTDEF /* Use fset in subr.el now! */
3984 defalias (struct Lisp_Subr
*sname
, char *string
)
3987 sym
= intern (string
);
3988 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3992 /* Define an "integer variable"; a symbol whose value is forwarded to a
3993 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
3994 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3996 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3997 const char *namestring
, EMACS_INT
*address
)
4000 sym
= intern_c_string (namestring
);
4001 i_fwd
->type
= Lisp_Fwd_Int
;
4002 i_fwd
->intvar
= address
;
4003 XSYMBOL (sym
)->declared_special
= 1;
4004 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4005 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4008 /* Similar but define a variable whose value is t if address contains 1,
4009 nil if address contains 0. */
4011 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4012 const char *namestring
, int *address
)
4015 sym
= intern_c_string (namestring
);
4016 b_fwd
->type
= Lisp_Fwd_Bool
;
4017 b_fwd
->boolvar
= address
;
4018 XSYMBOL (sym
)->declared_special
= 1;
4019 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4020 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4021 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4024 /* Similar but define a variable whose value is the Lisp Object stored
4025 at address. Two versions: with and without gc-marking of the C
4026 variable. The nopro version is used when that variable will be
4027 gc-marked for some other reason, since marking the same slot twice
4028 can cause trouble with strings. */
4030 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4031 const char *namestring
, Lisp_Object
*address
)
4034 sym
= intern_c_string (namestring
);
4035 o_fwd
->type
= Lisp_Fwd_Obj
;
4036 o_fwd
->objvar
= address
;
4037 XSYMBOL (sym
)->declared_special
= 1;
4038 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4039 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4043 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4044 const char *namestring
, Lisp_Object
*address
)
4046 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4047 staticpro (address
);
4050 /* Similar but define a variable whose value is the Lisp Object stored
4051 at a particular offset in the current kboard object. */
4054 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4055 const char *namestring
, int offset
)
4058 sym
= intern_c_string (namestring
);
4059 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4060 ko_fwd
->offset
= offset
;
4061 XSYMBOL (sym
)->declared_special
= 1;
4062 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4063 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4066 /* Record the value of load-path used at the start of dumping
4067 so we can see if the site changed it later during dumping. */
4068 static Lisp_Object dump_path
;
4074 int turn_off_warning
= 0;
4076 /* Compute the default Vload-path, with the following logic:
4077 If CANNOT_DUMP, just use PATH_LOADSEARCH, prepending PATH_SITELOADSEARCH
4078 unless --no-site-lisp.
4079 Else if purify-flag (ie dumping) start from PATH_DUMPLOADSEARCH;
4080 otherwise start from PATH_LOADSEARCH.
4081 If !initialized, then just set both Vload_path and dump_path.
4082 If initialized, then if Vload_path != dump_path, do nothing.
4083 (Presumably the load-path has already been changed by something.
4084 This can only (?) be from a site-load file during dumping.)
4085 If Vinstallation_directory is not nil (ie, running uninstalled):
4086 Add installation-dir/lisp (if exists and not already a member),
4087 at the front, and turn off warnings about missing directories
4088 (because we are presumably running uninstalled).
4089 If it does not exist, add dump_path at the end instead.
4090 Add installation-dir/leim (if exists and not already a member)
4092 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4093 and not already a member) at the front.
4094 If installation-dir != source-dir (ie running an uninstalled,
4095 out-of-tree build) AND install-dir/src/Makefile exists BUT
4096 install-dir/src/Makefile.in does NOT exist (this is a sanity
4097 check), then repeat the above steps for source-dir/lisp,
4099 Finally, add the site-lisp directories at the front (if !no_site_lisp).
4101 We then warn about any of the load-path elements that do not
4102 exist. The only ones that might not exist are those from
4103 PATH_LOADSEARCH, and perhaps dump_path.
4105 Having done all this, we then throw it all away if purify-flag is
4106 nil (ie, not dumping) and EMACSLOADPATH is set, and just
4107 unconditionally use the latter value instead.
4108 So AFAICS the only net results of all the previous steps will be
4109 possibly to issue some irrelevant warnings.
4111 FIXME? There's a case for saying that if we are running
4112 uninstalled, the eventual installation directories should not yet
4113 be included in load-path.
4117 normal
= PATH_LOADSEARCH
;
4118 Vload_path
= decode_env_path (0, normal
);
4121 Lisp_Object sitelisp
;
4122 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4123 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4126 if (NILP (Vpurify_flag
))
4127 normal
= PATH_LOADSEARCH
;
4129 normal
= PATH_DUMPLOADSEARCH
;
4131 /* In a dumped Emacs, we normally reset the value of Vload_path using
4132 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4133 the source directory, instead of the path of the installed elisp
4134 libraries. However, if it appears that Vload_path has already been
4135 changed from the default that was saved before dumping, don't
4136 change it further. */
4139 if (! NILP (Fequal (dump_path
, Vload_path
)))
4141 Vload_path
= decode_env_path (0, normal
);
4142 if (!NILP (Vinstallation_directory
))
4144 Lisp_Object tem
, tem1
;
4146 /* Add to the path the lisp subdir of the
4147 installation dir, if it exists. */
4148 tem
= Fexpand_file_name (build_string ("lisp"),
4149 Vinstallation_directory
);
4150 tem1
= Ffile_exists_p (tem
);
4153 if (NILP (Fmember (tem
, Vload_path
)))
4155 turn_off_warning
= 1;
4156 Vload_path
= Fcons (tem
, Vload_path
);
4160 /* That dir doesn't exist, so add the build-time
4161 Lisp dirs instead. */
4162 Vload_path
= nconc2 (Vload_path
, dump_path
);
4164 /* Add leim under the installation dir, if it exists. */
4165 tem
= Fexpand_file_name (build_string ("leim"),
4166 Vinstallation_directory
);
4167 tem1
= Ffile_exists_p (tem
);
4170 if (NILP (Fmember (tem
, Vload_path
)))
4171 Vload_path
= Fcons (tem
, Vload_path
);
4174 /* Add site-lisp under the installation dir, if it exists. */
4177 tem
= Fexpand_file_name (build_string ("site-lisp"),
4178 Vinstallation_directory
);
4179 tem1
= Ffile_exists_p (tem
);
4182 if (NILP (Fmember (tem
, Vload_path
)))
4183 Vload_path
= Fcons (tem
, Vload_path
);
4187 /* If Emacs was not built in the source directory,
4188 and it is run from where it was built, add to load-path
4189 the lisp, leim and site-lisp dirs under that directory. */
4191 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4195 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4196 Vinstallation_directory
);
4197 tem1
= Ffile_exists_p (tem
);
4199 /* Don't be fooled if they moved the entire source tree
4200 AFTER dumping Emacs. If the build directory is indeed
4201 different from the source dir, src/Makefile.in and
4202 src/Makefile will not be found together. */
4203 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4204 Vinstallation_directory
);
4205 tem2
= Ffile_exists_p (tem
);
4206 if (!NILP (tem1
) && NILP (tem2
))
4208 tem
= Fexpand_file_name (build_string ("lisp"),
4211 if (NILP (Fmember (tem
, Vload_path
)))
4212 Vload_path
= Fcons (tem
, Vload_path
);
4214 tem
= Fexpand_file_name (build_string ("leim"),
4217 if (NILP (Fmember (tem
, Vload_path
)))
4218 Vload_path
= Fcons (tem
, Vload_path
);
4222 tem
= Fexpand_file_name (build_string ("site-lisp"),
4225 if (NILP (Fmember (tem
, Vload_path
)))
4226 Vload_path
= Fcons (tem
, Vload_path
);
4229 } /* Vinstallation_directory != Vsource_directory */
4231 } /* if Vinstallation_directory */
4233 /* Add the site-lisp directories at the front. */
4234 /* Note: If the site changed the load-path during dumping,
4235 --no-site-lisp is ignored. I don't know what to do about this.
4239 Lisp_Object sitelisp
;
4240 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4241 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4243 } /* if dump_path == Vload_path */
4245 else /* !initialized */
4247 /* NORMAL refers to the lisp dir in the source directory. */
4248 /* We used to add ../lisp at the front here, but
4249 that caused trouble because it was copied from dump_path
4250 into Vload_path, above, when Vinstallation_directory was non-nil.
4251 It should be unnecessary. */
4252 Vload_path
= decode_env_path (0, normal
);
4253 dump_path
= Vload_path
;
4255 #endif /* CANNOT_DUMP */
4257 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4258 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4259 almost never correct, thereby causing a warning to be printed out that
4260 confuses users. Since PATH_LOADSEARCH is always overridden by the
4261 EMACSLOADPATH environment variable below, disable the warning on NT. */
4263 /* HAVE_NS also uses EMACSLOADPATH. */
4265 /* Warn if dirs in the *standard* path don't exist. */
4266 if (!turn_off_warning
)
4268 Lisp_Object path_tail
;
4270 for (path_tail
= Vload_path
;
4272 path_tail
= XCDR (path_tail
))
4274 Lisp_Object dirfile
;
4275 dirfile
= Fcar (path_tail
);
4276 if (STRINGP (dirfile
))
4278 dirfile
= Fdirectory_file_name (dirfile
);
4279 /* Do we really need to warn about missing site-lisp dirs?
4280 It's true that the installation should have created
4281 them and added subdirs.el, but it's harmless if they
4283 if (access (SSDATA (dirfile
), 0) < 0)
4284 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4289 #endif /* !(WINDOWSNT || HAVE_NS) */
4291 /* If the EMACSLOADPATH environment variable is set, use its value.
4292 This doesn't apply if we're dumping. */
4294 if (NILP (Vpurify_flag
)
4295 && egetenv ("EMACSLOADPATH"))
4297 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4301 load_in_progress
= 0;
4302 Vload_file_name
= Qnil
;
4304 load_descriptor_list
= Qnil
;
4306 Vstandard_input
= Qt
;
4307 Vloads_in_progress
= Qnil
;
4310 /* Print a warning, using format string FORMAT, that directory DIRNAME
4311 does not exist. Print it on stderr and put it in *Messages*. */
4314 dir_warning (const char *format
, Lisp_Object dirname
)
4316 fprintf (stderr
, format
, SDATA (dirname
));
4318 /* Don't log the warning before we've initialized!! */
4322 ptrdiff_t message_len
;
4324 SAFE_ALLOCA (buffer
, char *,
4325 SBYTES (dirname
) + strlen (format
) - (sizeof "%s" - 1) + 1);
4326 message_len
= esprintf (buffer
, format
, SDATA (dirname
));
4327 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4333 syms_of_lread (void)
4336 defsubr (&Sread_from_string
);
4338 defsubr (&Sintern_soft
);
4339 defsubr (&Sunintern
);
4340 defsubr (&Sget_load_suffixes
);
4342 defsubr (&Seval_buffer
);
4343 defsubr (&Seval_region
);
4344 defsubr (&Sread_char
);
4345 defsubr (&Sread_char_exclusive
);
4346 defsubr (&Sread_event
);
4347 defsubr (&Sget_file_char
);
4348 defsubr (&Smapatoms
);
4349 defsubr (&Slocate_file_internal
);
4351 DEFVAR_LISP ("obarray", Vobarray
,
4352 doc
: /* Symbol table for use by `intern' and `read'.
4353 It is a vector whose length ought to be prime for best results.
4354 The vector's contents don't make sense if examined from Lisp programs;
4355 to find all the symbols in an obarray, use `mapatoms'. */);
4357 DEFVAR_LISP ("values", Vvalues
,
4358 doc
: /* List of values of all expressions which were read, evaluated and printed.
4359 Order is reverse chronological. */);
4360 XSYMBOL (intern ("values"))->declared_special
= 0;
4362 DEFVAR_LISP ("standard-input", Vstandard_input
,
4363 doc
: /* Stream for read to get input from.
4364 See documentation of `read' for possible values. */);
4365 Vstandard_input
= Qt
;
4367 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4368 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4370 If this variable is a buffer, then only forms read from that buffer
4371 will be added to `read-symbol-positions-list'.
4372 If this variable is t, then all read forms will be added.
4373 The effect of all other values other than nil are not currently
4374 defined, although they may be in the future.
4376 The positions are relative to the last call to `read' or
4377 `read-from-string'. It is probably a bad idea to set this variable at
4378 the toplevel; bind it instead. */);
4379 Vread_with_symbol_positions
= Qnil
;
4381 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4382 doc
: /* A list mapping read symbols to their positions.
4383 This variable is modified during calls to `read' or
4384 `read-from-string', but only when `read-with-symbol-positions' is
4387 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4388 CHAR-POSITION is an integer giving the offset of that occurrence of the
4389 symbol from the position where `read' or `read-from-string' started.
4391 Note that a symbol will appear multiple times in this list, if it was
4392 read multiple times. The list is in the same order as the symbols
4394 Vread_symbol_positions_list
= Qnil
;
4396 DEFVAR_LISP ("read-circle", Vread_circle
,
4397 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4400 DEFVAR_LISP ("load-path", Vload_path
,
4401 doc
: /* List of directories to search for files to load.
4402 Each element is a string (directory name) or nil (try default directory).
4403 Initialized based on EMACSLOADPATH environment variable, if any,
4404 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4406 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4407 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4408 This list should not include the empty string.
4409 `load' and related functions try to append these suffixes, in order,
4410 to the specified file name if a Lisp suffix is allowed or required. */);
4411 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4412 Fcons (make_pure_c_string (".el"), Qnil
));
4413 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4414 doc
: /* List of suffixes that indicate representations of \
4416 This list should normally start with the empty string.
4418 Enabling Auto Compression mode appends the suffixes in
4419 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4420 mode removes them again. `load' and related functions use this list to
4421 determine whether they should look for compressed versions of a file
4422 and, if so, which suffixes they should try to append to the file name
4423 in order to do so. However, if you want to customize which suffixes
4424 the loading functions recognize as compression suffixes, you should
4425 customize `jka-compr-load-suffixes' rather than the present variable. */);
4426 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4428 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4429 doc
: /* Non-nil if inside of `load'. */);
4430 DEFSYM (Qload_in_progress
, "load-in-progress");
4432 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4433 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4434 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4436 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4437 a symbol \(a feature name).
4439 When `load' is run and the file-name argument matches an element's
4440 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4441 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4443 An error in FORMS does not undo the load, but does prevent execution of
4444 the rest of the FORMS. */);
4445 Vafter_load_alist
= Qnil
;
4447 DEFVAR_LISP ("load-history", Vload_history
,
4448 doc
: /* Alist mapping loaded file names to symbols and features.
4449 Each alist element should be a list (FILE-NAME ENTRIES...), where
4450 FILE-NAME is the name of a file that has been loaded into Emacs.
4451 The file name is absolute and true (i.e. it doesn't contain symlinks).
4452 As an exception, one of the alist elements may have FILE-NAME nil,
4453 for symbols and features not associated with any file.
4455 The remaining ENTRIES in the alist element describe the functions and
4456 variables defined in that file, the features provided, and the
4457 features required. Each entry has the form `(provide . FEATURE)',
4458 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4459 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4460 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4461 autoload before this file redefined it as a function. In addition,
4462 entries may also be single symbols, which means that SYMBOL was
4463 defined by `defvar' or `defconst'.
4465 During preloading, the file name recorded is relative to the main Lisp
4466 directory. These file names are converted to absolute at startup. */);
4467 Vload_history
= Qnil
;
4469 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4470 doc
: /* Full name of file being loaded by `load'. */);
4471 Vload_file_name
= Qnil
;
4473 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4474 doc
: /* File name, including directory, of user's initialization file.
4475 If the file loaded had extension `.elc', and the corresponding source file
4476 exists, this variable contains the name of source file, suitable for use
4477 by functions like `custom-save-all' which edit the init file.
4478 While Emacs loads and evaluates the init file, value is the real name
4479 of the file, regardless of whether or not it has the `.elc' extension. */);
4480 Vuser_init_file
= Qnil
;
4482 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4483 doc
: /* Used for internal purposes by `load'. */);
4484 Vcurrent_load_list
= Qnil
;
4486 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4487 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4488 The default is nil, which means use the function `read'. */);
4489 Vload_read_function
= Qnil
;
4491 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4492 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4493 This function is for doing code conversion before reading the source file.
4494 If nil, loading is done without any code conversion.
4495 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4496 FULLNAME is the full name of FILE.
4497 See `load' for the meaning of the remaining arguments. */);
4498 Vload_source_file_function
= Qnil
;
4500 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4501 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4502 This is useful when the file being loaded is a temporary copy. */);
4503 load_force_doc_strings
= 0;
4505 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4506 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4507 This is normally bound by `load' and `eval-buffer' to control `read',
4508 and is not meant for users to change. */);
4509 load_convert_to_unibyte
= 0;
4511 DEFVAR_LISP ("source-directory", Vsource_directory
,
4512 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4513 You cannot count on them to still be there! */);
4515 = Fexpand_file_name (build_string ("../"),
4516 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4518 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4519 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4520 Vpreloaded_file_list
= Qnil
;
4522 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4523 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4524 Vbyte_boolean_vars
= Qnil
;
4526 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4527 doc
: /* Non-nil means load dangerous compiled Lisp files.
4528 Some versions of XEmacs use different byte codes than Emacs. These
4529 incompatible byte codes can make Emacs crash when it tries to execute
4531 load_dangerous_libraries
= 0;
4533 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4534 doc
: /* Non-nil means force printing messages when loading Lisp files.
4535 This overrides the value of the NOMESSAGE argument to `load'. */);
4536 force_load_messages
= 0;
4538 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4539 doc
: /* Regular expression matching safe to load compiled Lisp files.
4540 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4541 from the file, and matches them against this regular expression.
4542 When the regular expression matches, the file is considered to be safe
4543 to load. See also `load-dangerous-libraries'. */);
4544 Vbytecomp_version_regexp
4545 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4547 Qlexical_binding
= intern ("lexical-binding");
4548 staticpro (&Qlexical_binding
);
4549 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4550 doc
: /* Whether to use lexical binding when evaluating code.
4551 Non-nil means that the code in the current buffer should be evaluated
4552 with lexical binding.
4553 This variable is automatically set from the file variables of an
4554 interpreted Lisp file read using `load'. Unlike other file local
4555 variables, this must be set in the first line of a file. */);
4556 Fmake_variable_buffer_local (Qlexical_binding
);
4558 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4559 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4560 Veval_buffer_list
= Qnil
;
4562 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4563 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4564 Vold_style_backquotes
= Qnil
;
4565 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4567 /* Vsource_directory was initialized in init_lread. */
4569 load_descriptor_list
= Qnil
;
4570 staticpro (&load_descriptor_list
);
4572 DEFSYM (Qcurrent_load_list
, "current-load-list");
4573 DEFSYM (Qstandard_input
, "standard-input");
4574 DEFSYM (Qread_char
, "read-char");
4575 DEFSYM (Qget_file_char
, "get-file-char");
4576 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4577 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4579 DEFSYM (Qbackquote
, "`");
4580 DEFSYM (Qcomma
, ",");
4581 DEFSYM (Qcomma_at
, ",@");
4582 DEFSYM (Qcomma_dot
, ",.");
4584 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4585 DEFSYM (Qascii_character
, "ascii-character");
4586 DEFSYM (Qfunction
, "function");
4587 DEFSYM (Qload
, "load");
4588 DEFSYM (Qload_file_name
, "load-file-name");
4589 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4590 DEFSYM (Qfile_truename
, "file-truename");
4591 DEFSYM (Qdir_ok
, "dir-ok");
4592 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4594 staticpro (&dump_path
);
4596 staticpro (&read_objects
);
4597 read_objects
= Qnil
;
4598 staticpro (&seen_list
);
4601 Vloads_in_progress
= Qnil
;
4602 staticpro (&Vloads_in_progress
);
4604 DEFSYM (Qhash_table
, "hash-table");
4605 DEFSYM (Qdata
, "data");
4606 DEFSYM (Qtest
, "test");
4607 DEFSYM (Qsize
, "size");
4608 DEFSYM (Qweakness
, "weakness");
4609 DEFSYM (Qrehash_size
, "rehash-size");
4610 DEFSYM (Qrehash_threshold
, "rehash-threshold");