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
&& in_file_vars
)
834 if (i
< sizeof var
- 1)
836 UPDATE_BEG_END_STATE (ch
);
840 /* Stop scanning if no colon was found before end marker. */
844 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
850 /* Read a variable value. */
853 while (ch
== ' ' || ch
== '\t')
857 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
859 if (i
< sizeof val
- 1)
861 UPDATE_BEG_END_STATE (ch
);
865 /* The value was terminated by an end-marker, which
868 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
872 if (strcmp (var
, "lexical-binding") == 0)
875 rv
= (strcmp (val
, "nil") != 0);
881 while (ch
!= '\n' && ch
!= EOF
)
888 /* Value is a version number of byte compiled code if the file
889 associated with file descriptor FD is a compiled Lisp file that's
890 safe to load. Only files compiled with Emacs are safe to load.
891 Files compiled with XEmacs can lead to a crash in Fbyte_code
892 because of an incompatible change in the byte compiler. */
895 safe_to_load_p (int fd
)
902 /* Read the first few bytes from the file, and look for a line
903 specifying the byte compiler version used. */
904 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
909 /* Skip to the next newline, skipping over the initial `ELC'
910 with NUL bytes following it, but note the version. */
911 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
916 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
923 lseek (fd
, 0, SEEK_SET
);
928 /* Callback for record_unwind_protect. Restore the old load list OLD,
929 after loading a file successfully. */
932 record_load_unwind (Lisp_Object old
)
934 return Vloads_in_progress
= old
;
937 /* This handler function is used via internal_condition_case_1. */
940 load_error_handler (Lisp_Object data
)
946 load_warn_old_style_backquotes (Lisp_Object file
)
948 if (!NILP (Vold_style_backquotes
))
951 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
958 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
959 doc
: /* Return the suffixes that `load' should try if a suffix is \
961 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
964 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
965 while (CONSP (suffixes
))
967 Lisp_Object exts
= Vload_file_rep_suffixes
;
968 suffix
= XCAR (suffixes
);
969 suffixes
= XCDR (suffixes
);
974 lst
= Fcons (concat2 (suffix
, ext
), lst
);
977 return Fnreverse (lst
);
980 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
981 doc
: /* Execute a file of Lisp code named FILE.
982 First try FILE with `.elc' appended, then try with `.el',
983 then try FILE unmodified (the exact suffixes in the exact order are
984 determined by `load-suffixes'). Environment variable references in
985 FILE are replaced with their values by calling `substitute-in-file-name'.
986 This function searches the directories in `load-path'.
988 If optional second arg NOERROR is non-nil,
989 report no error if FILE doesn't exist.
990 Print messages at start and end of loading unless
991 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
993 If optional fourth arg NOSUFFIX is non-nil, don't try adding
994 suffixes `.elc' or `.el' to the specified name FILE.
995 If optional fifth arg MUST-SUFFIX is non-nil, insist on
996 the suffix `.elc' or `.el'; don't accept just FILE unless
997 it ends in one of those suffixes or includes a directory name.
999 If this function fails to find a file, it may look for different
1000 representations of that file before trying another file.
1001 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
1002 to the file name. Emacs uses this feature mainly to find compressed
1003 versions of files when Auto Compression mode is enabled.
1005 The exact suffixes that this function tries out, in the exact order,
1006 are given by the value of the variable `load-file-rep-suffixes' if
1007 NOSUFFIX is non-nil and by the return value of the function
1008 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1009 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1010 and then the former.
1012 Loading a file records its definitions, and its `provide' and
1013 `require' calls, in an element of `load-history' whose
1014 car is the file name loaded. See `load-history'.
1016 While the file is in the process of being loaded, the variable
1017 `load-in-progress' is non-nil and the variable `load-file-name'
1018 is bound to the file's name.
1020 Return t if the file exists and loads successfully. */)
1021 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1023 register FILE *stream
;
1024 register int fd
= -1;
1025 int count
= SPECPDL_INDEX ();
1026 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1027 Lisp_Object found
, efound
, hist_file_name
;
1028 /* 1 means we printed the ".el is newer" message. */
1030 /* 1 means we are loading a compiled file. */
1032 Lisp_Object handler
;
1034 const char *fmode
= "r";
1042 CHECK_STRING (file
);
1044 /* If file name is magic, call the handler. */
1045 /* This shouldn't be necessary any more now that `openp' handles it right.
1046 handler = Ffind_file_name_handler (file, Qload);
1047 if (!NILP (handler))
1048 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1050 /* Do this after the handler to avoid
1051 the need to gcpro noerror, nomessage and nosuffix.
1052 (Below here, we care only whether they are nil or not.)
1053 The presence of this call is the result of a historical accident:
1054 it used to be in every file-operation and when it got removed
1055 everywhere, it accidentally stayed here. Since then, enough people
1056 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1057 that it seemed risky to remove. */
1058 if (! NILP (noerror
))
1060 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1061 Qt
, load_error_handler
);
1066 file
= Fsubstitute_in_file_name (file
);
1069 /* Avoid weird lossage with null string as arg,
1070 since it would try to load a directory as a Lisp file */
1071 if (SCHARS (file
) > 0)
1073 int size
= SBYTES (file
);
1076 GCPRO2 (file
, found
);
1078 if (! NILP (must_suffix
))
1080 /* Don't insist on adding a suffix if FILE already ends with one. */
1082 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1085 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1087 /* Don't insist on adding a suffix
1088 if the argument includes a directory name. */
1089 else if (! NILP (Ffile_name_directory (file
)))
1093 fd
= openp (Vload_path
, file
,
1094 (!NILP (nosuffix
) ? Qnil
1095 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1096 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1097 tmp
[1] = Vload_file_rep_suffixes
,
1106 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1110 /* Tell startup.el whether or not we found the user's init file. */
1111 if (EQ (Qt
, Vuser_init_file
))
1112 Vuser_init_file
= found
;
1114 /* If FD is -2, that means openp found a magic file. */
1117 if (NILP (Fequal (found
, file
)))
1118 /* If FOUND is a different file name from FILE,
1119 find its handler even if we have already inhibited
1120 the `load' operation on FILE. */
1121 handler
= Ffind_file_name_handler (found
, Qt
);
1123 handler
= Ffind_file_name_handler (found
, Qload
);
1124 if (! NILP (handler
))
1125 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1128 /* Check if we're stuck in a recursive load cycle.
1130 2000-09-21: It's not possible to just check for the file loaded
1131 being a member of Vloads_in_progress. This fails because of the
1132 way the byte compiler currently works; `provide's are not
1133 evaluated, see font-lock.el/jit-lock.el as an example. This
1134 leads to a certain amount of ``normal'' recursion.
1136 Also, just loading a file recursively is not always an error in
1137 the general case; the second load may do something different. */
1141 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1142 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1146 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1148 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1149 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1152 /* All loads are by default dynamic, unless the file itself specifies
1153 otherwise using a file-variable in the first line. This is bound here
1154 so that it takes effect whether or not we use
1155 Vload_source_file_function. */
1156 specbind (Qlexical_binding
, Qnil
);
1158 /* Get the name for load-history. */
1159 hist_file_name
= (! NILP (Vpurify_flag
)
1160 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1161 tmp
[1] = Ffile_name_nondirectory (found
),
1167 /* Check for the presence of old-style quotes and warn about them. */
1168 specbind (Qold_style_backquotes
, Qnil
);
1169 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1171 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1172 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1173 /* Load .elc files directly, but not when they are
1174 remote and have no handler! */
1181 GCPRO3 (file
, found
, hist_file_name
);
1184 && ! (version
= safe_to_load_p (fd
)))
1187 if (!load_dangerous_libraries
)
1191 error ("File `%s' was not compiled in Emacs",
1194 else if (!NILP (nomessage
) && !force_load_messages
)
1195 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1200 efound
= ENCODE_FILE (found
);
1205 stat (SSDATA (efound
), &s1
);
1206 SSET (efound
, SBYTES (efound
) - 1, 0);
1207 result
= stat (SSDATA (efound
), &s2
);
1208 SSET (efound
, SBYTES (efound
) - 1, 'c');
1210 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1212 /* Make the progress messages mention that source is newer. */
1215 /* If we won't print another message, mention this anyway. */
1216 if (!NILP (nomessage
) && !force_load_messages
)
1218 Lisp_Object msg_file
;
1219 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1220 message_with_string ("Source file `%s' newer than byte-compiled file",
1229 /* We are loading a source file (*.el). */
1230 if (!NILP (Vload_source_file_function
))
1236 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1237 NILP (noerror
) ? Qnil
: Qt
,
1238 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1239 return unbind_to (count
, val
);
1243 GCPRO3 (file
, found
, hist_file_name
);
1247 efound
= ENCODE_FILE (found
);
1248 stream
= fopen (SSDATA (efound
), fmode
);
1249 #else /* not WINDOWSNT */
1250 stream
= fdopen (fd
, fmode
);
1251 #endif /* not WINDOWSNT */
1255 error ("Failure to create stdio stream for %s", SDATA (file
));
1258 if (! NILP (Vpurify_flag
))
1259 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1261 if (NILP (nomessage
) || force_load_messages
)
1264 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1267 message_with_string ("Loading %s (source)...", file
, 1);
1269 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1271 else /* The typical case; compiled file newer than source file. */
1272 message_with_string ("Loading %s...", file
, 1);
1275 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1276 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1277 specbind (Qload_file_name
, found
);
1278 specbind (Qinhibit_file_name_operation
, Qnil
);
1279 load_descriptor_list
1280 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1281 specbind (Qload_in_progress
, Qt
);
1284 if (lisp_file_lexically_bound_p (Qget_file_char
))
1285 Fset (Qlexical_binding
, Qt
);
1287 if (! version
|| version
>= 22)
1288 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1289 0, Qnil
, Qnil
, Qnil
, Qnil
);
1292 /* We can't handle a file which was compiled with
1293 byte-compile-dynamic by older version of Emacs. */
1294 specbind (Qload_force_doc_strings
, Qt
);
1295 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1296 0, Qnil
, Qnil
, Qnil
, Qnil
);
1298 unbind_to (count
, Qnil
);
1300 /* Run any eval-after-load forms for this file */
1301 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1302 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1306 xfree (saved_doc_string
);
1307 saved_doc_string
= 0;
1308 saved_doc_string_size
= 0;
1310 xfree (prev_saved_doc_string
);
1311 prev_saved_doc_string
= 0;
1312 prev_saved_doc_string_size
= 0;
1314 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1317 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1320 message_with_string ("Loading %s (source)...done", file
, 1);
1322 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1324 else /* The typical case; compiled file newer than source file. */
1325 message_with_string ("Loading %s...done", file
, 1);
1332 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1334 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1345 load_descriptor_unwind (Lisp_Object oldlist
)
1347 load_descriptor_list
= oldlist
;
1351 /* Close all descriptors in use for Floads.
1352 This is used when starting a subprocess. */
1355 close_load_descs (void)
1359 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1360 emacs_close (XFASTINT (XCAR (tail
)));
1365 complete_filename_p (Lisp_Object pathname
)
1367 register const unsigned char *s
= SDATA (pathname
);
1368 return (IS_DIRECTORY_SEP (s
[0])
1369 || (SCHARS (pathname
) > 2
1370 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1373 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1374 doc
: /* Search for FILENAME through PATH.
1375 Returns the file's name in absolute form, or nil if not found.
1376 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1377 file name when searching.
1378 If non-nil, PREDICATE is used instead of `file-readable-p'.
1379 PREDICATE can also be an integer to pass to the access(2) function,
1380 in which case file-name-handlers are ignored.
1381 This function will normally skip directories, so if you want it to find
1382 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1383 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1386 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1387 if (NILP (predicate
) && fd
> 0)
1392 static Lisp_Object Qdir_ok
;
1394 /* Search for a file whose name is STR, looking in directories
1395 in the Lisp list PATH, and trying suffixes from SUFFIX.
1396 On success, returns a file descriptor. On failure, returns -1.
1398 SUFFIXES is a list of strings containing possible suffixes.
1399 The empty suffix is automatically added if the list is empty.
1401 PREDICATE non-nil means don't open the files,
1402 just look for one that satisfies the predicate. In this case,
1403 returns 1 on success. The predicate can be a lisp function or
1404 an integer to pass to `access' (in which case file-name-handlers
1407 If STOREPTR is nonzero, it points to a slot where the name of
1408 the file actually found should be stored as a Lisp string.
1409 nil is stored there on failure.
1411 If the file we find is remote, return -2
1412 but store the found remote file name in *STOREPTR. */
1415 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1418 EMACS_INT fn_size
= 100;
1420 register char *fn
= buf
;
1422 EMACS_INT want_length
;
1423 Lisp_Object filename
;
1425 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1426 Lisp_Object string
, tail
, encoded_fn
;
1427 EMACS_INT max_suffix_len
= 0;
1431 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1433 CHECK_STRING_CAR (tail
);
1434 max_suffix_len
= max (max_suffix_len
,
1435 SBYTES (XCAR (tail
)));
1438 string
= filename
= encoded_fn
= Qnil
;
1439 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1444 if (complete_filename_p (str
))
1447 for (; CONSP (path
); path
= XCDR (path
))
1449 filename
= Fexpand_file_name (str
, XCAR (path
));
1450 if (!complete_filename_p (filename
))
1451 /* If there are non-absolute elts in PATH (eg ".") */
1452 /* Of course, this could conceivably lose if luser sets
1453 default-directory to be something non-absolute... */
1455 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1456 if (!complete_filename_p (filename
))
1457 /* Give up on this path element! */
1461 /* Calculate maximum length of any filename made from
1462 this path element/specified file name and any possible suffix. */
1463 want_length
= max_suffix_len
+ SBYTES (filename
);
1464 if (fn_size
<= want_length
)
1465 fn
= (char *) alloca (fn_size
= 100 + want_length
);
1467 /* Loop over suffixes. */
1468 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1469 CONSP (tail
); tail
= XCDR (tail
))
1471 int lsuffix
= SBYTES (XCAR (tail
));
1472 Lisp_Object handler
;
1475 /* Concatenate path element/specified name with the suffix.
1476 If the directory starts with /:, remove that. */
1477 if (SCHARS (filename
) > 2
1478 && SREF (filename
, 0) == '/'
1479 && SREF (filename
, 1) == ':')
1481 strncpy (fn
, SSDATA (filename
) + 2,
1482 SBYTES (filename
) - 2);
1483 fn
[SBYTES (filename
) - 2] = 0;
1487 strncpy (fn
, SSDATA (filename
),
1489 fn
[SBYTES (filename
)] = 0;
1492 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1493 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1495 /* Check that the file exists and is not a directory. */
1496 /* We used to only check for handlers on non-absolute file names:
1500 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1501 It's not clear why that was the case and it breaks things like
1502 (load "/bar.el") where the file is actually "/bar.el.gz". */
1503 string
= build_string (fn
);
1504 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1505 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1507 if (NILP (predicate
))
1508 exists
= !NILP (Ffile_readable_p (string
));
1511 Lisp_Object tmp
= call1 (predicate
, string
);
1512 exists
= !NILP (tmp
)
1513 && (EQ (tmp
, Qdir_ok
)
1514 || NILP (Ffile_directory_p (string
)));
1519 /* We succeeded; return this descriptor and filename. */
1530 encoded_fn
= ENCODE_FILE (string
);
1531 pfn
= SSDATA (encoded_fn
);
1532 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1535 /* Check that we can access or open it. */
1536 if (NATNUMP (predicate
))
1537 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1539 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1543 /* We succeeded; return this descriptor and filename. */
1561 /* Merge the list we've accumulated of globals from the current input source
1562 into the load_history variable. The details depend on whether
1563 the source has an associated file name or not.
1565 FILENAME is the file name that we are loading from.
1566 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1569 build_load_history (Lisp_Object filename
, int entire
)
1571 register Lisp_Object tail
, prev
, newelt
;
1572 register Lisp_Object tem
, tem2
;
1573 register int foundit
= 0;
1575 tail
= Vload_history
;
1578 while (CONSP (tail
))
1582 /* Find the feature's previous assoc list... */
1583 if (!NILP (Fequal (filename
, Fcar (tem
))))
1587 /* If we're loading the entire file, remove old data. */
1591 Vload_history
= XCDR (tail
);
1593 Fsetcdr (prev
, XCDR (tail
));
1596 /* Otherwise, cons on new symbols that are not already members. */
1599 tem2
= Vcurrent_load_list
;
1601 while (CONSP (tem2
))
1603 newelt
= XCAR (tem2
);
1605 if (NILP (Fmember (newelt
, tem
)))
1606 Fsetcar (tail
, Fcons (XCAR (tem
),
1607 Fcons (newelt
, XCDR (tem
))));
1620 /* If we're loading an entire file, cons the new assoc onto the
1621 front of load-history, the most-recently-loaded position. Also
1622 do this if we didn't find an existing member for the file. */
1623 if (entire
|| !foundit
)
1624 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1629 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1636 readevalloop_1 (Lisp_Object old
)
1638 load_convert_to_unibyte
= ! NILP (old
);
1642 /* Signal an `end-of-file' error, if possible with file name
1646 end_of_file_error (void)
1648 if (STRINGP (Vload_file_name
))
1649 xsignal1 (Qend_of_file
, Vload_file_name
);
1651 xsignal0 (Qend_of_file
);
1654 /* UNIBYTE specifies how to set load_convert_to_unibyte
1655 for this invocation.
1656 READFUN, if non-nil, is used instead of `read'.
1658 START, END specify region to read in current buffer (from eval-region).
1659 If the input is not from a buffer, they must be nil. */
1662 readevalloop (Lisp_Object readcharfun
,
1664 Lisp_Object sourcename
,
1666 Lisp_Object unibyte
, Lisp_Object readfun
,
1667 Lisp_Object start
, Lisp_Object end
)
1670 register Lisp_Object val
;
1671 int count
= SPECPDL_INDEX ();
1672 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1673 struct buffer
*b
= 0;
1674 int continue_reading_p
;
1675 Lisp_Object lex_bound
;
1676 /* Nonzero if reading an entire buffer. */
1677 int whole_buffer
= 0;
1678 /* 1 on the first time around. */
1681 if (MARKERP (readcharfun
))
1684 start
= readcharfun
;
1687 if (BUFFERP (readcharfun
))
1688 b
= XBUFFER (readcharfun
);
1689 else if (MARKERP (readcharfun
))
1690 b
= XMARKER (readcharfun
)->buffer
;
1692 /* We assume START is nil when input is not from a buffer. */
1693 if (! NILP (start
) && !b
)
1696 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1697 specbind (Qcurrent_load_list
, Qnil
);
1698 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1699 load_convert_to_unibyte
= !NILP (unibyte
);
1701 /* If lexical binding is active (either because it was specified in
1702 the file's header, or via a buffer-local variable), create an empty
1703 lexical environment, otherwise, turn off lexical binding. */
1704 lex_bound
= find_symbol_value (Qlexical_binding
);
1705 specbind (Qinternal_interpreter_environment
,
1706 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1707 ? Qnil
: Fcons (Qt
, Qnil
));
1709 GCPRO4 (sourcename
, readfun
, start
, end
);
1711 /* Try to ensure sourcename is a truename, except whilst preloading. */
1712 if (NILP (Vpurify_flag
)
1713 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1714 && !NILP (Ffboundp (Qfile_truename
)))
1715 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1717 LOADHIST_ATTACH (sourcename
);
1719 continue_reading_p
= 1;
1720 while (continue_reading_p
)
1722 int count1
= SPECPDL_INDEX ();
1724 if (b
!= 0 && NILP (BVAR (b
, name
)))
1725 error ("Reading from killed buffer");
1729 /* Switch to the buffer we are reading from. */
1730 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1731 set_buffer_internal (b
);
1733 /* Save point in it. */
1734 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1735 /* Save ZV in it. */
1736 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1737 /* Those get unbound after we read one expression. */
1739 /* Set point and ZV around stuff to be read. */
1742 Fnarrow_to_region (make_number (BEGV
), end
);
1744 /* Just for cleanliness, convert END to a marker
1745 if it is an integer. */
1747 end
= Fpoint_max_marker ();
1750 /* On the first cycle, we can easily test here
1751 whether we are reading the whole buffer. */
1752 if (b
&& first_sexp
)
1753 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1760 while ((c
= READCHAR
) != '\n' && c
!= -1);
1765 unbind_to (count1
, Qnil
);
1769 /* Ignore whitespace here, so we can detect eof. */
1770 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1771 || c
== 0x8a0) /* NBSP */
1774 if (!NILP (Vpurify_flag
) && c
== '(')
1776 record_unwind_protect (unreadpure
, Qnil
);
1777 val
= read_list (-1, readcharfun
);
1782 read_objects
= Qnil
;
1783 if (!NILP (readfun
))
1785 val
= call1 (readfun
, readcharfun
);
1787 /* If READCHARFUN has set point to ZV, we should
1788 stop reading, even if the form read sets point
1789 to a different value when evaluated. */
1790 if (BUFFERP (readcharfun
))
1792 struct buffer
*buf
= XBUFFER (readcharfun
);
1793 if (BUF_PT (buf
) == BUF_ZV (buf
))
1794 continue_reading_p
= 0;
1797 else if (! NILP (Vload_read_function
))
1798 val
= call1 (Vload_read_function
, readcharfun
);
1800 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1803 if (!NILP (start
) && continue_reading_p
)
1804 start
= Fpoint_marker ();
1806 /* Restore saved point and BEGV. */
1807 unbind_to (count1
, Qnil
);
1809 /* Now eval what we just read. */
1810 val
= eval_sub (val
);
1814 Vvalues
= Fcons (val
, Vvalues
);
1815 if (EQ (Vstandard_output
, Qt
))
1824 build_load_history (sourcename
,
1825 stream
|| whole_buffer
);
1829 unbind_to (count
, Qnil
);
1832 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1833 doc
: /* Execute the current buffer as Lisp code.
1834 When called from a Lisp program (i.e., not interactively), this
1835 function accepts up to five optional arguments:
1836 BUFFER is the buffer to evaluate (nil means use current buffer).
1837 PRINTFLAG controls printing of output:
1838 A value of nil means discard it; anything else is stream for print.
1839 FILENAME specifies the file name to use for `load-history'.
1840 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1842 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1843 functions should work normally even if PRINTFLAG is nil.
1845 This function preserves the position of point. */)
1846 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1848 int count
= SPECPDL_INDEX ();
1849 Lisp_Object tem
, buf
;
1852 buf
= Fcurrent_buffer ();
1854 buf
= Fget_buffer (buffer
);
1856 error ("No such buffer");
1858 if (NILP (printflag
) && NILP (do_allow_print
))
1863 if (NILP (filename
))
1864 filename
= BVAR (XBUFFER (buf
), filename
);
1866 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1867 specbind (Qstandard_output
, tem
);
1868 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1869 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1870 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1871 readevalloop (buf
, 0, filename
,
1872 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1873 unbind_to (count
, Qnil
);
1878 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1879 doc
: /* Execute the region as Lisp code.
1880 When called from programs, expects two arguments,
1881 giving starting and ending indices in the current buffer
1882 of the text to be executed.
1883 Programs can pass third argument PRINTFLAG which controls output:
1884 A value of nil means discard it; anything else is stream for printing it.
1885 Also the fourth argument READ-FUNCTION, if non-nil, is used
1886 instead of `read' to read each expression. It gets one argument
1887 which is the input stream for reading characters.
1889 This function does not move point. */)
1890 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1892 /* FIXME: Do the eval-sexp-add-defvars danse! */
1893 int count
= SPECPDL_INDEX ();
1894 Lisp_Object tem
, cbuf
;
1896 cbuf
= Fcurrent_buffer ();
1898 if (NILP (printflag
))
1902 specbind (Qstandard_output
, tem
);
1903 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1905 /* readevalloop calls functions which check the type of start and end. */
1906 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1907 !NILP (printflag
), Qnil
, read_function
,
1910 return unbind_to (count
, Qnil
);
1914 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1915 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1916 If STREAM is nil, use the value of `standard-input' (which see).
1917 STREAM or the value of `standard-input' may be:
1918 a buffer (read from point and advance it)
1919 a marker (read from where it points and advance it)
1920 a function (call it with no arguments for each character,
1921 call it with a char as argument to push a char back)
1922 a string (takes text from string, starting at the beginning)
1923 t (read text line using minibuffer and use it, or read from
1924 standard input in batch mode). */)
1925 (Lisp_Object stream
)
1928 stream
= Vstandard_input
;
1929 if (EQ (stream
, Qt
))
1930 stream
= Qread_char
;
1931 if (EQ (stream
, Qread_char
))
1932 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1934 return read_internal_start (stream
, Qnil
, Qnil
);
1937 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1938 doc
: /* Read one Lisp expression which is represented as text by STRING.
1939 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1940 START and END optionally delimit a substring of STRING from which to read;
1941 they default to 0 and (length STRING) respectively. */)
1942 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1945 CHECK_STRING (string
);
1946 /* read_internal_start sets read_from_string_index. */
1947 ret
= read_internal_start (string
, start
, end
);
1948 return Fcons (ret
, make_number (read_from_string_index
));
1951 /* Function to set up the global context we need in toplevel read
1954 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1955 /* start, end only used when stream is a string. */
1960 new_backquote_flag
= 0;
1961 read_objects
= Qnil
;
1962 if (EQ (Vread_with_symbol_positions
, Qt
)
1963 || EQ (Vread_with_symbol_positions
, stream
))
1964 Vread_symbol_positions_list
= Qnil
;
1966 if (STRINGP (stream
)
1967 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1969 EMACS_INT startval
, endval
;
1972 if (STRINGP (stream
))
1975 string
= XCAR (stream
);
1978 endval
= SCHARS (string
);
1982 endval
= XINT (end
);
1983 if (endval
< 0 || endval
> SCHARS (string
))
1984 args_out_of_range (string
, end
);
1991 CHECK_NUMBER (start
);
1992 startval
= XINT (start
);
1993 if (startval
< 0 || startval
> endval
)
1994 args_out_of_range (string
, start
);
1996 read_from_string_index
= startval
;
1997 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1998 read_from_string_limit
= endval
;
2001 retval
= read0 (stream
);
2002 if (EQ (Vread_with_symbol_positions
, Qt
)
2003 || EQ (Vread_with_symbol_positions
, stream
))
2004 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2009 /* Signal Qinvalid_read_syntax error.
2010 S is error string of length N (if > 0) */
2013 invalid_syntax (const char *s
, int n
)
2017 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
2021 /* Use this for recursive reads, in contexts where internal tokens
2025 read0 (Lisp_Object readcharfun
)
2027 register Lisp_Object val
;
2030 val
= read1 (readcharfun
, &c
, 0);
2034 xsignal1 (Qinvalid_read_syntax
,
2035 Fmake_string (make_number (1), make_number (c
)));
2038 static int read_buffer_size
;
2039 static char *read_buffer
;
2041 /* Read a \-escape sequence, assuming we already read the `\'.
2042 If the escape sequence forces unibyte, return eight-bit char. */
2045 read_escape (Lisp_Object readcharfun
, int stringp
)
2047 register int c
= READCHAR
;
2048 /* \u allows up to four hex digits, \U up to eight. Default to the
2049 behavior for \u, and change this value in the case that \U is seen. */
2050 int unicode_hex_count
= 4;
2055 end_of_file_error ();
2085 error ("Invalid escape character syntax");
2088 c
= read_escape (readcharfun
, 0);
2089 return c
| meta_modifier
;
2094 error ("Invalid escape character syntax");
2097 c
= read_escape (readcharfun
, 0);
2098 return c
| shift_modifier
;
2103 error ("Invalid escape character syntax");
2106 c
= read_escape (readcharfun
, 0);
2107 return c
| hyper_modifier
;
2112 error ("Invalid escape character syntax");
2115 c
= read_escape (readcharfun
, 0);
2116 return c
| alt_modifier
;
2120 if (stringp
|| c
!= '-')
2127 c
= read_escape (readcharfun
, 0);
2128 return c
| super_modifier
;
2133 error ("Invalid escape character syntax");
2137 c
= read_escape (readcharfun
, 0);
2138 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2139 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2140 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2141 return c
| ctrl_modifier
;
2142 /* ASCII control chars are made from letters (both cases),
2143 as well as the non-letters within 0100...0137. */
2144 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2145 return (c
& (037 | ~0177));
2146 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2147 return (c
& (037 | ~0177));
2149 return c
| ctrl_modifier
;
2159 /* An octal escape, as in ANSI C. */
2161 register int i
= c
- '0';
2162 register int count
= 0;
2165 if ((c
= READCHAR
) >= '0' && c
<= '7')
2177 if (i
>= 0x80 && i
< 0x100)
2178 i
= BYTE8_TO_CHAR (i
);
2183 /* A hex escape, as in ANSI C. */
2190 if (c
>= '0' && c
<= '9')
2195 else if ((c
>= 'a' && c
<= 'f')
2196 || (c
>= 'A' && c
<= 'F'))
2199 if (c
>= 'a' && c
<= 'f')
2212 if (count
< 3 && i
>= 0x80)
2213 return BYTE8_TO_CHAR (i
);
2218 /* Post-Unicode-2.0: Up to eight hex chars. */
2219 unicode_hex_count
= 8;
2222 /* A Unicode escape. We only permit them in strings and characters,
2223 not arbitrarily in the source code, as in some other languages. */
2228 while (++count
<= unicode_hex_count
)
2231 /* isdigit and isalpha may be locale-specific, which we don't
2233 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2234 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2235 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2238 error ("Non-hex digit used for Unicode escape");
2243 error ("Non-Unicode character: 0x%x", i
);
2252 /* Return the digit that CHARACTER stands for in the given BASE.
2253 Return -1 if CHARACTER is out of range for BASE,
2254 and -2 if CHARACTER is not valid for any supported BASE. */
2256 digit_to_number (int character
, int base
)
2260 if ('0' <= character
&& character
<= '9')
2261 digit
= character
- '0';
2262 else if ('a' <= character
&& character
<= 'z')
2263 digit
= character
- 'a' + 10;
2264 else if ('A' <= character
&& character
<= 'Z')
2265 digit
= character
- 'A' + 10;
2269 return digit
< base
? digit
: -1;
2272 /* Read an integer in radix RADIX using READCHARFUN to read
2273 characters. RADIX must be in the interval [2..36]; if it isn't, a
2274 read error is signaled . Value is the integer read. Signals an
2275 error if encountering invalid read syntax or if RADIX is out of
2279 read_integer (Lisp_Object readcharfun
, int radix
)
2281 /* Room for sign, leading 0, other digits, trailing null byte. */
2282 char buf
[1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1];
2284 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2286 if (radix
< 2 || radix
> 36)
2294 if (c
== '-' || c
== '+')
2305 /* Ignore redundant leading zeros, so the buffer doesn't
2306 fill up with them. */
2312 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2319 if (p
< buf
+ sizeof buf
- 1)
2334 sprintf (buf
, "integer, radix %d", radix
);
2335 invalid_syntax (buf
, 0);
2338 return string_to_number (buf
, radix
, 0);
2342 /* If the next token is ')' or ']' or '.', we store that character
2343 in *PCH and the return value is not interesting. Else, we store
2344 zero in *PCH and we read and return one lisp object.
2346 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2349 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2352 unsigned uninterned_symbol
= 0;
2360 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2362 end_of_file_error ();
2367 return read_list (0, readcharfun
);
2370 return read_vector (readcharfun
, 0);
2386 /* Accept extended format for hashtables (extensible to
2388 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2389 Lisp_Object tmp
= read_list (0, readcharfun
);
2390 Lisp_Object head
= CAR_SAFE (tmp
);
2391 Lisp_Object data
= Qnil
;
2392 Lisp_Object val
= Qnil
;
2393 /* The size is 2 * number of allowed keywords to
2395 Lisp_Object params
[10];
2397 Lisp_Object key
= Qnil
;
2398 int param_count
= 0;
2400 if (!EQ (head
, Qhash_table
))
2401 error ("Invalid extended read marker at head of #s list "
2402 "(only hash-table allowed)");
2404 tmp
= CDR_SAFE (tmp
);
2406 /* This is repetitive but fast and simple. */
2407 params
[param_count
] = QCsize
;
2408 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2409 if (!NILP (params
[param_count
+ 1]))
2412 params
[param_count
] = QCtest
;
2413 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2414 if (!NILP (params
[param_count
+ 1]))
2417 params
[param_count
] = QCweakness
;
2418 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2419 if (!NILP (params
[param_count
+ 1]))
2422 params
[param_count
] = QCrehash_size
;
2423 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2424 if (!NILP (params
[param_count
+ 1]))
2427 params
[param_count
] = QCrehash_threshold
;
2428 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2429 if (!NILP (params
[param_count
+ 1]))
2432 /* This is the hashtable data. */
2433 data
= Fplist_get (tmp
, Qdata
);
2435 /* Now use params to make a new hashtable and fill it. */
2436 ht
= Fmake_hash_table (param_count
, params
);
2438 while (CONSP (data
))
2443 error ("Odd number of elements in hashtable data");
2446 Fputhash (key
, val
, ht
);
2452 invalid_syntax ("#", 1);
2460 tmp
= read_vector (readcharfun
, 0);
2461 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2462 error ("Invalid size char-table");
2463 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2474 tmp
= read_vector (readcharfun
, 0);
2475 if (!INTEGERP (AREF (tmp
, 0)))
2476 error ("Invalid depth in char-table");
2477 depth
= XINT (AREF (tmp
, 0));
2478 if (depth
< 1 || depth
> 3)
2479 error ("Invalid depth in char-table");
2480 size
= ASIZE (tmp
) - 2;
2481 if (chartab_size
[depth
] != size
)
2482 error ("Invalid size char-table");
2483 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2486 invalid_syntax ("#^^", 3);
2488 invalid_syntax ("#^", 2);
2493 length
= read1 (readcharfun
, pch
, first_in_list
);
2497 Lisp_Object tmp
, val
;
2499 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2500 / BOOL_VECTOR_BITS_PER_CHAR
);
2503 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2504 if (STRING_MULTIBYTE (tmp
)
2505 || (size_in_chars
!= SCHARS (tmp
)
2506 /* We used to print 1 char too many
2507 when the number of bits was a multiple of 8.
2508 Accept such input in case it came from an old
2510 && ! (XFASTINT (length
)
2511 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2512 invalid_syntax ("#&...", 5);
2514 val
= Fmake_bool_vector (length
, Qnil
);
2515 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2516 /* Clear the extraneous bits in the last byte. */
2517 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2518 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2519 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2522 invalid_syntax ("#&...", 5);
2526 /* Accept compiled functions at read-time so that we don't have to
2527 build them using function calls. */
2529 tmp
= read_vector (readcharfun
, 1);
2530 return Fmake_byte_code (ASIZE (tmp
),
2531 XVECTOR (tmp
)->contents
);
2536 struct gcpro gcpro1
;
2539 /* Read the string itself. */
2540 tmp
= read1 (readcharfun
, &ch
, 0);
2541 if (ch
!= 0 || !STRINGP (tmp
))
2542 invalid_syntax ("#", 1);
2544 /* Read the intervals and their properties. */
2547 Lisp_Object beg
, end
, plist
;
2549 beg
= read1 (readcharfun
, &ch
, 0);
2554 end
= read1 (readcharfun
, &ch
, 0);
2556 plist
= read1 (readcharfun
, &ch
, 0);
2558 invalid_syntax ("Invalid string property list", 0);
2559 Fset_text_properties (beg
, end
, plist
, tmp
);
2565 /* #@NUMBER is used to skip NUMBER following characters.
2566 That's used in .elc files to skip over doc strings
2567 and function definitions. */
2573 /* Read a decimal integer. */
2574 while ((c
= READCHAR
) >= 0
2575 && c
>= '0' && c
<= '9')
2583 if (load_force_doc_strings
2584 && (EQ (readcharfun
, Qget_file_char
)
2585 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2587 /* If we are supposed to force doc strings into core right now,
2588 record the last string that we skipped,
2589 and record where in the file it comes from. */
2591 /* But first exchange saved_doc_string
2592 with prev_saved_doc_string, so we save two strings. */
2594 char *temp
= saved_doc_string
;
2595 int temp_size
= saved_doc_string_size
;
2596 file_offset temp_pos
= saved_doc_string_position
;
2597 int temp_len
= saved_doc_string_length
;
2599 saved_doc_string
= prev_saved_doc_string
;
2600 saved_doc_string_size
= prev_saved_doc_string_size
;
2601 saved_doc_string_position
= prev_saved_doc_string_position
;
2602 saved_doc_string_length
= prev_saved_doc_string_length
;
2604 prev_saved_doc_string
= temp
;
2605 prev_saved_doc_string_size
= temp_size
;
2606 prev_saved_doc_string_position
= temp_pos
;
2607 prev_saved_doc_string_length
= temp_len
;
2610 if (saved_doc_string_size
== 0)
2612 saved_doc_string_size
= nskip
+ 100;
2613 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2615 if (nskip
> saved_doc_string_size
)
2617 saved_doc_string_size
= nskip
+ 100;
2618 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2619 saved_doc_string_size
);
2622 saved_doc_string_position
= file_tell (instream
);
2624 /* Copy that many characters into saved_doc_string. */
2625 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2626 saved_doc_string
[i
] = c
= READCHAR
;
2628 saved_doc_string_length
= i
;
2632 /* Skip that many characters. */
2633 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2642 /* #! appears at the beginning of an executable file.
2643 Skip the first line. */
2644 while (c
!= '\n' && c
>= 0)
2649 return Vload_file_name
;
2651 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2652 /* #:foo is the uninterned symbol named foo. */
2655 uninterned_symbol
= 1;
2659 /* Reader forms that can reuse previously read objects. */
2660 if (c
>= '0' && c
<= '9')
2665 /* Read a non-negative integer. */
2666 while (c
>= '0' && c
<= '9')
2672 /* #n=object returns object, but associates it with n for #n#. */
2673 if (c
== '=' && !NILP (Vread_circle
))
2675 /* Make a placeholder for #n# to use temporarily */
2676 Lisp_Object placeholder
;
2679 placeholder
= Fcons (Qnil
, Qnil
);
2680 cell
= Fcons (make_number (n
), placeholder
);
2681 read_objects
= Fcons (cell
, read_objects
);
2683 /* Read the object itself. */
2684 tem
= read0 (readcharfun
);
2686 /* Now put it everywhere the placeholder was... */
2687 substitute_object_in_subtree (tem
, placeholder
);
2689 /* ...and #n# will use the real value from now on. */
2690 Fsetcdr (cell
, tem
);
2694 /* #n# returns a previously read object. */
2695 if (c
== '#' && !NILP (Vread_circle
))
2697 tem
= Fassq (make_number (n
), read_objects
);
2700 /* Fall through to error message. */
2702 else if (c
== 'r' || c
== 'R')
2703 return read_integer (readcharfun
, n
);
2705 /* Fall through to error message. */
2707 else if (c
== 'x' || c
== 'X')
2708 return read_integer (readcharfun
, 16);
2709 else if (c
== 'o' || c
== 'O')
2710 return read_integer (readcharfun
, 8);
2711 else if (c
== 'b' || c
== 'B')
2712 return read_integer (readcharfun
, 2);
2715 invalid_syntax ("#", 1);
2718 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2723 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2728 int next_char
= READCHAR
;
2730 /* Transition from old-style to new-style:
2731 If we see "(`" it used to mean old-style, which usually works
2732 fine because ` should almost never appear in such a position
2733 for new-style. But occasionally we need "(`" to mean new
2734 style, so we try to distinguish the two by the fact that we
2735 can either write "( `foo" or "(` foo", where the first
2736 intends to use new-style whereas the second intends to use
2737 old-style. For Emacs-25, we should completely remove this
2738 first_in_list exception (old-style can still be obtained via
2740 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2742 Vold_style_backquotes
= Qt
;
2749 new_backquote_flag
++;
2750 value
= read0 (readcharfun
);
2751 new_backquote_flag
--;
2753 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2758 int next_char
= READCHAR
;
2760 /* Transition from old-style to new-style:
2761 It used to be impossible to have a new-style , other than within
2762 a new-style `. This is sufficient when ` and , are used in the
2763 normal way, but ` and , can also appear in args to macros that
2764 will not interpret them in the usual way, in which case , may be
2765 used without any ` anywhere near.
2766 So we now use the same heuristic as for backquote: old-style
2767 unquotes are only recognized when first on a list, and when
2768 followed by a space.
2769 Because it's more difficult to peak 2 chars ahead, a new-style
2770 ,@ can still not be used outside of a `, unless it's in the middle
2772 if (new_backquote_flag
2774 || (next_char
!= ' ' && next_char
!= '@'))
2776 Lisp_Object comma_type
= Qnil
;
2781 comma_type
= Qcomma_at
;
2783 comma_type
= Qcomma_dot
;
2786 if (ch
>= 0) UNREAD (ch
);
2787 comma_type
= Qcomma
;
2790 value
= read0 (readcharfun
);
2791 return Fcons (comma_type
, Fcons (value
, Qnil
));
2795 Vold_style_backquotes
= Qt
;
2807 end_of_file_error ();
2809 /* Accept `single space' syntax like (list ? x) where the
2810 whitespace character is SPC or TAB.
2811 Other literal whitespace like NL, CR, and FF are not accepted,
2812 as there are well-established escape sequences for these. */
2813 if (c
== ' ' || c
== '\t')
2814 return make_number (c
);
2817 c
= read_escape (readcharfun
, 0);
2818 modifiers
= c
& CHAR_MODIFIER_MASK
;
2819 c
&= ~CHAR_MODIFIER_MASK
;
2820 if (CHAR_BYTE8_P (c
))
2821 c
= CHAR_TO_BYTE8 (c
);
2824 next_char
= READCHAR
;
2825 ok
= (next_char
<= 040
2826 || (next_char
< 0200
2827 && (strchr ("\"';()[]#?`,.", next_char
))));
2830 return make_number (c
);
2832 invalid_syntax ("?", 1);
2837 char *p
= read_buffer
;
2838 char *end
= read_buffer
+ read_buffer_size
;
2840 /* Nonzero if we saw an escape sequence specifying
2841 a multibyte character. */
2842 int force_multibyte
= 0;
2843 /* Nonzero if we saw an escape sequence specifying
2844 a single-byte character. */
2845 int force_singlebyte
= 0;
2849 while ((ch
= READCHAR
) >= 0
2852 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2854 int offset
= p
- read_buffer
;
2855 read_buffer
= (char *) xrealloc (read_buffer
,
2856 read_buffer_size
*= 2);
2857 p
= read_buffer
+ offset
;
2858 end
= read_buffer
+ read_buffer_size
;
2865 ch
= read_escape (readcharfun
, 1);
2867 /* CH is -1 if \ newline has just been seen */
2870 if (p
== read_buffer
)
2875 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2876 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2878 if (CHAR_BYTE8_P (ch
))
2879 force_singlebyte
= 1;
2880 else if (! ASCII_CHAR_P (ch
))
2881 force_multibyte
= 1;
2882 else /* i.e. ASCII_CHAR_P (ch) */
2884 /* Allow `\C- ' and `\C-?'. */
2885 if (modifiers
== CHAR_CTL
)
2888 ch
= 0, modifiers
= 0;
2890 ch
= 127, modifiers
= 0;
2892 if (modifiers
& CHAR_SHIFT
)
2894 /* Shift modifier is valid only with [A-Za-z]. */
2895 if (ch
>= 'A' && ch
<= 'Z')
2896 modifiers
&= ~CHAR_SHIFT
;
2897 else if (ch
>= 'a' && ch
<= 'z')
2898 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2901 if (modifiers
& CHAR_META
)
2903 /* Move the meta bit to the right place for a
2905 modifiers
&= ~CHAR_META
;
2906 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2907 force_singlebyte
= 1;
2911 /* Any modifiers remaining are invalid. */
2913 error ("Invalid modifier in string");
2914 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2918 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2919 if (CHAR_BYTE8_P (ch
))
2920 force_singlebyte
= 1;
2921 else if (! ASCII_CHAR_P (ch
))
2922 force_multibyte
= 1;
2928 end_of_file_error ();
2930 /* If purifying, and string starts with \ newline,
2931 return zero instead. This is for doc strings
2932 that we are really going to find in etc/DOC.nn.nn */
2933 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2934 return make_number (0);
2936 if (force_multibyte
)
2937 /* READ_BUFFER already contains valid multibyte forms. */
2939 else if (force_singlebyte
)
2941 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
2943 p
= read_buffer
+ nchars
;
2947 /* Otherwise, READ_BUFFER contains only ASCII. */
2950 /* We want readchar_count to be the number of characters, not
2951 bytes. Hence we adjust for multibyte characters in the
2952 string. ... But it doesn't seem to be necessary, because
2953 READCHAR *does* read multibyte characters from buffers. */
2954 /* readchar_count -= (p - read_buffer) - nchars; */
2956 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2958 || (p
- read_buffer
!= nchars
)));
2959 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2961 || (p
- read_buffer
!= nchars
)));
2966 int next_char
= READCHAR
;
2969 if (next_char
<= 040
2970 || (next_char
< 0200
2971 && (strchr ("\"';([#?`,", next_char
))))
2977 /* Otherwise, we fall through! Note that the atom-reading loop
2978 below will now loop at least once, assuring that we will not
2979 try to UNREAD two characters in a row. */
2983 if (c
<= 040) goto retry
;
2984 if (c
== 0x8a0) /* NBSP */
2987 char *p
= read_buffer
;
2991 char *end
= read_buffer
+ read_buffer_size
;
2995 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2997 int offset
= p
- read_buffer
;
2998 read_buffer
= (char *) xrealloc (read_buffer
,
2999 read_buffer_size
*= 2);
3000 p
= read_buffer
+ offset
;
3001 end
= read_buffer
+ read_buffer_size
;
3008 end_of_file_error ();
3013 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3018 && c
!= 0x8a0 /* NBSP */
3020 || !(strchr ("\"';()[]#`,", c
))));
3024 int offset
= p
- read_buffer
;
3025 read_buffer
= (char *) xrealloc (read_buffer
,
3026 read_buffer_size
*= 2);
3027 p
= read_buffer
+ offset
;
3028 end
= read_buffer
+ read_buffer_size
;
3035 if (!quoted
&& !uninterned_symbol
)
3037 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3038 if (! NILP (result
))
3042 Lisp_Object name
, result
;
3043 EMACS_INT nbytes
= p
- read_buffer
;
3046 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3050 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3051 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3053 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3054 result
= (uninterned_symbol
? Fmake_symbol (name
)
3055 : Fintern (name
, Qnil
));
3057 if (EQ (Vread_with_symbol_positions
, Qt
)
3058 || EQ (Vread_with_symbol_positions
, readcharfun
))
3059 Vread_symbol_positions_list
=
3060 /* Kind of a hack; this will probably fail if characters
3061 in the symbol name were escaped. Not really a big
3063 Fcons (Fcons (result
,
3064 make_number (readchar_count
3065 - XFASTINT (Flength (Fsymbol_name (result
))))),
3066 Vread_symbol_positions_list
);
3074 /* List of nodes we've seen during substitute_object_in_subtree. */
3075 static Lisp_Object seen_list
;
3078 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3080 Lisp_Object check_object
;
3082 /* We haven't seen any objects when we start. */
3085 /* Make all the substitutions. */
3087 = substitute_object_recurse (object
, placeholder
, object
);
3089 /* Clear seen_list because we're done with it. */
3092 /* The returned object here is expected to always eq the
3094 if (!EQ (check_object
, object
))
3095 error ("Unexpected mutation error in reader");
3098 /* Feval doesn't get called from here, so no gc protection is needed. */
3099 #define SUBSTITUTE(get_val, set_val) \
3101 Lisp_Object old_value = get_val; \
3102 Lisp_Object true_value \
3103 = substitute_object_recurse (object, placeholder, \
3106 if (!EQ (old_value, true_value)) \
3113 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3115 /* If we find the placeholder, return the target object. */
3116 if (EQ (placeholder
, subtree
))
3119 /* If we've been to this node before, don't explore it again. */
3120 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3123 /* If this node can be the entry point to a cycle, remember that
3124 we've seen it. It can only be such an entry point if it was made
3125 by #n=, which means that we can find it as a value in
3127 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3128 seen_list
= Fcons (subtree
, seen_list
);
3130 /* Recurse according to subtree's type.
3131 Every branch must return a Lisp_Object. */
3132 switch (XTYPE (subtree
))
3134 case Lisp_Vectorlike
:
3137 if (BOOL_VECTOR_P (subtree
))
3138 return subtree
; /* No sub-objects anyway. */
3139 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3140 || COMPILEDP (subtree
))
3141 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3142 else if (VECTORP (subtree
))
3143 length
= ASIZE (subtree
);
3145 /* An unknown pseudovector may contain non-Lisp fields, so we
3146 can't just blindly traverse all its fields. We used to call
3147 `Flength' which signaled `sequencep', so I just preserved this
3149 wrong_type_argument (Qsequencep
, subtree
);
3151 for (i
= 0; i
< length
; i
++)
3152 SUBSTITUTE (AREF (subtree
, i
),
3153 ASET (subtree
, i
, true_value
));
3159 SUBSTITUTE (XCAR (subtree
),
3160 XSETCAR (subtree
, true_value
));
3161 SUBSTITUTE (XCDR (subtree
),
3162 XSETCDR (subtree
, true_value
));
3168 /* Check for text properties in each interval.
3169 substitute_in_interval contains part of the logic. */
3171 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3172 Lisp_Object arg
= Fcons (object
, placeholder
);
3174 traverse_intervals_noorder (root_interval
,
3175 &substitute_in_interval
, arg
);
3180 /* Other types don't recurse any further. */
3186 /* Helper function for substitute_object_recurse. */
3188 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3190 Lisp_Object object
= Fcar (arg
);
3191 Lisp_Object placeholder
= Fcdr (arg
);
3193 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3203 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3204 integer syntax and fits in a fixnum, else return the nearest float if CP has
3205 either floating point or integer syntax and BASE is 10, else return nil. If
3206 IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
3207 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3208 number has integer syntax but does not fit. */
3211 string_to_number (char const *string
, int base
, int ignore_trailing
)
3214 char const *cp
= string
;
3216 int float_syntax
= 0;
3219 /* Compute NaN and infinities using a variable, to cope with compilers that
3220 think they are smarter than we are. */
3223 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3224 IEEE floating point hosts, and works around a formerly-common bug where
3225 atof ("-0.0") drops the sign. */
3226 int negative
= *cp
== '-';
3228 int signedp
= negative
|| *cp
== '+';
3233 leading_digit
= digit_to_number (*cp
, base
);
3234 if (0 <= leading_digit
)
3239 while (0 <= digit_to_number (*cp
, base
));
3249 if ('0' <= *cp
&& *cp
<= '9')
3254 while ('0' <= *cp
&& *cp
<= '9');
3256 if (*cp
== 'e' || *cp
== 'E')
3258 char const *ecp
= cp
;
3260 if (*cp
== '+' || *cp
== '-')
3262 if ('0' <= *cp
&& *cp
<= '9')
3267 while ('0' <= *cp
&& *cp
<= '9');
3269 else if (cp
[-1] == '+'
3270 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3276 else if (cp
[-1] == '+'
3277 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3281 value
= zero
/ zero
;
3283 /* If that made a "negative" NaN, negate it. */
3286 union { double d
; char c
[sizeof (double)]; }
3287 u_data
, u_minus_zero
;
3289 u_minus_zero
.d
= -0.0;
3290 for (i
= 0; i
< sizeof (double); i
++)
3291 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3297 /* Now VALUE is a positive NaN. */
3303 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3304 || state
== (LEAD_INT
|E_EXP
));
3307 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3308 any prefix that matches. Otherwise, the entire string must match. */
3309 if (! (ignore_trailing
3310 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3311 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3314 /* If the number uses integer and not float syntax, and is in C-language
3315 range, use its value, preferably as a fixnum. */
3316 if (0 <= leading_digit
&& ! float_syntax
)
3320 /* Fast special case for single-digit integers. This also avoids a
3321 glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
3322 case some versions of strtoumax accept numbers like "0x1" that Emacs
3324 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3325 return make_number (negative
? -leading_digit
: leading_digit
);
3328 n
= strtoumax (string
+ signedp
, NULL
, base
);
3329 if (errno
== ERANGE
)
3331 /* Unfortunately there's no simple and accurate way to convert
3332 non-base-10 numbers that are out of C-language range. */
3334 xsignal (Qoverflow_error
, list1 (build_string (string
)));
3336 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3338 EMACS_INT signed_n
= n
;
3339 return make_number (negative
? -signed_n
: signed_n
);
3345 /* Either the number uses float syntax, or it does not fit into a fixnum.
3346 Convert it from string to floating point, unless the value is already
3347 known because it is an infinity, a NAN, or its absolute value fits in
3350 value
= atof (string
+ signedp
);
3352 return make_float (negative
? -value
: value
);
3357 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3361 register Lisp_Object
*ptr
;
3362 register Lisp_Object tem
, item
, vector
;
3363 register struct Lisp_Cons
*otem
;
3366 tem
= read_list (1, readcharfun
);
3367 len
= Flength (tem
);
3368 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3370 size
= ASIZE (vector
);
3371 ptr
= XVECTOR (vector
)->contents
;
3372 for (i
= 0; i
< size
; i
++)
3375 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3376 bytecode object, the docstring containing the bytecode and
3377 constants values must be treated as unibyte and passed to
3378 Fread, to get the actual bytecode string and constants vector. */
3379 if (bytecodeflag
&& load_force_doc_strings
)
3381 if (i
== COMPILED_BYTECODE
)
3383 if (!STRINGP (item
))
3384 error ("Invalid byte code");
3386 /* Delay handling the bytecode slot until we know whether
3387 it is lazily-loaded (we can tell by whether the
3388 constants slot is nil). */
3389 ptr
[COMPILED_CONSTANTS
] = item
;
3392 else if (i
== COMPILED_CONSTANTS
)
3394 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3398 /* Coerce string to unibyte (like string-as-unibyte,
3399 but without generating extra garbage and
3400 guaranteeing no change in the contents). */
3401 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3402 STRING_SET_UNIBYTE (bytestr
);
3404 item
= Fread (Fcons (bytestr
, readcharfun
));
3406 error ("Invalid byte code");
3408 otem
= XCONS (item
);
3409 bytestr
= XCAR (item
);
3414 /* Now handle the bytecode slot. */
3415 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3417 else if (i
== COMPILED_DOC_STRING
3419 && ! STRING_MULTIBYTE (item
))
3421 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3422 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3424 item
= Fstring_as_multibyte (item
);
3427 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3435 /* FLAG = 1 means check for ] to terminate rather than ) and .
3436 FLAG = -1 means check for starting with defun
3437 and make structure pure. */
3440 read_list (int flag
, register Lisp_Object readcharfun
)
3442 /* -1 means check next element for defun,
3443 0 means don't check,
3444 1 means already checked and found defun. */
3445 int defunflag
= flag
< 0 ? -1 : 0;
3446 Lisp_Object val
, tail
;
3447 register Lisp_Object elt
, tem
;
3448 struct gcpro gcpro1
, gcpro2
;
3449 /* 0 is the normal case.
3450 1 means this list is a doc reference; replace it with the number 0.
3451 2 means this list is a doc reference; replace it with the doc string. */
3452 int doc_reference
= 0;
3454 /* Initialize this to 1 if we are reading a list. */
3455 int first_in_list
= flag
<= 0;
3464 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3469 /* While building, if the list starts with #$, treat it specially. */
3470 if (EQ (elt
, Vload_file_name
)
3472 && !NILP (Vpurify_flag
))
3474 if (NILP (Vdoc_file_name
))
3475 /* We have not yet called Snarf-documentation, so assume
3476 this file is described in the DOC-MM.NN file
3477 and Snarf-documentation will fill in the right value later.
3478 For now, replace the whole list with 0. */
3481 /* We have already called Snarf-documentation, so make a relative
3482 file name for this file, so it can be found properly
3483 in the installed Lisp directory.
3484 We don't use Fexpand_file_name because that would make
3485 the directory absolute now. */
3486 elt
= concat2 (build_string ("../lisp/"),
3487 Ffile_name_nondirectory (elt
));
3489 else if (EQ (elt
, Vload_file_name
)
3491 && load_force_doc_strings
)
3500 invalid_syntax (") or . in a vector", 18);
3508 XSETCDR (tail
, read0 (readcharfun
));
3510 val
= read0 (readcharfun
);
3511 read1 (readcharfun
, &ch
, 0);
3515 if (doc_reference
== 1)
3516 return make_number (0);
3517 if (doc_reference
== 2)
3519 /* Get a doc string from the file we are loading.
3520 If it's in saved_doc_string, get it from there.
3522 Here, we don't know if the string is a
3523 bytecode string or a doc string. As a
3524 bytecode string must be unibyte, we always
3525 return a unibyte string. If it is actually a
3526 doc string, caller must make it
3529 int pos
= XINT (XCDR (val
));
3530 /* Position is negative for user variables. */
3531 if (pos
< 0) pos
= -pos
;
3532 if (pos
>= saved_doc_string_position
3533 && pos
< (saved_doc_string_position
3534 + saved_doc_string_length
))
3536 int start
= pos
- saved_doc_string_position
;
3539 /* Process quoting with ^A,
3540 and find the end of the string,
3541 which is marked with ^_ (037). */
3542 for (from
= start
, to
= start
;
3543 saved_doc_string
[from
] != 037;)
3545 int c
= saved_doc_string
[from
++];
3548 c
= saved_doc_string
[from
++];
3550 saved_doc_string
[to
++] = c
;
3552 saved_doc_string
[to
++] = 0;
3554 saved_doc_string
[to
++] = 037;
3557 saved_doc_string
[to
++] = c
;
3560 return make_unibyte_string (saved_doc_string
+ start
,
3563 /* Look in prev_saved_doc_string the same way. */
3564 else if (pos
>= prev_saved_doc_string_position
3565 && pos
< (prev_saved_doc_string_position
3566 + prev_saved_doc_string_length
))
3568 int start
= pos
- prev_saved_doc_string_position
;
3571 /* Process quoting with ^A,
3572 and find the end of the string,
3573 which is marked with ^_ (037). */
3574 for (from
= start
, to
= start
;
3575 prev_saved_doc_string
[from
] != 037;)
3577 int c
= prev_saved_doc_string
[from
++];
3580 c
= prev_saved_doc_string
[from
++];
3582 prev_saved_doc_string
[to
++] = c
;
3584 prev_saved_doc_string
[to
++] = 0;
3586 prev_saved_doc_string
[to
++] = 037;
3589 prev_saved_doc_string
[to
++] = c
;
3592 return make_unibyte_string (prev_saved_doc_string
3597 return get_doc_string (val
, 1, 0);
3602 invalid_syntax (". in wrong context", 18);
3604 invalid_syntax ("] in a list", 11);
3606 tem
= (read_pure
&& flag
<= 0
3607 ? pure_cons (elt
, Qnil
)
3608 : Fcons (elt
, Qnil
));
3610 XSETCDR (tail
, tem
);
3615 defunflag
= EQ (elt
, Qdefun
);
3616 else if (defunflag
> 0)
3621 static Lisp_Object initial_obarray
;
3623 /* oblookup stores the bucket number here, for the sake of Funintern. */
3625 static size_t oblookup_last_bucket_number
;
3627 static size_t hash_string (const char *ptr
, size_t len
);
3629 /* Get an error if OBARRAY is not an obarray.
3630 If it is one, return it. */
3633 check_obarray (Lisp_Object obarray
)
3635 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3637 /* If Vobarray is now invalid, force it to be valid. */
3638 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3639 wrong_type_argument (Qvectorp
, obarray
);
3644 /* Intern the C string STR: return a symbol with that name,
3645 interned in the current obarray. */
3648 intern (const char *str
)
3651 int len
= strlen (str
);
3652 Lisp_Object obarray
;
3655 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3656 obarray
= check_obarray (obarray
);
3657 tem
= oblookup (obarray
, str
, len
, len
);
3660 return Fintern (make_string (str
, len
), obarray
);
3664 intern_c_string (const char *str
)
3667 int len
= strlen (str
);
3668 Lisp_Object obarray
;
3671 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3672 obarray
= check_obarray (obarray
);
3673 tem
= oblookup (obarray
, str
, len
, len
);
3677 if (NILP (Vpurify_flag
))
3678 /* Creating a non-pure string from a string literal not
3679 implemented yet. We could just use make_string here and live
3680 with the extra copy. */
3683 return Fintern (make_pure_c_string (str
), obarray
);
3686 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3687 doc
: /* Return the canonical symbol whose name is STRING.
3688 If there is none, one is created by this function and returned.
3689 A second optional argument specifies the obarray to use;
3690 it defaults to the value of `obarray'. */)
3691 (Lisp_Object string
, Lisp_Object obarray
)
3693 register Lisp_Object tem
, sym
, *ptr
;
3695 if (NILP (obarray
)) obarray
= Vobarray
;
3696 obarray
= check_obarray (obarray
);
3698 CHECK_STRING (string
);
3700 tem
= oblookup (obarray
, SSDATA (string
),
3703 if (!INTEGERP (tem
))
3706 if (!NILP (Vpurify_flag
))
3707 string
= Fpurecopy (string
);
3708 sym
= Fmake_symbol (string
);
3710 if (EQ (obarray
, initial_obarray
))
3711 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3713 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3715 if ((SREF (string
, 0) == ':')
3716 && EQ (obarray
, initial_obarray
))
3718 XSYMBOL (sym
)->constant
= 1;
3719 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3720 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3723 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3725 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3727 XSYMBOL (sym
)->next
= 0;
3732 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3733 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3734 NAME may be a string or a symbol. If it is a symbol, that exact
3735 symbol is searched for.
3736 A second optional argument specifies the obarray to use;
3737 it defaults to the value of `obarray'. */)
3738 (Lisp_Object name
, Lisp_Object obarray
)
3740 register Lisp_Object tem
, string
;
3742 if (NILP (obarray
)) obarray
= Vobarray
;
3743 obarray
= check_obarray (obarray
);
3745 if (!SYMBOLP (name
))
3747 CHECK_STRING (name
);
3751 string
= SYMBOL_NAME (name
);
3753 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3754 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3760 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3761 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3762 The value is t if a symbol was found and deleted, nil otherwise.
3763 NAME may be a string or a symbol. If it is a symbol, that symbol
3764 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3765 OBARRAY defaults to the value of the variable `obarray'. */)
3766 (Lisp_Object name
, Lisp_Object obarray
)
3768 register Lisp_Object string
, tem
;
3771 if (NILP (obarray
)) obarray
= Vobarray
;
3772 obarray
= check_obarray (obarray
);
3775 string
= SYMBOL_NAME (name
);
3778 CHECK_STRING (name
);
3782 tem
= oblookup (obarray
, SSDATA (string
),
3787 /* If arg was a symbol, don't delete anything but that symbol itself. */
3788 if (SYMBOLP (name
) && !EQ (name
, tem
))
3791 /* There are plenty of other symbols which will screw up the Emacs
3792 session if we unintern them, as well as even more ways to use
3793 `setq' or `fset' or whatnot to make the Emacs session
3794 unusable. Let's not go down this silly road. --Stef */
3795 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3796 error ("Attempt to unintern t or nil"); */
3798 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3800 hash
= oblookup_last_bucket_number
;
3802 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3804 if (XSYMBOL (tem
)->next
)
3805 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3807 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3811 Lisp_Object tail
, following
;
3813 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3814 XSYMBOL (tail
)->next
;
3817 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3818 if (EQ (following
, tem
))
3820 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3829 /* Return the symbol in OBARRAY whose names matches the string
3830 of SIZE characters (SIZE_BYTE bytes) at PTR.
3831 If there is no such symbol in OBARRAY, return nil.
3833 Also store the bucket number in oblookup_last_bucket_number. */
3836 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3840 register Lisp_Object tail
;
3841 Lisp_Object bucket
, tem
;
3843 if (!VECTORP (obarray
)
3844 || (obsize
= ASIZE (obarray
)) == 0)
3846 obarray
= check_obarray (obarray
);
3847 obsize
= ASIZE (obarray
);
3849 /* This is sometimes needed in the middle of GC. */
3850 obsize
&= ~ARRAY_MARK_FLAG
;
3851 hash
= hash_string (ptr
, size_byte
) % obsize
;
3852 bucket
= XVECTOR (obarray
)->contents
[hash
];
3853 oblookup_last_bucket_number
= hash
;
3854 if (EQ (bucket
, make_number (0)))
3856 else if (!SYMBOLP (bucket
))
3857 error ("Bad data in guts of obarray"); /* Like CADR error message */
3859 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3861 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3862 && SCHARS (SYMBOL_NAME (tail
)) == size
3863 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3865 else if (XSYMBOL (tail
)->next
== 0)
3868 XSETINT (tem
, hash
);
3873 hash_string (const char *ptr
, size_t len
)
3875 register const char *p
= ptr
;
3876 register const char *end
= p
+ len
;
3877 register unsigned char c
;
3878 register size_t hash
= 0;
3883 if (c
>= 0140) c
-= 40;
3884 hash
= (hash
<< 3) + (hash
>> (CHAR_BIT
* sizeof hash
- 4)) + c
;
3890 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3893 register Lisp_Object tail
;
3894 CHECK_VECTOR (obarray
);
3895 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3897 tail
= XVECTOR (obarray
)->contents
[i
];
3902 if (XSYMBOL (tail
)->next
== 0)
3904 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3910 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3912 call1 (function
, sym
);
3915 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3916 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3917 OBARRAY defaults to the value of `obarray'. */)
3918 (Lisp_Object function
, Lisp_Object obarray
)
3920 if (NILP (obarray
)) obarray
= Vobarray
;
3921 obarray
= check_obarray (obarray
);
3923 map_obarray (obarray
, mapatoms_1
, function
);
3927 #define OBARRAY_SIZE 1511
3932 Lisp_Object oblength
;
3934 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3936 Vobarray
= Fmake_vector (oblength
, make_number (0));
3937 initial_obarray
= Vobarray
;
3938 staticpro (&initial_obarray
);
3940 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3941 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3942 NILP (Vpurify_flag) check in intern_c_string. */
3943 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3944 Qnil
= intern_c_string ("nil");
3946 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3947 so those two need to be fixed manally. */
3948 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3949 XSYMBOL (Qunbound
)->function
= Qunbound
;
3950 XSYMBOL (Qunbound
)->plist
= Qnil
;
3951 /* XSYMBOL (Qnil)->function = Qunbound; */
3952 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3953 XSYMBOL (Qnil
)->constant
= 1;
3954 XSYMBOL (Qnil
)->plist
= Qnil
;
3956 Qt
= intern_c_string ("t");
3957 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3958 XSYMBOL (Qt
)->constant
= 1;
3960 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3963 Qvariable_documentation
= intern_c_string ("variable-documentation");
3964 staticpro (&Qvariable_documentation
);
3966 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3967 read_buffer
= (char *) xmalloc (read_buffer_size
);
3971 defsubr (struct Lisp_Subr
*sname
)
3974 sym
= intern_c_string (sname
->symbol_name
);
3975 XSETTYPED_PVECTYPE (sname
, size
, PVEC_SUBR
);
3976 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3979 #ifdef NOTDEF /* use fset in subr.el now */
3981 defalias (sname
, string
)
3982 struct Lisp_Subr
*sname
;
3986 sym
= intern (string
);
3987 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3991 /* Define an "integer variable"; a symbol whose value is forwarded to a
3992 C variable of type int. Sample call (munged w "xx" to fool make-docfile):
3993 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3995 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3996 const char *namestring
, EMACS_INT
*address
)
3999 sym
= intern_c_string (namestring
);
4000 i_fwd
->type
= Lisp_Fwd_Int
;
4001 i_fwd
->intvar
= address
;
4002 XSYMBOL (sym
)->declared_special
= 1;
4003 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4004 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4007 /* Similar but define a variable whose value is t if address contains 1,
4008 nil if address contains 0. */
4010 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4011 const char *namestring
, int *address
)
4014 sym
= intern_c_string (namestring
);
4015 b_fwd
->type
= Lisp_Fwd_Bool
;
4016 b_fwd
->boolvar
= address
;
4017 XSYMBOL (sym
)->declared_special
= 1;
4018 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4019 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4020 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4023 /* Similar but define a variable whose value is the Lisp Object stored
4024 at address. Two versions: with and without gc-marking of the C
4025 variable. The nopro version is used when that variable will be
4026 gc-marked for some other reason, since marking the same slot twice
4027 can cause trouble with strings. */
4029 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4030 const char *namestring
, Lisp_Object
*address
)
4033 sym
= intern_c_string (namestring
);
4034 o_fwd
->type
= Lisp_Fwd_Obj
;
4035 o_fwd
->objvar
= address
;
4036 XSYMBOL (sym
)->declared_special
= 1;
4037 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4038 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4042 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4043 const char *namestring
, Lisp_Object
*address
)
4045 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4046 staticpro (address
);
4049 /* Similar but define a variable whose value is the Lisp Object stored
4050 at a particular offset in the current kboard object. */
4053 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4054 const char *namestring
, int offset
)
4057 sym
= intern_c_string (namestring
);
4058 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4059 ko_fwd
->offset
= offset
;
4060 XSYMBOL (sym
)->declared_special
= 1;
4061 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4062 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4065 /* Record the value of load-path used at the start of dumping
4066 so we can see if the site changed it later during dumping. */
4067 static Lisp_Object dump_path
;
4073 int turn_off_warning
= 0;
4075 /* Compute the default load-path. */
4077 normal
= PATH_LOADSEARCH
;
4078 Vload_path
= decode_env_path (0, normal
);
4080 if (NILP (Vpurify_flag
))
4081 normal
= PATH_LOADSEARCH
;
4083 normal
= PATH_DUMPLOADSEARCH
;
4085 /* In a dumped Emacs, we normally have to reset the value of
4086 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4087 uses ../lisp, instead of the path of the installed elisp
4088 libraries. However, if it appears that Vload_path was changed
4089 from the default before dumping, don't override that value. */
4092 if (! NILP (Fequal (dump_path
, Vload_path
)))
4094 Vload_path
= decode_env_path (0, normal
);
4095 if (!NILP (Vinstallation_directory
))
4097 Lisp_Object tem
, tem1
, sitelisp
;
4099 /* Remove site-lisp dirs from path temporarily and store
4100 them in sitelisp, then conc them on at the end so
4101 they're always first in path. */
4105 tem
= Fcar (Vload_path
);
4106 tem1
= Fstring_match (build_string ("site-lisp"),
4110 Vload_path
= Fcdr (Vload_path
);
4111 sitelisp
= Fcons (tem
, sitelisp
);
4117 /* Add to the path the lisp subdir of the
4118 installation dir, if it exists. */
4119 tem
= Fexpand_file_name (build_string ("lisp"),
4120 Vinstallation_directory
);
4121 tem1
= Ffile_exists_p (tem
);
4124 if (NILP (Fmember (tem
, Vload_path
)))
4126 turn_off_warning
= 1;
4127 Vload_path
= Fcons (tem
, Vload_path
);
4131 /* That dir doesn't exist, so add the build-time
4132 Lisp dirs instead. */
4133 Vload_path
= nconc2 (Vload_path
, dump_path
);
4135 /* Add leim under the installation dir, if it exists. */
4136 tem
= Fexpand_file_name (build_string ("leim"),
4137 Vinstallation_directory
);
4138 tem1
= Ffile_exists_p (tem
);
4141 if (NILP (Fmember (tem
, Vload_path
)))
4142 Vload_path
= Fcons (tem
, Vload_path
);
4145 /* Add site-lisp under the installation dir, if it exists. */
4146 tem
= Fexpand_file_name (build_string ("site-lisp"),
4147 Vinstallation_directory
);
4148 tem1
= Ffile_exists_p (tem
);
4151 if (NILP (Fmember (tem
, Vload_path
)))
4152 Vload_path
= Fcons (tem
, Vload_path
);
4155 /* If Emacs was not built in the source directory,
4156 and it is run from where it was built, add to load-path
4157 the lisp, leim and site-lisp dirs under that directory. */
4159 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4163 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4164 Vinstallation_directory
);
4165 tem1
= Ffile_exists_p (tem
);
4167 /* Don't be fooled if they moved the entire source tree
4168 AFTER dumping Emacs. If the build directory is indeed
4169 different from the source dir, src/Makefile.in and
4170 src/Makefile will not be found together. */
4171 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4172 Vinstallation_directory
);
4173 tem2
= Ffile_exists_p (tem
);
4174 if (!NILP (tem1
) && NILP (tem2
))
4176 tem
= Fexpand_file_name (build_string ("lisp"),
4179 if (NILP (Fmember (tem
, Vload_path
)))
4180 Vload_path
= Fcons (tem
, Vload_path
);
4182 tem
= Fexpand_file_name (build_string ("leim"),
4185 if (NILP (Fmember (tem
, Vload_path
)))
4186 Vload_path
= Fcons (tem
, Vload_path
);
4188 tem
= Fexpand_file_name (build_string ("site-lisp"),
4191 if (NILP (Fmember (tem
, Vload_path
)))
4192 Vload_path
= Fcons (tem
, Vload_path
);
4195 if (!NILP (sitelisp
) && !no_site_lisp
)
4196 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4202 /* NORMAL refers to the lisp dir in the source directory. */
4203 /* We used to add ../lisp at the front here, but
4204 that caused trouble because it was copied from dump_path
4205 into Vload_path, above, when Vinstallation_directory was non-nil.
4206 It should be unnecessary. */
4207 Vload_path
= decode_env_path (0, normal
);
4208 dump_path
= Vload_path
;
4212 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4213 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4214 almost never correct, thereby causing a warning to be printed out that
4215 confuses users. Since PATH_LOADSEARCH is always overridden by the
4216 EMACSLOADPATH environment variable below, disable the warning on NT. */
4218 /* Warn if dirs in the *standard* path don't exist. */
4219 if (!turn_off_warning
)
4221 Lisp_Object path_tail
;
4223 for (path_tail
= Vload_path
;
4225 path_tail
= XCDR (path_tail
))
4227 Lisp_Object dirfile
;
4228 dirfile
= Fcar (path_tail
);
4229 if (STRINGP (dirfile
))
4231 dirfile
= Fdirectory_file_name (dirfile
);
4232 if (access (SSDATA (dirfile
), 0) < 0)
4233 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4238 #endif /* !(WINDOWSNT || HAVE_NS) */
4240 /* If the EMACSLOADPATH environment variable is set, use its value.
4241 This doesn't apply if we're dumping. */
4243 if (NILP (Vpurify_flag
)
4244 && egetenv ("EMACSLOADPATH"))
4246 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4250 load_in_progress
= 0;
4251 Vload_file_name
= Qnil
;
4253 load_descriptor_list
= Qnil
;
4255 Vstandard_input
= Qt
;
4256 Vloads_in_progress
= Qnil
;
4259 /* Print a warning, using format string FORMAT, that directory DIRNAME
4260 does not exist. Print it on stderr and put it in *Messages*. */
4263 dir_warning (const char *format
, Lisp_Object dirname
)
4266 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4268 fprintf (stderr
, format
, SDATA (dirname
));
4269 sprintf (buffer
, format
, SDATA (dirname
));
4270 /* Don't log the warning before we've initialized!! */
4272 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4276 syms_of_lread (void)
4279 defsubr (&Sread_from_string
);
4281 defsubr (&Sintern_soft
);
4282 defsubr (&Sunintern
);
4283 defsubr (&Sget_load_suffixes
);
4285 defsubr (&Seval_buffer
);
4286 defsubr (&Seval_region
);
4287 defsubr (&Sread_char
);
4288 defsubr (&Sread_char_exclusive
);
4289 defsubr (&Sread_event
);
4290 defsubr (&Sget_file_char
);
4291 defsubr (&Smapatoms
);
4292 defsubr (&Slocate_file_internal
);
4294 DEFVAR_LISP ("obarray", Vobarray
,
4295 doc
: /* Symbol table for use by `intern' and `read'.
4296 It is a vector whose length ought to be prime for best results.
4297 The vector's contents don't make sense if examined from Lisp programs;
4298 to find all the symbols in an obarray, use `mapatoms'. */);
4300 DEFVAR_LISP ("values", Vvalues
,
4301 doc
: /* List of values of all expressions which were read, evaluated and printed.
4302 Order is reverse chronological. */);
4304 DEFVAR_LISP ("standard-input", Vstandard_input
,
4305 doc
: /* Stream for read to get input from.
4306 See documentation of `read' for possible values. */);
4307 Vstandard_input
= Qt
;
4309 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4310 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4312 If this variable is a buffer, then only forms read from that buffer
4313 will be added to `read-symbol-positions-list'.
4314 If this variable is t, then all read forms will be added.
4315 The effect of all other values other than nil are not currently
4316 defined, although they may be in the future.
4318 The positions are relative to the last call to `read' or
4319 `read-from-string'. It is probably a bad idea to set this variable at
4320 the toplevel; bind it instead. */);
4321 Vread_with_symbol_positions
= Qnil
;
4323 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4324 doc
: /* A list mapping read symbols to their positions.
4325 This variable is modified during calls to `read' or
4326 `read-from-string', but only when `read-with-symbol-positions' is
4329 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4330 CHAR-POSITION is an integer giving the offset of that occurrence of the
4331 symbol from the position where `read' or `read-from-string' started.
4333 Note that a symbol will appear multiple times in this list, if it was
4334 read multiple times. The list is in the same order as the symbols
4336 Vread_symbol_positions_list
= Qnil
;
4338 DEFVAR_LISP ("read-circle", Vread_circle
,
4339 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4342 DEFVAR_LISP ("load-path", Vload_path
,
4343 doc
: /* *List of directories to search for files to load.
4344 Each element is a string (directory name) or nil (try default directory).
4345 Initialized based on EMACSLOADPATH environment variable, if any,
4346 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4348 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4349 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4350 This list should not include the empty string.
4351 `load' and related functions try to append these suffixes, in order,
4352 to the specified file name if a Lisp suffix is allowed or required. */);
4353 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4354 Fcons (make_pure_c_string (".el"), Qnil
));
4355 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4356 doc
: /* List of suffixes that indicate representations of \
4358 This list should normally start with the empty string.
4360 Enabling Auto Compression mode appends the suffixes in
4361 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4362 mode removes them again. `load' and related functions use this list to
4363 determine whether they should look for compressed versions of a file
4364 and, if so, which suffixes they should try to append to the file name
4365 in order to do so. However, if you want to customize which suffixes
4366 the loading functions recognize as compression suffixes, you should
4367 customize `jka-compr-load-suffixes' rather than the present variable. */);
4368 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4370 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4371 doc
: /* Non-nil if inside of `load'. */);
4372 Qload_in_progress
= intern_c_string ("load-in-progress");
4373 staticpro (&Qload_in_progress
);
4375 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4376 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4377 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4379 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4380 a symbol \(a feature name).
4382 When `load' is run and the file-name argument matches an element's
4383 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4384 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4386 An error in FORMS does not undo the load, but does prevent execution of
4387 the rest of the FORMS. */);
4388 Vafter_load_alist
= Qnil
;
4390 DEFVAR_LISP ("load-history", Vload_history
,
4391 doc
: /* Alist mapping loaded file names to symbols and features.
4392 Each alist element should be a list (FILE-NAME ENTRIES...), where
4393 FILE-NAME is the name of a file that has been loaded into Emacs.
4394 The file name is absolute and true (i.e. it doesn't contain symlinks).
4395 As an exception, one of the alist elements may have FILE-NAME nil,
4396 for symbols and features not associated with any file.
4398 The remaining ENTRIES in the alist element describe the functions and
4399 variables defined in that file, the features provided, and the
4400 features required. Each entry has the form `(provide . FEATURE)',
4401 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4402 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4403 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4404 SYMBOL was an autoload before this file redefined it as a function.
4406 During preloading, the file name recorded is relative to the main Lisp
4407 directory. These file names are converted to absolute at startup. */);
4408 Vload_history
= Qnil
;
4410 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4411 doc
: /* Full name of file being loaded by `load'. */);
4412 Vload_file_name
= Qnil
;
4414 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4415 doc
: /* File name, including directory, of user's initialization file.
4416 If the file loaded had extension `.elc', and the corresponding source file
4417 exists, this variable contains the name of source file, suitable for use
4418 by functions like `custom-save-all' which edit the init file.
4419 While Emacs loads and evaluates the init file, value is the real name
4420 of the file, regardless of whether or not it has the `.elc' extension. */);
4421 Vuser_init_file
= Qnil
;
4423 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4424 doc
: /* Used for internal purposes by `load'. */);
4425 Vcurrent_load_list
= Qnil
;
4427 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4428 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4429 The default is nil, which means use the function `read'. */);
4430 Vload_read_function
= Qnil
;
4432 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4433 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4434 This function is for doing code conversion before reading the source file.
4435 If nil, loading is done without any code conversion.
4436 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4437 FULLNAME is the full name of FILE.
4438 See `load' for the meaning of the remaining arguments. */);
4439 Vload_source_file_function
= Qnil
;
4441 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4442 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4443 This is useful when the file being loaded is a temporary copy. */);
4444 load_force_doc_strings
= 0;
4446 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4447 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4448 This is normally bound by `load' and `eval-buffer' to control `read',
4449 and is not meant for users to change. */);
4450 load_convert_to_unibyte
= 0;
4452 DEFVAR_LISP ("source-directory", Vsource_directory
,
4453 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4454 You cannot count on them to still be there! */);
4456 = Fexpand_file_name (build_string ("../"),
4457 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4459 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4460 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4461 Vpreloaded_file_list
= Qnil
;
4463 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4464 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4465 Vbyte_boolean_vars
= Qnil
;
4467 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4468 doc
: /* Non-nil means load dangerous compiled Lisp files.
4469 Some versions of XEmacs use different byte codes than Emacs. These
4470 incompatible byte codes can make Emacs crash when it tries to execute
4472 load_dangerous_libraries
= 0;
4474 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4475 doc
: /* Non-nil means force printing messages when loading Lisp files.
4476 This overrides the value of the NOMESSAGE argument to `load'. */);
4477 force_load_messages
= 0;
4479 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4480 doc
: /* Regular expression matching safe to load compiled Lisp files.
4481 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4482 from the file, and matches them against this regular expression.
4483 When the regular expression matches, the file is considered to be safe
4484 to load. See also `load-dangerous-libraries'. */);
4485 Vbytecomp_version_regexp
4486 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4488 Qlexical_binding
= intern ("lexical-binding");
4489 staticpro (&Qlexical_binding
);
4490 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4491 doc
: /* If non-nil, use lexical binding when evaluating code.
4492 This only applies to code evaluated by `eval-buffer' and `eval-region'.
4493 This variable is automatically set from the file variables of an interpreted
4494 Lisp file read using `load'. */);
4495 Fmake_variable_buffer_local (Qlexical_binding
);
4497 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4498 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4499 Veval_buffer_list
= Qnil
;
4501 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4502 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4503 Vold_style_backquotes
= Qnil
;
4504 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4505 staticpro (&Qold_style_backquotes
);
4507 /* Vsource_directory was initialized in init_lread. */
4509 load_descriptor_list
= Qnil
;
4510 staticpro (&load_descriptor_list
);
4512 Qcurrent_load_list
= intern_c_string ("current-load-list");
4513 staticpro (&Qcurrent_load_list
);
4515 Qstandard_input
= intern_c_string ("standard-input");
4516 staticpro (&Qstandard_input
);
4518 Qread_char
= intern_c_string ("read-char");
4519 staticpro (&Qread_char
);
4521 Qget_file_char
= intern_c_string ("get-file-char");
4522 staticpro (&Qget_file_char
);
4524 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4525 staticpro (&Qget_emacs_mule_file_char
);
4527 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4528 staticpro (&Qload_force_doc_strings
);
4530 Qbackquote
= intern_c_string ("`");
4531 staticpro (&Qbackquote
);
4532 Qcomma
= intern_c_string (",");
4533 staticpro (&Qcomma
);
4534 Qcomma_at
= intern_c_string (",@");
4535 staticpro (&Qcomma_at
);
4536 Qcomma_dot
= intern_c_string (",.");
4537 staticpro (&Qcomma_dot
);
4539 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4540 staticpro (&Qinhibit_file_name_operation
);
4542 Qascii_character
= intern_c_string ("ascii-character");
4543 staticpro (&Qascii_character
);
4545 Qfunction
= intern_c_string ("function");
4546 staticpro (&Qfunction
);
4548 Qload
= intern_c_string ("load");
4551 Qload_file_name
= intern_c_string ("load-file-name");
4552 staticpro (&Qload_file_name
);
4554 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4555 staticpro (&Qeval_buffer_list
);
4557 Qfile_truename
= intern_c_string ("file-truename");
4558 staticpro (&Qfile_truename
) ;
4560 Qdir_ok
= intern_c_string ("dir-ok");
4561 staticpro (&Qdir_ok
);
4563 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4564 staticpro (&Qdo_after_load_evaluation
) ;
4566 staticpro (&dump_path
);
4568 staticpro (&read_objects
);
4569 read_objects
= Qnil
;
4570 staticpro (&seen_list
);
4573 Vloads_in_progress
= Qnil
;
4574 staticpro (&Vloads_in_progress
);
4576 Qhash_table
= intern_c_string ("hash-table");
4577 staticpro (&Qhash_table
);
4578 Qdata
= intern_c_string ("data");
4580 Qtest
= intern_c_string ("test");
4582 Qsize
= intern_c_string ("size");
4584 Qweakness
= intern_c_string ("weakness");
4585 staticpro (&Qweakness
);
4586 Qrehash_size
= intern_c_string ("rehash-size");
4587 staticpro (&Qrehash_size
);
4588 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4589 staticpro (&Qrehash_threshold
);