1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2011 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
29 #include "intervals.h"
31 #include "character.h"
38 #include "termhooks.h"
40 #include "blockinput.h"
51 #endif /* HAVE_SETLOCALE */
56 #define file_offset off_t
57 #define file_tell ftello
59 #define file_offset long
60 #define file_tell ftell
63 /* hash table read constants */
64 static Lisp_Object Qhash_table
, Qdata
;
65 static Lisp_Object Qtest
, Qsize
;
66 static Lisp_Object Qweakness
;
67 static Lisp_Object Qrehash_size
;
68 static Lisp_Object Qrehash_threshold
;
70 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
71 Lisp_Object Qstandard_input
;
72 Lisp_Object Qvariable_documentation
;
73 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
74 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
75 static Lisp_Object Qinhibit_file_name_operation
;
76 static Lisp_Object Qeval_buffer_list
;
77 static Lisp_Object Qlexical_binding
;
78 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
80 /* Used instead of Qget_file_char while loading *.elc files compiled
81 by Emacs 21 or older. */
82 static Lisp_Object Qget_emacs_mule_file_char
;
84 static Lisp_Object Qload_force_doc_strings
;
86 extern Lisp_Object Qinternal_interpreter_environment
;
88 static Lisp_Object Qload_in_progress
;
90 /* The association list of objects read with the #n=object form.
91 Each member of the list has the form (n . object), and is used to
92 look up the object for the corresponding #n# construct.
93 It must be set to nil before all top-level calls to read0. */
94 static Lisp_Object read_objects
;
96 /* Nonzero means READCHAR should read bytes one by one (not character)
97 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
98 This is set to 1 by read1 temporarily while handling #@NUMBER. */
99 static int load_each_byte
;
101 /* List of descriptors now open for Fload. */
102 static Lisp_Object load_descriptor_list
;
104 /* File for get_file_char to read from. Use by load. */
105 static FILE *instream
;
107 /* When nonzero, read conses in pure space */
108 static int read_pure
;
110 /* For use within read-from-string (this reader is non-reentrant!!) */
111 static EMACS_INT read_from_string_index
;
112 static EMACS_INT read_from_string_index_byte
;
113 static EMACS_INT read_from_string_limit
;
115 /* Number of characters read in the current call to Fread or
116 Fread_from_string. */
117 static EMACS_INT readchar_count
;
119 /* This contains the last string skipped with #@. */
120 static char *saved_doc_string
;
121 /* Length of buffer allocated in saved_doc_string. */
122 static int saved_doc_string_size
;
123 /* Length of actual data in saved_doc_string. */
124 static int saved_doc_string_length
;
125 /* This is the file position that string came from. */
126 static file_offset saved_doc_string_position
;
128 /* This contains the previous string skipped with #@.
129 We copy it from saved_doc_string when a new string
130 is put in saved_doc_string. */
131 static char *prev_saved_doc_string
;
132 /* Length of buffer allocated in prev_saved_doc_string. */
133 static int prev_saved_doc_string_size
;
134 /* Length of actual data in prev_saved_doc_string. */
135 static int prev_saved_doc_string_length
;
136 /* This is the file position that string came from. */
137 static file_offset prev_saved_doc_string_position
;
139 /* Nonzero means inside a new-style backquote
140 with no surrounding parentheses.
141 Fread initializes this to zero, so we need not specbind it
142 or worry about what happens to it when there is an error. */
143 static int new_backquote_flag
;
144 static Lisp_Object Qold_style_backquotes
;
146 /* A list of file names for files being loaded in Fload. Used to
147 check for recursive loads. */
149 static Lisp_Object Vloads_in_progress
;
151 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
154 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
, int,
155 Lisp_Object
, Lisp_Object
,
156 Lisp_Object
, Lisp_Object
);
157 static Lisp_Object
load_unwind (Lisp_Object
);
158 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
160 static void invalid_syntax (const char *, int) NO_RETURN
;
161 static void end_of_file_error (void) NO_RETURN
;
164 /* Functions that read one byte from the current source READCHARFUN
165 or unreads one byte. If the integer argument C is -1, it returns
166 one read byte, or -1 when there's no more byte in the source. If C
167 is 0 or positive, it unreads C, and the return value is not
170 static int readbyte_for_lambda (int, Lisp_Object
);
171 static int readbyte_from_file (int, Lisp_Object
);
172 static int readbyte_from_string (int, Lisp_Object
);
174 /* Handle unreading and rereading of characters.
175 Write READCHAR to read a character,
176 UNREAD(c) to unread c to be read again.
178 These macros correctly read/unread multibyte characters. */
180 #define READCHAR readchar (readcharfun, NULL)
181 #define UNREAD(c) unreadchar (readcharfun, c)
183 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
184 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
186 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
187 Qlambda, or a cons, we use this to keep an unread character because
188 a file stream can't handle multibyte-char unreading. The value -1
189 means that there's no unread character. */
190 static int unread_char
;
193 readchar (Lisp_Object readcharfun
, int *multibyte
)
197 int (*readbyte
) (int, Lisp_Object
);
198 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
200 int emacs_mule_encoding
= 0;
207 if (BUFFERP (readcharfun
))
209 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
211 EMACS_INT pt_byte
= BUF_PT_BYTE (inbuffer
);
213 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
216 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
218 /* Fetch the character code from the buffer. */
219 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
220 BUF_INC_POS (inbuffer
, pt_byte
);
227 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
228 if (! ASCII_BYTE_P (c
))
229 c
= BYTE8_TO_CHAR (c
);
232 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
236 if (MARKERP (readcharfun
))
238 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
240 EMACS_INT bytepos
= marker_byte_position (readcharfun
);
242 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
245 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
247 /* Fetch the character code from the buffer. */
248 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
249 BUF_INC_POS (inbuffer
, bytepos
);
256 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
257 if (! ASCII_BYTE_P (c
))
258 c
= BYTE8_TO_CHAR (c
);
262 XMARKER (readcharfun
)->bytepos
= bytepos
;
263 XMARKER (readcharfun
)->charpos
++;
268 if (EQ (readcharfun
, Qlambda
))
270 readbyte
= readbyte_for_lambda
;
274 if (EQ (readcharfun
, Qget_file_char
))
276 readbyte
= readbyte_from_file
;
280 if (STRINGP (readcharfun
))
282 if (read_from_string_index
>= read_from_string_limit
)
284 else if (STRING_MULTIBYTE (readcharfun
))
288 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
289 read_from_string_index
,
290 read_from_string_index_byte
);
294 c
= SREF (readcharfun
, read_from_string_index_byte
);
295 read_from_string_index
++;
296 read_from_string_index_byte
++;
301 if (CONSP (readcharfun
))
303 /* This is the case that read_vector is reading from a unibyte
304 string that contains a byte sequence previously skipped
305 because of #@NUMBER. The car part of readcharfun is that
306 string, and the cdr part is a value of readcharfun given to
308 readbyte
= readbyte_from_string
;
309 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
310 emacs_mule_encoding
= 1;
314 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
316 readbyte
= readbyte_from_file
;
317 emacs_mule_encoding
= 1;
321 tem
= call0 (readcharfun
);
328 if (unread_char
>= 0)
334 c
= (*readbyte
) (-1, readcharfun
);
335 if (c
< 0 || load_each_byte
)
339 if (ASCII_BYTE_P (c
))
341 if (emacs_mule_encoding
)
342 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
345 len
= BYTES_BY_CHAR_HEAD (c
);
348 c
= (*readbyte
) (-1, readcharfun
);
349 if (c
< 0 || ! TRAILING_CODE_P (c
))
352 (*readbyte
) (buf
[i
], readcharfun
);
353 return BYTE8_TO_CHAR (buf
[0]);
357 return STRING_CHAR (buf
);
360 /* Unread the character C in the way appropriate for the stream READCHARFUN.
361 If the stream is a user function, call it with the char as argument. */
364 unreadchar (Lisp_Object readcharfun
, int c
)
368 /* Don't back up the pointer if we're unreading the end-of-input mark,
369 since readchar didn't advance it when we read it. */
371 else if (BUFFERP (readcharfun
))
373 struct buffer
*b
= XBUFFER (readcharfun
);
374 EMACS_INT charpos
= BUF_PT (b
);
375 EMACS_INT bytepos
= BUF_PT_BYTE (b
);
377 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
378 BUF_DEC_POS (b
, bytepos
);
382 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
384 else if (MARKERP (readcharfun
))
386 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
387 EMACS_INT bytepos
= XMARKER (readcharfun
)->bytepos
;
389 XMARKER (readcharfun
)->charpos
--;
390 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
391 BUF_DEC_POS (b
, bytepos
);
395 XMARKER (readcharfun
)->bytepos
= bytepos
;
397 else if (STRINGP (readcharfun
))
399 read_from_string_index
--;
400 read_from_string_index_byte
401 = string_char_to_byte (readcharfun
, read_from_string_index
);
403 else if (CONSP (readcharfun
))
407 else if (EQ (readcharfun
, Qlambda
))
411 else if (EQ (readcharfun
, Qget_file_char
)
412 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
417 ungetc (c
, instream
);
424 call1 (readcharfun
, make_number (c
));
428 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
430 return read_bytecode_char (c
>= 0);
435 readbyte_from_file (int c
, Lisp_Object readcharfun
)
440 ungetc (c
, instream
);
449 /* Interrupted reads have been observed while reading over the network */
450 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
462 return (c
== EOF
? -1 : c
);
466 readbyte_from_string (int c
, Lisp_Object readcharfun
)
468 Lisp_Object string
= XCAR (readcharfun
);
472 read_from_string_index
--;
473 read_from_string_index_byte
474 = string_char_to_byte (string
, read_from_string_index
);
477 if (read_from_string_index
>= read_from_string_limit
)
480 FETCH_STRING_CHAR_ADVANCE (c
, string
,
481 read_from_string_index
,
482 read_from_string_index_byte
);
487 /* Read one non-ASCII character from INSTREAM. The character is
488 encoded in `emacs-mule' and the first byte is already read in
492 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
494 /* Emacs-mule coding uses at most 4-byte for one character. */
495 unsigned char buf
[4];
496 int len
= emacs_mule_bytes
[c
];
497 struct charset
*charset
;
502 /* C is not a valid leading-code of `emacs-mule'. */
503 return BYTE8_TO_CHAR (c
);
509 c
= (*readbyte
) (-1, readcharfun
);
513 (*readbyte
) (buf
[i
], readcharfun
);
514 return BYTE8_TO_CHAR (buf
[0]);
521 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
522 code
= buf
[1] & 0x7F;
526 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
527 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
529 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
530 code
= buf
[2] & 0x7F;
534 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
535 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
540 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
541 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
543 c
= DECODE_CHAR (charset
, code
);
545 Fsignal (Qinvalid_read_syntax
,
546 Fcons (build_string ("invalid multibyte form"), Qnil
));
551 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
553 static Lisp_Object
read0 (Lisp_Object
);
554 static Lisp_Object
read1 (Lisp_Object
, int *, int);
556 static Lisp_Object
read_list (int, Lisp_Object
);
557 static Lisp_Object
read_vector (Lisp_Object
, int);
559 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
561 static void substitute_object_in_subtree (Lisp_Object
,
563 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
566 /* Get a character from the tty. */
568 /* Read input events until we get one that's acceptable for our purposes.
570 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
571 until we get a character we like, and then stuffed into
574 If ASCII_REQUIRED is non-zero, we check function key events to see
575 if the unmodified version of the symbol has a Qascii_character
576 property, and use that character, if present.
578 If ERROR_NONASCII is non-zero, we signal an error if the input we
579 get isn't an ASCII character with modifiers. If it's zero but
580 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
583 If INPUT_METHOD is nonzero, we invoke the current input method
584 if the character warrants that.
586 If SECONDS is a number, we wait that many seconds for input, and
587 return Qnil if no input arrives within that time. */
590 read_filtered_event (int no_switch_frame
, int ascii_required
,
591 int error_nonascii
, int input_method
, Lisp_Object seconds
)
593 Lisp_Object val
, delayed_switch_frame
;
596 #ifdef HAVE_WINDOW_SYSTEM
597 if (display_hourglass_p
)
601 delayed_switch_frame
= Qnil
;
603 /* Compute timeout. */
604 if (NUMBERP (seconds
))
606 EMACS_TIME wait_time
;
608 double duration
= extract_float (seconds
);
610 sec
= (int) duration
;
611 usec
= (duration
- sec
) * 1000000;
612 EMACS_GET_TIME (end_time
);
613 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
614 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
617 /* Read until we get an acceptable event. */
620 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
621 NUMBERP (seconds
) ? &end_time
: NULL
);
622 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
627 /* switch-frame events are put off until after the next ASCII
628 character. This is better than signaling an error just because
629 the last characters were typed to a separate minibuffer frame,
630 for example. Eventually, some code which can deal with
631 switch-frame events will read it and process it. */
633 && EVENT_HAS_PARAMETERS (val
)
634 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
636 delayed_switch_frame
= val
;
640 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
642 /* Convert certain symbols to their ASCII equivalents. */
645 Lisp_Object tem
, tem1
;
646 tem
= Fget (val
, Qevent_symbol_element_mask
);
649 tem1
= Fget (Fcar (tem
), Qascii_character
);
650 /* Merge this symbol's modifier bits
651 with the ASCII equivalent of its basic code. */
653 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
657 /* If we don't have a character now, deal with it appropriately. */
662 Vunread_command_events
= Fcons (val
, Qnil
);
663 error ("Non-character input-event");
670 if (! NILP (delayed_switch_frame
))
671 unread_switch_frame
= delayed_switch_frame
;
675 #ifdef HAVE_WINDOW_SYSTEM
676 if (display_hourglass_p
)
685 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
686 doc
: /* Read a character from the command input (keyboard or macro).
687 It is returned as a number.
688 If the character has modifiers, they are resolved and reflected to the
689 character code if possible (e.g. C-SPC -> 0).
691 If the user generates an event which is not a character (i.e. a mouse
692 click or function key event), `read-char' signals an error. As an
693 exception, switch-frame events are put off until non-character events
695 If you want to read non-character events, or ignore them, call
696 `read-event' or `read-char-exclusive' instead.
698 If the optional argument PROMPT is non-nil, display that as a prompt.
699 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
700 input method is turned on in the current buffer, that input method
701 is used for reading a character.
702 If the optional argument SECONDS is non-nil, it should be a number
703 specifying the maximum number of seconds to wait for input. If no
704 input arrives in that time, return nil. SECONDS may be a
705 floating-point value. */)
706 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
711 message_with_string ("%s", prompt
, 0);
712 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
714 return (NILP (val
) ? Qnil
715 : make_number (char_resolve_modifier_mask (XINT (val
))));
718 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
719 doc
: /* Read an event object from the input stream.
720 If the optional argument PROMPT is non-nil, display that as a prompt.
721 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
722 input method is turned on in the current buffer, that input method
723 is used for reading a character.
724 If the optional argument SECONDS is non-nil, it should be a number
725 specifying the maximum number of seconds to wait for input. If no
726 input arrives in that time, return nil. SECONDS may be a
727 floating-point value. */)
728 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
731 message_with_string ("%s", prompt
, 0);
732 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
735 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
736 doc
: /* Read a character from the command input (keyboard or macro).
737 It is returned as a number. Non-character events are ignored.
738 If the character has modifiers, they are resolved and reflected to the
739 character code if possible (e.g. C-SPC -> 0).
741 If the optional argument PROMPT is non-nil, display that as a prompt.
742 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
743 input method is turned on in the current buffer, that input method
744 is used for reading a character.
745 If the optional argument SECONDS is non-nil, it should be a number
746 specifying the maximum number of seconds to wait for input. If no
747 input arrives in that time, return nil. SECONDS may be a
748 floating-point value. */)
749 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
754 message_with_string ("%s", prompt
, 0);
756 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
758 return (NILP (val
) ? Qnil
759 : make_number (char_resolve_modifier_mask (XINT (val
))));
762 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
763 doc
: /* Don't use this yourself. */)
766 register Lisp_Object val
;
768 XSETINT (val
, getc (instream
));
776 /* Return true if the lisp code read using READCHARFUN defines a non-nil
777 `lexical-binding' file variable. After returning, the stream is
778 positioned following the first line, if it is a comment, otherwise
782 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
786 /* The first line isn't a comment, just give up. */
792 /* Look for an appropriate file-variable in the first line. */
796 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
797 } beg_end_state
= NOMINAL
;
798 int in_file_vars
= 0;
800 #define UPDATE_BEG_END_STATE(ch) \
801 if (beg_end_state == NOMINAL) \
802 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
803 else if (beg_end_state == AFTER_FIRST_DASH) \
804 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
805 else if (beg_end_state == AFTER_ASTERIX) \
808 in_file_vars = !in_file_vars; \
809 beg_end_state = NOMINAL; \
812 /* Skip until we get to the file vars, if any. */
816 UPDATE_BEG_END_STATE (ch
);
818 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
822 char var
[100], val
[100];
827 /* Read a variable name. */
828 while (ch
== ' ' || ch
== '\t')
832 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
)
834 if (i
< sizeof var
- 1)
836 UPDATE_BEG_END_STATE (ch
);
840 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
846 /* Read a variable value. */
849 while (ch
== ' ' || ch
== '\t')
853 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
855 if (i
< sizeof val
- 1)
857 UPDATE_BEG_END_STATE (ch
);
861 /* The value was terminated by an end-marker, which
864 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
868 if (strcmp (var
, "lexical-binding") == 0)
871 rv
= (strcmp (val
, "nil") != 0);
877 while (ch
!= '\n' && ch
!= EOF
)
884 /* Value is a version number of byte compiled code if the file
885 associated with file descriptor FD is a compiled Lisp file that's
886 safe to load. Only files compiled with Emacs are safe to load.
887 Files compiled with XEmacs can lead to a crash in Fbyte_code
888 because of an incompatible change in the byte compiler. */
891 safe_to_load_p (int fd
)
898 /* Read the first few bytes from the file, and look for a line
899 specifying the byte compiler version used. */
900 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
905 /* Skip to the next newline, skipping over the initial `ELC'
906 with NUL bytes following it, but note the version. */
907 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
912 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
919 lseek (fd
, 0, SEEK_SET
);
924 /* Callback for record_unwind_protect. Restore the old load list OLD,
925 after loading a file successfully. */
928 record_load_unwind (Lisp_Object old
)
930 return Vloads_in_progress
= old
;
933 /* This handler function is used via internal_condition_case_1. */
936 load_error_handler (Lisp_Object data
)
942 load_warn_old_style_backquotes (Lisp_Object file
)
944 if (!NILP (Vold_style_backquotes
))
947 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
954 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
955 doc
: /* Return the suffixes that `load' should try if a suffix is \
957 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
960 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
961 while (CONSP (suffixes
))
963 Lisp_Object exts
= Vload_file_rep_suffixes
;
964 suffix
= XCAR (suffixes
);
965 suffixes
= XCDR (suffixes
);
970 lst
= Fcons (concat2 (suffix
, ext
), lst
);
973 return Fnreverse (lst
);
976 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
977 doc
: /* Execute a file of Lisp code named FILE.
978 First try FILE with `.elc' appended, then try with `.el',
979 then try FILE unmodified (the exact suffixes in the exact order are
980 determined by `load-suffixes'). Environment variable references in
981 FILE are replaced with their values by calling `substitute-in-file-name'.
982 This function searches the directories in `load-path'.
984 If optional second arg NOERROR is non-nil,
985 report no error if FILE doesn't exist.
986 Print messages at start and end of loading unless
987 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
989 If optional fourth arg NOSUFFIX is non-nil, don't try adding
990 suffixes `.elc' or `.el' to the specified name FILE.
991 If optional fifth arg MUST-SUFFIX is non-nil, insist on
992 the suffix `.elc' or `.el'; don't accept just FILE unless
993 it ends in one of those suffixes or includes a directory name.
995 If this function fails to find a file, it may look for different
996 representations of that file before trying another file.
997 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
998 to the file name. Emacs uses this feature mainly to find compressed
999 versions of files when Auto Compression mode is enabled.
1001 The exact suffixes that this function tries out, in the exact order,
1002 are given by the value of the variable `load-file-rep-suffixes' if
1003 NOSUFFIX is non-nil and by the return value of the function
1004 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1005 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1006 and then the former.
1008 Loading a file records its definitions, and its `provide' and
1009 `require' calls, in an element of `load-history' whose
1010 car is the file name loaded. See `load-history'.
1012 While the file is in the process of being loaded, the variable
1013 `load-in-progress' is non-nil and the variable `load-file-name'
1014 is bound to the file's name.
1016 Return t if the file exists and loads successfully. */)
1017 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1019 register FILE *stream
;
1020 register int fd
= -1;
1021 int count
= SPECPDL_INDEX ();
1022 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1023 Lisp_Object found
, efound
, hist_file_name
;
1024 /* 1 means we printed the ".el is newer" message. */
1026 /* 1 means we are loading a compiled file. */
1028 Lisp_Object handler
;
1030 const char *fmode
= "r";
1038 CHECK_STRING (file
);
1040 /* If file name is magic, call the handler. */
1041 /* This shouldn't be necessary any more now that `openp' handles it right.
1042 handler = Ffind_file_name_handler (file, Qload);
1043 if (!NILP (handler))
1044 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1046 /* Do this after the handler to avoid
1047 the need to gcpro noerror, nomessage and nosuffix.
1048 (Below here, we care only whether they are nil or not.)
1049 The presence of this call is the result of a historical accident:
1050 it used to be in every file-operation and when it got removed
1051 everywhere, it accidentally stayed here. Since then, enough people
1052 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1053 that it seemed risky to remove. */
1054 if (! NILP (noerror
))
1056 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1057 Qt
, load_error_handler
);
1062 file
= Fsubstitute_in_file_name (file
);
1065 /* Avoid weird lossage with null string as arg,
1066 since it would try to load a directory as a Lisp file */
1067 if (SCHARS (file
) > 0)
1069 int size
= SBYTES (file
);
1072 GCPRO2 (file
, found
);
1074 if (! NILP (must_suffix
))
1076 /* Don't insist on adding a suffix if FILE already ends with one. */
1078 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1081 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1083 /* Don't insist on adding a suffix
1084 if the argument includes a directory name. */
1085 else if (! NILP (Ffile_name_directory (file
)))
1089 fd
= openp (Vload_path
, file
,
1090 (!NILP (nosuffix
) ? Qnil
1091 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1092 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1093 tmp
[1] = Vload_file_rep_suffixes
,
1102 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1106 /* Tell startup.el whether or not we found the user's init file. */
1107 if (EQ (Qt
, Vuser_init_file
))
1108 Vuser_init_file
= found
;
1110 /* If FD is -2, that means openp found a magic file. */
1113 if (NILP (Fequal (found
, file
)))
1114 /* If FOUND is a different file name from FILE,
1115 find its handler even if we have already inhibited
1116 the `load' operation on FILE. */
1117 handler
= Ffind_file_name_handler (found
, Qt
);
1119 handler
= Ffind_file_name_handler (found
, Qload
);
1120 if (! NILP (handler
))
1121 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1124 /* Check if we're stuck in a recursive load cycle.
1126 2000-09-21: It's not possible to just check for the file loaded
1127 being a member of Vloads_in_progress. This fails because of the
1128 way the byte compiler currently works; `provide's are not
1129 evaluated, see font-lock.el/jit-lock.el as an example. This
1130 leads to a certain amount of ``normal'' recursion.
1132 Also, just loading a file recursively is not always an error in
1133 the general case; the second load may do something different. */
1137 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1138 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1142 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1144 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1145 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1148 /* All loads are by default dynamic, unless the file itself specifies
1149 otherwise using a file-variable in the first line. This is bound here
1150 so that it takes effect whether or not we use
1151 Vload_source_file_function. */
1152 specbind (Qlexical_binding
, Qnil
);
1154 /* Get the name for load-history. */
1155 hist_file_name
= (! NILP (Vpurify_flag
)
1156 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1157 tmp
[1] = Ffile_name_nondirectory (found
),
1163 /* Check for the presence of old-style quotes and warn about them. */
1164 specbind (Qold_style_backquotes
, Qnil
);
1165 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1167 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1168 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1169 /* Load .elc files directly, but not when they are
1170 remote and have no handler! */
1177 GCPRO3 (file
, found
, hist_file_name
);
1180 && ! (version
= safe_to_load_p (fd
)))
1183 if (!load_dangerous_libraries
)
1187 error ("File `%s' was not compiled in Emacs",
1190 else if (!NILP (nomessage
) && !force_load_messages
)
1191 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1196 efound
= ENCODE_FILE (found
);
1201 stat (SSDATA (efound
), &s1
);
1202 SSET (efound
, SBYTES (efound
) - 1, 0);
1203 result
= stat (SSDATA (efound
), &s2
);
1204 SSET (efound
, SBYTES (efound
) - 1, 'c');
1206 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1208 /* Make the progress messages mention that source is newer. */
1211 /* If we won't print another message, mention this anyway. */
1212 if (!NILP (nomessage
) && !force_load_messages
)
1214 Lisp_Object msg_file
;
1215 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1216 message_with_string ("Source file `%s' newer than byte-compiled file",
1225 /* We are loading a source file (*.el). */
1226 if (!NILP (Vload_source_file_function
))
1232 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1233 NILP (noerror
) ? Qnil
: Qt
,
1234 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1235 return unbind_to (count
, val
);
1239 GCPRO3 (file
, found
, hist_file_name
);
1243 efound
= ENCODE_FILE (found
);
1244 stream
= fopen (SSDATA (efound
), fmode
);
1245 #else /* not WINDOWSNT */
1246 stream
= fdopen (fd
, fmode
);
1247 #endif /* not WINDOWSNT */
1251 error ("Failure to create stdio stream for %s", SDATA (file
));
1254 if (! NILP (Vpurify_flag
))
1255 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1257 if (NILP (nomessage
) || force_load_messages
)
1260 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1263 message_with_string ("Loading %s (source)...", file
, 1);
1265 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1267 else /* The typical case; compiled file newer than source file. */
1268 message_with_string ("Loading %s...", file
, 1);
1271 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1272 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1273 specbind (Qload_file_name
, found
);
1274 specbind (Qinhibit_file_name_operation
, Qnil
);
1275 load_descriptor_list
1276 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1277 specbind (Qload_in_progress
, Qt
);
1280 if (lisp_file_lexically_bound_p (Qget_file_char
))
1281 Fset (Qlexical_binding
, Qt
);
1283 if (! version
|| version
>= 22)
1284 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1285 0, Qnil
, Qnil
, Qnil
, Qnil
);
1288 /* We can't handle a file which was compiled with
1289 byte-compile-dynamic by older version of Emacs. */
1290 specbind (Qload_force_doc_strings
, Qt
);
1291 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1292 0, Qnil
, Qnil
, Qnil
, Qnil
);
1294 unbind_to (count
, Qnil
);
1296 /* Run any eval-after-load forms for this file */
1297 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1298 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1302 xfree (saved_doc_string
);
1303 saved_doc_string
= 0;
1304 saved_doc_string_size
= 0;
1306 xfree (prev_saved_doc_string
);
1307 prev_saved_doc_string
= 0;
1308 prev_saved_doc_string_size
= 0;
1310 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1313 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1316 message_with_string ("Loading %s (source)...done", file
, 1);
1318 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1320 else /* The typical case; compiled file newer than source file. */
1321 message_with_string ("Loading %s...done", file
, 1);
1328 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1330 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1341 load_descriptor_unwind (Lisp_Object oldlist
)
1343 load_descriptor_list
= oldlist
;
1347 /* Close all descriptors in use for Floads.
1348 This is used when starting a subprocess. */
1351 close_load_descs (void)
1355 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1356 emacs_close (XFASTINT (XCAR (tail
)));
1361 complete_filename_p (Lisp_Object pathname
)
1363 register const unsigned char *s
= SDATA (pathname
);
1364 return (IS_DIRECTORY_SEP (s
[0])
1365 || (SCHARS (pathname
) > 2
1366 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1369 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1370 doc
: /* Search for FILENAME through PATH.
1371 Returns the file's name in absolute form, or nil if not found.
1372 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1373 file name when searching.
1374 If non-nil, PREDICATE is used instead of `file-readable-p'.
1375 PREDICATE can also be an integer to pass to the access(2) function,
1376 in which case file-name-handlers are ignored.
1377 This function will normally skip directories, so if you want it to find
1378 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1379 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1382 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1383 if (NILP (predicate
) && fd
> 0)
1388 static Lisp_Object Qdir_ok
;
1390 /* Search for a file whose name is STR, looking in directories
1391 in the Lisp list PATH, and trying suffixes from SUFFIX.
1392 On success, returns a file descriptor. On failure, returns -1.
1394 SUFFIXES is a list of strings containing possible suffixes.
1395 The empty suffix is automatically added if the list is empty.
1397 PREDICATE non-nil means don't open the files,
1398 just look for one that satisfies the predicate. In this case,
1399 returns 1 on success. The predicate can be a lisp function or
1400 an integer to pass to `access' (in which case file-name-handlers
1403 If STOREPTR is nonzero, it points to a slot where the name of
1404 the file actually found should be stored as a Lisp string.
1405 nil is stored there on failure.
1407 If the file we find is remote, return -2
1408 but store the found remote file name in *STOREPTR. */
1411 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1414 EMACS_INT fn_size
= 100;
1416 register char *fn
= buf
;
1418 EMACS_INT want_length
;
1419 Lisp_Object filename
;
1421 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1422 Lisp_Object string
, tail
, encoded_fn
;
1423 EMACS_INT max_suffix_len
= 0;
1427 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1429 CHECK_STRING_CAR (tail
);
1430 max_suffix_len
= max (max_suffix_len
,
1431 SBYTES (XCAR (tail
)));
1434 string
= filename
= encoded_fn
= Qnil
;
1435 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1440 if (complete_filename_p (str
))
1443 for (; CONSP (path
); path
= XCDR (path
))
1445 filename
= Fexpand_file_name (str
, XCAR (path
));
1446 if (!complete_filename_p (filename
))
1447 /* If there are non-absolute elts in PATH (eg ".") */
1448 /* Of course, this could conceivably lose if luser sets
1449 default-directory to be something non-absolute... */
1451 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1452 if (!complete_filename_p (filename
))
1453 /* Give up on this path element! */
1457 /* Calculate maximum length of any filename made from
1458 this path element/specified file name and any possible suffix. */
1459 want_length
= max_suffix_len
+ SBYTES (filename
);
1460 if (fn_size
<= want_length
)
1461 fn
= (char *) alloca (fn_size
= 100 + want_length
);
1463 /* Loop over suffixes. */
1464 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1465 CONSP (tail
); tail
= XCDR (tail
))
1467 int lsuffix
= SBYTES (XCAR (tail
));
1468 Lisp_Object handler
;
1471 /* Concatenate path element/specified name with the suffix.
1472 If the directory starts with /:, remove that. */
1473 if (SCHARS (filename
) > 2
1474 && SREF (filename
, 0) == '/'
1475 && SREF (filename
, 1) == ':')
1477 strncpy (fn
, SSDATA (filename
) + 2,
1478 SBYTES (filename
) - 2);
1479 fn
[SBYTES (filename
) - 2] = 0;
1483 strncpy (fn
, SSDATA (filename
),
1485 fn
[SBYTES (filename
)] = 0;
1488 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1489 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1491 /* Check that the file exists and is not a directory. */
1492 /* We used to only check for handlers on non-absolute file names:
1496 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1497 It's not clear why that was the case and it breaks things like
1498 (load "/bar.el") where the file is actually "/bar.el.gz". */
1499 string
= build_string (fn
);
1500 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1501 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1503 if (NILP (predicate
))
1504 exists
= !NILP (Ffile_readable_p (string
));
1507 Lisp_Object tmp
= call1 (predicate
, string
);
1508 exists
= !NILP (tmp
)
1509 && (EQ (tmp
, Qdir_ok
)
1510 || NILP (Ffile_directory_p (string
)));
1515 /* We succeeded; return this descriptor and filename. */
1526 encoded_fn
= ENCODE_FILE (string
);
1527 pfn
= SSDATA (encoded_fn
);
1528 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1531 /* Check that we can access or open it. */
1532 if (NATNUMP (predicate
))
1533 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1535 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1539 /* We succeeded; return this descriptor and filename. */
1557 /* Merge the list we've accumulated of globals from the current input source
1558 into the load_history variable. The details depend on whether
1559 the source has an associated file name or not.
1561 FILENAME is the file name that we are loading from.
1562 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1565 build_load_history (Lisp_Object filename
, int entire
)
1567 register Lisp_Object tail
, prev
, newelt
;
1568 register Lisp_Object tem
, tem2
;
1569 register int foundit
= 0;
1571 tail
= Vload_history
;
1574 while (CONSP (tail
))
1578 /* Find the feature's previous assoc list... */
1579 if (!NILP (Fequal (filename
, Fcar (tem
))))
1583 /* If we're loading the entire file, remove old data. */
1587 Vload_history
= XCDR (tail
);
1589 Fsetcdr (prev
, XCDR (tail
));
1592 /* Otherwise, cons on new symbols that are not already members. */
1595 tem2
= Vcurrent_load_list
;
1597 while (CONSP (tem2
))
1599 newelt
= XCAR (tem2
);
1601 if (NILP (Fmember (newelt
, tem
)))
1602 Fsetcar (tail
, Fcons (XCAR (tem
),
1603 Fcons (newelt
, XCDR (tem
))));
1616 /* If we're loading an entire file, cons the new assoc onto the
1617 front of load-history, the most-recently-loaded position. Also
1618 do this if we didn't find an existing member for the file. */
1619 if (entire
|| !foundit
)
1620 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1625 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1632 readevalloop_1 (Lisp_Object old
)
1634 load_convert_to_unibyte
= ! NILP (old
);
1638 /* Signal an `end-of-file' error, if possible with file name
1642 end_of_file_error (void)
1644 if (STRINGP (Vload_file_name
))
1645 xsignal1 (Qend_of_file
, Vload_file_name
);
1647 xsignal0 (Qend_of_file
);
1650 /* UNIBYTE specifies how to set load_convert_to_unibyte
1651 for this invocation.
1652 READFUN, if non-nil, is used instead of `read'.
1654 START, END specify region to read in current buffer (from eval-region).
1655 If the input is not from a buffer, they must be nil. */
1658 readevalloop (Lisp_Object readcharfun
,
1660 Lisp_Object sourcename
,
1662 Lisp_Object unibyte
, Lisp_Object readfun
,
1663 Lisp_Object start
, Lisp_Object end
)
1666 register Lisp_Object val
;
1667 int count
= SPECPDL_INDEX ();
1668 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1669 struct buffer
*b
= 0;
1670 int continue_reading_p
;
1671 Lisp_Object lex_bound
;
1672 /* Nonzero if reading an entire buffer. */
1673 int whole_buffer
= 0;
1674 /* 1 on the first time around. */
1677 if (MARKERP (readcharfun
))
1680 start
= readcharfun
;
1683 if (BUFFERP (readcharfun
))
1684 b
= XBUFFER (readcharfun
);
1685 else if (MARKERP (readcharfun
))
1686 b
= XMARKER (readcharfun
)->buffer
;
1688 /* We assume START is nil when input is not from a buffer. */
1689 if (! NILP (start
) && !b
)
1692 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1693 specbind (Qcurrent_load_list
, Qnil
);
1694 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1695 load_convert_to_unibyte
= !NILP (unibyte
);
1697 /* If lexical binding is active (either because it was specified in
1698 the file's header, or via a buffer-local variable), create an empty
1699 lexical environment, otherwise, turn off lexical binding. */
1700 lex_bound
= find_symbol_value (Qlexical_binding
);
1701 specbind (Qinternal_interpreter_environment
,
1702 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1703 ? Qnil
: Fcons (Qt
, Qnil
));
1705 GCPRO4 (sourcename
, readfun
, start
, end
);
1707 /* Try to ensure sourcename is a truename, except whilst preloading. */
1708 if (NILP (Vpurify_flag
)
1709 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1710 && !NILP (Ffboundp (Qfile_truename
)))
1711 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1713 LOADHIST_ATTACH (sourcename
);
1715 continue_reading_p
= 1;
1716 while (continue_reading_p
)
1718 int count1
= SPECPDL_INDEX ();
1720 if (b
!= 0 && NILP (BVAR (b
, name
)))
1721 error ("Reading from killed buffer");
1725 /* Switch to the buffer we are reading from. */
1726 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1727 set_buffer_internal (b
);
1729 /* Save point in it. */
1730 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1731 /* Save ZV in it. */
1732 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1733 /* Those get unbound after we read one expression. */
1735 /* Set point and ZV around stuff to be read. */
1738 Fnarrow_to_region (make_number (BEGV
), end
);
1740 /* Just for cleanliness, convert END to a marker
1741 if it is an integer. */
1743 end
= Fpoint_max_marker ();
1746 /* On the first cycle, we can easily test here
1747 whether we are reading the whole buffer. */
1748 if (b
&& first_sexp
)
1749 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1756 while ((c
= READCHAR
) != '\n' && c
!= -1);
1761 unbind_to (count1
, Qnil
);
1765 /* Ignore whitespace here, so we can detect eof. */
1766 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1767 || c
== 0x8a0) /* NBSP */
1770 if (!NILP (Vpurify_flag
) && c
== '(')
1772 record_unwind_protect (unreadpure
, Qnil
);
1773 val
= read_list (-1, readcharfun
);
1778 read_objects
= Qnil
;
1779 if (!NILP (readfun
))
1781 val
= call1 (readfun
, readcharfun
);
1783 /* If READCHARFUN has set point to ZV, we should
1784 stop reading, even if the form read sets point
1785 to a different value when evaluated. */
1786 if (BUFFERP (readcharfun
))
1788 struct buffer
*buf
= XBUFFER (readcharfun
);
1789 if (BUF_PT (buf
) == BUF_ZV (buf
))
1790 continue_reading_p
= 0;
1793 else if (! NILP (Vload_read_function
))
1794 val
= call1 (Vload_read_function
, readcharfun
);
1796 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1799 if (!NILP (start
) && continue_reading_p
)
1800 start
= Fpoint_marker ();
1802 /* Restore saved point and BEGV. */
1803 unbind_to (count1
, Qnil
);
1805 /* Now eval what we just read. */
1806 val
= eval_sub (val
);
1810 Vvalues
= Fcons (val
, Vvalues
);
1811 if (EQ (Vstandard_output
, Qt
))
1820 build_load_history (sourcename
,
1821 stream
|| whole_buffer
);
1825 unbind_to (count
, Qnil
);
1828 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1829 doc
: /* Execute the current buffer as Lisp code.
1830 When called from a Lisp program (i.e., not interactively), this
1831 function accepts up to five optional arguments:
1832 BUFFER is the buffer to evaluate (nil means use current buffer).
1833 PRINTFLAG controls printing of output:
1834 A value of nil means discard it; anything else is stream for print.
1835 FILENAME specifies the file name to use for `load-history'.
1836 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1838 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1839 functions should work normally even if PRINTFLAG is nil.
1841 This function preserves the position of point. */)
1842 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1844 int count
= SPECPDL_INDEX ();
1845 Lisp_Object tem
, buf
;
1848 buf
= Fcurrent_buffer ();
1850 buf
= Fget_buffer (buffer
);
1852 error ("No such buffer");
1854 if (NILP (printflag
) && NILP (do_allow_print
))
1859 if (NILP (filename
))
1860 filename
= BVAR (XBUFFER (buf
), filename
);
1862 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1863 specbind (Qstandard_output
, tem
);
1864 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1865 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1866 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1867 readevalloop (buf
, 0, filename
,
1868 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1869 unbind_to (count
, Qnil
);
1874 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1875 doc
: /* Execute the region as Lisp code.
1876 When called from programs, expects two arguments,
1877 giving starting and ending indices in the current buffer
1878 of the text to be executed.
1879 Programs can pass third argument PRINTFLAG which controls output:
1880 A value of nil means discard it; anything else is stream for printing it.
1881 Also the fourth argument READ-FUNCTION, if non-nil, is used
1882 instead of `read' to read each expression. It gets one argument
1883 which is the input stream for reading characters.
1885 This function does not move point. */)
1886 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1888 /* FIXME: Do the eval-sexp-add-defvars danse! */
1889 int count
= SPECPDL_INDEX ();
1890 Lisp_Object tem
, cbuf
;
1892 cbuf
= Fcurrent_buffer ();
1894 if (NILP (printflag
))
1898 specbind (Qstandard_output
, tem
);
1899 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1901 /* readevalloop calls functions which check the type of start and end. */
1902 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1903 !NILP (printflag
), Qnil
, read_function
,
1906 return unbind_to (count
, Qnil
);
1910 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1911 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1912 If STREAM is nil, use the value of `standard-input' (which see).
1913 STREAM or the value of `standard-input' may be:
1914 a buffer (read from point and advance it)
1915 a marker (read from where it points and advance it)
1916 a function (call it with no arguments for each character,
1917 call it with a char as argument to push a char back)
1918 a string (takes text from string, starting at the beginning)
1919 t (read text line using minibuffer and use it, or read from
1920 standard input in batch mode). */)
1921 (Lisp_Object stream
)
1924 stream
= Vstandard_input
;
1925 if (EQ (stream
, Qt
))
1926 stream
= Qread_char
;
1927 if (EQ (stream
, Qread_char
))
1928 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1930 return read_internal_start (stream
, Qnil
, Qnil
);
1933 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1934 doc
: /* Read one Lisp expression which is represented as text by STRING.
1935 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1936 START and END optionally delimit a substring of STRING from which to read;
1937 they default to 0 and (length STRING) respectively. */)
1938 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1941 CHECK_STRING (string
);
1942 /* read_internal_start sets read_from_string_index. */
1943 ret
= read_internal_start (string
, start
, end
);
1944 return Fcons (ret
, make_number (read_from_string_index
));
1947 /* Function to set up the global context we need in toplevel read
1950 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1951 /* start, end only used when stream is a string. */
1956 new_backquote_flag
= 0;
1957 read_objects
= Qnil
;
1958 if (EQ (Vread_with_symbol_positions
, Qt
)
1959 || EQ (Vread_with_symbol_positions
, stream
))
1960 Vread_symbol_positions_list
= Qnil
;
1962 if (STRINGP (stream
)
1963 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1965 EMACS_INT startval
, endval
;
1968 if (STRINGP (stream
))
1971 string
= XCAR (stream
);
1974 endval
= SCHARS (string
);
1978 endval
= XINT (end
);
1979 if (endval
< 0 || endval
> SCHARS (string
))
1980 args_out_of_range (string
, end
);
1987 CHECK_NUMBER (start
);
1988 startval
= XINT (start
);
1989 if (startval
< 0 || startval
> endval
)
1990 args_out_of_range (string
, start
);
1992 read_from_string_index
= startval
;
1993 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1994 read_from_string_limit
= endval
;
1997 retval
= read0 (stream
);
1998 if (EQ (Vread_with_symbol_positions
, Qt
)
1999 || EQ (Vread_with_symbol_positions
, stream
))
2000 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2005 /* Signal Qinvalid_read_syntax error.
2006 S is error string of length N (if > 0) */
2009 invalid_syntax (const char *s
, int n
)
2013 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
2017 /* Use this for recursive reads, in contexts where internal tokens
2021 read0 (Lisp_Object readcharfun
)
2023 register Lisp_Object val
;
2026 val
= read1 (readcharfun
, &c
, 0);
2030 xsignal1 (Qinvalid_read_syntax
,
2031 Fmake_string (make_number (1), make_number (c
)));
2034 static int read_buffer_size
;
2035 static char *read_buffer
;
2037 /* Read a \-escape sequence, assuming we already read the `\'.
2038 If the escape sequence forces unibyte, return eight-bit char. */
2041 read_escape (Lisp_Object readcharfun
, int stringp
)
2043 register int c
= READCHAR
;
2044 /* \u allows up to four hex digits, \U up to eight. Default to the
2045 behavior for \u, and change this value in the case that \U is seen. */
2046 int unicode_hex_count
= 4;
2051 end_of_file_error ();
2081 error ("Invalid escape character syntax");
2084 c
= read_escape (readcharfun
, 0);
2085 return c
| meta_modifier
;
2090 error ("Invalid escape character syntax");
2093 c
= read_escape (readcharfun
, 0);
2094 return c
| shift_modifier
;
2099 error ("Invalid escape character syntax");
2102 c
= read_escape (readcharfun
, 0);
2103 return c
| hyper_modifier
;
2108 error ("Invalid escape character syntax");
2111 c
= read_escape (readcharfun
, 0);
2112 return c
| alt_modifier
;
2116 if (stringp
|| c
!= '-')
2123 c
= read_escape (readcharfun
, 0);
2124 return c
| super_modifier
;
2129 error ("Invalid escape character syntax");
2133 c
= read_escape (readcharfun
, 0);
2134 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2135 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2136 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2137 return c
| ctrl_modifier
;
2138 /* ASCII control chars are made from letters (both cases),
2139 as well as the non-letters within 0100...0137. */
2140 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2141 return (c
& (037 | ~0177));
2142 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2143 return (c
& (037 | ~0177));
2145 return c
| ctrl_modifier
;
2155 /* An octal escape, as in ANSI C. */
2157 register int i
= c
- '0';
2158 register int count
= 0;
2161 if ((c
= READCHAR
) >= '0' && c
<= '7')
2173 if (i
>= 0x80 && i
< 0x100)
2174 i
= BYTE8_TO_CHAR (i
);
2179 /* A hex escape, as in ANSI C. */
2186 if (c
>= '0' && c
<= '9')
2191 else if ((c
>= 'a' && c
<= 'f')
2192 || (c
>= 'A' && c
<= 'F'))
2195 if (c
>= 'a' && c
<= 'f')
2208 if (count
< 3 && i
>= 0x80)
2209 return BYTE8_TO_CHAR (i
);
2214 /* Post-Unicode-2.0: Up to eight hex chars. */
2215 unicode_hex_count
= 8;
2218 /* A Unicode escape. We only permit them in strings and characters,
2219 not arbitrarily in the source code, as in some other languages. */
2224 while (++count
<= unicode_hex_count
)
2227 /* isdigit and isalpha may be locale-specific, which we don't
2229 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2230 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2231 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2234 error ("Non-hex digit used for Unicode escape");
2239 error ("Non-Unicode character: 0x%x", i
);
2248 /* Return the digit that CHARACTER stands for in the given BASE.
2249 Return -1 if CHARACTER is out of range for BASE,
2250 and -2 if CHARACTER is not valid for any supported BASE. */
2252 digit_to_number (int character
, int base
)
2256 if ('0' <= character
&& character
<= '9')
2257 digit
= character
- '0';
2258 else if ('a' <= character
&& character
<= 'z')
2259 digit
= character
- 'a' + 10;
2260 else if ('A' <= character
&& character
<= 'Z')
2261 digit
= character
- 'A' + 10;
2265 return digit
< base
? digit
: -1;
2268 /* Read an integer in radix RADIX using READCHARFUN to read
2269 characters. RADIX must be in the interval [2..36]; if it isn't, a
2270 read error is signaled . Value is the integer read. Signals an
2271 error if encountering invalid read syntax or if RADIX is out of
2275 read_integer (Lisp_Object readcharfun
, int radix
)
2277 /* Room for sign, leading 0, other digits, trailing null byte. */
2278 char buf
[1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1];
2280 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2282 if (radix
< 2 || radix
> 36)
2290 if (c
== '-' || c
== '+')
2301 /* Ignore redundant leading zeros, so the buffer doesn't
2302 fill up with them. */
2308 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2315 if (p
< buf
+ sizeof buf
- 1)
2330 sprintf (buf
, "integer, radix %d", radix
);
2331 invalid_syntax (buf
, 0);
2334 return string_to_number (buf
, radix
, 0);
2338 /* If the next token is ')' or ']' or '.', we store that character
2339 in *PCH and the return value is not interesting. Else, we store
2340 zero in *PCH and we read and return one lisp object.
2342 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2345 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2348 unsigned uninterned_symbol
= 0;
2356 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2358 end_of_file_error ();
2363 return read_list (0, readcharfun
);
2366 return read_vector (readcharfun
, 0);
2382 /* Accept extended format for hashtables (extensible to
2384 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2385 Lisp_Object tmp
= read_list (0, readcharfun
);
2386 Lisp_Object head
= CAR_SAFE (tmp
);
2387 Lisp_Object data
= Qnil
;
2388 Lisp_Object val
= Qnil
;
2389 /* The size is 2 * number of allowed keywords to
2391 Lisp_Object params
[10];
2393 Lisp_Object key
= Qnil
;
2394 int param_count
= 0;
2396 if (!EQ (head
, Qhash_table
))
2397 error ("Invalid extended read marker at head of #s list "
2398 "(only hash-table allowed)");
2400 tmp
= CDR_SAFE (tmp
);
2402 /* This is repetitive but fast and simple. */
2403 params
[param_count
] = QCsize
;
2404 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2405 if (!NILP (params
[param_count
+ 1]))
2408 params
[param_count
] = QCtest
;
2409 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2410 if (!NILP (params
[param_count
+ 1]))
2413 params
[param_count
] = QCweakness
;
2414 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2415 if (!NILP (params
[param_count
+ 1]))
2418 params
[param_count
] = QCrehash_size
;
2419 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2420 if (!NILP (params
[param_count
+ 1]))
2423 params
[param_count
] = QCrehash_threshold
;
2424 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2425 if (!NILP (params
[param_count
+ 1]))
2428 /* This is the hashtable data. */
2429 data
= Fplist_get (tmp
, Qdata
);
2431 /* Now use params to make a new hashtable and fill it. */
2432 ht
= Fmake_hash_table (param_count
, params
);
2434 while (CONSP (data
))
2439 error ("Odd number of elements in hashtable data");
2442 Fputhash (key
, val
, ht
);
2448 invalid_syntax ("#", 1);
2456 tmp
= read_vector (readcharfun
, 0);
2457 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2458 error ("Invalid size char-table");
2459 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2470 tmp
= read_vector (readcharfun
, 0);
2471 if (!INTEGERP (AREF (tmp
, 0)))
2472 error ("Invalid depth in char-table");
2473 depth
= XINT (AREF (tmp
, 0));
2474 if (depth
< 1 || depth
> 3)
2475 error ("Invalid depth in char-table");
2476 size
= ASIZE (tmp
) - 2;
2477 if (chartab_size
[depth
] != size
)
2478 error ("Invalid size char-table");
2479 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2482 invalid_syntax ("#^^", 3);
2484 invalid_syntax ("#^", 2);
2489 length
= read1 (readcharfun
, pch
, first_in_list
);
2493 Lisp_Object tmp
, val
;
2495 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2496 / BOOL_VECTOR_BITS_PER_CHAR
);
2499 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2500 if (STRING_MULTIBYTE (tmp
)
2501 || (size_in_chars
!= SCHARS (tmp
)
2502 /* We used to print 1 char too many
2503 when the number of bits was a multiple of 8.
2504 Accept such input in case it came from an old
2506 && ! (XFASTINT (length
)
2507 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2508 invalid_syntax ("#&...", 5);
2510 val
= Fmake_bool_vector (length
, Qnil
);
2511 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2512 /* Clear the extraneous bits in the last byte. */
2513 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2514 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2515 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2518 invalid_syntax ("#&...", 5);
2522 /* Accept compiled functions at read-time so that we don't have to
2523 build them using function calls. */
2525 tmp
= read_vector (readcharfun
, 1);
2526 return Fmake_byte_code (ASIZE (tmp
),
2527 XVECTOR (tmp
)->contents
);
2532 struct gcpro gcpro1
;
2535 /* Read the string itself. */
2536 tmp
= read1 (readcharfun
, &ch
, 0);
2537 if (ch
!= 0 || !STRINGP (tmp
))
2538 invalid_syntax ("#", 1);
2540 /* Read the intervals and their properties. */
2543 Lisp_Object beg
, end
, plist
;
2545 beg
= read1 (readcharfun
, &ch
, 0);
2550 end
= read1 (readcharfun
, &ch
, 0);
2552 plist
= read1 (readcharfun
, &ch
, 0);
2554 invalid_syntax ("Invalid string property list", 0);
2555 Fset_text_properties (beg
, end
, plist
, tmp
);
2561 /* #@NUMBER is used to skip NUMBER following characters.
2562 That's used in .elc files to skip over doc strings
2563 and function definitions. */
2569 /* Read a decimal integer. */
2570 while ((c
= READCHAR
) >= 0
2571 && c
>= '0' && c
<= '9')
2579 if (load_force_doc_strings
2580 && (EQ (readcharfun
, Qget_file_char
)
2581 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2583 /* If we are supposed to force doc strings into core right now,
2584 record the last string that we skipped,
2585 and record where in the file it comes from. */
2587 /* But first exchange saved_doc_string
2588 with prev_saved_doc_string, so we save two strings. */
2590 char *temp
= saved_doc_string
;
2591 int temp_size
= saved_doc_string_size
;
2592 file_offset temp_pos
= saved_doc_string_position
;
2593 int temp_len
= saved_doc_string_length
;
2595 saved_doc_string
= prev_saved_doc_string
;
2596 saved_doc_string_size
= prev_saved_doc_string_size
;
2597 saved_doc_string_position
= prev_saved_doc_string_position
;
2598 saved_doc_string_length
= prev_saved_doc_string_length
;
2600 prev_saved_doc_string
= temp
;
2601 prev_saved_doc_string_size
= temp_size
;
2602 prev_saved_doc_string_position
= temp_pos
;
2603 prev_saved_doc_string_length
= temp_len
;
2606 if (saved_doc_string_size
== 0)
2608 saved_doc_string_size
= nskip
+ 100;
2609 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2611 if (nskip
> saved_doc_string_size
)
2613 saved_doc_string_size
= nskip
+ 100;
2614 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2615 saved_doc_string_size
);
2618 saved_doc_string_position
= file_tell (instream
);
2620 /* Copy that many characters into saved_doc_string. */
2621 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2622 saved_doc_string
[i
] = c
= READCHAR
;
2624 saved_doc_string_length
= i
;
2628 /* Skip that many characters. */
2629 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2638 /* #! appears at the beginning of an executable file.
2639 Skip the first line. */
2640 while (c
!= '\n' && c
>= 0)
2645 return Vload_file_name
;
2647 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2648 /* #:foo is the uninterned symbol named foo. */
2651 uninterned_symbol
= 1;
2655 /* Reader forms that can reuse previously read objects. */
2656 if (c
>= '0' && c
<= '9')
2661 /* Read a non-negative integer. */
2662 while (c
>= '0' && c
<= '9')
2668 /* #n=object returns object, but associates it with n for #n#. */
2669 if (c
== '=' && !NILP (Vread_circle
))
2671 /* Make a placeholder for #n# to use temporarily */
2672 Lisp_Object placeholder
;
2675 placeholder
= Fcons (Qnil
, Qnil
);
2676 cell
= Fcons (make_number (n
), placeholder
);
2677 read_objects
= Fcons (cell
, read_objects
);
2679 /* Read the object itself. */
2680 tem
= read0 (readcharfun
);
2682 /* Now put it everywhere the placeholder was... */
2683 substitute_object_in_subtree (tem
, placeholder
);
2685 /* ...and #n# will use the real value from now on. */
2686 Fsetcdr (cell
, tem
);
2690 /* #n# returns a previously read object. */
2691 if (c
== '#' && !NILP (Vread_circle
))
2693 tem
= Fassq (make_number (n
), read_objects
);
2696 /* Fall through to error message. */
2698 else if (c
== 'r' || c
== 'R')
2699 return read_integer (readcharfun
, n
);
2701 /* Fall through to error message. */
2703 else if (c
== 'x' || c
== 'X')
2704 return read_integer (readcharfun
, 16);
2705 else if (c
== 'o' || c
== 'O')
2706 return read_integer (readcharfun
, 8);
2707 else if (c
== 'b' || c
== 'B')
2708 return read_integer (readcharfun
, 2);
2711 invalid_syntax ("#", 1);
2714 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2719 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2724 int next_char
= READCHAR
;
2726 /* Transition from old-style to new-style:
2727 If we see "(`" it used to mean old-style, which usually works
2728 fine because ` should almost never appear in such a position
2729 for new-style. But occasionally we need "(`" to mean new
2730 style, so we try to distinguish the two by the fact that we
2731 can either write "( `foo" or "(` foo", where the first
2732 intends to use new-style whereas the second intends to use
2733 old-style. For Emacs-25, we should completely remove this
2734 first_in_list exception (old-style can still be obtained via
2736 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2738 Vold_style_backquotes
= Qt
;
2745 new_backquote_flag
++;
2746 value
= read0 (readcharfun
);
2747 new_backquote_flag
--;
2749 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2754 int next_char
= READCHAR
;
2756 /* Transition from old-style to new-style:
2757 It used to be impossible to have a new-style , other than within
2758 a new-style `. This is sufficient when ` and , are used in the
2759 normal way, but ` and , can also appear in args to macros that
2760 will not interpret them in the usual way, in which case , may be
2761 used without any ` anywhere near.
2762 So we now use the same heuristic as for backquote: old-style
2763 unquotes are only recognized when first on a list, and when
2764 followed by a space.
2765 Because it's more difficult to peak 2 chars ahead, a new-style
2766 ,@ can still not be used outside of a `, unless it's in the middle
2768 if (new_backquote_flag
2770 || (next_char
!= ' ' && next_char
!= '@'))
2772 Lisp_Object comma_type
= Qnil
;
2777 comma_type
= Qcomma_at
;
2779 comma_type
= Qcomma_dot
;
2782 if (ch
>= 0) UNREAD (ch
);
2783 comma_type
= Qcomma
;
2786 value
= read0 (readcharfun
);
2787 return Fcons (comma_type
, Fcons (value
, Qnil
));
2791 Vold_style_backquotes
= Qt
;
2803 end_of_file_error ();
2805 /* Accept `single space' syntax like (list ? x) where the
2806 whitespace character is SPC or TAB.
2807 Other literal whitespace like NL, CR, and FF are not accepted,
2808 as there are well-established escape sequences for these. */
2809 if (c
== ' ' || c
== '\t')
2810 return make_number (c
);
2813 c
= read_escape (readcharfun
, 0);
2814 modifiers
= c
& CHAR_MODIFIER_MASK
;
2815 c
&= ~CHAR_MODIFIER_MASK
;
2816 if (CHAR_BYTE8_P (c
))
2817 c
= CHAR_TO_BYTE8 (c
);
2820 next_char
= READCHAR
;
2821 ok
= (next_char
<= 040
2822 || (next_char
< 0200
2823 && (strchr ("\"';()[]#?`,.", next_char
))));
2826 return make_number (c
);
2828 invalid_syntax ("?", 1);
2833 char *p
= read_buffer
;
2834 char *end
= read_buffer
+ read_buffer_size
;
2836 /* Nonzero if we saw an escape sequence specifying
2837 a multibyte character. */
2838 int force_multibyte
= 0;
2839 /* Nonzero if we saw an escape sequence specifying
2840 a single-byte character. */
2841 int force_singlebyte
= 0;
2845 while ((ch
= READCHAR
) >= 0
2848 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2850 int offset
= p
- read_buffer
;
2851 read_buffer
= (char *) xrealloc (read_buffer
,
2852 read_buffer_size
*= 2);
2853 p
= read_buffer
+ offset
;
2854 end
= read_buffer
+ read_buffer_size
;
2861 ch
= read_escape (readcharfun
, 1);
2863 /* CH is -1 if \ newline has just been seen */
2866 if (p
== read_buffer
)
2871 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2872 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2874 if (CHAR_BYTE8_P (ch
))
2875 force_singlebyte
= 1;
2876 else if (! ASCII_CHAR_P (ch
))
2877 force_multibyte
= 1;
2878 else /* i.e. ASCII_CHAR_P (ch) */
2880 /* Allow `\C- ' and `\C-?'. */
2881 if (modifiers
== CHAR_CTL
)
2884 ch
= 0, modifiers
= 0;
2886 ch
= 127, modifiers
= 0;
2888 if (modifiers
& CHAR_SHIFT
)
2890 /* Shift modifier is valid only with [A-Za-z]. */
2891 if (ch
>= 'A' && ch
<= 'Z')
2892 modifiers
&= ~CHAR_SHIFT
;
2893 else if (ch
>= 'a' && ch
<= 'z')
2894 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2897 if (modifiers
& CHAR_META
)
2899 /* Move the meta bit to the right place for a
2901 modifiers
&= ~CHAR_META
;
2902 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2903 force_singlebyte
= 1;
2907 /* Any modifiers remaining are invalid. */
2909 error ("Invalid modifier in string");
2910 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2914 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2915 if (CHAR_BYTE8_P (ch
))
2916 force_singlebyte
= 1;
2917 else if (! ASCII_CHAR_P (ch
))
2918 force_multibyte
= 1;
2924 end_of_file_error ();
2926 /* If purifying, and string starts with \ newline,
2927 return zero instead. This is for doc strings
2928 that we are really going to find in etc/DOC.nn.nn */
2929 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2930 return make_number (0);
2932 if (force_multibyte
)
2933 /* READ_BUFFER already contains valid multibyte forms. */
2935 else if (force_singlebyte
)
2937 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
2939 p
= read_buffer
+ nchars
;
2943 /* Otherwise, READ_BUFFER contains only ASCII. */
2946 /* We want readchar_count to be the number of characters, not
2947 bytes. Hence we adjust for multibyte characters in the
2948 string. ... But it doesn't seem to be necessary, because
2949 READCHAR *does* read multibyte characters from buffers. */
2950 /* readchar_count -= (p - read_buffer) - nchars; */
2952 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2954 || (p
- read_buffer
!= nchars
)));
2955 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2957 || (p
- read_buffer
!= nchars
)));
2962 int next_char
= READCHAR
;
2965 if (next_char
<= 040
2966 || (next_char
< 0200
2967 && (strchr ("\"';([#?`,", next_char
))))
2973 /* Otherwise, we fall through! Note that the atom-reading loop
2974 below will now loop at least once, assuring that we will not
2975 try to UNREAD two characters in a row. */
2979 if (c
<= 040) goto retry
;
2980 if (c
== 0x8a0) /* NBSP */
2983 char *p
= read_buffer
;
2987 char *end
= read_buffer
+ read_buffer_size
;
2991 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2993 int offset
= p
- read_buffer
;
2994 read_buffer
= (char *) xrealloc (read_buffer
,
2995 read_buffer_size
*= 2);
2996 p
= read_buffer
+ offset
;
2997 end
= read_buffer
+ read_buffer_size
;
3004 end_of_file_error ();
3009 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3014 && c
!= 0x8a0 /* NBSP */
3016 || !(strchr ("\"';()[]#`,", c
))));
3020 int offset
= p
- read_buffer
;
3021 read_buffer
= (char *) xrealloc (read_buffer
,
3022 read_buffer_size
*= 2);
3023 p
= read_buffer
+ offset
;
3024 end
= read_buffer
+ read_buffer_size
;
3031 if (!quoted
&& !uninterned_symbol
)
3033 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3034 if (! NILP (result
))
3038 Lisp_Object name
, result
;
3039 EMACS_INT nbytes
= p
- read_buffer
;
3042 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3046 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3047 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3049 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3050 result
= (uninterned_symbol
? Fmake_symbol (name
)
3051 : Fintern (name
, Qnil
));
3053 if (EQ (Vread_with_symbol_positions
, Qt
)
3054 || EQ (Vread_with_symbol_positions
, readcharfun
))
3055 Vread_symbol_positions_list
=
3056 /* Kind of a hack; this will probably fail if characters
3057 in the symbol name were escaped. Not really a big
3059 Fcons (Fcons (result
,
3060 make_number (readchar_count
3061 - XFASTINT (Flength (Fsymbol_name (result
))))),
3062 Vread_symbol_positions_list
);
3070 /* List of nodes we've seen during substitute_object_in_subtree. */
3071 static Lisp_Object seen_list
;
3074 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3076 Lisp_Object check_object
;
3078 /* We haven't seen any objects when we start. */
3081 /* Make all the substitutions. */
3083 = substitute_object_recurse (object
, placeholder
, object
);
3085 /* Clear seen_list because we're done with it. */
3088 /* The returned object here is expected to always eq the
3090 if (!EQ (check_object
, object
))
3091 error ("Unexpected mutation error in reader");
3094 /* Feval doesn't get called from here, so no gc protection is needed. */
3095 #define SUBSTITUTE(get_val, set_val) \
3097 Lisp_Object old_value = get_val; \
3098 Lisp_Object true_value \
3099 = substitute_object_recurse (object, placeholder, \
3102 if (!EQ (old_value, true_value)) \
3109 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3111 /* If we find the placeholder, return the target object. */
3112 if (EQ (placeholder
, subtree
))
3115 /* If we've been to this node before, don't explore it again. */
3116 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3119 /* If this node can be the entry point to a cycle, remember that
3120 we've seen it. It can only be such an entry point if it was made
3121 by #n=, which means that we can find it as a value in
3123 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3124 seen_list
= Fcons (subtree
, seen_list
);
3126 /* Recurse according to subtree's type.
3127 Every branch must return a Lisp_Object. */
3128 switch (XTYPE (subtree
))
3130 case Lisp_Vectorlike
:
3133 if (BOOL_VECTOR_P (subtree
))
3134 return subtree
; /* No sub-objects anyway. */
3135 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3136 || COMPILEDP (subtree
))
3137 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3138 else if (VECTORP (subtree
))
3139 length
= ASIZE (subtree
);
3141 /* An unknown pseudovector may contain non-Lisp fields, so we
3142 can't just blindly traverse all its fields. We used to call
3143 `Flength' which signaled `sequencep', so I just preserved this
3145 wrong_type_argument (Qsequencep
, subtree
);
3147 for (i
= 0; i
< length
; i
++)
3148 SUBSTITUTE (AREF (subtree
, i
),
3149 ASET (subtree
, i
, true_value
));
3155 SUBSTITUTE (XCAR (subtree
),
3156 XSETCAR (subtree
, true_value
));
3157 SUBSTITUTE (XCDR (subtree
),
3158 XSETCDR (subtree
, true_value
));
3164 /* Check for text properties in each interval.
3165 substitute_in_interval contains part of the logic. */
3167 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3168 Lisp_Object arg
= Fcons (object
, placeholder
);
3170 traverse_intervals_noorder (root_interval
,
3171 &substitute_in_interval
, arg
);
3176 /* Other types don't recurse any further. */
3182 /* Helper function for substitute_object_recurse. */
3184 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3186 Lisp_Object object
= Fcar (arg
);
3187 Lisp_Object placeholder
= Fcdr (arg
);
3189 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3199 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3200 integer syntax and fits in a fixnum, else return the nearest float if CP has
3201 either floating point or integer syntax and BASE is 10, else return nil. If
3202 IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
3203 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3204 number has integer syntax but does not fit. */
3207 string_to_number (char const *string
, int base
, int ignore_trailing
)
3210 char const *cp
= string
;
3212 int float_syntax
= 0;
3215 /* Compute NaN and infinities using a variable, to cope with compilers that
3216 think they are smarter than we are. */
3219 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3220 IEEE floating point hosts, and works around a formerly-common bug where
3221 atof ("-0.0") drops the sign. */
3222 int negative
= *cp
== '-';
3224 int signedp
= negative
|| *cp
== '+';
3229 leading_digit
= digit_to_number (*cp
, base
);
3230 if (0 <= leading_digit
)
3235 while (0 <= digit_to_number (*cp
, base
));
3245 if ('0' <= *cp
&& *cp
<= '9')
3250 while ('0' <= *cp
&& *cp
<= '9');
3252 if (*cp
== 'e' || *cp
== 'E')
3254 char const *ecp
= cp
;
3256 if (*cp
== '+' || *cp
== '-')
3258 if ('0' <= *cp
&& *cp
<= '9')
3263 while ('0' <= *cp
&& *cp
<= '9');
3265 else if (cp
[-1] == '+'
3266 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3272 else if (cp
[-1] == '+'
3273 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3277 value
= zero
/ zero
;
3279 /* If that made a "negative" NaN, negate it. */
3282 union { double d
; char c
[sizeof (double)]; }
3283 u_data
, u_minus_zero
;
3285 u_minus_zero
.d
= -0.0;
3286 for (i
= 0; i
< sizeof (double); i
++)
3287 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3293 /* Now VALUE is a positive NaN. */
3299 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3300 || state
== (LEAD_INT
|E_EXP
));
3303 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3304 any prefix that matches. Otherwise, the entire string must match. */
3305 if (! (ignore_trailing
3306 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3307 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3310 /* If the number uses integer and not float syntax, and is in C-language
3311 range, use its value, preferably as a fixnum. */
3312 if (0 <= leading_digit
&& ! float_syntax
)
3316 /* Fast special case for single-digit integers. This also avoids a
3317 glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
3318 case some versions of strtoumax accept numbers like "0x1" that Emacs
3320 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3321 return make_number (negative
? -leading_digit
: leading_digit
);
3324 n
= strtoumax (string
+ signedp
, NULL
, base
);
3325 if (errno
== ERANGE
)
3327 /* Unfortunately there's no simple and accurate way to convert
3328 non-base-10 numbers that are out of C-language range. */
3330 xsignal (Qoverflow_error
, list1 (build_string (string
)));
3332 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3334 EMACS_INT signed_n
= n
;
3335 return make_number (negative
? -signed_n
: signed_n
);
3341 /* Either the number uses float syntax, or it does not fit into a fixnum.
3342 Convert it from string to floating point, unless the value is already
3343 known because it is an infinity, a NAN, or its absolute value fits in
3346 value
= atof (string
+ signedp
);
3348 return make_float (negative
? -value
: value
);
3353 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3357 register Lisp_Object
*ptr
;
3358 register Lisp_Object tem
, item
, vector
;
3359 register struct Lisp_Cons
*otem
;
3362 tem
= read_list (1, readcharfun
);
3363 len
= Flength (tem
);
3364 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3366 size
= ASIZE (vector
);
3367 ptr
= XVECTOR (vector
)->contents
;
3368 for (i
= 0; i
< size
; i
++)
3371 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3372 bytecode object, the docstring containing the bytecode and
3373 constants values must be treated as unibyte and passed to
3374 Fread, to get the actual bytecode string and constants vector. */
3375 if (bytecodeflag
&& load_force_doc_strings
)
3377 if (i
== COMPILED_BYTECODE
)
3379 if (!STRINGP (item
))
3380 error ("Invalid byte code");
3382 /* Delay handling the bytecode slot until we know whether
3383 it is lazily-loaded (we can tell by whether the
3384 constants slot is nil). */
3385 ptr
[COMPILED_CONSTANTS
] = item
;
3388 else if (i
== COMPILED_CONSTANTS
)
3390 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3394 /* Coerce string to unibyte (like string-as-unibyte,
3395 but without generating extra garbage and
3396 guaranteeing no change in the contents). */
3397 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3398 STRING_SET_UNIBYTE (bytestr
);
3400 item
= Fread (Fcons (bytestr
, readcharfun
));
3402 error ("Invalid byte code");
3404 otem
= XCONS (item
);
3405 bytestr
= XCAR (item
);
3410 /* Now handle the bytecode slot. */
3411 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3413 else if (i
== COMPILED_DOC_STRING
3415 && ! STRING_MULTIBYTE (item
))
3417 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3418 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3420 item
= Fstring_as_multibyte (item
);
3423 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3431 /* FLAG = 1 means check for ] to terminate rather than ) and .
3432 FLAG = -1 means check for starting with defun
3433 and make structure pure. */
3436 read_list (int flag
, register Lisp_Object readcharfun
)
3438 /* -1 means check next element for defun,
3439 0 means don't check,
3440 1 means already checked and found defun. */
3441 int defunflag
= flag
< 0 ? -1 : 0;
3442 Lisp_Object val
, tail
;
3443 register Lisp_Object elt
, tem
;
3444 struct gcpro gcpro1
, gcpro2
;
3445 /* 0 is the normal case.
3446 1 means this list is a doc reference; replace it with the number 0.
3447 2 means this list is a doc reference; replace it with the doc string. */
3448 int doc_reference
= 0;
3450 /* Initialize this to 1 if we are reading a list. */
3451 int first_in_list
= flag
<= 0;
3460 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3465 /* While building, if the list starts with #$, treat it specially. */
3466 if (EQ (elt
, Vload_file_name
)
3468 && !NILP (Vpurify_flag
))
3470 if (NILP (Vdoc_file_name
))
3471 /* We have not yet called Snarf-documentation, so assume
3472 this file is described in the DOC-MM.NN file
3473 and Snarf-documentation will fill in the right value later.
3474 For now, replace the whole list with 0. */
3477 /* We have already called Snarf-documentation, so make a relative
3478 file name for this file, so it can be found properly
3479 in the installed Lisp directory.
3480 We don't use Fexpand_file_name because that would make
3481 the directory absolute now. */
3482 elt
= concat2 (build_string ("../lisp/"),
3483 Ffile_name_nondirectory (elt
));
3485 else if (EQ (elt
, Vload_file_name
)
3487 && load_force_doc_strings
)
3496 invalid_syntax (") or . in a vector", 18);
3504 XSETCDR (tail
, read0 (readcharfun
));
3506 val
= read0 (readcharfun
);
3507 read1 (readcharfun
, &ch
, 0);
3511 if (doc_reference
== 1)
3512 return make_number (0);
3513 if (doc_reference
== 2)
3515 /* Get a doc string from the file we are loading.
3516 If it's in saved_doc_string, get it from there.
3518 Here, we don't know if the string is a
3519 bytecode string or a doc string. As a
3520 bytecode string must be unibyte, we always
3521 return a unibyte string. If it is actually a
3522 doc string, caller must make it
3525 int pos
= XINT (XCDR (val
));
3526 /* Position is negative for user variables. */
3527 if (pos
< 0) pos
= -pos
;
3528 if (pos
>= saved_doc_string_position
3529 && pos
< (saved_doc_string_position
3530 + saved_doc_string_length
))
3532 int start
= pos
- saved_doc_string_position
;
3535 /* Process quoting with ^A,
3536 and find the end of the string,
3537 which is marked with ^_ (037). */
3538 for (from
= start
, to
= start
;
3539 saved_doc_string
[from
] != 037;)
3541 int c
= saved_doc_string
[from
++];
3544 c
= saved_doc_string
[from
++];
3546 saved_doc_string
[to
++] = c
;
3548 saved_doc_string
[to
++] = 0;
3550 saved_doc_string
[to
++] = 037;
3553 saved_doc_string
[to
++] = c
;
3556 return make_unibyte_string (saved_doc_string
+ start
,
3559 /* Look in prev_saved_doc_string the same way. */
3560 else if (pos
>= prev_saved_doc_string_position
3561 && pos
< (prev_saved_doc_string_position
3562 + prev_saved_doc_string_length
))
3564 int start
= pos
- prev_saved_doc_string_position
;
3567 /* Process quoting with ^A,
3568 and find the end of the string,
3569 which is marked with ^_ (037). */
3570 for (from
= start
, to
= start
;
3571 prev_saved_doc_string
[from
] != 037;)
3573 int c
= prev_saved_doc_string
[from
++];
3576 c
= prev_saved_doc_string
[from
++];
3578 prev_saved_doc_string
[to
++] = c
;
3580 prev_saved_doc_string
[to
++] = 0;
3582 prev_saved_doc_string
[to
++] = 037;
3585 prev_saved_doc_string
[to
++] = c
;
3588 return make_unibyte_string (prev_saved_doc_string
3593 return get_doc_string (val
, 1, 0);
3598 invalid_syntax (". in wrong context", 18);
3600 invalid_syntax ("] in a list", 11);
3602 tem
= (read_pure
&& flag
<= 0
3603 ? pure_cons (elt
, Qnil
)
3604 : Fcons (elt
, Qnil
));
3606 XSETCDR (tail
, tem
);
3611 defunflag
= EQ (elt
, Qdefun
);
3612 else if (defunflag
> 0)
3617 static Lisp_Object initial_obarray
;
3619 /* oblookup stores the bucket number here, for the sake of Funintern. */
3621 static size_t oblookup_last_bucket_number
;
3623 static size_t hash_string (const char *ptr
, size_t len
);
3625 /* Get an error if OBARRAY is not an obarray.
3626 If it is one, return it. */
3629 check_obarray (Lisp_Object obarray
)
3631 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3633 /* If Vobarray is now invalid, force it to be valid. */
3634 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3635 wrong_type_argument (Qvectorp
, obarray
);
3640 /* Intern the C string STR: return a symbol with that name,
3641 interned in the current obarray. */
3644 intern (const char *str
)
3647 int len
= strlen (str
);
3648 Lisp_Object obarray
;
3651 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3652 obarray
= check_obarray (obarray
);
3653 tem
= oblookup (obarray
, str
, len
, len
);
3656 return Fintern (make_string (str
, len
), obarray
);
3660 intern_c_string (const char *str
)
3663 int len
= strlen (str
);
3664 Lisp_Object obarray
;
3667 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3668 obarray
= check_obarray (obarray
);
3669 tem
= oblookup (obarray
, str
, len
, len
);
3673 if (NILP (Vpurify_flag
))
3674 /* Creating a non-pure string from a string literal not
3675 implemented yet. We could just use make_string here and live
3676 with the extra copy. */
3679 return Fintern (make_pure_c_string (str
), obarray
);
3682 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3683 doc
: /* Return the canonical symbol whose name is STRING.
3684 If there is none, one is created by this function and returned.
3685 A second optional argument specifies the obarray to use;
3686 it defaults to the value of `obarray'. */)
3687 (Lisp_Object string
, Lisp_Object obarray
)
3689 register Lisp_Object tem
, sym
, *ptr
;
3691 if (NILP (obarray
)) obarray
= Vobarray
;
3692 obarray
= check_obarray (obarray
);
3694 CHECK_STRING (string
);
3696 tem
= oblookup (obarray
, SSDATA (string
),
3699 if (!INTEGERP (tem
))
3702 if (!NILP (Vpurify_flag
))
3703 string
= Fpurecopy (string
);
3704 sym
= Fmake_symbol (string
);
3706 if (EQ (obarray
, initial_obarray
))
3707 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3709 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3711 if ((SREF (string
, 0) == ':')
3712 && EQ (obarray
, initial_obarray
))
3714 XSYMBOL (sym
)->constant
= 1;
3715 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3716 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3719 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3721 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3723 XSYMBOL (sym
)->next
= 0;
3728 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3729 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3730 NAME may be a string or a symbol. If it is a symbol, that exact
3731 symbol is searched for.
3732 A second optional argument specifies the obarray to use;
3733 it defaults to the value of `obarray'. */)
3734 (Lisp_Object name
, Lisp_Object obarray
)
3736 register Lisp_Object tem
, string
;
3738 if (NILP (obarray
)) obarray
= Vobarray
;
3739 obarray
= check_obarray (obarray
);
3741 if (!SYMBOLP (name
))
3743 CHECK_STRING (name
);
3747 string
= SYMBOL_NAME (name
);
3749 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3750 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3756 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3757 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3758 The value is t if a symbol was found and deleted, nil otherwise.
3759 NAME may be a string or a symbol. If it is a symbol, that symbol
3760 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3761 OBARRAY defaults to the value of the variable `obarray'. */)
3762 (Lisp_Object name
, Lisp_Object obarray
)
3764 register Lisp_Object string
, tem
;
3767 if (NILP (obarray
)) obarray
= Vobarray
;
3768 obarray
= check_obarray (obarray
);
3771 string
= SYMBOL_NAME (name
);
3774 CHECK_STRING (name
);
3778 tem
= oblookup (obarray
, SSDATA (string
),
3783 /* If arg was a symbol, don't delete anything but that symbol itself. */
3784 if (SYMBOLP (name
) && !EQ (name
, tem
))
3787 /* There are plenty of other symbols which will screw up the Emacs
3788 session if we unintern them, as well as even more ways to use
3789 `setq' or `fset' or whatnot to make the Emacs session
3790 unusable. Let's not go down this silly road. --Stef */
3791 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3792 error ("Attempt to unintern t or nil"); */
3794 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3796 hash
= oblookup_last_bucket_number
;
3798 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3800 if (XSYMBOL (tem
)->next
)
3801 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3803 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3807 Lisp_Object tail
, following
;
3809 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3810 XSYMBOL (tail
)->next
;
3813 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3814 if (EQ (following
, tem
))
3816 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3825 /* Return the symbol in OBARRAY whose names matches the string
3826 of SIZE characters (SIZE_BYTE bytes) at PTR.
3827 If there is no such symbol in OBARRAY, return nil.
3829 Also store the bucket number in oblookup_last_bucket_number. */
3832 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3836 register Lisp_Object tail
;
3837 Lisp_Object bucket
, tem
;
3839 if (!VECTORP (obarray
)
3840 || (obsize
= ASIZE (obarray
)) == 0)
3842 obarray
= check_obarray (obarray
);
3843 obsize
= ASIZE (obarray
);
3845 /* This is sometimes needed in the middle of GC. */
3846 obsize
&= ~ARRAY_MARK_FLAG
;
3847 hash
= hash_string (ptr
, size_byte
) % obsize
;
3848 bucket
= XVECTOR (obarray
)->contents
[hash
];
3849 oblookup_last_bucket_number
= hash
;
3850 if (EQ (bucket
, make_number (0)))
3852 else if (!SYMBOLP (bucket
))
3853 error ("Bad data in guts of obarray"); /* Like CADR error message */
3855 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3857 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3858 && SCHARS (SYMBOL_NAME (tail
)) == size
3859 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3861 else if (XSYMBOL (tail
)->next
== 0)
3864 XSETINT (tem
, hash
);
3869 hash_string (const char *ptr
, size_t len
)
3871 register const char *p
= ptr
;
3872 register const char *end
= p
+ len
;
3873 register unsigned char c
;
3874 register size_t hash
= 0;
3879 if (c
>= 0140) c
-= 40;
3880 hash
= (hash
<< 3) + (hash
>> (CHAR_BIT
* sizeof hash
- 4)) + c
;
3886 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3889 register Lisp_Object tail
;
3890 CHECK_VECTOR (obarray
);
3891 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3893 tail
= XVECTOR (obarray
)->contents
[i
];
3898 if (XSYMBOL (tail
)->next
== 0)
3900 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3906 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3908 call1 (function
, sym
);
3911 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3912 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3913 OBARRAY defaults to the value of `obarray'. */)
3914 (Lisp_Object function
, Lisp_Object obarray
)
3916 if (NILP (obarray
)) obarray
= Vobarray
;
3917 obarray
= check_obarray (obarray
);
3919 map_obarray (obarray
, mapatoms_1
, function
);
3923 #define OBARRAY_SIZE 1511
3928 Lisp_Object oblength
;
3930 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3932 Vobarray
= Fmake_vector (oblength
, make_number (0));
3933 initial_obarray
= Vobarray
;
3934 staticpro (&initial_obarray
);
3936 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3937 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3938 NILP (Vpurify_flag) check in intern_c_string. */
3939 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3940 Qnil
= intern_c_string ("nil");
3942 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3943 so those two need to be fixed manally. */
3944 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3945 XSYMBOL (Qunbound
)->function
= Qunbound
;
3946 XSYMBOL (Qunbound
)->plist
= Qnil
;
3947 /* XSYMBOL (Qnil)->function = Qunbound; */
3948 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3949 XSYMBOL (Qnil
)->constant
= 1;
3950 XSYMBOL (Qnil
)->plist
= Qnil
;
3952 Qt
= intern_c_string ("t");
3953 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3954 XSYMBOL (Qt
)->constant
= 1;
3956 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3959 Qvariable_documentation
= intern_c_string ("variable-documentation");
3960 staticpro (&Qvariable_documentation
);
3962 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3963 read_buffer
= (char *) xmalloc (read_buffer_size
);
3967 defsubr (struct Lisp_Subr
*sname
)
3970 sym
= intern_c_string (sname
->symbol_name
);
3971 XSETTYPED_PVECTYPE (sname
, size
, PVEC_SUBR
);
3972 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3975 #ifdef NOTDEF /* use fset in subr.el now */
3977 defalias (sname
, string
)
3978 struct Lisp_Subr
*sname
;
3982 sym
= intern (string
);
3983 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3987 /* Define an "integer variable"; a symbol whose value is forwarded to a
3988 C variable of type int. Sample call (munged w "xx" to fool make-docfile):
3989 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3991 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3992 const char *namestring
, EMACS_INT
*address
)
3995 sym
= intern_c_string (namestring
);
3996 i_fwd
->type
= Lisp_Fwd_Int
;
3997 i_fwd
->intvar
= address
;
3998 XSYMBOL (sym
)->declared_special
= 1;
3999 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4000 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4003 /* Similar but define a variable whose value is t if address contains 1,
4004 nil if address contains 0. */
4006 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4007 const char *namestring
, int *address
)
4010 sym
= intern_c_string (namestring
);
4011 b_fwd
->type
= Lisp_Fwd_Bool
;
4012 b_fwd
->boolvar
= address
;
4013 XSYMBOL (sym
)->declared_special
= 1;
4014 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4015 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4016 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4019 /* Similar but define a variable whose value is the Lisp Object stored
4020 at address. Two versions: with and without gc-marking of the C
4021 variable. The nopro version is used when that variable will be
4022 gc-marked for some other reason, since marking the same slot twice
4023 can cause trouble with strings. */
4025 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4026 const char *namestring
, Lisp_Object
*address
)
4029 sym
= intern_c_string (namestring
);
4030 o_fwd
->type
= Lisp_Fwd_Obj
;
4031 o_fwd
->objvar
= address
;
4032 XSYMBOL (sym
)->declared_special
= 1;
4033 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4034 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4038 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4039 const char *namestring
, Lisp_Object
*address
)
4041 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4042 staticpro (address
);
4045 /* Similar but define a variable whose value is the Lisp Object stored
4046 at a particular offset in the current kboard object. */
4049 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4050 const char *namestring
, int offset
)
4053 sym
= intern_c_string (namestring
);
4054 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4055 ko_fwd
->offset
= offset
;
4056 XSYMBOL (sym
)->declared_special
= 1;
4057 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4058 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4061 /* Record the value of load-path used at the start of dumping
4062 so we can see if the site changed it later during dumping. */
4063 static Lisp_Object dump_path
;
4069 int turn_off_warning
= 0;
4071 /* Compute the default load-path. */
4073 normal
= PATH_LOADSEARCH
;
4074 Vload_path
= decode_env_path (0, normal
);
4076 if (NILP (Vpurify_flag
))
4077 normal
= PATH_LOADSEARCH
;
4079 normal
= PATH_DUMPLOADSEARCH
;
4081 /* In a dumped Emacs, we normally have to reset the value of
4082 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4083 uses ../lisp, instead of the path of the installed elisp
4084 libraries. However, if it appears that Vload_path was changed
4085 from the default before dumping, don't override that value. */
4088 if (! NILP (Fequal (dump_path
, Vload_path
)))
4090 Vload_path
= decode_env_path (0, normal
);
4091 if (!NILP (Vinstallation_directory
))
4093 Lisp_Object tem
, tem1
, sitelisp
;
4095 /* Remove site-lisp dirs from path temporarily and store
4096 them in sitelisp, then conc them on at the end so
4097 they're always first in path. */
4101 tem
= Fcar (Vload_path
);
4102 tem1
= Fstring_match (build_string ("site-lisp"),
4106 Vload_path
= Fcdr (Vload_path
);
4107 sitelisp
= Fcons (tem
, sitelisp
);
4113 /* Add to the path the lisp subdir of the
4114 installation dir, if it exists. */
4115 tem
= Fexpand_file_name (build_string ("lisp"),
4116 Vinstallation_directory
);
4117 tem1
= Ffile_exists_p (tem
);
4120 if (NILP (Fmember (tem
, Vload_path
)))
4122 turn_off_warning
= 1;
4123 Vload_path
= Fcons (tem
, Vload_path
);
4127 /* That dir doesn't exist, so add the build-time
4128 Lisp dirs instead. */
4129 Vload_path
= nconc2 (Vload_path
, dump_path
);
4131 /* Add leim under the installation dir, if it exists. */
4132 tem
= Fexpand_file_name (build_string ("leim"),
4133 Vinstallation_directory
);
4134 tem1
= Ffile_exists_p (tem
);
4137 if (NILP (Fmember (tem
, Vload_path
)))
4138 Vload_path
= Fcons (tem
, Vload_path
);
4141 /* Add site-lisp under the installation dir, if it exists. */
4142 tem
= Fexpand_file_name (build_string ("site-lisp"),
4143 Vinstallation_directory
);
4144 tem1
= Ffile_exists_p (tem
);
4147 if (NILP (Fmember (tem
, Vload_path
)))
4148 Vload_path
= Fcons (tem
, Vload_path
);
4151 /* If Emacs was not built in the source directory,
4152 and it is run from where it was built, add to load-path
4153 the lisp, leim and site-lisp dirs under that directory. */
4155 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4159 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4160 Vinstallation_directory
);
4161 tem1
= Ffile_exists_p (tem
);
4163 /* Don't be fooled if they moved the entire source tree
4164 AFTER dumping Emacs. If the build directory is indeed
4165 different from the source dir, src/Makefile.in and
4166 src/Makefile will not be found together. */
4167 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4168 Vinstallation_directory
);
4169 tem2
= Ffile_exists_p (tem
);
4170 if (!NILP (tem1
) && NILP (tem2
))
4172 tem
= Fexpand_file_name (build_string ("lisp"),
4175 if (NILP (Fmember (tem
, Vload_path
)))
4176 Vload_path
= Fcons (tem
, Vload_path
);
4178 tem
= Fexpand_file_name (build_string ("leim"),
4181 if (NILP (Fmember (tem
, Vload_path
)))
4182 Vload_path
= Fcons (tem
, Vload_path
);
4184 tem
= Fexpand_file_name (build_string ("site-lisp"),
4187 if (NILP (Fmember (tem
, Vload_path
)))
4188 Vload_path
= Fcons (tem
, Vload_path
);
4191 if (!NILP (sitelisp
) && !no_site_lisp
)
4192 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4198 /* NORMAL refers to the lisp dir in the source directory. */
4199 /* We used to add ../lisp at the front here, but
4200 that caused trouble because it was copied from dump_path
4201 into Vload_path, above, when Vinstallation_directory was non-nil.
4202 It should be unnecessary. */
4203 Vload_path
= decode_env_path (0, normal
);
4204 dump_path
= Vload_path
;
4208 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4209 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4210 almost never correct, thereby causing a warning to be printed out that
4211 confuses users. Since PATH_LOADSEARCH is always overridden by the
4212 EMACSLOADPATH environment variable below, disable the warning on NT. */
4214 /* Warn if dirs in the *standard* path don't exist. */
4215 if (!turn_off_warning
)
4217 Lisp_Object path_tail
;
4219 for (path_tail
= Vload_path
;
4221 path_tail
= XCDR (path_tail
))
4223 Lisp_Object dirfile
;
4224 dirfile
= Fcar (path_tail
);
4225 if (STRINGP (dirfile
))
4227 dirfile
= Fdirectory_file_name (dirfile
);
4228 if (access (SSDATA (dirfile
), 0) < 0)
4229 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4234 #endif /* !(WINDOWSNT || HAVE_NS) */
4236 /* If the EMACSLOADPATH environment variable is set, use its value.
4237 This doesn't apply if we're dumping. */
4239 if (NILP (Vpurify_flag
)
4240 && egetenv ("EMACSLOADPATH"))
4242 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4246 load_in_progress
= 0;
4247 Vload_file_name
= Qnil
;
4249 load_descriptor_list
= Qnil
;
4251 Vstandard_input
= Qt
;
4252 Vloads_in_progress
= Qnil
;
4255 /* Print a warning, using format string FORMAT, that directory DIRNAME
4256 does not exist. Print it on stderr and put it in *Messages*. */
4259 dir_warning (const char *format
, Lisp_Object dirname
)
4262 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4264 fprintf (stderr
, format
, SDATA (dirname
));
4265 sprintf (buffer
, format
, SDATA (dirname
));
4266 /* Don't log the warning before we've initialized!! */
4268 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4272 syms_of_lread (void)
4275 defsubr (&Sread_from_string
);
4277 defsubr (&Sintern_soft
);
4278 defsubr (&Sunintern
);
4279 defsubr (&Sget_load_suffixes
);
4281 defsubr (&Seval_buffer
);
4282 defsubr (&Seval_region
);
4283 defsubr (&Sread_char
);
4284 defsubr (&Sread_char_exclusive
);
4285 defsubr (&Sread_event
);
4286 defsubr (&Sget_file_char
);
4287 defsubr (&Smapatoms
);
4288 defsubr (&Slocate_file_internal
);
4290 DEFVAR_LISP ("obarray", Vobarray
,
4291 doc
: /* Symbol table for use by `intern' and `read'.
4292 It is a vector whose length ought to be prime for best results.
4293 The vector's contents don't make sense if examined from Lisp programs;
4294 to find all the symbols in an obarray, use `mapatoms'. */);
4296 DEFVAR_LISP ("values", Vvalues
,
4297 doc
: /* List of values of all expressions which were read, evaluated and printed.
4298 Order is reverse chronological. */);
4300 DEFVAR_LISP ("standard-input", Vstandard_input
,
4301 doc
: /* Stream for read to get input from.
4302 See documentation of `read' for possible values. */);
4303 Vstandard_input
= Qt
;
4305 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4306 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4308 If this variable is a buffer, then only forms read from that buffer
4309 will be added to `read-symbol-positions-list'.
4310 If this variable is t, then all read forms will be added.
4311 The effect of all other values other than nil are not currently
4312 defined, although they may be in the future.
4314 The positions are relative to the last call to `read' or
4315 `read-from-string'. It is probably a bad idea to set this variable at
4316 the toplevel; bind it instead. */);
4317 Vread_with_symbol_positions
= Qnil
;
4319 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4320 doc
: /* A list mapping read symbols to their positions.
4321 This variable is modified during calls to `read' or
4322 `read-from-string', but only when `read-with-symbol-positions' is
4325 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4326 CHAR-POSITION is an integer giving the offset of that occurrence of the
4327 symbol from the position where `read' or `read-from-string' started.
4329 Note that a symbol will appear multiple times in this list, if it was
4330 read multiple times. The list is in the same order as the symbols
4332 Vread_symbol_positions_list
= Qnil
;
4334 DEFVAR_LISP ("read-circle", Vread_circle
,
4335 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4338 DEFVAR_LISP ("load-path", Vload_path
,
4339 doc
: /* *List of directories to search for files to load.
4340 Each element is a string (directory name) or nil (try default directory).
4341 Initialized based on EMACSLOADPATH environment variable, if any,
4342 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4344 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4345 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4346 This list should not include the empty string.
4347 `load' and related functions try to append these suffixes, in order,
4348 to the specified file name if a Lisp suffix is allowed or required. */);
4349 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4350 Fcons (make_pure_c_string (".el"), Qnil
));
4351 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4352 doc
: /* List of suffixes that indicate representations of \
4354 This list should normally start with the empty string.
4356 Enabling Auto Compression mode appends the suffixes in
4357 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4358 mode removes them again. `load' and related functions use this list to
4359 determine whether they should look for compressed versions of a file
4360 and, if so, which suffixes they should try to append to the file name
4361 in order to do so. However, if you want to customize which suffixes
4362 the loading functions recognize as compression suffixes, you should
4363 customize `jka-compr-load-suffixes' rather than the present variable. */);
4364 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4366 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4367 doc
: /* Non-nil if inside of `load'. */);
4368 Qload_in_progress
= intern_c_string ("load-in-progress");
4369 staticpro (&Qload_in_progress
);
4371 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4372 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4373 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4375 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4376 a symbol \(a feature name).
4378 When `load' is run and the file-name argument matches an element's
4379 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4380 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4382 An error in FORMS does not undo the load, but does prevent execution of
4383 the rest of the FORMS. */);
4384 Vafter_load_alist
= Qnil
;
4386 DEFVAR_LISP ("load-history", Vload_history
,
4387 doc
: /* Alist mapping loaded file names to symbols and features.
4388 Each alist element should be a list (FILE-NAME ENTRIES...), where
4389 FILE-NAME is the name of a file that has been loaded into Emacs.
4390 The file name is absolute and true (i.e. it doesn't contain symlinks).
4391 As an exception, one of the alist elements may have FILE-NAME nil,
4392 for symbols and features not associated with any file.
4394 The remaining ENTRIES in the alist element describe the functions and
4395 variables defined in that file, the features provided, and the
4396 features required. Each entry has the form `(provide . FEATURE)',
4397 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4398 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4399 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4400 SYMBOL was an autoload before this file redefined it as a function.
4402 During preloading, the file name recorded is relative to the main Lisp
4403 directory. These file names are converted to absolute at startup. */);
4404 Vload_history
= Qnil
;
4406 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4407 doc
: /* Full name of file being loaded by `load'. */);
4408 Vload_file_name
= Qnil
;
4410 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4411 doc
: /* File name, including directory, of user's initialization file.
4412 If the file loaded had extension `.elc', and the corresponding source file
4413 exists, this variable contains the name of source file, suitable for use
4414 by functions like `custom-save-all' which edit the init file.
4415 While Emacs loads and evaluates the init file, value is the real name
4416 of the file, regardless of whether or not it has the `.elc' extension. */);
4417 Vuser_init_file
= Qnil
;
4419 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4420 doc
: /* Used for internal purposes by `load'. */);
4421 Vcurrent_load_list
= Qnil
;
4423 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4424 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4425 The default is nil, which means use the function `read'. */);
4426 Vload_read_function
= Qnil
;
4428 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4429 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4430 This function is for doing code conversion before reading the source file.
4431 If nil, loading is done without any code conversion.
4432 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4433 FULLNAME is the full name of FILE.
4434 See `load' for the meaning of the remaining arguments. */);
4435 Vload_source_file_function
= Qnil
;
4437 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4438 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4439 This is useful when the file being loaded is a temporary copy. */);
4440 load_force_doc_strings
= 0;
4442 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4443 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4444 This is normally bound by `load' and `eval-buffer' to control `read',
4445 and is not meant for users to change. */);
4446 load_convert_to_unibyte
= 0;
4448 DEFVAR_LISP ("source-directory", Vsource_directory
,
4449 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4450 You cannot count on them to still be there! */);
4452 = Fexpand_file_name (build_string ("../"),
4453 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4455 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4456 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4457 Vpreloaded_file_list
= Qnil
;
4459 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4460 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4461 Vbyte_boolean_vars
= Qnil
;
4463 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4464 doc
: /* Non-nil means load dangerous compiled Lisp files.
4465 Some versions of XEmacs use different byte codes than Emacs. These
4466 incompatible byte codes can make Emacs crash when it tries to execute
4468 load_dangerous_libraries
= 0;
4470 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4471 doc
: /* Non-nil means force printing messages when loading Lisp files.
4472 This overrides the value of the NOMESSAGE argument to `load'. */);
4473 force_load_messages
= 0;
4475 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4476 doc
: /* Regular expression matching safe to load compiled Lisp files.
4477 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4478 from the file, and matches them against this regular expression.
4479 When the regular expression matches, the file is considered to be safe
4480 to load. See also `load-dangerous-libraries'. */);
4481 Vbytecomp_version_regexp
4482 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4484 Qlexical_binding
= intern ("lexical-binding");
4485 staticpro (&Qlexical_binding
);
4486 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4487 doc
: /* If non-nil, use lexical binding when evaluating code.
4488 This only applies to code evaluated by `eval-buffer' and `eval-region'.
4489 This variable is automatically set from the file variables of an interpreted
4490 Lisp file read using `load'. */);
4491 Fmake_variable_buffer_local (Qlexical_binding
);
4493 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4494 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4495 Veval_buffer_list
= Qnil
;
4497 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4498 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4499 Vold_style_backquotes
= Qnil
;
4500 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4501 staticpro (&Qold_style_backquotes
);
4503 /* Vsource_directory was initialized in init_lread. */
4505 load_descriptor_list
= Qnil
;
4506 staticpro (&load_descriptor_list
);
4508 Qcurrent_load_list
= intern_c_string ("current-load-list");
4509 staticpro (&Qcurrent_load_list
);
4511 Qstandard_input
= intern_c_string ("standard-input");
4512 staticpro (&Qstandard_input
);
4514 Qread_char
= intern_c_string ("read-char");
4515 staticpro (&Qread_char
);
4517 Qget_file_char
= intern_c_string ("get-file-char");
4518 staticpro (&Qget_file_char
);
4520 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4521 staticpro (&Qget_emacs_mule_file_char
);
4523 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4524 staticpro (&Qload_force_doc_strings
);
4526 Qbackquote
= intern_c_string ("`");
4527 staticpro (&Qbackquote
);
4528 Qcomma
= intern_c_string (",");
4529 staticpro (&Qcomma
);
4530 Qcomma_at
= intern_c_string (",@");
4531 staticpro (&Qcomma_at
);
4532 Qcomma_dot
= intern_c_string (",.");
4533 staticpro (&Qcomma_dot
);
4535 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4536 staticpro (&Qinhibit_file_name_operation
);
4538 Qascii_character
= intern_c_string ("ascii-character");
4539 staticpro (&Qascii_character
);
4541 Qfunction
= intern_c_string ("function");
4542 staticpro (&Qfunction
);
4544 Qload
= intern_c_string ("load");
4547 Qload_file_name
= intern_c_string ("load-file-name");
4548 staticpro (&Qload_file_name
);
4550 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4551 staticpro (&Qeval_buffer_list
);
4553 Qfile_truename
= intern_c_string ("file-truename");
4554 staticpro (&Qfile_truename
) ;
4556 Qdir_ok
= intern_c_string ("dir-ok");
4557 staticpro (&Qdir_ok
);
4559 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4560 staticpro (&Qdo_after_load_evaluation
) ;
4562 staticpro (&dump_path
);
4564 staticpro (&read_objects
);
4565 read_objects
= Qnil
;
4566 staticpro (&seen_list
);
4569 Vloads_in_progress
= Qnil
;
4570 staticpro (&Vloads_in_progress
);
4572 Qhash_table
= intern_c_string ("hash-table");
4573 staticpro (&Qhash_table
);
4574 Qdata
= intern_c_string ("data");
4576 Qtest
= intern_c_string ("test");
4578 Qsize
= intern_c_string ("size");
4580 Qweakness
= intern_c_string ("weakness");
4581 staticpro (&Qweakness
);
4582 Qrehash_size
= intern_c_string ("rehash-size");
4583 staticpro (&Qrehash_size
);
4584 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4585 staticpro (&Qrehash_threshold
);