1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2012 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
27 #include <limits.h> /* For CHAR_BIT. */
30 #include "intervals.h"
31 #include "character.h"
39 #include "termhooks.h"
41 #include "blockinput.h"
52 #endif /* HAVE_SETLOCALE */
57 #define file_offset off_t
58 #define file_tell ftello
60 #define file_offset long
61 #define file_tell ftell
64 /* Hash table read constants. */
65 static Lisp_Object Qhash_table
, Qdata
;
66 static Lisp_Object Qtest
, Qsize
;
67 static Lisp_Object Qweakness
;
68 static Lisp_Object Qrehash_size
;
69 static Lisp_Object Qrehash_threshold
;
71 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
72 Lisp_Object Qstandard_input
;
73 Lisp_Object Qvariable_documentation
;
74 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
75 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
76 static Lisp_Object Qinhibit_file_name_operation
;
77 static Lisp_Object Qeval_buffer_list
;
78 static Lisp_Object Qlexical_binding
;
79 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
81 /* Used instead of Qget_file_char while loading *.elc files compiled
82 by Emacs 21 or older. */
83 static Lisp_Object Qget_emacs_mule_file_char
;
85 static Lisp_Object Qload_force_doc_strings
;
87 extern Lisp_Object Qinternal_interpreter_environment
;
89 static Lisp_Object Qload_in_progress
;
91 /* The association list of objects read with the #n=object form.
92 Each member of the list has the form (n . object), and is used to
93 look up the object for the corresponding #n# construct.
94 It must be set to nil before all top-level calls to read0. */
95 static Lisp_Object read_objects
;
97 /* Nonzero means READCHAR should read bytes one by one (not character)
98 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
99 This is set to 1 by read1 temporarily while handling #@NUMBER. */
100 static int load_each_byte
;
102 /* List of descriptors now open for Fload. */
103 static Lisp_Object load_descriptor_list
;
105 /* File for get_file_char to read from. Use by load. */
106 static FILE *instream
;
108 /* For use within read-from-string (this reader is non-reentrant!!) */
109 static ptrdiff_t read_from_string_index
;
110 static ptrdiff_t read_from_string_index_byte
;
111 static ptrdiff_t read_from_string_limit
;
113 /* Number of characters read in the current call to Fread or
114 Fread_from_string. */
115 static EMACS_INT readchar_count
;
117 /* This contains the last string skipped with #@. */
118 static char *saved_doc_string
;
119 /* Length of buffer allocated in saved_doc_string. */
120 static ptrdiff_t saved_doc_string_size
;
121 /* Length of actual data in saved_doc_string. */
122 static ptrdiff_t saved_doc_string_length
;
123 /* This is the file position that string came from. */
124 static file_offset saved_doc_string_position
;
126 /* This contains the previous string skipped with #@.
127 We copy it from saved_doc_string when a new string
128 is put in saved_doc_string. */
129 static char *prev_saved_doc_string
;
130 /* Length of buffer allocated in prev_saved_doc_string. */
131 static ptrdiff_t prev_saved_doc_string_size
;
132 /* Length of actual data in prev_saved_doc_string. */
133 static ptrdiff_t prev_saved_doc_string_length
;
134 /* This is the file position that string came from. */
135 static file_offset prev_saved_doc_string_position
;
137 /* Nonzero means inside a new-style backquote
138 with no surrounding parentheses.
139 Fread initializes this to zero, so we need not specbind it
140 or worry about what happens to it when there is an error. */
141 static int new_backquote_flag
;
142 static Lisp_Object Qold_style_backquotes
;
144 /* A list of file names for files being loaded in Fload. Used to
145 check for recursive loads. */
147 static Lisp_Object Vloads_in_progress
;
149 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
152 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
, int,
153 Lisp_Object
, Lisp_Object
,
154 Lisp_Object
, Lisp_Object
);
155 static Lisp_Object
load_unwind (Lisp_Object
);
156 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
158 /* Functions that read one byte from the current source READCHARFUN
159 or unreads one byte. If the integer argument C is -1, it returns
160 one read byte, or -1 when there's no more byte in the source. If C
161 is 0 or positive, it unreads C, and the return value is not
164 static int readbyte_for_lambda (int, Lisp_Object
);
165 static int readbyte_from_file (int, Lisp_Object
);
166 static int readbyte_from_string (int, Lisp_Object
);
168 /* Handle unreading and rereading of characters.
169 Write READCHAR to read a character,
170 UNREAD(c) to unread c to be read again.
172 These macros correctly read/unread multibyte characters. */
174 #define READCHAR readchar (readcharfun, NULL)
175 #define UNREAD(c) unreadchar (readcharfun, c)
177 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
178 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
180 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
181 Qlambda, or a cons, we use this to keep an unread character because
182 a file stream can't handle multibyte-char unreading. The value -1
183 means that there's no unread character. */
184 static int unread_char
;
187 readchar (Lisp_Object readcharfun
, int *multibyte
)
191 int (*readbyte
) (int, Lisp_Object
);
192 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
194 int emacs_mule_encoding
= 0;
201 if (BUFFERP (readcharfun
))
203 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
205 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
207 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
210 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
212 /* Fetch the character code from the buffer. */
213 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
214 BUF_INC_POS (inbuffer
, pt_byte
);
221 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
222 if (! ASCII_BYTE_P (c
))
223 c
= BYTE8_TO_CHAR (c
);
226 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
230 if (MARKERP (readcharfun
))
232 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
234 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
236 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
239 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
241 /* Fetch the character code from the buffer. */
242 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
243 BUF_INC_POS (inbuffer
, bytepos
);
250 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
251 if (! ASCII_BYTE_P (c
))
252 c
= BYTE8_TO_CHAR (c
);
256 XMARKER (readcharfun
)->bytepos
= bytepos
;
257 XMARKER (readcharfun
)->charpos
++;
262 if (EQ (readcharfun
, Qlambda
))
264 readbyte
= readbyte_for_lambda
;
268 if (EQ (readcharfun
, Qget_file_char
))
270 readbyte
= readbyte_from_file
;
274 if (STRINGP (readcharfun
))
276 if (read_from_string_index
>= read_from_string_limit
)
278 else if (STRING_MULTIBYTE (readcharfun
))
282 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
283 read_from_string_index
,
284 read_from_string_index_byte
);
288 c
= SREF (readcharfun
, read_from_string_index_byte
);
289 read_from_string_index
++;
290 read_from_string_index_byte
++;
295 if (CONSP (readcharfun
))
297 /* This is the case that read_vector is reading from a unibyte
298 string that contains a byte sequence previously skipped
299 because of #@NUMBER. The car part of readcharfun is that
300 string, and the cdr part is a value of readcharfun given to
302 readbyte
= readbyte_from_string
;
303 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
304 emacs_mule_encoding
= 1;
308 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
310 readbyte
= readbyte_from_file
;
311 emacs_mule_encoding
= 1;
315 tem
= call0 (readcharfun
);
322 if (unread_char
>= 0)
328 c
= (*readbyte
) (-1, readcharfun
);
329 if (c
< 0 || load_each_byte
)
333 if (ASCII_BYTE_P (c
))
335 if (emacs_mule_encoding
)
336 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
339 len
= BYTES_BY_CHAR_HEAD (c
);
342 c
= (*readbyte
) (-1, readcharfun
);
343 if (c
< 0 || ! TRAILING_CODE_P (c
))
346 (*readbyte
) (buf
[i
], readcharfun
);
347 return BYTE8_TO_CHAR (buf
[0]);
351 return STRING_CHAR (buf
);
354 /* Unread the character C in the way appropriate for the stream READCHARFUN.
355 If the stream is a user function, call it with the char as argument. */
358 unreadchar (Lisp_Object readcharfun
, int c
)
362 /* Don't back up the pointer if we're unreading the end-of-input mark,
363 since readchar didn't advance it when we read it. */
365 else if (BUFFERP (readcharfun
))
367 struct buffer
*b
= XBUFFER (readcharfun
);
368 ptrdiff_t charpos
= BUF_PT (b
);
369 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
371 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
372 BUF_DEC_POS (b
, bytepos
);
376 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
378 else if (MARKERP (readcharfun
))
380 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
381 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
383 XMARKER (readcharfun
)->charpos
--;
384 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
385 BUF_DEC_POS (b
, bytepos
);
389 XMARKER (readcharfun
)->bytepos
= bytepos
;
391 else if (STRINGP (readcharfun
))
393 read_from_string_index
--;
394 read_from_string_index_byte
395 = string_char_to_byte (readcharfun
, read_from_string_index
);
397 else if (CONSP (readcharfun
))
401 else if (EQ (readcharfun
, Qlambda
))
405 else if (EQ (readcharfun
, Qget_file_char
)
406 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
411 ungetc (c
, instream
);
418 call1 (readcharfun
, make_number (c
));
422 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
424 return read_bytecode_char (c
>= 0);
429 readbyte_from_file (int c
, Lisp_Object readcharfun
)
434 ungetc (c
, instream
);
443 /* Interrupted reads have been observed while reading over the network. */
444 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
456 return (c
== EOF
? -1 : c
);
460 readbyte_from_string (int c
, Lisp_Object readcharfun
)
462 Lisp_Object string
= XCAR (readcharfun
);
466 read_from_string_index
--;
467 read_from_string_index_byte
468 = string_char_to_byte (string
, read_from_string_index
);
471 if (read_from_string_index
>= read_from_string_limit
)
474 FETCH_STRING_CHAR_ADVANCE (c
, string
,
475 read_from_string_index
,
476 read_from_string_index_byte
);
481 /* Read one non-ASCII character from INSTREAM. The character is
482 encoded in `emacs-mule' and the first byte is already read in
486 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
488 /* Emacs-mule coding uses at most 4-byte for one character. */
489 unsigned char buf
[4];
490 int len
= emacs_mule_bytes
[c
];
491 struct charset
*charset
;
496 /* C is not a valid leading-code of `emacs-mule'. */
497 return BYTE8_TO_CHAR (c
);
503 c
= (*readbyte
) (-1, readcharfun
);
507 (*readbyte
) (buf
[i
], readcharfun
);
508 return BYTE8_TO_CHAR (buf
[0]);
515 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
516 code
= buf
[1] & 0x7F;
520 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
521 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
523 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
524 code
= buf
[2] & 0x7F;
528 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
529 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
534 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
535 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
537 c
= DECODE_CHAR (charset
, code
);
539 Fsignal (Qinvalid_read_syntax
,
540 Fcons (build_string ("invalid multibyte form"), Qnil
));
545 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
547 static Lisp_Object
read0 (Lisp_Object
);
548 static Lisp_Object
read1 (Lisp_Object
, int *, int);
550 static Lisp_Object
read_list (int, Lisp_Object
);
551 static Lisp_Object
read_vector (Lisp_Object
, int);
553 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
555 static void substitute_object_in_subtree (Lisp_Object
,
557 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
560 /* Get a character from the tty. */
562 /* Read input events until we get one that's acceptable for our purposes.
564 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
565 until we get a character we like, and then stuffed into
568 If ASCII_REQUIRED is non-zero, we check function key events to see
569 if the unmodified version of the symbol has a Qascii_character
570 property, and use that character, if present.
572 If ERROR_NONASCII is non-zero, we signal an error if the input we
573 get isn't an ASCII character with modifiers. If it's zero but
574 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
577 If INPUT_METHOD is nonzero, we invoke the current input method
578 if the character warrants that.
580 If SECONDS is a number, we wait that many seconds for input, and
581 return Qnil if no input arrives within that time. */
584 read_filtered_event (int no_switch_frame
, int ascii_required
,
585 int error_nonascii
, int input_method
, Lisp_Object seconds
)
587 Lisp_Object val
, delayed_switch_frame
;
590 #ifdef HAVE_WINDOW_SYSTEM
591 if (display_hourglass_p
)
595 delayed_switch_frame
= Qnil
;
597 /* Compute timeout. */
598 if (NUMBERP (seconds
))
600 double duration
= extract_float (seconds
);
601 EMACS_TIME wait_time
= EMACS_TIME_FROM_DOUBLE (duration
);
602 EMACS_GET_TIME (end_time
);
603 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
606 /* Read until we get an acceptable event. */
609 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
610 NUMBERP (seconds
) ? &end_time
: NULL
);
611 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
616 /* switch-frame events are put off until after the next ASCII
617 character. This is better than signaling an error just because
618 the last characters were typed to a separate minibuffer frame,
619 for example. Eventually, some code which can deal with
620 switch-frame events will read it and process it. */
622 && EVENT_HAS_PARAMETERS (val
)
623 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
625 delayed_switch_frame
= val
;
629 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
631 /* Convert certain symbols to their ASCII equivalents. */
634 Lisp_Object tem
, tem1
;
635 tem
= Fget (val
, Qevent_symbol_element_mask
);
638 tem1
= Fget (Fcar (tem
), Qascii_character
);
639 /* Merge this symbol's modifier bits
640 with the ASCII equivalent of its basic code. */
642 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
646 /* If we don't have a character now, deal with it appropriately. */
651 Vunread_command_events
= Fcons (val
, Qnil
);
652 error ("Non-character input-event");
659 if (! NILP (delayed_switch_frame
))
660 unread_switch_frame
= delayed_switch_frame
;
664 #ifdef HAVE_WINDOW_SYSTEM
665 if (display_hourglass_p
)
674 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
675 doc
: /* Read a character from the command input (keyboard or macro).
676 It is returned as a number.
677 If the character has modifiers, they are resolved and reflected to the
678 character code if possible (e.g. C-SPC -> 0).
680 If the user generates an event which is not a character (i.e. a mouse
681 click or function key event), `read-char' signals an error. As an
682 exception, switch-frame events are put off until non-character events
684 If you want to read non-character events, or ignore them, call
685 `read-event' or `read-char-exclusive' instead.
687 If the optional argument PROMPT is non-nil, display that as a prompt.
688 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
689 input method is turned on in the current buffer, that input method
690 is used for reading a character.
691 If the optional argument SECONDS is non-nil, it should be a number
692 specifying the maximum number of seconds to wait for input. If no
693 input arrives in that time, return nil. SECONDS may be a
694 floating-point value. */)
695 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
700 message_with_string ("%s", prompt
, 0);
701 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
703 return (NILP (val
) ? Qnil
704 : make_number (char_resolve_modifier_mask (XINT (val
))));
707 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
708 doc
: /* Read an event object from the input stream.
709 If the optional argument PROMPT is non-nil, display that as a prompt.
710 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
711 input method is turned on in the current buffer, that input method
712 is used for reading a character.
713 If the optional argument SECONDS is non-nil, it should be a number
714 specifying the maximum number of seconds to wait for input. If no
715 input arrives in that time, return nil. SECONDS may be a
716 floating-point value. */)
717 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
720 message_with_string ("%s", prompt
, 0);
721 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
724 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
725 doc
: /* Read a character from the command input (keyboard or macro).
726 It is returned as a number. Non-character events are ignored.
727 If the character has modifiers, they are resolved and reflected to the
728 character code if possible (e.g. C-SPC -> 0).
730 If the optional argument PROMPT is non-nil, display that as a prompt.
731 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
732 input method is turned on in the current buffer, that input method
733 is used for reading a character.
734 If the optional argument SECONDS is non-nil, it should be a number
735 specifying the maximum number of seconds to wait for input. If no
736 input arrives in that time, return nil. SECONDS may be a
737 floating-point value. */)
738 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
743 message_with_string ("%s", prompt
, 0);
745 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
747 return (NILP (val
) ? Qnil
748 : make_number (char_resolve_modifier_mask (XINT (val
))));
751 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
752 doc
: /* Don't use this yourself. */)
755 register Lisp_Object val
;
757 XSETINT (val
, getc (instream
));
765 /* Return true if the lisp code read using READCHARFUN defines a non-nil
766 `lexical-binding' file variable. After returning, the stream is
767 positioned following the first line, if it is a comment, otherwise
771 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
775 /* The first line isn't a comment, just give up. */
781 /* Look for an appropriate file-variable in the first line. */
785 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
786 } beg_end_state
= NOMINAL
;
787 int in_file_vars
= 0;
789 #define UPDATE_BEG_END_STATE(ch) \
790 if (beg_end_state == NOMINAL) \
791 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
792 else if (beg_end_state == AFTER_FIRST_DASH) \
793 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
794 else if (beg_end_state == AFTER_ASTERIX) \
797 in_file_vars = !in_file_vars; \
798 beg_end_state = NOMINAL; \
801 /* Skip until we get to the file vars, if any. */
805 UPDATE_BEG_END_STATE (ch
);
807 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
811 char var
[100], val
[100];
816 /* Read a variable name. */
817 while (ch
== ' ' || ch
== '\t')
821 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
823 if (i
< sizeof var
- 1)
825 UPDATE_BEG_END_STATE (ch
);
829 /* Stop scanning if no colon was found before end marker. */
830 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
833 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
839 /* Read a variable value. */
842 while (ch
== ' ' || ch
== '\t')
846 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
848 if (i
< sizeof val
- 1)
850 UPDATE_BEG_END_STATE (ch
);
854 /* The value was terminated by an end-marker, which remove. */
856 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
860 if (strcmp (var
, "lexical-binding") == 0)
863 rv
= (strcmp (val
, "nil") != 0);
869 while (ch
!= '\n' && ch
!= EOF
)
876 /* Value is a version number of byte compiled code if the file
877 associated with file descriptor FD is a compiled Lisp file that's
878 safe to load. Only files compiled with Emacs are safe to load.
879 Files compiled with XEmacs can lead to a crash in Fbyte_code
880 because of an incompatible change in the byte compiler. */
883 safe_to_load_p (int fd
)
890 /* Read the first few bytes from the file, and look for a line
891 specifying the byte compiler version used. */
892 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
897 /* Skip to the next newline, skipping over the initial `ELC'
898 with NUL bytes following it, but note the version. */
899 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
904 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
911 lseek (fd
, 0, SEEK_SET
);
916 /* Callback for record_unwind_protect. Restore the old load list OLD,
917 after loading a file successfully. */
920 record_load_unwind (Lisp_Object old
)
922 return Vloads_in_progress
= old
;
925 /* This handler function is used via internal_condition_case_1. */
928 load_error_handler (Lisp_Object data
)
934 load_warn_old_style_backquotes (Lisp_Object file
)
936 if (!NILP (Vold_style_backquotes
))
939 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
946 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
947 doc
: /* Return the suffixes that `load' should try if a suffix is \
949 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
952 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
953 while (CONSP (suffixes
))
955 Lisp_Object exts
= Vload_file_rep_suffixes
;
956 suffix
= XCAR (suffixes
);
957 suffixes
= XCDR (suffixes
);
962 lst
= Fcons (concat2 (suffix
, ext
), lst
);
965 return Fnreverse (lst
);
968 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
969 doc
: /* Execute a file of Lisp code named FILE.
970 First try FILE with `.elc' appended, then try with `.el',
971 then try FILE unmodified (the exact suffixes in the exact order are
972 determined by `load-suffixes'). Environment variable references in
973 FILE are replaced with their values by calling `substitute-in-file-name'.
974 This function searches the directories in `load-path'.
976 If optional second arg NOERROR is non-nil,
977 report no error if FILE doesn't exist.
978 Print messages at start and end of loading unless
979 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
981 If optional fourth arg NOSUFFIX is non-nil, don't try adding
982 suffixes `.elc' or `.el' to the specified name FILE.
983 If optional fifth arg MUST-SUFFIX is non-nil, insist on
984 the suffix `.elc' or `.el'; don't accept just FILE unless
985 it ends in one of those suffixes or includes a directory name.
987 If this function fails to find a file, it may look for different
988 representations of that file before trying another file.
989 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
990 to the file name. Emacs uses this feature mainly to find compressed
991 versions of files when Auto Compression mode is enabled.
993 The exact suffixes that this function tries out, in the exact order,
994 are given by the value of the variable `load-file-rep-suffixes' if
995 NOSUFFIX is non-nil and by the return value of the function
996 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
997 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1000 Loading a file records its definitions, and its `provide' and
1001 `require' calls, in an element of `load-history' whose
1002 car is the file name loaded. See `load-history'.
1004 While the file is in the process of being loaded, the variable
1005 `load-in-progress' is non-nil and the variable `load-file-name'
1006 is bound to the file's name.
1008 Return t if the file exists and loads successfully. */)
1009 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1011 register FILE *stream
;
1012 register int fd
= -1;
1013 ptrdiff_t count
= SPECPDL_INDEX ();
1014 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1015 Lisp_Object found
, efound
, hist_file_name
;
1016 /* 1 means we printed the ".el is newer" message. */
1018 /* 1 means we are loading a compiled file. */
1020 Lisp_Object handler
;
1022 const char *fmode
= "r";
1030 CHECK_STRING (file
);
1032 /* If file name is magic, call the handler. */
1033 /* This shouldn't be necessary any more now that `openp' handles it right.
1034 handler = Ffind_file_name_handler (file, Qload);
1035 if (!NILP (handler))
1036 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1038 /* Do this after the handler to avoid
1039 the need to gcpro noerror, nomessage and nosuffix.
1040 (Below here, we care only whether they are nil or not.)
1041 The presence of this call is the result of a historical accident:
1042 it used to be in every file-operation and when it got removed
1043 everywhere, it accidentally stayed here. Since then, enough people
1044 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1045 that it seemed risky to remove. */
1046 if (! NILP (noerror
))
1048 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1049 Qt
, load_error_handler
);
1054 file
= Fsubstitute_in_file_name (file
);
1057 /* Avoid weird lossage with null string as arg,
1058 since it would try to load a directory as a Lisp file. */
1059 if (SBYTES (file
) > 0)
1061 ptrdiff_t size
= SBYTES (file
);
1064 GCPRO2 (file
, found
);
1066 if (! NILP (must_suffix
))
1068 /* Don't insist on adding a suffix if FILE already ends with one. */
1070 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1073 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1075 /* Don't insist on adding a suffix
1076 if the argument includes a directory name. */
1077 else if (! NILP (Ffile_name_directory (file
)))
1081 fd
= openp (Vload_path
, file
,
1082 (!NILP (nosuffix
) ? Qnil
1083 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1084 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1085 tmp
[1] = Vload_file_rep_suffixes
,
1094 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1098 /* Tell startup.el whether or not we found the user's init file. */
1099 if (EQ (Qt
, Vuser_init_file
))
1100 Vuser_init_file
= found
;
1102 /* If FD is -2, that means openp found a magic file. */
1105 if (NILP (Fequal (found
, file
)))
1106 /* If FOUND is a different file name from FILE,
1107 find its handler even if we have already inhibited
1108 the `load' operation on FILE. */
1109 handler
= Ffind_file_name_handler (found
, Qt
);
1111 handler
= Ffind_file_name_handler (found
, Qload
);
1112 if (! NILP (handler
))
1113 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1115 /* Tramp has to deal with semi-broken packages that prepend
1116 drive letters to remote files. For that reason, Tramp
1117 catches file operations that test for file existence, which
1118 makes openp think X:/foo.elc files are remote. However,
1119 Tramp does not catch `load' operations for such files, so we
1120 end up with a nil as the `load' handler above. If we would
1121 continue with fd = -2, we will behave wrongly, and in
1122 particular try reading a .elc file in the "rt" mode instead
1123 of "rb". See bug #9311 for the results. To work around
1124 this, we try to open the file locally, and go with that if it
1126 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1132 /* Check if we're stuck in a recursive load cycle.
1134 2000-09-21: It's not possible to just check for the file loaded
1135 being a member of Vloads_in_progress. This fails because of the
1136 way the byte compiler currently works; `provide's are not
1137 evaluated, see font-lock.el/jit-lock.el as an example. This
1138 leads to a certain amount of ``normal'' recursion.
1140 Also, just loading a file recursively is not always an error in
1141 the general case; the second load may do something different. */
1145 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1146 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1150 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1152 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1153 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1156 /* All loads are by default dynamic, unless the file itself specifies
1157 otherwise using a file-variable in the first line. This is bound here
1158 so that it takes effect whether or not we use
1159 Vload_source_file_function. */
1160 specbind (Qlexical_binding
, Qnil
);
1162 /* Get the name for load-history. */
1163 hist_file_name
= (! NILP (Vpurify_flag
)
1164 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1165 tmp
[1] = Ffile_name_nondirectory (found
),
1171 /* Check for the presence of old-style quotes and warn about them. */
1172 specbind (Qold_style_backquotes
, Qnil
);
1173 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1175 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1176 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1177 /* Load .elc files directly, but not when they are
1178 remote and have no handler! */
1185 GCPRO3 (file
, found
, hist_file_name
);
1188 && ! (version
= safe_to_load_p (fd
)))
1191 if (!load_dangerous_libraries
)
1195 error ("File `%s' was not compiled in Emacs",
1198 else if (!NILP (nomessage
) && !force_load_messages
)
1199 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1204 efound
= ENCODE_FILE (found
);
1209 result
= stat (SSDATA (efound
), &s1
);
1212 SSET (efound
, SBYTES (efound
) - 1, 0);
1213 result
= stat (SSDATA (efound
), &s2
);
1214 SSET (efound
, SBYTES (efound
) - 1, 'c');
1217 if (result
== 0 && s1
.st_mtime
< s2
.st_mtime
)
1219 /* Make the progress messages mention that source is newer. */
1222 /* If we won't print another message, mention this anyway. */
1223 if (!NILP (nomessage
) && !force_load_messages
)
1225 Lisp_Object msg_file
;
1226 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1227 message_with_string ("Source file `%s' newer than byte-compiled file",
1236 /* We are loading a source file (*.el). */
1237 if (!NILP (Vload_source_file_function
))
1243 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1244 NILP (noerror
) ? Qnil
: Qt
,
1245 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1246 return unbind_to (count
, val
);
1250 GCPRO3 (file
, found
, hist_file_name
);
1253 efound
= ENCODE_FILE (found
);
1254 /* If we somehow got here with fd == -2, meaning the file is deemed
1255 to be remote, don't even try to reopen the file locally; just
1256 force a failure instead. */
1260 stream
= fopen (SSDATA (efound
), fmode
);
1264 #else /* not WINDOWSNT */
1265 stream
= fdopen (fd
, fmode
);
1266 #endif /* not WINDOWSNT */
1270 error ("Failure to create stdio stream for %s", SDATA (file
));
1273 if (! NILP (Vpurify_flag
))
1274 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1276 if (NILP (nomessage
) || force_load_messages
)
1279 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1282 message_with_string ("Loading %s (source)...", file
, 1);
1284 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1286 else /* The typical case; compiled file newer than source file. */
1287 message_with_string ("Loading %s...", file
, 1);
1290 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1291 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1292 specbind (Qload_file_name
, found
);
1293 specbind (Qinhibit_file_name_operation
, Qnil
);
1294 load_descriptor_list
1295 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1296 specbind (Qload_in_progress
, Qt
);
1299 if (lisp_file_lexically_bound_p (Qget_file_char
))
1300 Fset (Qlexical_binding
, Qt
);
1302 if (! version
|| version
>= 22)
1303 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1304 0, Qnil
, Qnil
, Qnil
, Qnil
);
1307 /* We can't handle a file which was compiled with
1308 byte-compile-dynamic by older version of Emacs. */
1309 specbind (Qload_force_doc_strings
, Qt
);
1310 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1311 0, Qnil
, Qnil
, Qnil
, Qnil
);
1313 unbind_to (count
, Qnil
);
1315 /* Run any eval-after-load forms for this file. */
1316 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1317 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1321 xfree (saved_doc_string
);
1322 saved_doc_string
= 0;
1323 saved_doc_string_size
= 0;
1325 xfree (prev_saved_doc_string
);
1326 prev_saved_doc_string
= 0;
1327 prev_saved_doc_string_size
= 0;
1329 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1332 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1335 message_with_string ("Loading %s (source)...done", file
, 1);
1337 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1339 else /* The typical case; compiled file newer than source file. */
1340 message_with_string ("Loading %s...done", file
, 1);
1347 load_unwind (Lisp_Object arg
) /* Used as unwind-protect function in load. */
1349 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1360 load_descriptor_unwind (Lisp_Object oldlist
)
1362 load_descriptor_list
= oldlist
;
1366 /* Close all descriptors in use for Floads.
1367 This is used when starting a subprocess. */
1370 close_load_descs (void)
1374 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1375 emacs_close (XFASTINT (XCAR (tail
)));
1380 complete_filename_p (Lisp_Object pathname
)
1382 register const unsigned char *s
= SDATA (pathname
);
1383 return (IS_DIRECTORY_SEP (s
[0])
1384 || (SCHARS (pathname
) > 2
1385 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1388 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1389 doc
: /* Search for FILENAME through PATH.
1390 Returns the file's name in absolute form, or nil if not found.
1391 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1392 file name when searching.
1393 If non-nil, PREDICATE is used instead of `file-readable-p'.
1394 PREDICATE can also be an integer to pass to the access(2) function,
1395 in which case file-name-handlers are ignored.
1396 This function will normally skip directories, so if you want it to find
1397 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1398 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1401 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1402 if (NILP (predicate
) && fd
> 0)
1407 static Lisp_Object Qdir_ok
;
1409 /* Search for a file whose name is STR, looking in directories
1410 in the Lisp list PATH, and trying suffixes from SUFFIX.
1411 On success, returns a file descriptor. On failure, returns -1.
1413 SUFFIXES is a list of strings containing possible suffixes.
1414 The empty suffix is automatically added if the list is empty.
1416 PREDICATE non-nil means don't open the files,
1417 just look for one that satisfies the predicate. In this case,
1418 returns 1 on success. The predicate can be a lisp function or
1419 an integer to pass to `access' (in which case file-name-handlers
1422 If STOREPTR is nonzero, it points to a slot where the name of
1423 the file actually found should be stored as a Lisp string.
1424 nil is stored there on failure.
1426 If the file we find is remote, return -2
1427 but store the found remote file name in *STOREPTR. */
1430 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1433 ptrdiff_t fn_size
= 100;
1435 register char *fn
= buf
;
1437 ptrdiff_t want_length
;
1438 Lisp_Object filename
;
1440 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1441 Lisp_Object string
, tail
, encoded_fn
;
1442 ptrdiff_t max_suffix_len
= 0;
1446 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1448 CHECK_STRING_CAR (tail
);
1449 max_suffix_len
= max (max_suffix_len
,
1450 SBYTES (XCAR (tail
)));
1453 string
= filename
= encoded_fn
= Qnil
;
1454 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1459 if (complete_filename_p (str
))
1462 for (; CONSP (path
); path
= XCDR (path
))
1464 filename
= Fexpand_file_name (str
, XCAR (path
));
1465 if (!complete_filename_p (filename
))
1466 /* If there are non-absolute elts in PATH (eg "."). */
1467 /* Of course, this could conceivably lose if luser sets
1468 default-directory to be something non-absolute... */
1470 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1471 if (!complete_filename_p (filename
))
1472 /* Give up on this path element! */
1476 /* Calculate maximum length of any filename made from
1477 this path element/specified file name and any possible suffix. */
1478 want_length
= max_suffix_len
+ SBYTES (filename
);
1479 if (fn_size
<= want_length
)
1480 fn
= (char *) alloca (fn_size
= 100 + want_length
);
1482 /* Loop over suffixes. */
1483 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1484 CONSP (tail
); tail
= XCDR (tail
))
1486 ptrdiff_t lsuffix
= SBYTES (XCAR (tail
));
1487 Lisp_Object handler
;
1490 /* Concatenate path element/specified name with the suffix.
1491 If the directory starts with /:, remove that. */
1492 if (SCHARS (filename
) > 2
1493 && SREF (filename
, 0) == '/'
1494 && SREF (filename
, 1) == ':')
1496 strncpy (fn
, SSDATA (filename
) + 2,
1497 SBYTES (filename
) - 2);
1498 fn
[SBYTES (filename
) - 2] = 0;
1502 strncpy (fn
, SSDATA (filename
),
1504 fn
[SBYTES (filename
)] = 0;
1507 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1508 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1510 /* Check that the file exists and is not a directory. */
1511 /* We used to only check for handlers on non-absolute file names:
1515 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1516 It's not clear why that was the case and it breaks things like
1517 (load "/bar.el") where the file is actually "/bar.el.gz". */
1518 string
= build_string (fn
);
1519 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1520 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1522 if (NILP (predicate
))
1523 exists
= !NILP (Ffile_readable_p (string
));
1526 Lisp_Object tmp
= call1 (predicate
, string
);
1527 exists
= !NILP (tmp
)
1528 && (EQ (tmp
, Qdir_ok
)
1529 || NILP (Ffile_directory_p (string
)));
1534 /* We succeeded; return this descriptor and filename. */
1545 encoded_fn
= ENCODE_FILE (string
);
1546 pfn
= SSDATA (encoded_fn
);
1547 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1550 /* Check that we can access or open it. */
1551 if (NATNUMP (predicate
))
1552 fd
= (((XFASTINT (predicate
) & ~INT_MAX
) == 0
1553 && access (pfn
, XFASTINT (predicate
)) == 0)
1556 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1560 /* We succeeded; return this descriptor and filename. */
1578 /* Merge the list we've accumulated of globals from the current input source
1579 into the load_history variable. The details depend on whether
1580 the source has an associated file name or not.
1582 FILENAME is the file name that we are loading from.
1583 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1586 build_load_history (Lisp_Object filename
, int entire
)
1588 register Lisp_Object tail
, prev
, newelt
;
1589 register Lisp_Object tem
, tem2
;
1590 register int foundit
= 0;
1592 tail
= Vload_history
;
1595 while (CONSP (tail
))
1599 /* Find the feature's previous assoc list... */
1600 if (!NILP (Fequal (filename
, Fcar (tem
))))
1604 /* If we're loading the entire file, remove old data. */
1608 Vload_history
= XCDR (tail
);
1610 Fsetcdr (prev
, XCDR (tail
));
1613 /* Otherwise, cons on new symbols that are not already members. */
1616 tem2
= Vcurrent_load_list
;
1618 while (CONSP (tem2
))
1620 newelt
= XCAR (tem2
);
1622 if (NILP (Fmember (newelt
, tem
)))
1623 Fsetcar (tail
, Fcons (XCAR (tem
),
1624 Fcons (newelt
, XCDR (tem
))));
1637 /* If we're loading an entire file, cons the new assoc onto the
1638 front of load-history, the most-recently-loaded position. Also
1639 do this if we didn't find an existing member for the file. */
1640 if (entire
|| !foundit
)
1641 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1646 readevalloop_1 (Lisp_Object old
)
1648 load_convert_to_unibyte
= ! NILP (old
);
1652 /* Signal an `end-of-file' error, if possible with file name
1655 static _Noreturn
void
1656 end_of_file_error (void)
1658 if (STRINGP (Vload_file_name
))
1659 xsignal1 (Qend_of_file
, Vload_file_name
);
1661 xsignal0 (Qend_of_file
);
1664 /* UNIBYTE specifies how to set load_convert_to_unibyte
1665 for this invocation.
1666 READFUN, if non-nil, is used instead of `read'.
1668 START, END specify region to read in current buffer (from eval-region).
1669 If the input is not from a buffer, they must be nil. */
1672 readevalloop (Lisp_Object readcharfun
,
1674 Lisp_Object sourcename
,
1676 Lisp_Object unibyte
, Lisp_Object readfun
,
1677 Lisp_Object start
, Lisp_Object end
)
1680 register Lisp_Object val
;
1681 ptrdiff_t count
= SPECPDL_INDEX ();
1682 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1683 struct buffer
*b
= 0;
1684 int continue_reading_p
;
1685 Lisp_Object lex_bound
;
1686 /* Nonzero if reading an entire buffer. */
1687 int whole_buffer
= 0;
1688 /* 1 on the first time around. */
1691 if (MARKERP (readcharfun
))
1694 start
= readcharfun
;
1697 if (BUFFERP (readcharfun
))
1698 b
= XBUFFER (readcharfun
);
1699 else if (MARKERP (readcharfun
))
1700 b
= XMARKER (readcharfun
)->buffer
;
1702 /* We assume START is nil when input is not from a buffer. */
1703 if (! NILP (start
) && !b
)
1706 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1707 specbind (Qcurrent_load_list
, Qnil
);
1708 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1709 load_convert_to_unibyte
= !NILP (unibyte
);
1711 /* If lexical binding is active (either because it was specified in
1712 the file's header, or via a buffer-local variable), create an empty
1713 lexical environment, otherwise, turn off lexical binding. */
1714 lex_bound
= find_symbol_value (Qlexical_binding
);
1715 specbind (Qinternal_interpreter_environment
,
1716 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1717 ? Qnil
: Fcons (Qt
, Qnil
));
1719 GCPRO4 (sourcename
, readfun
, start
, end
);
1721 /* Try to ensure sourcename is a truename, except whilst preloading. */
1722 if (NILP (Vpurify_flag
)
1723 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1724 && !NILP (Ffboundp (Qfile_truename
)))
1725 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1727 LOADHIST_ATTACH (sourcename
);
1729 continue_reading_p
= 1;
1730 while (continue_reading_p
)
1732 ptrdiff_t count1
= SPECPDL_INDEX ();
1734 if (b
!= 0 && NILP (BVAR (b
, name
)))
1735 error ("Reading from killed buffer");
1739 /* Switch to the buffer we are reading from. */
1740 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1741 set_buffer_internal (b
);
1743 /* Save point in it. */
1744 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1745 /* Save ZV in it. */
1746 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1747 /* Those get unbound after we read one expression. */
1749 /* Set point and ZV around stuff to be read. */
1752 Fnarrow_to_region (make_number (BEGV
), end
);
1754 /* Just for cleanliness, convert END to a marker
1755 if it is an integer. */
1757 end
= Fpoint_max_marker ();
1760 /* On the first cycle, we can easily test here
1761 whether we are reading the whole buffer. */
1762 if (b
&& first_sexp
)
1763 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1770 while ((c
= READCHAR
) != '\n' && c
!= -1);
1775 unbind_to (count1
, Qnil
);
1779 /* Ignore whitespace here, so we can detect eof. */
1780 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1781 || c
== 0xa0) /* NBSP */
1784 if (!NILP (Vpurify_flag
) && c
== '(')
1786 val
= read_list (0, readcharfun
);
1791 read_objects
= Qnil
;
1792 if (!NILP (readfun
))
1794 val
= call1 (readfun
, readcharfun
);
1796 /* If READCHARFUN has set point to ZV, we should
1797 stop reading, even if the form read sets point
1798 to a different value when evaluated. */
1799 if (BUFFERP (readcharfun
))
1801 struct buffer
*buf
= XBUFFER (readcharfun
);
1802 if (BUF_PT (buf
) == BUF_ZV (buf
))
1803 continue_reading_p
= 0;
1806 else if (! NILP (Vload_read_function
))
1807 val
= call1 (Vload_read_function
, readcharfun
);
1809 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1812 if (!NILP (start
) && continue_reading_p
)
1813 start
= Fpoint_marker ();
1815 /* Restore saved point and BEGV. */
1816 unbind_to (count1
, Qnil
);
1818 /* Now eval what we just read. */
1819 val
= eval_sub (val
);
1823 Vvalues
= Fcons (val
, Vvalues
);
1824 if (EQ (Vstandard_output
, Qt
))
1833 build_load_history (sourcename
,
1834 stream
|| whole_buffer
);
1838 unbind_to (count
, Qnil
);
1841 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1842 doc
: /* Execute the current buffer as Lisp code.
1843 When called from a Lisp program (i.e., not interactively), this
1844 function accepts up to five optional arguments:
1845 BUFFER is the buffer to evaluate (nil means use current buffer).
1846 PRINTFLAG controls printing of output:
1847 A value of nil means discard it; anything else is stream for print.
1848 FILENAME specifies the file name to use for `load-history'.
1849 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1851 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1852 functions should work normally even if PRINTFLAG is nil.
1854 This function preserves the position of point. */)
1855 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1857 ptrdiff_t count
= SPECPDL_INDEX ();
1858 Lisp_Object tem
, buf
;
1861 buf
= Fcurrent_buffer ();
1863 buf
= Fget_buffer (buffer
);
1865 error ("No such buffer");
1867 if (NILP (printflag
) && NILP (do_allow_print
))
1872 if (NILP (filename
))
1873 filename
= BVAR (XBUFFER (buf
), filename
);
1875 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1876 specbind (Qstandard_output
, tem
);
1877 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1878 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1879 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1880 readevalloop (buf
, 0, filename
,
1881 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1882 unbind_to (count
, Qnil
);
1887 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1888 doc
: /* Execute the region as Lisp code.
1889 When called from programs, expects two arguments,
1890 giving starting and ending indices in the current buffer
1891 of the text to be executed.
1892 Programs can pass third argument PRINTFLAG which controls output:
1893 A value of nil means discard it; anything else is stream for printing it.
1894 Also the fourth argument READ-FUNCTION, if non-nil, is used
1895 instead of `read' to read each expression. It gets one argument
1896 which is the input stream for reading characters.
1898 This function does not move point. */)
1899 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1901 /* FIXME: Do the eval-sexp-add-defvars dance! */
1902 ptrdiff_t count
= SPECPDL_INDEX ();
1903 Lisp_Object tem
, cbuf
;
1905 cbuf
= Fcurrent_buffer ();
1907 if (NILP (printflag
))
1911 specbind (Qstandard_output
, tem
);
1912 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1914 /* `readevalloop' calls functions which check the type of start and end. */
1915 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1916 !NILP (printflag
), Qnil
, read_function
,
1919 return unbind_to (count
, Qnil
);
1923 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1924 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1925 If STREAM is nil, use the value of `standard-input' (which see).
1926 STREAM or the value of `standard-input' may be:
1927 a buffer (read from point and advance it)
1928 a marker (read from where it points and advance it)
1929 a function (call it with no arguments for each character,
1930 call it with a char as argument to push a char back)
1931 a string (takes text from string, starting at the beginning)
1932 t (read text line using minibuffer and use it, or read from
1933 standard input in batch mode). */)
1934 (Lisp_Object stream
)
1937 stream
= Vstandard_input
;
1938 if (EQ (stream
, Qt
))
1939 stream
= Qread_char
;
1940 if (EQ (stream
, Qread_char
))
1941 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1943 return read_internal_start (stream
, Qnil
, Qnil
);
1946 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1947 doc
: /* Read one Lisp expression which is represented as text by STRING.
1948 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1949 FINAL-STRING-INDEX is an integer giving the position of the next
1950 remaining character in STRING.
1951 START and END optionally delimit a substring of STRING from which to read;
1952 they default to 0 and (length STRING) respectively. */)
1953 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1956 CHECK_STRING (string
);
1957 /* `read_internal_start' sets `read_from_string_index'. */
1958 ret
= read_internal_start (string
, start
, end
);
1959 return Fcons (ret
, make_number (read_from_string_index
));
1962 /* Function to set up the global context we need in toplevel read
1965 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1966 /* `start', `end' only used when stream is a string. */
1971 new_backquote_flag
= 0;
1972 read_objects
= Qnil
;
1973 if (EQ (Vread_with_symbol_positions
, Qt
)
1974 || EQ (Vread_with_symbol_positions
, stream
))
1975 Vread_symbol_positions_list
= Qnil
;
1977 if (STRINGP (stream
)
1978 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1980 ptrdiff_t startval
, endval
;
1983 if (STRINGP (stream
))
1986 string
= XCAR (stream
);
1989 endval
= SCHARS (string
);
1993 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
1994 args_out_of_range (string
, end
);
1995 endval
= XINT (end
);
2002 CHECK_NUMBER (start
);
2003 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2004 args_out_of_range (string
, start
);
2005 startval
= XINT (start
);
2007 read_from_string_index
= startval
;
2008 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2009 read_from_string_limit
= endval
;
2012 retval
= read0 (stream
);
2013 if (EQ (Vread_with_symbol_positions
, Qt
)
2014 || EQ (Vread_with_symbol_positions
, stream
))
2015 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2020 /* Signal Qinvalid_read_syntax error.
2021 S is error string of length N (if > 0) */
2023 static _Noreturn
void
2024 invalid_syntax (const char *s
)
2026 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2030 /* Use this for recursive reads, in contexts where internal tokens
2034 read0 (Lisp_Object readcharfun
)
2036 register Lisp_Object val
;
2039 val
= read1 (readcharfun
, &c
, 0);
2043 xsignal1 (Qinvalid_read_syntax
,
2044 Fmake_string (make_number (1), make_number (c
)));
2047 static ptrdiff_t read_buffer_size
;
2048 static char *read_buffer
;
2050 /* Read a \-escape sequence, assuming we already read the `\'.
2051 If the escape sequence forces unibyte, return eight-bit char. */
2054 read_escape (Lisp_Object readcharfun
, int stringp
)
2056 register int c
= READCHAR
;
2057 /* \u allows up to four hex digits, \U up to eight. Default to the
2058 behavior for \u, and change this value in the case that \U is seen. */
2059 int unicode_hex_count
= 4;
2064 end_of_file_error ();
2094 error ("Invalid escape character syntax");
2097 c
= read_escape (readcharfun
, 0);
2098 return c
| meta_modifier
;
2103 error ("Invalid escape character syntax");
2106 c
= read_escape (readcharfun
, 0);
2107 return c
| shift_modifier
;
2112 error ("Invalid escape character syntax");
2115 c
= read_escape (readcharfun
, 0);
2116 return c
| hyper_modifier
;
2121 error ("Invalid escape character syntax");
2124 c
= read_escape (readcharfun
, 0);
2125 return c
| alt_modifier
;
2129 if (stringp
|| c
!= '-')
2136 c
= read_escape (readcharfun
, 0);
2137 return c
| super_modifier
;
2142 error ("Invalid escape character syntax");
2146 c
= read_escape (readcharfun
, 0);
2147 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2148 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2149 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2150 return c
| ctrl_modifier
;
2151 /* ASCII control chars are made from letters (both cases),
2152 as well as the non-letters within 0100...0137. */
2153 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2154 return (c
& (037 | ~0177));
2155 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2156 return (c
& (037 | ~0177));
2158 return c
| ctrl_modifier
;
2168 /* An octal escape, as in ANSI C. */
2170 register int i
= c
- '0';
2171 register int count
= 0;
2174 if ((c
= READCHAR
) >= '0' && c
<= '7')
2186 if (i
>= 0x80 && i
< 0x100)
2187 i
= BYTE8_TO_CHAR (i
);
2192 /* A hex escape, as in ANSI C. */
2199 if (c
>= '0' && c
<= '9')
2204 else if ((c
>= 'a' && c
<= 'f')
2205 || (c
>= 'A' && c
<= 'F'))
2208 if (c
>= 'a' && c
<= 'f')
2218 /* Allow hex escapes as large as ?\xfffffff, because some
2219 packages use them to denote characters with modifiers. */
2220 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2221 error ("Hex character out of range: \\x%x...", i
);
2225 if (count
< 3 && i
>= 0x80)
2226 return BYTE8_TO_CHAR (i
);
2231 /* Post-Unicode-2.0: Up to eight hex chars. */
2232 unicode_hex_count
= 8;
2235 /* A Unicode escape. We only permit them in strings and characters,
2236 not arbitrarily in the source code, as in some other languages. */
2241 while (++count
<= unicode_hex_count
)
2244 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2246 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2247 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2248 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2250 error ("Non-hex digit used for Unicode escape");
2253 error ("Non-Unicode character: 0x%x", i
);
2262 /* Return the digit that CHARACTER stands for in the given BASE.
2263 Return -1 if CHARACTER is out of range for BASE,
2264 and -2 if CHARACTER is not valid for any supported BASE. */
2266 digit_to_number (int character
, int base
)
2270 if ('0' <= character
&& character
<= '9')
2271 digit
= character
- '0';
2272 else if ('a' <= character
&& character
<= 'z')
2273 digit
= character
- 'a' + 10;
2274 else if ('A' <= character
&& character
<= 'Z')
2275 digit
= character
- 'A' + 10;
2279 return digit
< base
? digit
: -1;
2282 /* Read an integer in radix RADIX using READCHARFUN to read
2283 characters. RADIX must be in the interval [2..36]; if it isn't, a
2284 read error is signaled . Value is the integer read. Signals an
2285 error if encountering invalid read syntax or if RADIX is out of
2289 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2291 /* Room for sign, leading 0, other digits, trailing null byte.
2292 Also, room for invalid syntax diagnostic. */
2293 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2294 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2296 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2298 if (radix
< 2 || radix
> 36)
2306 if (c
== '-' || c
== '+')
2317 /* Ignore redundant leading zeros, so the buffer doesn't
2318 fill up with them. */
2324 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2331 if (p
< buf
+ sizeof buf
- 1)
2345 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2346 invalid_syntax (buf
);
2349 return string_to_number (buf
, radix
, 0);
2353 /* If the next token is ')' or ']' or '.', we store that character
2354 in *PCH and the return value is not interesting. Else, we store
2355 zero in *PCH and we read and return one lisp object.
2357 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2360 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2363 unsigned uninterned_symbol
= 0;
2371 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2373 end_of_file_error ();
2378 return read_list (0, readcharfun
);
2381 return read_vector (readcharfun
, 0);
2397 /* Accept extended format for hashtables (extensible to
2399 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2400 Lisp_Object tmp
= read_list (0, readcharfun
);
2401 Lisp_Object head
= CAR_SAFE (tmp
);
2402 Lisp_Object data
= Qnil
;
2403 Lisp_Object val
= Qnil
;
2404 /* The size is 2 * number of allowed keywords to
2406 Lisp_Object params
[10];
2408 Lisp_Object key
= Qnil
;
2409 int param_count
= 0;
2411 if (!EQ (head
, Qhash_table
))
2412 error ("Invalid extended read marker at head of #s list "
2413 "(only hash-table allowed)");
2415 tmp
= CDR_SAFE (tmp
);
2417 /* This is repetitive but fast and simple. */
2418 params
[param_count
] = QCsize
;
2419 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2420 if (!NILP (params
[param_count
+ 1]))
2423 params
[param_count
] = QCtest
;
2424 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2425 if (!NILP (params
[param_count
+ 1]))
2428 params
[param_count
] = QCweakness
;
2429 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2430 if (!NILP (params
[param_count
+ 1]))
2433 params
[param_count
] = QCrehash_size
;
2434 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2435 if (!NILP (params
[param_count
+ 1]))
2438 params
[param_count
] = QCrehash_threshold
;
2439 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2440 if (!NILP (params
[param_count
+ 1]))
2443 /* This is the hashtable data. */
2444 data
= Fplist_get (tmp
, Qdata
);
2446 /* Now use params to make a new hashtable and fill it. */
2447 ht
= Fmake_hash_table (param_count
, params
);
2449 while (CONSP (data
))
2454 error ("Odd number of elements in hashtable data");
2457 Fputhash (key
, val
, ht
);
2463 invalid_syntax ("#");
2471 tmp
= read_vector (readcharfun
, 0);
2472 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2473 error ("Invalid size char-table");
2474 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2486 tmp
= read_vector (readcharfun
, 0);
2489 error ("Invalid size char-table");
2490 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2491 error ("Invalid depth in char-table");
2492 depth
= XINT (AREF (tmp
, 0));
2493 if (chartab_size
[depth
] != size
- 2)
2494 error ("Invalid size char-table");
2495 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2498 invalid_syntax ("#^^");
2500 invalid_syntax ("#^");
2505 length
= read1 (readcharfun
, pch
, first_in_list
);
2509 Lisp_Object tmp
, val
;
2510 EMACS_INT size_in_chars
2511 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2512 / BOOL_VECTOR_BITS_PER_CHAR
);
2515 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2516 if (STRING_MULTIBYTE (tmp
)
2517 || (size_in_chars
!= SCHARS (tmp
)
2518 /* We used to print 1 char too many
2519 when the number of bits was a multiple of 8.
2520 Accept such input in case it came from an old
2522 && ! (XFASTINT (length
)
2523 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2524 invalid_syntax ("#&...");
2526 val
= Fmake_bool_vector (length
, Qnil
);
2527 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2528 /* Clear the extraneous bits in the last byte. */
2529 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2530 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2531 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2534 invalid_syntax ("#&...");
2538 /* Accept compiled functions at read-time so that we don't have to
2539 build them using function calls. */
2541 tmp
= read_vector (readcharfun
, 1);
2542 make_byte_code (XVECTOR (tmp
));
2548 struct gcpro gcpro1
;
2551 /* Read the string itself. */
2552 tmp
= read1 (readcharfun
, &ch
, 0);
2553 if (ch
!= 0 || !STRINGP (tmp
))
2554 invalid_syntax ("#");
2556 /* Read the intervals and their properties. */
2559 Lisp_Object beg
, end
, plist
;
2561 beg
= read1 (readcharfun
, &ch
, 0);
2566 end
= read1 (readcharfun
, &ch
, 0);
2568 plist
= read1 (readcharfun
, &ch
, 0);
2570 invalid_syntax ("Invalid string property list");
2571 Fset_text_properties (beg
, end
, plist
, tmp
);
2577 /* #@NUMBER is used to skip NUMBER following characters.
2578 That's used in .elc files to skip over doc strings
2579 and function definitions. */
2582 enum { extra
= 100 };
2583 ptrdiff_t i
, nskip
= 0;
2586 /* Read a decimal integer. */
2587 while ((c
= READCHAR
) >= 0
2588 && c
>= '0' && c
<= '9')
2590 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2597 if (load_force_doc_strings
2598 && (EQ (readcharfun
, Qget_file_char
)
2599 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2601 /* If we are supposed to force doc strings into core right now,
2602 record the last string that we skipped,
2603 and record where in the file it comes from. */
2605 /* But first exchange saved_doc_string
2606 with prev_saved_doc_string, so we save two strings. */
2608 char *temp
= saved_doc_string
;
2609 ptrdiff_t temp_size
= saved_doc_string_size
;
2610 file_offset temp_pos
= saved_doc_string_position
;
2611 ptrdiff_t temp_len
= saved_doc_string_length
;
2613 saved_doc_string
= prev_saved_doc_string
;
2614 saved_doc_string_size
= prev_saved_doc_string_size
;
2615 saved_doc_string_position
= prev_saved_doc_string_position
;
2616 saved_doc_string_length
= prev_saved_doc_string_length
;
2618 prev_saved_doc_string
= temp
;
2619 prev_saved_doc_string_size
= temp_size
;
2620 prev_saved_doc_string_position
= temp_pos
;
2621 prev_saved_doc_string_length
= temp_len
;
2624 if (saved_doc_string_size
== 0)
2626 saved_doc_string
= (char *) xmalloc (nskip
+ extra
);
2627 saved_doc_string_size
= nskip
+ extra
;
2629 if (nskip
> saved_doc_string_size
)
2631 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2633 saved_doc_string_size
= nskip
+ extra
;
2636 saved_doc_string_position
= file_tell (instream
);
2638 /* Copy that many characters into saved_doc_string. */
2639 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2640 saved_doc_string
[i
] = c
= READCHAR
;
2642 saved_doc_string_length
= i
;
2646 /* Skip that many characters. */
2647 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2656 /* #! appears at the beginning of an executable file.
2657 Skip the first line. */
2658 while (c
!= '\n' && c
>= 0)
2663 return Vload_file_name
;
2665 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2666 /* #:foo is the uninterned symbol named foo. */
2669 uninterned_symbol
= 1;
2672 && c
!= 0xa0 /* NBSP */
2674 || strchr ("\"';()[]#`,", c
) == NULL
)))
2676 /* No symbol character follows, this is the empty
2679 return Fmake_symbol (build_string (""));
2683 /* ## is the empty symbol. */
2685 return Fintern (build_string (""), Qnil
);
2686 /* Reader forms that can reuse previously read objects. */
2687 if (c
>= '0' && c
<= '9')
2692 /* Read a non-negative integer. */
2693 while (c
>= '0' && c
<= '9')
2695 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2696 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2697 n
= MOST_POSITIVE_FIXNUM
+ 1;
2699 n
= n
* 10 + c
- '0';
2703 if (n
<= MOST_POSITIVE_FIXNUM
)
2705 if (c
== 'r' || c
== 'R')
2706 return read_integer (readcharfun
, n
);
2708 if (! NILP (Vread_circle
))
2710 /* #n=object returns object, but associates it with
2714 /* Make a placeholder for #n# to use temporarily. */
2715 Lisp_Object placeholder
;
2718 placeholder
= Fcons (Qnil
, Qnil
);
2719 cell
= Fcons (make_number (n
), placeholder
);
2720 read_objects
= Fcons (cell
, read_objects
);
2722 /* Read the object itself. */
2723 tem
= read0 (readcharfun
);
2725 /* Now put it everywhere the placeholder was... */
2726 substitute_object_in_subtree (tem
, placeholder
);
2728 /* ...and #n# will use the real value from now on. */
2729 Fsetcdr (cell
, tem
);
2734 /* #n# returns a previously read object. */
2737 tem
= Fassq (make_number (n
), read_objects
);
2743 /* Fall through to error message. */
2745 else if (c
== 'x' || c
== 'X')
2746 return read_integer (readcharfun
, 16);
2747 else if (c
== 'o' || c
== 'O')
2748 return read_integer (readcharfun
, 8);
2749 else if (c
== 'b' || c
== 'B')
2750 return read_integer (readcharfun
, 2);
2753 invalid_syntax ("#");
2756 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2761 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2766 int next_char
= READCHAR
;
2768 /* Transition from old-style to new-style:
2769 If we see "(`" it used to mean old-style, which usually works
2770 fine because ` should almost never appear in such a position
2771 for new-style. But occasionally we need "(`" to mean new
2772 style, so we try to distinguish the two by the fact that we
2773 can either write "( `foo" or "(` foo", where the first
2774 intends to use new-style whereas the second intends to use
2775 old-style. For Emacs-25, we should completely remove this
2776 first_in_list exception (old-style can still be obtained via
2778 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2780 Vold_style_backquotes
= Qt
;
2787 new_backquote_flag
++;
2788 value
= read0 (readcharfun
);
2789 new_backquote_flag
--;
2791 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2796 int next_char
= READCHAR
;
2798 /* Transition from old-style to new-style:
2799 It used to be impossible to have a new-style , other than within
2800 a new-style `. This is sufficient when ` and , are used in the
2801 normal way, but ` and , can also appear in args to macros that
2802 will not interpret them in the usual way, in which case , may be
2803 used without any ` anywhere near.
2804 So we now use the same heuristic as for backquote: old-style
2805 unquotes are only recognized when first on a list, and when
2806 followed by a space.
2807 Because it's more difficult to peek 2 chars ahead, a new-style
2808 ,@ can still not be used outside of a `, unless it's in the middle
2810 if (new_backquote_flag
2812 || (next_char
!= ' ' && next_char
!= '@'))
2814 Lisp_Object comma_type
= Qnil
;
2819 comma_type
= Qcomma_at
;
2821 comma_type
= Qcomma_dot
;
2824 if (ch
>= 0) UNREAD (ch
);
2825 comma_type
= Qcomma
;
2828 value
= read0 (readcharfun
);
2829 return Fcons (comma_type
, Fcons (value
, Qnil
));
2833 Vold_style_backquotes
= Qt
;
2845 end_of_file_error ();
2847 /* Accept `single space' syntax like (list ? x) where the
2848 whitespace character is SPC or TAB.
2849 Other literal whitespace like NL, CR, and FF are not accepted,
2850 as there are well-established escape sequences for these. */
2851 if (c
== ' ' || c
== '\t')
2852 return make_number (c
);
2855 c
= read_escape (readcharfun
, 0);
2856 modifiers
= c
& CHAR_MODIFIER_MASK
;
2857 c
&= ~CHAR_MODIFIER_MASK
;
2858 if (CHAR_BYTE8_P (c
))
2859 c
= CHAR_TO_BYTE8 (c
);
2862 next_char
= READCHAR
;
2863 ok
= (next_char
<= 040
2864 || (next_char
< 0200
2865 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2868 return make_number (c
);
2870 invalid_syntax ("?");
2875 char *p
= read_buffer
;
2876 char *end
= read_buffer
+ read_buffer_size
;
2878 /* Nonzero if we saw an escape sequence specifying
2879 a multibyte character. */
2880 int force_multibyte
= 0;
2881 /* Nonzero if we saw an escape sequence specifying
2882 a single-byte character. */
2883 int force_singlebyte
= 0;
2885 ptrdiff_t nchars
= 0;
2887 while ((ch
= READCHAR
) >= 0
2890 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2892 ptrdiff_t offset
= p
- read_buffer
;
2893 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2894 memory_full (SIZE_MAX
);
2895 read_buffer
= (char *) xrealloc (read_buffer
,
2896 read_buffer_size
* 2);
2897 read_buffer_size
*= 2;
2898 p
= read_buffer
+ offset
;
2899 end
= read_buffer
+ read_buffer_size
;
2906 ch
= read_escape (readcharfun
, 1);
2908 /* CH is -1 if \ newline has just been seen. */
2911 if (p
== read_buffer
)
2916 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2917 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2919 if (CHAR_BYTE8_P (ch
))
2920 force_singlebyte
= 1;
2921 else if (! ASCII_CHAR_P (ch
))
2922 force_multibyte
= 1;
2923 else /* I.e. ASCII_CHAR_P (ch). */
2925 /* Allow `\C- ' and `\C-?'. */
2926 if (modifiers
== CHAR_CTL
)
2929 ch
= 0, modifiers
= 0;
2931 ch
= 127, modifiers
= 0;
2933 if (modifiers
& CHAR_SHIFT
)
2935 /* Shift modifier is valid only with [A-Za-z]. */
2936 if (ch
>= 'A' && ch
<= 'Z')
2937 modifiers
&= ~CHAR_SHIFT
;
2938 else if (ch
>= 'a' && ch
<= 'z')
2939 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2942 if (modifiers
& CHAR_META
)
2944 /* Move the meta bit to the right place for a
2946 modifiers
&= ~CHAR_META
;
2947 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2948 force_singlebyte
= 1;
2952 /* Any modifiers remaining are invalid. */
2954 error ("Invalid modifier in string");
2955 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2959 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2960 if (CHAR_BYTE8_P (ch
))
2961 force_singlebyte
= 1;
2962 else if (! ASCII_CHAR_P (ch
))
2963 force_multibyte
= 1;
2969 end_of_file_error ();
2971 /* If purifying, and string starts with \ newline,
2972 return zero instead. This is for doc strings
2973 that we are really going to find in etc/DOC.nn.nn. */
2974 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2975 return make_number (0);
2977 if (! force_multibyte
&& force_singlebyte
)
2979 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
2980 forms. Convert it to unibyte. */
2981 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
2983 p
= read_buffer
+ nchars
;
2986 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2988 || (p
- read_buffer
!= nchars
)));
2993 int next_char
= READCHAR
;
2996 if (next_char
<= 040
2997 || (next_char
< 0200
2998 && strchr ("\"';([#?`,", next_char
) != NULL
))
3004 /* Otherwise, we fall through! Note that the atom-reading loop
3005 below will now loop at least once, assuring that we will not
3006 try to UNREAD two characters in a row. */
3010 if (c
<= 040) goto retry
;
3011 if (c
== 0xa0) /* NBSP */
3016 char *p
= read_buffer
;
3018 EMACS_INT start_position
= readchar_count
- 1;
3021 char *end
= read_buffer
+ read_buffer_size
;
3025 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3027 ptrdiff_t offset
= p
- read_buffer
;
3028 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3029 memory_full (SIZE_MAX
);
3030 read_buffer
= (char *) xrealloc (read_buffer
,
3031 read_buffer_size
* 2);
3032 read_buffer_size
*= 2;
3033 p
= read_buffer
+ offset
;
3034 end
= read_buffer
+ read_buffer_size
;
3041 end_of_file_error ();
3046 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3052 && c
!= 0xa0 /* NBSP */
3054 || strchr ("\"';()[]#`,", c
) == NULL
));
3058 ptrdiff_t offset
= p
- read_buffer
;
3059 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3060 memory_full (SIZE_MAX
);
3061 read_buffer
= (char *) xrealloc (read_buffer
,
3062 read_buffer_size
* 2);
3063 read_buffer_size
*= 2;
3064 p
= read_buffer
+ offset
;
3065 end
= read_buffer
+ read_buffer_size
;
3071 if (!quoted
&& !uninterned_symbol
)
3073 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3074 if (! NILP (result
))
3078 Lisp_Object name
, result
;
3079 ptrdiff_t nbytes
= p
- read_buffer
;
3082 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3086 name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3087 ? make_pure_string
: make_specified_string
)
3088 (read_buffer
, nchars
, nbytes
, multibyte
));
3089 result
= (uninterned_symbol
? Fmake_symbol (name
)
3090 : Fintern (name
, Qnil
));
3092 if (EQ (Vread_with_symbol_positions
, Qt
)
3093 || EQ (Vread_with_symbol_positions
, readcharfun
))
3094 Vread_symbol_positions_list
3095 = Fcons (Fcons (result
, make_number (start_position
)),
3096 Vread_symbol_positions_list
);
3104 /* List of nodes we've seen during substitute_object_in_subtree. */
3105 static Lisp_Object seen_list
;
3108 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3110 Lisp_Object check_object
;
3112 /* We haven't seen any objects when we start. */
3115 /* Make all the substitutions. */
3117 = substitute_object_recurse (object
, placeholder
, object
);
3119 /* Clear seen_list because we're done with it. */
3122 /* The returned object here is expected to always eq the
3124 if (!EQ (check_object
, object
))
3125 error ("Unexpected mutation error in reader");
3128 /* Feval doesn't get called from here, so no gc protection is needed. */
3129 #define SUBSTITUTE(get_val, set_val) \
3131 Lisp_Object old_value = get_val; \
3132 Lisp_Object true_value \
3133 = substitute_object_recurse (object, placeholder, \
3136 if (!EQ (old_value, true_value)) \
3143 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3145 /* If we find the placeholder, return the target object. */
3146 if (EQ (placeholder
, subtree
))
3149 /* If we've been to this node before, don't explore it again. */
3150 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3153 /* If this node can be the entry point to a cycle, remember that
3154 we've seen it. It can only be such an entry point if it was made
3155 by #n=, which means that we can find it as a value in
3157 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3158 seen_list
= Fcons (subtree
, seen_list
);
3160 /* Recurse according to subtree's type.
3161 Every branch must return a Lisp_Object. */
3162 switch (XTYPE (subtree
))
3164 case Lisp_Vectorlike
:
3166 ptrdiff_t i
, length
= 0;
3167 if (BOOL_VECTOR_P (subtree
))
3168 return subtree
; /* No sub-objects anyway. */
3169 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3170 || COMPILEDP (subtree
))
3171 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3172 else if (VECTORP (subtree
))
3173 length
= ASIZE (subtree
);
3175 /* An unknown pseudovector may contain non-Lisp fields, so we
3176 can't just blindly traverse all its fields. We used to call
3177 `Flength' which signaled `sequencep', so I just preserved this
3179 wrong_type_argument (Qsequencep
, subtree
);
3181 for (i
= 0; i
< length
; i
++)
3182 SUBSTITUTE (AREF (subtree
, i
),
3183 ASET (subtree
, i
, true_value
));
3189 SUBSTITUTE (XCAR (subtree
),
3190 XSETCAR (subtree
, true_value
));
3191 SUBSTITUTE (XCDR (subtree
),
3192 XSETCDR (subtree
, true_value
));
3198 /* Check for text properties in each interval.
3199 substitute_in_interval contains part of the logic. */
3201 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3202 Lisp_Object arg
= Fcons (object
, placeholder
);
3204 traverse_intervals_noorder (root_interval
,
3205 &substitute_in_interval
, arg
);
3210 /* Other types don't recurse any further. */
3216 /* Helper function for substitute_object_recurse. */
3218 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3220 Lisp_Object object
= Fcar (arg
);
3221 Lisp_Object placeholder
= Fcdr (arg
);
3223 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3233 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3234 integer syntax and fits in a fixnum, else return the nearest float if CP has
3235 either floating point or integer syntax and BASE is 10, else return nil. If
3236 IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
3237 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3238 number has integer syntax but does not fit. */
3241 string_to_number (char const *string
, int base
, int ignore_trailing
)
3244 char const *cp
= string
;
3246 int float_syntax
= 0;
3249 /* Compute NaN and infinities using a variable, to cope with compilers that
3250 think they are smarter than we are. */
3253 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3254 IEEE floating point hosts, and works around a formerly-common bug where
3255 atof ("-0.0") drops the sign. */
3256 int negative
= *cp
== '-';
3258 int signedp
= negative
|| *cp
== '+';
3263 leading_digit
= digit_to_number (*cp
, base
);
3264 if (0 <= leading_digit
)
3269 while (0 <= digit_to_number (*cp
, base
));
3279 if ('0' <= *cp
&& *cp
<= '9')
3284 while ('0' <= *cp
&& *cp
<= '9');
3286 if (*cp
== 'e' || *cp
== 'E')
3288 char const *ecp
= cp
;
3290 if (*cp
== '+' || *cp
== '-')
3292 if ('0' <= *cp
&& *cp
<= '9')
3297 while ('0' <= *cp
&& *cp
<= '9');
3299 else if (cp
[-1] == '+'
3300 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3306 else if (cp
[-1] == '+'
3307 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3311 value
= zero
/ zero
;
3313 /* If that made a "negative" NaN, negate it. */
3316 union { double d
; char c
[sizeof (double)]; }
3317 u_data
, u_minus_zero
;
3319 u_minus_zero
.d
= -0.0;
3320 for (i
= 0; i
< sizeof (double); i
++)
3321 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3327 /* Now VALUE is a positive NaN. */
3333 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3334 || state
== (LEAD_INT
|E_EXP
));
3337 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3338 any prefix that matches. Otherwise, the entire string must match. */
3339 if (! (ignore_trailing
3340 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3341 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3344 /* If the number uses integer and not float syntax, and is in C-language
3345 range, use its value, preferably as a fixnum. */
3346 if (0 <= leading_digit
&& ! float_syntax
)
3350 /* Fast special case for single-digit integers. This also avoids a
3351 glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
3352 case some versions of strtoumax accept numbers like "0x1" that Emacs
3354 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3355 return make_number (negative
? -leading_digit
: leading_digit
);
3358 n
= strtoumax (string
+ signedp
, NULL
, base
);
3359 if (errno
== ERANGE
)
3361 /* Unfortunately there's no simple and accurate way to convert
3362 non-base-10 numbers that are out of C-language range. */
3364 xsignal1 (Qoverflow_error
, build_string (string
));
3366 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3368 EMACS_INT signed_n
= n
;
3369 return make_number (negative
? -signed_n
: signed_n
);
3375 /* Either the number uses float syntax, or it does not fit into a fixnum.
3376 Convert it from string to floating point, unless the value is already
3377 known because it is an infinity, a NAN, or its absolute value fits in
3380 value
= atof (string
+ signedp
);
3382 return make_float (negative
? -value
: value
);
3387 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3390 register Lisp_Object
*ptr
;
3391 register Lisp_Object tem
, item
, vector
;
3392 register struct Lisp_Cons
*otem
;
3395 tem
= read_list (1, readcharfun
);
3396 len
= Flength (tem
);
3397 vector
= Fmake_vector (len
, Qnil
);
3399 size
= ASIZE (vector
);
3400 ptr
= XVECTOR (vector
)->contents
;
3401 for (i
= 0; i
< size
; i
++)
3404 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3405 bytecode object, the docstring containing the bytecode and
3406 constants values must be treated as unibyte and passed to
3407 Fread, to get the actual bytecode string and constants vector. */
3408 if (bytecodeflag
&& load_force_doc_strings
)
3410 if (i
== COMPILED_BYTECODE
)
3412 if (!STRINGP (item
))
3413 error ("Invalid byte code");
3415 /* Delay handling the bytecode slot until we know whether
3416 it is lazily-loaded (we can tell by whether the
3417 constants slot is nil). */
3418 ptr
[COMPILED_CONSTANTS
] = item
;
3421 else if (i
== COMPILED_CONSTANTS
)
3423 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3427 /* Coerce string to unibyte (like string-as-unibyte,
3428 but without generating extra garbage and
3429 guaranteeing no change in the contents). */
3430 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3431 STRING_SET_UNIBYTE (bytestr
);
3433 item
= Fread (Fcons (bytestr
, readcharfun
));
3435 error ("Invalid byte code");
3437 otem
= XCONS (item
);
3438 bytestr
= XCAR (item
);
3443 /* Now handle the bytecode slot. */
3444 ptr
[COMPILED_BYTECODE
] = bytestr
;
3446 else if (i
== COMPILED_DOC_STRING
3448 && ! STRING_MULTIBYTE (item
))
3450 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3451 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3453 item
= Fstring_as_multibyte (item
);
3464 /* FLAG = 1 means check for ] to terminate rather than ) and . */
3467 read_list (int flag
, register Lisp_Object readcharfun
)
3469 Lisp_Object val
, tail
;
3470 register Lisp_Object elt
, tem
;
3471 struct gcpro gcpro1
, gcpro2
;
3472 /* 0 is the normal case.
3473 1 means this list is a doc reference; replace it with the number 0.
3474 2 means this list is a doc reference; replace it with the doc string. */
3475 int doc_reference
= 0;
3477 /* Initialize this to 1 if we are reading a list. */
3478 int first_in_list
= flag
<= 0;
3487 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3492 /* While building, if the list starts with #$, treat it specially. */
3493 if (EQ (elt
, Vload_file_name
)
3495 && !NILP (Vpurify_flag
))
3497 if (NILP (Vdoc_file_name
))
3498 /* We have not yet called Snarf-documentation, so assume
3499 this file is described in the DOC-MM.NN file
3500 and Snarf-documentation will fill in the right value later.
3501 For now, replace the whole list with 0. */
3504 /* We have already called Snarf-documentation, so make a relative
3505 file name for this file, so it can be found properly
3506 in the installed Lisp directory.
3507 We don't use Fexpand_file_name because that would make
3508 the directory absolute now. */
3509 elt
= concat2 (build_string ("../lisp/"),
3510 Ffile_name_nondirectory (elt
));
3512 else if (EQ (elt
, Vload_file_name
)
3514 && load_force_doc_strings
)
3523 invalid_syntax (") or . in a vector");
3531 XSETCDR (tail
, read0 (readcharfun
));
3533 val
= read0 (readcharfun
);
3534 read1 (readcharfun
, &ch
, 0);
3538 if (doc_reference
== 1)
3539 return make_number (0);
3540 if (doc_reference
== 2)
3542 /* Get a doc string from the file we are loading.
3543 If it's in saved_doc_string, get it from there.
3545 Here, we don't know if the string is a
3546 bytecode string or a doc string. As a
3547 bytecode string must be unibyte, we always
3548 return a unibyte string. If it is actually a
3549 doc string, caller must make it
3552 EMACS_INT pos
= XINT (XCDR (val
));
3553 /* Position is negative for user variables. */
3554 if (pos
< 0) pos
= -pos
;
3555 if (pos
>= saved_doc_string_position
3556 && pos
< (saved_doc_string_position
3557 + saved_doc_string_length
))
3559 ptrdiff_t start
= pos
- saved_doc_string_position
;
3562 /* Process quoting with ^A,
3563 and find the end of the string,
3564 which is marked with ^_ (037). */
3565 for (from
= start
, to
= start
;
3566 saved_doc_string
[from
] != 037;)
3568 int c
= saved_doc_string
[from
++];
3571 c
= saved_doc_string
[from
++];
3573 saved_doc_string
[to
++] = c
;
3575 saved_doc_string
[to
++] = 0;
3577 saved_doc_string
[to
++] = 037;
3580 saved_doc_string
[to
++] = c
;
3583 return make_unibyte_string (saved_doc_string
+ start
,
3586 /* Look in prev_saved_doc_string the same way. */
3587 else if (pos
>= prev_saved_doc_string_position
3588 && pos
< (prev_saved_doc_string_position
3589 + prev_saved_doc_string_length
))
3592 pos
- prev_saved_doc_string_position
;
3595 /* Process quoting with ^A,
3596 and find the end of the string,
3597 which is marked with ^_ (037). */
3598 for (from
= start
, to
= start
;
3599 prev_saved_doc_string
[from
] != 037;)
3601 int c
= prev_saved_doc_string
[from
++];
3604 c
= prev_saved_doc_string
[from
++];
3606 prev_saved_doc_string
[to
++] = c
;
3608 prev_saved_doc_string
[to
++] = 0;
3610 prev_saved_doc_string
[to
++] = 037;
3613 prev_saved_doc_string
[to
++] = c
;
3616 return make_unibyte_string (prev_saved_doc_string
3621 return get_doc_string (val
, 1, 0);
3626 invalid_syntax (". in wrong context");
3628 invalid_syntax ("] in a list");
3630 tem
= Fcons (elt
, Qnil
);
3632 XSETCDR (tail
, tem
);
3639 static Lisp_Object initial_obarray
;
3641 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3643 static size_t oblookup_last_bucket_number
;
3645 /* Get an error if OBARRAY is not an obarray.
3646 If it is one, return it. */
3649 check_obarray (Lisp_Object obarray
)
3651 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3653 /* If Vobarray is now invalid, force it to be valid. */
3654 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3655 wrong_type_argument (Qvectorp
, obarray
);
3660 /* Intern the C string STR: return a symbol with that name,
3661 interned in the current obarray. */
3664 intern (const char *str
)
3667 ptrdiff_t len
= strlen (str
);
3668 Lisp_Object obarray
;
3671 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3672 obarray
= check_obarray (obarray
);
3673 tem
= oblookup (obarray
, str
, len
, len
);
3676 return Fintern (make_string (str
, len
), obarray
);
3680 intern_c_string (const char *str
)
3683 ptrdiff_t len
= strlen (str
);
3684 Lisp_Object obarray
;
3687 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3688 obarray
= check_obarray (obarray
);
3689 tem
= oblookup (obarray
, str
, len
, len
);
3693 if (NILP (Vpurify_flag
))
3694 /* Creating a non-pure string from a string literal not
3695 implemented yet. We could just use make_string here and live
3696 with the extra copy. */
3699 return Fintern (make_pure_c_string (str
), obarray
);
3702 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3703 doc
: /* Return the canonical symbol whose name is STRING.
3704 If there is none, one is created by this function and returned.
3705 A second optional argument specifies the obarray to use;
3706 it defaults to the value of `obarray'. */)
3707 (Lisp_Object string
, Lisp_Object obarray
)
3709 register Lisp_Object tem
, sym
, *ptr
;
3711 if (NILP (obarray
)) obarray
= Vobarray
;
3712 obarray
= check_obarray (obarray
);
3714 CHECK_STRING (string
);
3716 tem
= oblookup (obarray
, SSDATA (string
),
3719 if (!INTEGERP (tem
))
3722 if (!NILP (Vpurify_flag
))
3723 string
= Fpurecopy (string
);
3724 sym
= Fmake_symbol (string
);
3726 if (EQ (obarray
, initial_obarray
))
3727 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3729 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3731 if ((SREF (string
, 0) == ':')
3732 && EQ (obarray
, initial_obarray
))
3734 XSYMBOL (sym
)->constant
= 1;
3735 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3736 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3739 ptr
= &AREF (obarray
, XINT(tem
));
3741 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3743 XSYMBOL (sym
)->next
= 0;
3748 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3749 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3750 NAME may be a string or a symbol. If it is a symbol, that exact
3751 symbol is searched for.
3752 A second optional argument specifies the obarray to use;
3753 it defaults to the value of `obarray'. */)
3754 (Lisp_Object name
, Lisp_Object obarray
)
3756 register Lisp_Object tem
, string
;
3758 if (NILP (obarray
)) obarray
= Vobarray
;
3759 obarray
= check_obarray (obarray
);
3761 if (!SYMBOLP (name
))
3763 CHECK_STRING (name
);
3767 string
= SYMBOL_NAME (name
);
3769 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3770 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3776 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3777 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3778 The value is t if a symbol was found and deleted, nil otherwise.
3779 NAME may be a string or a symbol. If it is a symbol, that symbol
3780 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3781 OBARRAY defaults to the value of the variable `obarray'. */)
3782 (Lisp_Object name
, Lisp_Object obarray
)
3784 register Lisp_Object string
, tem
;
3787 if (NILP (obarray
)) obarray
= Vobarray
;
3788 obarray
= check_obarray (obarray
);
3791 string
= SYMBOL_NAME (name
);
3794 CHECK_STRING (name
);
3798 tem
= oblookup (obarray
, SSDATA (string
),
3803 /* If arg was a symbol, don't delete anything but that symbol itself. */
3804 if (SYMBOLP (name
) && !EQ (name
, tem
))
3807 /* There are plenty of other symbols which will screw up the Emacs
3808 session if we unintern them, as well as even more ways to use
3809 `setq' or `fset' or whatnot to make the Emacs session
3810 unusable. Let's not go down this silly road. --Stef */
3811 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3812 error ("Attempt to unintern t or nil"); */
3814 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3816 hash
= oblookup_last_bucket_number
;
3818 if (EQ (AREF (obarray
, hash
), tem
))
3820 if (XSYMBOL (tem
)->next
)
3821 XSETSYMBOL (AREF (obarray
, hash
), XSYMBOL (tem
)->next
);
3823 XSETINT (AREF (obarray
, hash
), 0);
3827 Lisp_Object tail
, following
;
3829 for (tail
= AREF (obarray
, hash
);
3830 XSYMBOL (tail
)->next
;
3833 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3834 if (EQ (following
, tem
))
3836 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3845 /* Return the symbol in OBARRAY whose names matches the string
3846 of SIZE characters (SIZE_BYTE bytes) at PTR.
3847 If there is no such symbol in OBARRAY, return nil.
3849 Also store the bucket number in oblookup_last_bucket_number. */
3852 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3856 register Lisp_Object tail
;
3857 Lisp_Object bucket
, tem
;
3859 if (!VECTORP (obarray
)
3860 || (obsize
= ASIZE (obarray
)) == 0)
3862 obarray
= check_obarray (obarray
);
3863 obsize
= ASIZE (obarray
);
3865 /* This is sometimes needed in the middle of GC. */
3866 obsize
&= ~ARRAY_MARK_FLAG
;
3867 hash
= hash_string (ptr
, size_byte
) % obsize
;
3868 bucket
= AREF (obarray
, hash
);
3869 oblookup_last_bucket_number
= hash
;
3870 if (EQ (bucket
, make_number (0)))
3872 else if (!SYMBOLP (bucket
))
3873 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3875 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3877 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3878 && SCHARS (SYMBOL_NAME (tail
)) == size
3879 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3881 else if (XSYMBOL (tail
)->next
== 0)
3884 XSETINT (tem
, hash
);
3889 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3892 register Lisp_Object tail
;
3893 CHECK_VECTOR (obarray
);
3894 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3896 tail
= AREF (obarray
, i
);
3901 if (XSYMBOL (tail
)->next
== 0)
3903 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3909 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3911 call1 (function
, sym
);
3914 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3915 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3916 OBARRAY defaults to the value of `obarray'. */)
3917 (Lisp_Object function
, Lisp_Object obarray
)
3919 if (NILP (obarray
)) obarray
= Vobarray
;
3920 obarray
= check_obarray (obarray
);
3922 map_obarray (obarray
, mapatoms_1
, function
);
3926 #define OBARRAY_SIZE 1511
3931 Lisp_Object oblength
;
3932 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3934 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3936 Vobarray
= Fmake_vector (oblength
, make_number (0));
3937 initial_obarray
= Vobarray
;
3938 staticpro (&initial_obarray
);
3940 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3941 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3942 NILP (Vpurify_flag) check in intern_c_string. */
3943 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3944 Qnil
= intern_c_string ("nil");
3946 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3947 so those two need to be fixed manually. */
3948 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3949 XSYMBOL (Qunbound
)->function
= Qunbound
;
3950 XSYMBOL (Qunbound
)->plist
= Qnil
;
3951 /* XSYMBOL (Qnil)->function = Qunbound; */
3952 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3953 XSYMBOL (Qnil
)->constant
= 1;
3954 XSYMBOL (Qnil
)->declared_special
= 1;
3955 XSYMBOL (Qnil
)->plist
= Qnil
;
3957 Qt
= intern_c_string ("t");
3958 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3959 XSYMBOL (Qnil
)->declared_special
= 1;
3960 XSYMBOL (Qt
)->constant
= 1;
3962 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3965 DEFSYM (Qvariable_documentation
, "variable-documentation");
3967 read_buffer
= (char *) xmalloc (size
);
3968 read_buffer_size
= size
;
3972 defsubr (struct Lisp_Subr
*sname
)
3975 sym
= intern_c_string (sname
->symbol_name
);
3976 XSETTYPED_PVECTYPE (sname
, size
, PVEC_SUBR
);
3977 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3980 #ifdef NOTDEF /* Use fset in subr.el now! */
3982 defalias (struct Lisp_Subr
*sname
, char *string
)
3985 sym
= intern (string
);
3986 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3990 /* Define an "integer variable"; a symbol whose value is forwarded to a
3991 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
3992 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3994 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3995 const char *namestring
, EMACS_INT
*address
)
3998 sym
= intern_c_string (namestring
);
3999 i_fwd
->type
= Lisp_Fwd_Int
;
4000 i_fwd
->intvar
= address
;
4001 XSYMBOL (sym
)->declared_special
= 1;
4002 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4003 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4006 /* Similar but define a variable whose value is t if address contains 1,
4007 nil if address contains 0. */
4009 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4010 const char *namestring
, int *address
)
4013 sym
= intern_c_string (namestring
);
4014 b_fwd
->type
= Lisp_Fwd_Bool
;
4015 b_fwd
->boolvar
= address
;
4016 XSYMBOL (sym
)->declared_special
= 1;
4017 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4018 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4019 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4022 /* Similar but define a variable whose value is the Lisp Object stored
4023 at address. Two versions: with and without gc-marking of the C
4024 variable. The nopro version is used when that variable will be
4025 gc-marked for some other reason, since marking the same slot twice
4026 can cause trouble with strings. */
4028 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4029 const char *namestring
, Lisp_Object
*address
)
4032 sym
= intern_c_string (namestring
);
4033 o_fwd
->type
= Lisp_Fwd_Obj
;
4034 o_fwd
->objvar
= address
;
4035 XSYMBOL (sym
)->declared_special
= 1;
4036 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4037 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4041 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4042 const char *namestring
, Lisp_Object
*address
)
4044 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4045 staticpro (address
);
4048 /* Similar but define a variable whose value is the Lisp Object stored
4049 at a particular offset in the current kboard object. */
4052 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4053 const char *namestring
, int offset
)
4056 sym
= intern_c_string (namestring
);
4057 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4058 ko_fwd
->offset
= offset
;
4059 XSYMBOL (sym
)->declared_special
= 1;
4060 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4061 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4064 /* Record the value of load-path used at the start of dumping
4065 so we can see if the site changed it later during dumping. */
4066 static Lisp_Object dump_path
;
4072 int turn_off_warning
= 0;
4074 /* Compute the default Vload-path, with the following logic:
4075 If CANNOT_DUMP, just use PATH_LOADSEARCH, prepending PATH_SITELOADSEARCH
4076 unless --no-site-lisp.
4077 Else if purify-flag (ie dumping) start from PATH_DUMPLOADSEARCH;
4078 otherwise start from PATH_LOADSEARCH.
4079 If !initialized, then just set both Vload_path and dump_path.
4080 If initialized, then if Vload_path != dump_path, do nothing.
4081 (Presumably the load-path has already been changed by something.
4082 This can only (?) be from a site-load file during dumping.)
4083 If Vinstallation_directory is not nil (ie, running uninstalled):
4084 Add installation-dir/lisp (if exists and not already a member),
4085 at the front, and turn off warnings about missing directories
4086 (because we are presumably running uninstalled).
4087 If it does not exist, add dump_path at the end instead.
4088 Add installation-dir/leim (if exists and not already a member)
4090 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4091 and not already a member) at the front.
4092 If installation-dir != source-dir (ie running an uninstalled,
4093 out-of-tree build) AND install-dir/src/Makefile exists BUT
4094 install-dir/src/Makefile.in does NOT exist (this is a sanity
4095 check), then repeat the above steps for source-dir/lisp,
4097 Finally, add the site-lisp directories at the front (if !no_site_lisp).
4099 We then warn about any of the load-path elements that do not
4100 exist. The only ones that might not exist are those from
4101 PATH_LOADSEARCH, and perhaps dump_path.
4103 Having done all this, we then throw it all away if purify-flag is
4104 nil (ie, not dumping) and EMACSLOADPATH is set, and just
4105 unconditionally use the latter value instead.
4106 So AFAICS the only net results of all the previous steps will be
4107 possibly to issue some irrelevant warnings.
4109 FIXME? There's a case for saying that if we are running
4110 uninstalled, the eventual installation directories should not yet
4111 be included in load-path.
4115 normal
= PATH_LOADSEARCH
;
4116 Vload_path
= decode_env_path (0, normal
);
4119 Lisp_Object sitelisp
;
4120 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4121 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4124 if (NILP (Vpurify_flag
))
4125 normal
= PATH_LOADSEARCH
;
4127 normal
= PATH_DUMPLOADSEARCH
;
4129 /* In a dumped Emacs, we normally reset the value of Vload_path using
4130 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4131 the source directory, instead of the path of the installed elisp
4132 libraries. However, if it appears that Vload_path has already been
4133 changed from the default that was saved before dumping, don't
4134 change it further. */
4137 if (! NILP (Fequal (dump_path
, Vload_path
)))
4139 Vload_path
= decode_env_path (0, normal
);
4140 if (!NILP (Vinstallation_directory
))
4142 Lisp_Object tem
, tem1
;
4144 /* Add to the path the lisp subdir of the
4145 installation dir, if it exists. */
4146 tem
= Fexpand_file_name (build_string ("lisp"),
4147 Vinstallation_directory
);
4148 tem1
= Ffile_exists_p (tem
);
4151 if (NILP (Fmember (tem
, Vload_path
)))
4153 turn_off_warning
= 1;
4154 Vload_path
= Fcons (tem
, Vload_path
);
4158 /* That dir doesn't exist, so add the build-time
4159 Lisp dirs instead. */
4160 Vload_path
= nconc2 (Vload_path
, dump_path
);
4162 /* Add leim under the installation dir, if it exists. */
4163 tem
= Fexpand_file_name (build_string ("leim"),
4164 Vinstallation_directory
);
4165 tem1
= Ffile_exists_p (tem
);
4168 if (NILP (Fmember (tem
, Vload_path
)))
4169 Vload_path
= Fcons (tem
, Vload_path
);
4172 /* Add site-lisp under the installation dir, if it exists. */
4175 tem
= Fexpand_file_name (build_string ("site-lisp"),
4176 Vinstallation_directory
);
4177 tem1
= Ffile_exists_p (tem
);
4180 if (NILP (Fmember (tem
, Vload_path
)))
4181 Vload_path
= Fcons (tem
, Vload_path
);
4185 /* If Emacs was not built in the source directory,
4186 and it is run from where it was built, add to load-path
4187 the lisp, leim and site-lisp dirs under that directory. */
4189 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4193 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4194 Vinstallation_directory
);
4195 tem1
= Ffile_exists_p (tem
);
4197 /* Don't be fooled if they moved the entire source tree
4198 AFTER dumping Emacs. If the build directory is indeed
4199 different from the source dir, src/Makefile.in and
4200 src/Makefile will not be found together. */
4201 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4202 Vinstallation_directory
);
4203 tem2
= Ffile_exists_p (tem
);
4204 if (!NILP (tem1
) && NILP (tem2
))
4206 tem
= Fexpand_file_name (build_string ("lisp"),
4209 if (NILP (Fmember (tem
, Vload_path
)))
4210 Vload_path
= Fcons (tem
, Vload_path
);
4212 tem
= Fexpand_file_name (build_string ("leim"),
4215 if (NILP (Fmember (tem
, Vload_path
)))
4216 Vload_path
= Fcons (tem
, Vload_path
);
4220 tem
= Fexpand_file_name (build_string ("site-lisp"),
4223 if (NILP (Fmember (tem
, Vload_path
)))
4224 Vload_path
= Fcons (tem
, Vload_path
);
4227 } /* Vinstallation_directory != Vsource_directory */
4229 } /* if Vinstallation_directory */
4231 /* Add the site-lisp directories at the front. */
4232 /* Note: If the site changed the load-path during dumping,
4233 --no-site-lisp is ignored. I don't know what to do about this.
4237 Lisp_Object sitelisp
;
4238 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
);
4239 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4241 } /* if dump_path == Vload_path */
4243 else /* !initialized */
4245 /* NORMAL refers to the lisp dir in the source directory. */
4246 /* We used to add ../lisp at the front here, but
4247 that caused trouble because it was copied from dump_path
4248 into Vload_path, above, when Vinstallation_directory was non-nil.
4249 It should be unnecessary. */
4250 Vload_path
= decode_env_path (0, normal
);
4251 dump_path
= Vload_path
;
4253 #endif /* CANNOT_DUMP */
4255 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4256 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4257 almost never correct, thereby causing a warning to be printed out that
4258 confuses users. Since PATH_LOADSEARCH is always overridden by the
4259 EMACSLOADPATH environment variable below, disable the warning on NT. */
4261 /* HAVE_NS also uses EMACSLOADPATH. */
4263 /* Warn if dirs in the *standard* path don't exist. */
4264 if (!turn_off_warning
)
4266 Lisp_Object path_tail
;
4268 for (path_tail
= Vload_path
;
4270 path_tail
= XCDR (path_tail
))
4272 Lisp_Object dirfile
;
4273 dirfile
= Fcar (path_tail
);
4274 if (STRINGP (dirfile
))
4276 dirfile
= Fdirectory_file_name (dirfile
);
4277 /* Do we really need to warn about missing site-lisp dirs?
4278 It's true that the installation should have created
4279 them and added subdirs.el, but it's harmless if they
4281 if (access (SSDATA (dirfile
), 0) < 0)
4282 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4287 #endif /* !(WINDOWSNT || HAVE_NS) */
4289 /* If the EMACSLOADPATH environment variable is set, use its value.
4290 This doesn't apply if we're dumping. */
4292 if (NILP (Vpurify_flag
)
4293 && egetenv ("EMACSLOADPATH"))
4295 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4299 load_in_progress
= 0;
4300 Vload_file_name
= Qnil
;
4302 load_descriptor_list
= Qnil
;
4304 Vstandard_input
= Qt
;
4305 Vloads_in_progress
= Qnil
;
4308 /* Print a warning, using format string FORMAT, that directory DIRNAME
4309 does not exist. Print it on stderr and put it in *Messages*. */
4312 dir_warning (const char *format
, Lisp_Object dirname
)
4314 fprintf (stderr
, format
, SDATA (dirname
));
4316 /* Don't log the warning before we've initialized!! */
4320 ptrdiff_t message_len
;
4322 SAFE_ALLOCA (buffer
, char *,
4323 SBYTES (dirname
) + strlen (format
) - (sizeof "%s" - 1) + 1);
4324 message_len
= esprintf (buffer
, format
, SDATA (dirname
));
4325 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4331 syms_of_lread (void)
4334 defsubr (&Sread_from_string
);
4336 defsubr (&Sintern_soft
);
4337 defsubr (&Sunintern
);
4338 defsubr (&Sget_load_suffixes
);
4340 defsubr (&Seval_buffer
);
4341 defsubr (&Seval_region
);
4342 defsubr (&Sread_char
);
4343 defsubr (&Sread_char_exclusive
);
4344 defsubr (&Sread_event
);
4345 defsubr (&Sget_file_char
);
4346 defsubr (&Smapatoms
);
4347 defsubr (&Slocate_file_internal
);
4349 DEFVAR_LISP ("obarray", Vobarray
,
4350 doc
: /* Symbol table for use by `intern' and `read'.
4351 It is a vector whose length ought to be prime for best results.
4352 The vector's contents don't make sense if examined from Lisp programs;
4353 to find all the symbols in an obarray, use `mapatoms'. */);
4355 DEFVAR_LISP ("values", Vvalues
,
4356 doc
: /* List of values of all expressions which were read, evaluated and printed.
4357 Order is reverse chronological. */);
4358 XSYMBOL (intern ("values"))->declared_special
= 0;
4360 DEFVAR_LISP ("standard-input", Vstandard_input
,
4361 doc
: /* Stream for read to get input from.
4362 See documentation of `read' for possible values. */);
4363 Vstandard_input
= Qt
;
4365 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4366 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4368 If this variable is a buffer, then only forms read from that buffer
4369 will be added to `read-symbol-positions-list'.
4370 If this variable is t, then all read forms will be added.
4371 The effect of all other values other than nil are not currently
4372 defined, although they may be in the future.
4374 The positions are relative to the last call to `read' or
4375 `read-from-string'. It is probably a bad idea to set this variable at
4376 the toplevel; bind it instead. */);
4377 Vread_with_symbol_positions
= Qnil
;
4379 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4380 doc
: /* A list mapping read symbols to their positions.
4381 This variable is modified during calls to `read' or
4382 `read-from-string', but only when `read-with-symbol-positions' is
4385 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4386 CHAR-POSITION is an integer giving the offset of that occurrence of the
4387 symbol from the position where `read' or `read-from-string' started.
4389 Note that a symbol will appear multiple times in this list, if it was
4390 read multiple times. The list is in the same order as the symbols
4392 Vread_symbol_positions_list
= Qnil
;
4394 DEFVAR_LISP ("read-circle", Vread_circle
,
4395 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4398 DEFVAR_LISP ("load-path", Vload_path
,
4399 doc
: /* List of directories to search for files to load.
4400 Each element is a string (directory name) or nil (try default directory).
4401 Initialized based on EMACSLOADPATH environment variable, if any,
4402 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4404 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4405 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4406 This list should not include the empty string.
4407 `load' and related functions try to append these suffixes, in order,
4408 to the specified file name if a Lisp suffix is allowed or required. */);
4409 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4410 Fcons (make_pure_c_string (".el"), Qnil
));
4411 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4412 doc
: /* List of suffixes that indicate representations of \
4414 This list should normally start with the empty string.
4416 Enabling Auto Compression mode appends the suffixes in
4417 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4418 mode removes them again. `load' and related functions use this list to
4419 determine whether they should look for compressed versions of a file
4420 and, if so, which suffixes they should try to append to the file name
4421 in order to do so. However, if you want to customize which suffixes
4422 the loading functions recognize as compression suffixes, you should
4423 customize `jka-compr-load-suffixes' rather than the present variable. */);
4424 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4426 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4427 doc
: /* Non-nil if inside of `load'. */);
4428 DEFSYM (Qload_in_progress
, "load-in-progress");
4430 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4431 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4432 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4434 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4435 a symbol \(a feature name).
4437 When `load' is run and the file-name argument matches an element's
4438 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4439 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4441 An error in FORMS does not undo the load, but does prevent execution of
4442 the rest of the FORMS. */);
4443 Vafter_load_alist
= Qnil
;
4445 DEFVAR_LISP ("load-history", Vload_history
,
4446 doc
: /* Alist mapping loaded file names to symbols and features.
4447 Each alist element should be a list (FILE-NAME ENTRIES...), where
4448 FILE-NAME is the name of a file that has been loaded into Emacs.
4449 The file name is absolute and true (i.e. it doesn't contain symlinks).
4450 As an exception, one of the alist elements may have FILE-NAME nil,
4451 for symbols and features not associated with any file.
4453 The remaining ENTRIES in the alist element describe the functions and
4454 variables defined in that file, the features provided, and the
4455 features required. Each entry has the form `(provide . FEATURE)',
4456 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4457 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4458 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4459 autoload before this file redefined it as a function. In addition,
4460 entries may also be single symbols, which means that SYMBOL was
4461 defined by `defvar' or `defconst'.
4463 During preloading, the file name recorded is relative to the main Lisp
4464 directory. These file names are converted to absolute at startup. */);
4465 Vload_history
= Qnil
;
4467 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4468 doc
: /* Full name of file being loaded by `load'. */);
4469 Vload_file_name
= Qnil
;
4471 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4472 doc
: /* File name, including directory, of user's initialization file.
4473 If the file loaded had extension `.elc', and the corresponding source file
4474 exists, this variable contains the name of source file, suitable for use
4475 by functions like `custom-save-all' which edit the init file.
4476 While Emacs loads and evaluates the init file, value is the real name
4477 of the file, regardless of whether or not it has the `.elc' extension. */);
4478 Vuser_init_file
= Qnil
;
4480 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4481 doc
: /* Used for internal purposes by `load'. */);
4482 Vcurrent_load_list
= Qnil
;
4484 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4485 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4486 The default is nil, which means use the function `read'. */);
4487 Vload_read_function
= Qnil
;
4489 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4490 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4491 This function is for doing code conversion before reading the source file.
4492 If nil, loading is done without any code conversion.
4493 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4494 FULLNAME is the full name of FILE.
4495 See `load' for the meaning of the remaining arguments. */);
4496 Vload_source_file_function
= Qnil
;
4498 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4499 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4500 This is useful when the file being loaded is a temporary copy. */);
4501 load_force_doc_strings
= 0;
4503 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4504 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4505 This is normally bound by `load' and `eval-buffer' to control `read',
4506 and is not meant for users to change. */);
4507 load_convert_to_unibyte
= 0;
4509 DEFVAR_LISP ("source-directory", Vsource_directory
,
4510 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4511 You cannot count on them to still be there! */);
4513 = Fexpand_file_name (build_string ("../"),
4514 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4516 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4517 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4518 Vpreloaded_file_list
= Qnil
;
4520 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4521 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4522 Vbyte_boolean_vars
= Qnil
;
4524 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4525 doc
: /* Non-nil means load dangerous compiled Lisp files.
4526 Some versions of XEmacs use different byte codes than Emacs. These
4527 incompatible byte codes can make Emacs crash when it tries to execute
4529 load_dangerous_libraries
= 0;
4531 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4532 doc
: /* Non-nil means force printing messages when loading Lisp files.
4533 This overrides the value of the NOMESSAGE argument to `load'. */);
4534 force_load_messages
= 0;
4536 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4537 doc
: /* Regular expression matching safe to load compiled Lisp files.
4538 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4539 from the file, and matches them against this regular expression.
4540 When the regular expression matches, the file is considered to be safe
4541 to load. See also `load-dangerous-libraries'. */);
4542 Vbytecomp_version_regexp
4543 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4545 Qlexical_binding
= intern ("lexical-binding");
4546 staticpro (&Qlexical_binding
);
4547 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4548 doc
: /* Whether to use lexical binding when evaluating code.
4549 Non-nil means that the code in the current buffer should be evaluated
4550 with lexical binding.
4551 This variable is automatically set from the file variables of an
4552 interpreted Lisp file read using `load'. Unlike other file local
4553 variables, this must be set in the first line of a file. */);
4554 Fmake_variable_buffer_local (Qlexical_binding
);
4556 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4557 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4558 Veval_buffer_list
= Qnil
;
4560 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4561 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4562 Vold_style_backquotes
= Qnil
;
4563 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4565 /* Vsource_directory was initialized in init_lread. */
4567 load_descriptor_list
= Qnil
;
4568 staticpro (&load_descriptor_list
);
4570 DEFSYM (Qcurrent_load_list
, "current-load-list");
4571 DEFSYM (Qstandard_input
, "standard-input");
4572 DEFSYM (Qread_char
, "read-char");
4573 DEFSYM (Qget_file_char
, "get-file-char");
4574 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4575 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4577 DEFSYM (Qbackquote
, "`");
4578 DEFSYM (Qcomma
, ",");
4579 DEFSYM (Qcomma_at
, ",@");
4580 DEFSYM (Qcomma_dot
, ",.");
4582 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4583 DEFSYM (Qascii_character
, "ascii-character");
4584 DEFSYM (Qfunction
, "function");
4585 DEFSYM (Qload
, "load");
4586 DEFSYM (Qload_file_name
, "load-file-name");
4587 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4588 DEFSYM (Qfile_truename
, "file-truename");
4589 DEFSYM (Qdir_ok
, "dir-ok");
4590 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4592 staticpro (&dump_path
);
4594 staticpro (&read_objects
);
4595 read_objects
= Qnil
;
4596 staticpro (&seen_list
);
4599 Vloads_in_progress
= Qnil
;
4600 staticpro (&Vloads_in_progress
);
4602 DEFSYM (Qhash_table
, "hash-table");
4603 DEFSYM (Qdata
, "data");
4604 DEFSYM (Qtest
, "test");
4605 DEFSYM (Qsize
, "size");
4606 DEFSYM (Qweakness
, "weakness");
4607 DEFSYM (Qrehash_size
, "rehash-size");
4608 DEFSYM (Qrehash_threshold
, "rehash-threshold");