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>
27 #include <limits.h> /* for CHAR_BIT */
30 #include "intervals.h"
32 #include "character.h"
39 #include "termhooks.h"
41 #include "blockinput.h"
52 #endif /* HAVE_SETLOCALE */
57 #define file_offset off_t
58 #define file_tell ftello
60 #define file_offset long
61 #define file_tell ftell
64 /* hash table read constants */
65 static Lisp_Object Qhash_table
, Qdata
;
66 static Lisp_Object Qtest
, Qsize
;
67 static Lisp_Object Qweakness
;
68 static Lisp_Object Qrehash_size
;
69 static Lisp_Object Qrehash_threshold
;
71 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
72 Lisp_Object Qstandard_input
;
73 Lisp_Object Qvariable_documentation
;
74 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
75 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
76 static Lisp_Object Qinhibit_file_name_operation
;
77 static Lisp_Object Qeval_buffer_list
;
78 static Lisp_Object Qlexical_binding
;
79 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
81 /* Used instead of Qget_file_char while loading *.elc files compiled
82 by Emacs 21 or older. */
83 static Lisp_Object Qget_emacs_mule_file_char
;
85 static Lisp_Object Qload_force_doc_strings
;
87 extern Lisp_Object Qinternal_interpreter_environment
;
89 static Lisp_Object Qload_in_progress
;
91 /* The association list of objects read with the #n=object form.
92 Each member of the list has the form (n . object), and is used to
93 look up the object for the corresponding #n# construct.
94 It must be set to nil before all top-level calls to read0. */
95 static Lisp_Object read_objects
;
97 /* Nonzero means READCHAR should read bytes one by one (not character)
98 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
99 This is set to 1 by read1 temporarily while handling #@NUMBER. */
100 static int load_each_byte
;
102 /* List of descriptors now open for Fload. */
103 static Lisp_Object load_descriptor_list
;
105 /* File for get_file_char to read from. Use by load. */
106 static FILE *instream
;
108 /* When nonzero, read conses in pure space */
109 static int read_pure
;
111 /* For use within read-from-string (this reader is non-reentrant!!) */
112 static EMACS_INT read_from_string_index
;
113 static EMACS_INT read_from_string_index_byte
;
114 static EMACS_INT read_from_string_limit
;
116 /* Number of characters read in the current call to Fread or
117 Fread_from_string. */
118 static EMACS_INT readchar_count
;
120 /* This contains the last string skipped with #@. */
121 static char *saved_doc_string
;
122 /* Length of buffer allocated in saved_doc_string. */
123 static ptrdiff_t saved_doc_string_size
;
124 /* Length of actual data in saved_doc_string. */
125 static ptrdiff_t saved_doc_string_length
;
126 /* This is the file position that string came from. */
127 static file_offset saved_doc_string_position
;
129 /* This contains the previous string skipped with #@.
130 We copy it from saved_doc_string when a new string
131 is put in saved_doc_string. */
132 static char *prev_saved_doc_string
;
133 /* Length of buffer allocated in prev_saved_doc_string. */
134 static ptrdiff_t prev_saved_doc_string_size
;
135 /* Length of actual data in prev_saved_doc_string. */
136 static ptrdiff_t prev_saved_doc_string_length
;
137 /* This is the file position that string came from. */
138 static file_offset prev_saved_doc_string_position
;
140 /* Nonzero means inside a new-style backquote
141 with no surrounding parentheses.
142 Fread initializes this to zero, so we need not specbind it
143 or worry about what happens to it when there is an error. */
144 static int new_backquote_flag
;
145 static Lisp_Object Qold_style_backquotes
;
147 /* A list of file names for files being loaded in Fload. Used to
148 check for recursive loads. */
150 static Lisp_Object Vloads_in_progress
;
152 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
155 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
, int,
156 Lisp_Object
, Lisp_Object
,
157 Lisp_Object
, Lisp_Object
);
158 static Lisp_Object
load_unwind (Lisp_Object
);
159 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
161 static void invalid_syntax (const char *) NO_RETURN
;
162 static void end_of_file_error (void) NO_RETURN
;
165 /* Functions that read one byte from the current source READCHARFUN
166 or unreads one byte. If the integer argument C is -1, it returns
167 one read byte, or -1 when there's no more byte in the source. If C
168 is 0 or positive, it unreads C, and the return value is not
171 static int readbyte_for_lambda (int, Lisp_Object
);
172 static int readbyte_from_file (int, Lisp_Object
);
173 static int readbyte_from_string (int, Lisp_Object
);
175 /* Handle unreading and rereading of characters.
176 Write READCHAR to read a character,
177 UNREAD(c) to unread c to be read again.
179 These macros correctly read/unread multibyte characters. */
181 #define READCHAR readchar (readcharfun, NULL)
182 #define UNREAD(c) unreadchar (readcharfun, c)
184 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
185 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
187 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
188 Qlambda, or a cons, we use this to keep an unread character because
189 a file stream can't handle multibyte-char unreading. The value -1
190 means that there's no unread character. */
191 static int unread_char
;
194 readchar (Lisp_Object readcharfun
, int *multibyte
)
198 int (*readbyte
) (int, Lisp_Object
);
199 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
201 int emacs_mule_encoding
= 0;
208 if (BUFFERP (readcharfun
))
210 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
212 EMACS_INT pt_byte
= BUF_PT_BYTE (inbuffer
);
214 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
217 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
219 /* Fetch the character code from the buffer. */
220 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
221 BUF_INC_POS (inbuffer
, pt_byte
);
228 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
229 if (! ASCII_BYTE_P (c
))
230 c
= BYTE8_TO_CHAR (c
);
233 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
237 if (MARKERP (readcharfun
))
239 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
241 EMACS_INT bytepos
= marker_byte_position (readcharfun
);
243 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
246 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
248 /* Fetch the character code from the buffer. */
249 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
250 BUF_INC_POS (inbuffer
, bytepos
);
257 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
258 if (! ASCII_BYTE_P (c
))
259 c
= BYTE8_TO_CHAR (c
);
263 XMARKER (readcharfun
)->bytepos
= bytepos
;
264 XMARKER (readcharfun
)->charpos
++;
269 if (EQ (readcharfun
, Qlambda
))
271 readbyte
= readbyte_for_lambda
;
275 if (EQ (readcharfun
, Qget_file_char
))
277 readbyte
= readbyte_from_file
;
281 if (STRINGP (readcharfun
))
283 if (read_from_string_index
>= read_from_string_limit
)
285 else if (STRING_MULTIBYTE (readcharfun
))
289 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
290 read_from_string_index
,
291 read_from_string_index_byte
);
295 c
= SREF (readcharfun
, read_from_string_index_byte
);
296 read_from_string_index
++;
297 read_from_string_index_byte
++;
302 if (CONSP (readcharfun
))
304 /* This is the case that read_vector is reading from a unibyte
305 string that contains a byte sequence previously skipped
306 because of #@NUMBER. The car part of readcharfun is that
307 string, and the cdr part is a value of readcharfun given to
309 readbyte
= readbyte_from_string
;
310 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
311 emacs_mule_encoding
= 1;
315 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
317 readbyte
= readbyte_from_file
;
318 emacs_mule_encoding
= 1;
322 tem
= call0 (readcharfun
);
329 if (unread_char
>= 0)
335 c
= (*readbyte
) (-1, readcharfun
);
336 if (c
< 0 || load_each_byte
)
340 if (ASCII_BYTE_P (c
))
342 if (emacs_mule_encoding
)
343 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
346 len
= BYTES_BY_CHAR_HEAD (c
);
349 c
= (*readbyte
) (-1, readcharfun
);
350 if (c
< 0 || ! TRAILING_CODE_P (c
))
353 (*readbyte
) (buf
[i
], readcharfun
);
354 return BYTE8_TO_CHAR (buf
[0]);
358 return STRING_CHAR (buf
);
361 /* Unread the character C in the way appropriate for the stream READCHARFUN.
362 If the stream is a user function, call it with the char as argument. */
365 unreadchar (Lisp_Object readcharfun
, int c
)
369 /* Don't back up the pointer if we're unreading the end-of-input mark,
370 since readchar didn't advance it when we read it. */
372 else if (BUFFERP (readcharfun
))
374 struct buffer
*b
= XBUFFER (readcharfun
);
375 EMACS_INT charpos
= BUF_PT (b
);
376 EMACS_INT bytepos
= BUF_PT_BYTE (b
);
378 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
379 BUF_DEC_POS (b
, bytepos
);
383 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
385 else if (MARKERP (readcharfun
))
387 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
388 EMACS_INT bytepos
= XMARKER (readcharfun
)->bytepos
;
390 XMARKER (readcharfun
)->charpos
--;
391 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
392 BUF_DEC_POS (b
, bytepos
);
396 XMARKER (readcharfun
)->bytepos
= bytepos
;
398 else if (STRINGP (readcharfun
))
400 read_from_string_index
--;
401 read_from_string_index_byte
402 = string_char_to_byte (readcharfun
, read_from_string_index
);
404 else if (CONSP (readcharfun
))
408 else if (EQ (readcharfun
, Qlambda
))
412 else if (EQ (readcharfun
, Qget_file_char
)
413 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
418 ungetc (c
, instream
);
425 call1 (readcharfun
, make_number (c
));
429 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
431 return read_bytecode_char (c
>= 0);
436 readbyte_from_file (int c
, Lisp_Object readcharfun
)
441 ungetc (c
, instream
);
450 /* Interrupted reads have been observed while reading over the network */
451 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
463 return (c
== EOF
? -1 : c
);
467 readbyte_from_string (int c
, Lisp_Object readcharfun
)
469 Lisp_Object string
= XCAR (readcharfun
);
473 read_from_string_index
--;
474 read_from_string_index_byte
475 = string_char_to_byte (string
, read_from_string_index
);
478 if (read_from_string_index
>= read_from_string_limit
)
481 FETCH_STRING_CHAR_ADVANCE (c
, string
,
482 read_from_string_index
,
483 read_from_string_index_byte
);
488 /* Read one non-ASCII character from INSTREAM. The character is
489 encoded in `emacs-mule' and the first byte is already read in
493 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
495 /* Emacs-mule coding uses at most 4-byte for one character. */
496 unsigned char buf
[4];
497 int len
= emacs_mule_bytes
[c
];
498 struct charset
*charset
;
503 /* C is not a valid leading-code of `emacs-mule'. */
504 return BYTE8_TO_CHAR (c
);
510 c
= (*readbyte
) (-1, readcharfun
);
514 (*readbyte
) (buf
[i
], readcharfun
);
515 return BYTE8_TO_CHAR (buf
[0]);
522 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
523 code
= buf
[1] & 0x7F;
527 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
528 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
530 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
531 code
= buf
[2] & 0x7F;
535 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
536 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
541 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
542 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
544 c
= DECODE_CHAR (charset
, code
);
546 Fsignal (Qinvalid_read_syntax
,
547 Fcons (build_string ("invalid multibyte form"), Qnil
));
552 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
554 static Lisp_Object
read0 (Lisp_Object
);
555 static Lisp_Object
read1 (Lisp_Object
, int *, int);
557 static Lisp_Object
read_list (int, Lisp_Object
);
558 static Lisp_Object
read_vector (Lisp_Object
, int);
560 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
562 static void substitute_object_in_subtree (Lisp_Object
,
564 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
567 /* Get a character from the tty. */
569 /* Read input events until we get one that's acceptable for our purposes.
571 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
572 until we get a character we like, and then stuffed into
575 If ASCII_REQUIRED is non-zero, we check function key events to see
576 if the unmodified version of the symbol has a Qascii_character
577 property, and use that character, if present.
579 If ERROR_NONASCII is non-zero, we signal an error if the input we
580 get isn't an ASCII character with modifiers. If it's zero but
581 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
584 If INPUT_METHOD is nonzero, we invoke the current input method
585 if the character warrants that.
587 If SECONDS is a number, we wait that many seconds for input, and
588 return Qnil if no input arrives within that time. */
591 read_filtered_event (int no_switch_frame
, int ascii_required
,
592 int error_nonascii
, int input_method
, Lisp_Object seconds
)
594 Lisp_Object val
, delayed_switch_frame
;
597 #ifdef HAVE_WINDOW_SYSTEM
598 if (display_hourglass_p
)
602 delayed_switch_frame
= Qnil
;
604 /* Compute timeout. */
605 if (NUMBERP (seconds
))
607 EMACS_TIME wait_time
;
609 double duration
= extract_float (seconds
);
611 sec
= (int) duration
;
612 usec
= (duration
- sec
) * 1000000;
613 EMACS_GET_TIME (end_time
);
614 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
615 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
618 /* Read until we get an acceptable event. */
621 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
622 NUMBERP (seconds
) ? &end_time
: NULL
);
623 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
628 /* switch-frame events are put off until after the next ASCII
629 character. This is better than signaling an error just because
630 the last characters were typed to a separate minibuffer frame,
631 for example. Eventually, some code which can deal with
632 switch-frame events will read it and process it. */
634 && EVENT_HAS_PARAMETERS (val
)
635 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
637 delayed_switch_frame
= val
;
641 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
643 /* Convert certain symbols to their ASCII equivalents. */
646 Lisp_Object tem
, tem1
;
647 tem
= Fget (val
, Qevent_symbol_element_mask
);
650 tem1
= Fget (Fcar (tem
), Qascii_character
);
651 /* Merge this symbol's modifier bits
652 with the ASCII equivalent of its basic code. */
654 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
658 /* If we don't have a character now, deal with it appropriately. */
663 Vunread_command_events
= Fcons (val
, Qnil
);
664 error ("Non-character input-event");
671 if (! NILP (delayed_switch_frame
))
672 unread_switch_frame
= delayed_switch_frame
;
676 #ifdef HAVE_WINDOW_SYSTEM
677 if (display_hourglass_p
)
686 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
687 doc
: /* Read a character from the command input (keyboard or macro).
688 It is returned as a number.
689 If the character has modifiers, they are resolved and reflected to the
690 character code if possible (e.g. C-SPC -> 0).
692 If the user generates an event which is not a character (i.e. a mouse
693 click or function key event), `read-char' signals an error. As an
694 exception, switch-frame events are put off until non-character events
696 If you want to read non-character events, or ignore them, call
697 `read-event' or `read-char-exclusive' instead.
699 If the optional argument PROMPT is non-nil, display that as a prompt.
700 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
701 input method is turned on in the current buffer, that input method
702 is used for reading a character.
703 If the optional argument SECONDS is non-nil, it should be a number
704 specifying the maximum number of seconds to wait for input. If no
705 input arrives in that time, return nil. SECONDS may be a
706 floating-point value. */)
707 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
712 message_with_string ("%s", prompt
, 0);
713 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
715 return (NILP (val
) ? Qnil
716 : make_number (char_resolve_modifier_mask (XINT (val
))));
719 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
720 doc
: /* Read an event object from the input stream.
721 If the optional argument PROMPT is non-nil, display that as a prompt.
722 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
723 input method is turned on in the current buffer, that input method
724 is used for reading a character.
725 If the optional argument SECONDS is non-nil, it should be a number
726 specifying the maximum number of seconds to wait for input. If no
727 input arrives in that time, return nil. SECONDS may be a
728 floating-point value. */)
729 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
732 message_with_string ("%s", prompt
, 0);
733 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
736 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
737 doc
: /* Read a character from the command input (keyboard or macro).
738 It is returned as a number. Non-character events are ignored.
739 If the character has modifiers, they are resolved and reflected to the
740 character code if possible (e.g. C-SPC -> 0).
742 If the optional argument PROMPT is non-nil, display that as a prompt.
743 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
744 input method is turned on in the current buffer, that input method
745 is used for reading a character.
746 If the optional argument SECONDS is non-nil, it should be a number
747 specifying the maximum number of seconds to wait for input. If no
748 input arrives in that time, return nil. SECONDS may be a
749 floating-point value. */)
750 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
755 message_with_string ("%s", prompt
, 0);
757 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
759 return (NILP (val
) ? Qnil
760 : make_number (char_resolve_modifier_mask (XINT (val
))));
763 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
764 doc
: /* Don't use this yourself. */)
767 register Lisp_Object val
;
769 XSETINT (val
, getc (instream
));
777 /* Return true if the lisp code read using READCHARFUN defines a non-nil
778 `lexical-binding' file variable. After returning, the stream is
779 positioned following the first line, if it is a comment, otherwise
783 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
787 /* The first line isn't a comment, just give up. */
793 /* Look for an appropriate file-variable in the first line. */
797 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
798 } beg_end_state
= NOMINAL
;
799 int in_file_vars
= 0;
801 #define UPDATE_BEG_END_STATE(ch) \
802 if (beg_end_state == NOMINAL) \
803 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
804 else if (beg_end_state == AFTER_FIRST_DASH) \
805 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
806 else if (beg_end_state == AFTER_ASTERIX) \
809 in_file_vars = !in_file_vars; \
810 beg_end_state = NOMINAL; \
813 /* Skip until we get to the file vars, if any. */
817 UPDATE_BEG_END_STATE (ch
);
819 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
823 char var
[100], val
[100];
828 /* Read a variable name. */
829 while (ch
== ' ' || ch
== '\t')
833 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
835 if (i
< sizeof var
- 1)
837 UPDATE_BEG_END_STATE (ch
);
841 /* Stop scanning if no colon was found before end marker. */
845 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
851 /* Read a variable value. */
854 while (ch
== ' ' || ch
== '\t')
858 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
860 if (i
< sizeof val
- 1)
862 UPDATE_BEG_END_STATE (ch
);
866 /* The value was terminated by an end-marker, which
869 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
873 if (strcmp (var
, "lexical-binding") == 0)
876 rv
= (strcmp (val
, "nil") != 0);
882 while (ch
!= '\n' && ch
!= EOF
)
889 /* Value is a version number of byte compiled code if the file
890 associated with file descriptor FD is a compiled Lisp file that's
891 safe to load. Only files compiled with Emacs are safe to load.
892 Files compiled with XEmacs can lead to a crash in Fbyte_code
893 because of an incompatible change in the byte compiler. */
896 safe_to_load_p (int fd
)
903 /* Read the first few bytes from the file, and look for a line
904 specifying the byte compiler version used. */
905 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
910 /* Skip to the next newline, skipping over the initial `ELC'
911 with NUL bytes following it, but note the version. */
912 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
917 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
924 lseek (fd
, 0, SEEK_SET
);
929 /* Callback for record_unwind_protect. Restore the old load list OLD,
930 after loading a file successfully. */
933 record_load_unwind (Lisp_Object old
)
935 return Vloads_in_progress
= old
;
938 /* This handler function is used via internal_condition_case_1. */
941 load_error_handler (Lisp_Object data
)
947 load_warn_old_style_backquotes (Lisp_Object file
)
949 if (!NILP (Vold_style_backquotes
))
952 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
959 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
960 doc
: /* Return the suffixes that `load' should try if a suffix is \
962 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
965 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
966 while (CONSP (suffixes
))
968 Lisp_Object exts
= Vload_file_rep_suffixes
;
969 suffix
= XCAR (suffixes
);
970 suffixes
= XCDR (suffixes
);
975 lst
= Fcons (concat2 (suffix
, ext
), lst
);
978 return Fnreverse (lst
);
981 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
982 doc
: /* Execute a file of Lisp code named FILE.
983 First try FILE with `.elc' appended, then try with `.el',
984 then try FILE unmodified (the exact suffixes in the exact order are
985 determined by `load-suffixes'). Environment variable references in
986 FILE are replaced with their values by calling `substitute-in-file-name'.
987 This function searches the directories in `load-path'.
989 If optional second arg NOERROR is non-nil,
990 report no error if FILE doesn't exist.
991 Print messages at start and end of loading unless
992 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
994 If optional fourth arg NOSUFFIX is non-nil, don't try adding
995 suffixes `.elc' or `.el' to the specified name FILE.
996 If optional fifth arg MUST-SUFFIX is non-nil, insist on
997 the suffix `.elc' or `.el'; don't accept just FILE unless
998 it ends in one of those suffixes or includes a directory name.
1000 If this function fails to find a file, it may look for different
1001 representations of that file before trying another file.
1002 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
1003 to the file name. Emacs uses this feature mainly to find compressed
1004 versions of files when Auto Compression mode is enabled.
1006 The exact suffixes that this function tries out, in the exact order,
1007 are given by the value of the variable `load-file-rep-suffixes' if
1008 NOSUFFIX is non-nil and by the return value of the function
1009 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1010 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1011 and then the former.
1013 Loading a file records its definitions, and its `provide' and
1014 `require' calls, in an element of `load-history' whose
1015 car is the file name loaded. See `load-history'.
1017 While the file is in the process of being loaded, the variable
1018 `load-in-progress' is non-nil and the variable `load-file-name'
1019 is bound to the file's name.
1021 Return t if the file exists and loads successfully. */)
1022 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1024 register FILE *stream
;
1025 register int fd
= -1;
1026 int count
= SPECPDL_INDEX ();
1027 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1028 Lisp_Object found
, efound
, hist_file_name
;
1029 /* 1 means we printed the ".el is newer" message. */
1031 /* 1 means we are loading a compiled file. */
1033 Lisp_Object handler
;
1035 const char *fmode
= "r";
1043 CHECK_STRING (file
);
1045 /* If file name is magic, call the handler. */
1046 /* This shouldn't be necessary any more now that `openp' handles it right.
1047 handler = Ffind_file_name_handler (file, Qload);
1048 if (!NILP (handler))
1049 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1051 /* Do this after the handler to avoid
1052 the need to gcpro noerror, nomessage and nosuffix.
1053 (Below here, we care only whether they are nil or not.)
1054 The presence of this call is the result of a historical accident:
1055 it used to be in every file-operation and when it got removed
1056 everywhere, it accidentally stayed here. Since then, enough people
1057 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1058 that it seemed risky to remove. */
1059 if (! NILP (noerror
))
1061 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1062 Qt
, load_error_handler
);
1067 file
= Fsubstitute_in_file_name (file
);
1070 /* Avoid weird lossage with null string as arg,
1071 since it would try to load a directory as a Lisp file */
1072 if (SBYTES (file
) > 0)
1074 ptrdiff_t size
= SBYTES (file
);
1077 GCPRO2 (file
, found
);
1079 if (! NILP (must_suffix
))
1081 /* Don't insist on adding a suffix if FILE already ends with one. */
1083 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1086 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1088 /* Don't insist on adding a suffix
1089 if the argument includes a directory name. */
1090 else if (! NILP (Ffile_name_directory (file
)))
1094 fd
= openp (Vload_path
, file
,
1095 (!NILP (nosuffix
) ? Qnil
1096 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1097 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1098 tmp
[1] = Vload_file_rep_suffixes
,
1107 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1111 /* Tell startup.el whether or not we found the user's init file. */
1112 if (EQ (Qt
, Vuser_init_file
))
1113 Vuser_init_file
= found
;
1115 /* If FD is -2, that means openp found a magic file. */
1118 if (NILP (Fequal (found
, file
)))
1119 /* If FOUND is a different file name from FILE,
1120 find its handler even if we have already inhibited
1121 the `load' operation on FILE. */
1122 handler
= Ffind_file_name_handler (found
, Qt
);
1124 handler
= Ffind_file_name_handler (found
, Qload
);
1125 if (! NILP (handler
))
1126 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1129 /* Check if we're stuck in a recursive load cycle.
1131 2000-09-21: It's not possible to just check for the file loaded
1132 being a member of Vloads_in_progress. This fails because of the
1133 way the byte compiler currently works; `provide's are not
1134 evaluated, see font-lock.el/jit-lock.el as an example. This
1135 leads to a certain amount of ``normal'' recursion.
1137 Also, just loading a file recursively is not always an error in
1138 the general case; the second load may do something different. */
1142 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1143 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1147 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1149 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1150 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1153 /* All loads are by default dynamic, unless the file itself specifies
1154 otherwise using a file-variable in the first line. This is bound here
1155 so that it takes effect whether or not we use
1156 Vload_source_file_function. */
1157 specbind (Qlexical_binding
, Qnil
);
1159 /* Get the name for load-history. */
1160 hist_file_name
= (! NILP (Vpurify_flag
)
1161 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1162 tmp
[1] = Ffile_name_nondirectory (found
),
1168 /* Check for the presence of old-style quotes and warn about them. */
1169 specbind (Qold_style_backquotes
, Qnil
);
1170 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1172 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1173 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1174 /* Load .elc files directly, but not when they are
1175 remote and have no handler! */
1182 GCPRO3 (file
, found
, hist_file_name
);
1185 && ! (version
= safe_to_load_p (fd
)))
1188 if (!load_dangerous_libraries
)
1192 error ("File `%s' was not compiled in Emacs",
1195 else if (!NILP (nomessage
) && !force_load_messages
)
1196 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1201 efound
= ENCODE_FILE (found
);
1206 result
= stat (SSDATA (efound
), &s1
);
1209 SSET (efound
, SBYTES (efound
) - 1, 0);
1210 result
= stat (SSDATA (efound
), &s2
);
1211 SSET (efound
, SBYTES (efound
) - 1, 'c');
1214 if (result
== 0 && s1
.st_mtime
< s2
.st_mtime
)
1216 /* Make the progress messages mention that source is newer. */
1219 /* If we won't print another message, mention this anyway. */
1220 if (!NILP (nomessage
) && !force_load_messages
)
1222 Lisp_Object msg_file
;
1223 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1224 message_with_string ("Source file `%s' newer than byte-compiled file",
1233 /* We are loading a source file (*.el). */
1234 if (!NILP (Vload_source_file_function
))
1240 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1241 NILP (noerror
) ? Qnil
: Qt
,
1242 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1243 return unbind_to (count
, val
);
1247 GCPRO3 (file
, found
, hist_file_name
);
1251 efound
= ENCODE_FILE (found
);
1252 stream
= fopen (SSDATA (efound
), fmode
);
1253 #else /* not WINDOWSNT */
1254 stream
= fdopen (fd
, fmode
);
1255 #endif /* not WINDOWSNT */
1259 error ("Failure to create stdio stream for %s", SDATA (file
));
1262 if (! NILP (Vpurify_flag
))
1263 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1265 if (NILP (nomessage
) || force_load_messages
)
1268 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1271 message_with_string ("Loading %s (source)...", file
, 1);
1273 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1275 else /* The typical case; compiled file newer than source file. */
1276 message_with_string ("Loading %s...", file
, 1);
1279 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1280 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1281 specbind (Qload_file_name
, found
);
1282 specbind (Qinhibit_file_name_operation
, Qnil
);
1283 load_descriptor_list
1284 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1285 specbind (Qload_in_progress
, Qt
);
1288 if (lisp_file_lexically_bound_p (Qget_file_char
))
1289 Fset (Qlexical_binding
, Qt
);
1291 if (! version
|| version
>= 22)
1292 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1293 0, Qnil
, Qnil
, Qnil
, Qnil
);
1296 /* We can't handle a file which was compiled with
1297 byte-compile-dynamic by older version of Emacs. */
1298 specbind (Qload_force_doc_strings
, Qt
);
1299 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1300 0, Qnil
, Qnil
, Qnil
, Qnil
);
1302 unbind_to (count
, Qnil
);
1304 /* Run any eval-after-load forms for this file */
1305 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1306 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1310 xfree (saved_doc_string
);
1311 saved_doc_string
= 0;
1312 saved_doc_string_size
= 0;
1314 xfree (prev_saved_doc_string
);
1315 prev_saved_doc_string
= 0;
1316 prev_saved_doc_string_size
= 0;
1318 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1321 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1324 message_with_string ("Loading %s (source)...done", file
, 1);
1326 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1328 else /* The typical case; compiled file newer than source file. */
1329 message_with_string ("Loading %s...done", file
, 1);
1336 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1338 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1349 load_descriptor_unwind (Lisp_Object oldlist
)
1351 load_descriptor_list
= oldlist
;
1355 /* Close all descriptors in use for Floads.
1356 This is used when starting a subprocess. */
1359 close_load_descs (void)
1363 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1364 emacs_close (XFASTINT (XCAR (tail
)));
1369 complete_filename_p (Lisp_Object pathname
)
1371 register const unsigned char *s
= SDATA (pathname
);
1372 return (IS_DIRECTORY_SEP (s
[0])
1373 || (SCHARS (pathname
) > 2
1374 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1377 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1378 doc
: /* Search for FILENAME through PATH.
1379 Returns the file's name in absolute form, or nil if not found.
1380 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1381 file name when searching.
1382 If non-nil, PREDICATE is used instead of `file-readable-p'.
1383 PREDICATE can also be an integer to pass to the access(2) function,
1384 in which case file-name-handlers are ignored.
1385 This function will normally skip directories, so if you want it to find
1386 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1387 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1390 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1391 if (NILP (predicate
) && fd
> 0)
1396 static Lisp_Object Qdir_ok
;
1398 /* Search for a file whose name is STR, looking in directories
1399 in the Lisp list PATH, and trying suffixes from SUFFIX.
1400 On success, returns a file descriptor. On failure, returns -1.
1402 SUFFIXES is a list of strings containing possible suffixes.
1403 The empty suffix is automatically added if the list is empty.
1405 PREDICATE non-nil means don't open the files,
1406 just look for one that satisfies the predicate. In this case,
1407 returns 1 on success. The predicate can be a lisp function or
1408 an integer to pass to `access' (in which case file-name-handlers
1411 If STOREPTR is nonzero, it points to a slot where the name of
1412 the file actually found should be stored as a Lisp string.
1413 nil is stored there on failure.
1415 If the file we find is remote, return -2
1416 but store the found remote file name in *STOREPTR. */
1419 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1422 EMACS_INT fn_size
= 100;
1424 register char *fn
= buf
;
1426 EMACS_INT want_length
;
1427 Lisp_Object filename
;
1429 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1430 Lisp_Object string
, tail
, encoded_fn
;
1431 EMACS_INT max_suffix_len
= 0;
1435 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1437 CHECK_STRING_CAR (tail
);
1438 max_suffix_len
= max (max_suffix_len
,
1439 SBYTES (XCAR (tail
)));
1442 string
= filename
= encoded_fn
= Qnil
;
1443 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1448 if (complete_filename_p (str
))
1451 for (; CONSP (path
); path
= XCDR (path
))
1453 filename
= Fexpand_file_name (str
, XCAR (path
));
1454 if (!complete_filename_p (filename
))
1455 /* If there are non-absolute elts in PATH (eg ".") */
1456 /* Of course, this could conceivably lose if luser sets
1457 default-directory to be something non-absolute... */
1459 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1460 if (!complete_filename_p (filename
))
1461 /* Give up on this path element! */
1465 /* Calculate maximum length of any filename made from
1466 this path element/specified file name and any possible suffix. */
1467 want_length
= max_suffix_len
+ SBYTES (filename
);
1468 if (fn_size
<= want_length
)
1469 fn
= (char *) alloca (fn_size
= 100 + want_length
);
1471 /* Loop over suffixes. */
1472 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1473 CONSP (tail
); tail
= XCDR (tail
))
1475 ptrdiff_t lsuffix
= SBYTES (XCAR (tail
));
1476 Lisp_Object handler
;
1479 /* Concatenate path element/specified name with the suffix.
1480 If the directory starts with /:, remove that. */
1481 if (SCHARS (filename
) > 2
1482 && SREF (filename
, 0) == '/'
1483 && SREF (filename
, 1) == ':')
1485 strncpy (fn
, SSDATA (filename
) + 2,
1486 SBYTES (filename
) - 2);
1487 fn
[SBYTES (filename
) - 2] = 0;
1491 strncpy (fn
, SSDATA (filename
),
1493 fn
[SBYTES (filename
)] = 0;
1496 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1497 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1499 /* Check that the file exists and is not a directory. */
1500 /* We used to only check for handlers on non-absolute file names:
1504 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1505 It's not clear why that was the case and it breaks things like
1506 (load "/bar.el") where the file is actually "/bar.el.gz". */
1507 string
= build_string (fn
);
1508 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1509 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1511 if (NILP (predicate
))
1512 exists
= !NILP (Ffile_readable_p (string
));
1515 Lisp_Object tmp
= call1 (predicate
, string
);
1516 exists
= !NILP (tmp
)
1517 && (EQ (tmp
, Qdir_ok
)
1518 || NILP (Ffile_directory_p (string
)));
1523 /* We succeeded; return this descriptor and filename. */
1534 encoded_fn
= ENCODE_FILE (string
);
1535 pfn
= SSDATA (encoded_fn
);
1536 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1539 /* Check that we can access or open it. */
1540 if (NATNUMP (predicate
))
1541 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1543 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1547 /* We succeeded; return this descriptor and filename. */
1565 /* Merge the list we've accumulated of globals from the current input source
1566 into the load_history variable. The details depend on whether
1567 the source has an associated file name or not.
1569 FILENAME is the file name that we are loading from.
1570 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1573 build_load_history (Lisp_Object filename
, int entire
)
1575 register Lisp_Object tail
, prev
, newelt
;
1576 register Lisp_Object tem
, tem2
;
1577 register int foundit
= 0;
1579 tail
= Vload_history
;
1582 while (CONSP (tail
))
1586 /* Find the feature's previous assoc list... */
1587 if (!NILP (Fequal (filename
, Fcar (tem
))))
1591 /* If we're loading the entire file, remove old data. */
1595 Vload_history
= XCDR (tail
);
1597 Fsetcdr (prev
, XCDR (tail
));
1600 /* Otherwise, cons on new symbols that are not already members. */
1603 tem2
= Vcurrent_load_list
;
1605 while (CONSP (tem2
))
1607 newelt
= XCAR (tem2
);
1609 if (NILP (Fmember (newelt
, tem
)))
1610 Fsetcar (tail
, Fcons (XCAR (tem
),
1611 Fcons (newelt
, XCDR (tem
))));
1624 /* If we're loading an entire file, cons the new assoc onto the
1625 front of load-history, the most-recently-loaded position. Also
1626 do this if we didn't find an existing member for the file. */
1627 if (entire
|| !foundit
)
1628 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1633 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1640 readevalloop_1 (Lisp_Object old
)
1642 load_convert_to_unibyte
= ! NILP (old
);
1646 /* Signal an `end-of-file' error, if possible with file name
1650 end_of_file_error (void)
1652 if (STRINGP (Vload_file_name
))
1653 xsignal1 (Qend_of_file
, Vload_file_name
);
1655 xsignal0 (Qend_of_file
);
1658 /* UNIBYTE specifies how to set load_convert_to_unibyte
1659 for this invocation.
1660 READFUN, if non-nil, is used instead of `read'.
1662 START, END specify region to read in current buffer (from eval-region).
1663 If the input is not from a buffer, they must be nil. */
1666 readevalloop (Lisp_Object readcharfun
,
1668 Lisp_Object sourcename
,
1670 Lisp_Object unibyte
, Lisp_Object readfun
,
1671 Lisp_Object start
, Lisp_Object end
)
1674 register Lisp_Object val
;
1675 int count
= SPECPDL_INDEX ();
1676 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1677 struct buffer
*b
= 0;
1678 int continue_reading_p
;
1679 Lisp_Object lex_bound
;
1680 /* Nonzero if reading an entire buffer. */
1681 int whole_buffer
= 0;
1682 /* 1 on the first time around. */
1685 if (MARKERP (readcharfun
))
1688 start
= readcharfun
;
1691 if (BUFFERP (readcharfun
))
1692 b
= XBUFFER (readcharfun
);
1693 else if (MARKERP (readcharfun
))
1694 b
= XMARKER (readcharfun
)->buffer
;
1696 /* We assume START is nil when input is not from a buffer. */
1697 if (! NILP (start
) && !b
)
1700 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1701 specbind (Qcurrent_load_list
, Qnil
);
1702 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1703 load_convert_to_unibyte
= !NILP (unibyte
);
1705 /* If lexical binding is active (either because it was specified in
1706 the file's header, or via a buffer-local variable), create an empty
1707 lexical environment, otherwise, turn off lexical binding. */
1708 lex_bound
= find_symbol_value (Qlexical_binding
);
1709 specbind (Qinternal_interpreter_environment
,
1710 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1711 ? Qnil
: Fcons (Qt
, Qnil
));
1713 GCPRO4 (sourcename
, readfun
, start
, end
);
1715 /* Try to ensure sourcename is a truename, except whilst preloading. */
1716 if (NILP (Vpurify_flag
)
1717 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1718 && !NILP (Ffboundp (Qfile_truename
)))
1719 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1721 LOADHIST_ATTACH (sourcename
);
1723 continue_reading_p
= 1;
1724 while (continue_reading_p
)
1726 int count1
= SPECPDL_INDEX ();
1728 if (b
!= 0 && NILP (BVAR (b
, name
)))
1729 error ("Reading from killed buffer");
1733 /* Switch to the buffer we are reading from. */
1734 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1735 set_buffer_internal (b
);
1737 /* Save point in it. */
1738 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1739 /* Save ZV in it. */
1740 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1741 /* Those get unbound after we read one expression. */
1743 /* Set point and ZV around stuff to be read. */
1746 Fnarrow_to_region (make_number (BEGV
), end
);
1748 /* Just for cleanliness, convert END to a marker
1749 if it is an integer. */
1751 end
= Fpoint_max_marker ();
1754 /* On the first cycle, we can easily test here
1755 whether we are reading the whole buffer. */
1756 if (b
&& first_sexp
)
1757 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1764 while ((c
= READCHAR
) != '\n' && c
!= -1);
1769 unbind_to (count1
, Qnil
);
1773 /* Ignore whitespace here, so we can detect eof. */
1774 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1775 || c
== 0x8a0) /* NBSP */
1778 if (!NILP (Vpurify_flag
) && c
== '(')
1780 record_unwind_protect (unreadpure
, Qnil
);
1781 val
= read_list (-1, readcharfun
);
1786 read_objects
= Qnil
;
1787 if (!NILP (readfun
))
1789 val
= call1 (readfun
, readcharfun
);
1791 /* If READCHARFUN has set point to ZV, we should
1792 stop reading, even if the form read sets point
1793 to a different value when evaluated. */
1794 if (BUFFERP (readcharfun
))
1796 struct buffer
*buf
= XBUFFER (readcharfun
);
1797 if (BUF_PT (buf
) == BUF_ZV (buf
))
1798 continue_reading_p
= 0;
1801 else if (! NILP (Vload_read_function
))
1802 val
= call1 (Vload_read_function
, readcharfun
);
1804 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1807 if (!NILP (start
) && continue_reading_p
)
1808 start
= Fpoint_marker ();
1810 /* Restore saved point and BEGV. */
1811 unbind_to (count1
, Qnil
);
1813 /* Now eval what we just read. */
1814 val
= eval_sub (val
);
1818 Vvalues
= Fcons (val
, Vvalues
);
1819 if (EQ (Vstandard_output
, Qt
))
1828 build_load_history (sourcename
,
1829 stream
|| whole_buffer
);
1833 unbind_to (count
, Qnil
);
1836 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1837 doc
: /* Execute the current buffer as Lisp code.
1838 When called from a Lisp program (i.e., not interactively), this
1839 function accepts up to five optional arguments:
1840 BUFFER is the buffer to evaluate (nil means use current buffer).
1841 PRINTFLAG controls printing of output:
1842 A value of nil means discard it; anything else is stream for print.
1843 FILENAME specifies the file name to use for `load-history'.
1844 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1846 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1847 functions should work normally even if PRINTFLAG is nil.
1849 This function preserves the position of point. */)
1850 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1852 int count
= SPECPDL_INDEX ();
1853 Lisp_Object tem
, buf
;
1856 buf
= Fcurrent_buffer ();
1858 buf
= Fget_buffer (buffer
);
1860 error ("No such buffer");
1862 if (NILP (printflag
) && NILP (do_allow_print
))
1867 if (NILP (filename
))
1868 filename
= BVAR (XBUFFER (buf
), filename
);
1870 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1871 specbind (Qstandard_output
, tem
);
1872 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1873 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1874 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1875 readevalloop (buf
, 0, filename
,
1876 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1877 unbind_to (count
, Qnil
);
1882 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1883 doc
: /* Execute the region as Lisp code.
1884 When called from programs, expects two arguments,
1885 giving starting and ending indices in the current buffer
1886 of the text to be executed.
1887 Programs can pass third argument PRINTFLAG which controls output:
1888 A value of nil means discard it; anything else is stream for printing it.
1889 Also the fourth argument READ-FUNCTION, if non-nil, is used
1890 instead of `read' to read each expression. It gets one argument
1891 which is the input stream for reading characters.
1893 This function does not move point. */)
1894 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1896 /* FIXME: Do the eval-sexp-add-defvars danse! */
1897 int count
= SPECPDL_INDEX ();
1898 Lisp_Object tem
, cbuf
;
1900 cbuf
= Fcurrent_buffer ();
1902 if (NILP (printflag
))
1906 specbind (Qstandard_output
, tem
);
1907 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1909 /* readevalloop calls functions which check the type of start and end. */
1910 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1911 !NILP (printflag
), Qnil
, read_function
,
1914 return unbind_to (count
, Qnil
);
1918 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1919 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1920 If STREAM is nil, use the value of `standard-input' (which see).
1921 STREAM or the value of `standard-input' may be:
1922 a buffer (read from point and advance it)
1923 a marker (read from where it points and advance it)
1924 a function (call it with no arguments for each character,
1925 call it with a char as argument to push a char back)
1926 a string (takes text from string, starting at the beginning)
1927 t (read text line using minibuffer and use it, or read from
1928 standard input in batch mode). */)
1929 (Lisp_Object stream
)
1932 stream
= Vstandard_input
;
1933 if (EQ (stream
, Qt
))
1934 stream
= Qread_char
;
1935 if (EQ (stream
, Qread_char
))
1936 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1938 return read_internal_start (stream
, Qnil
, Qnil
);
1941 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1942 doc
: /* Read one Lisp expression which is represented as text by STRING.
1943 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1944 START and END optionally delimit a substring of STRING from which to read;
1945 they default to 0 and (length STRING) respectively. */)
1946 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1949 CHECK_STRING (string
);
1950 /* read_internal_start sets read_from_string_index. */
1951 ret
= read_internal_start (string
, start
, end
);
1952 return Fcons (ret
, make_number (read_from_string_index
));
1955 /* Function to set up the global context we need in toplevel read
1958 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1959 /* start, end only used when stream is a string. */
1964 new_backquote_flag
= 0;
1965 read_objects
= Qnil
;
1966 if (EQ (Vread_with_symbol_positions
, Qt
)
1967 || EQ (Vread_with_symbol_positions
, stream
))
1968 Vread_symbol_positions_list
= Qnil
;
1970 if (STRINGP (stream
)
1971 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1973 EMACS_INT startval
, endval
;
1976 if (STRINGP (stream
))
1979 string
= XCAR (stream
);
1982 endval
= SCHARS (string
);
1986 endval
= XINT (end
);
1987 if (endval
< 0 || endval
> SCHARS (string
))
1988 args_out_of_range (string
, end
);
1995 CHECK_NUMBER (start
);
1996 startval
= XINT (start
);
1997 if (startval
< 0 || startval
> endval
)
1998 args_out_of_range (string
, start
);
2000 read_from_string_index
= startval
;
2001 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2002 read_from_string_limit
= endval
;
2005 retval
= read0 (stream
);
2006 if (EQ (Vread_with_symbol_positions
, Qt
)
2007 || EQ (Vread_with_symbol_positions
, stream
))
2008 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2013 /* Signal Qinvalid_read_syntax error.
2014 S is error string of length N (if > 0) */
2017 invalid_syntax (const char *s
)
2019 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2023 /* Use this for recursive reads, in contexts where internal tokens
2027 read0 (Lisp_Object readcharfun
)
2029 register Lisp_Object val
;
2032 val
= read1 (readcharfun
, &c
, 0);
2036 xsignal1 (Qinvalid_read_syntax
,
2037 Fmake_string (make_number (1), make_number (c
)));
2040 static ptrdiff_t read_buffer_size
;
2041 static char *read_buffer
;
2043 /* Read a \-escape sequence, assuming we already read the `\'.
2044 If the escape sequence forces unibyte, return eight-bit char. */
2047 read_escape (Lisp_Object readcharfun
, int stringp
)
2049 register int c
= READCHAR
;
2050 /* \u allows up to four hex digits, \U up to eight. Default to the
2051 behavior for \u, and change this value in the case that \U is seen. */
2052 int unicode_hex_count
= 4;
2057 end_of_file_error ();
2087 error ("Invalid escape character syntax");
2090 c
= read_escape (readcharfun
, 0);
2091 return c
| meta_modifier
;
2096 error ("Invalid escape character syntax");
2099 c
= read_escape (readcharfun
, 0);
2100 return c
| shift_modifier
;
2105 error ("Invalid escape character syntax");
2108 c
= read_escape (readcharfun
, 0);
2109 return c
| hyper_modifier
;
2114 error ("Invalid escape character syntax");
2117 c
= read_escape (readcharfun
, 0);
2118 return c
| alt_modifier
;
2122 if (stringp
|| c
!= '-')
2129 c
= read_escape (readcharfun
, 0);
2130 return c
| super_modifier
;
2135 error ("Invalid escape character syntax");
2139 c
= read_escape (readcharfun
, 0);
2140 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2141 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2142 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2143 return c
| ctrl_modifier
;
2144 /* ASCII control chars are made from letters (both cases),
2145 as well as the non-letters within 0100...0137. */
2146 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2147 return (c
& (037 | ~0177));
2148 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2149 return (c
& (037 | ~0177));
2151 return c
| ctrl_modifier
;
2161 /* An octal escape, as in ANSI C. */
2163 register int i
= c
- '0';
2164 register int count
= 0;
2167 if ((c
= READCHAR
) >= '0' && c
<= '7')
2179 if (i
>= 0x80 && i
< 0x100)
2180 i
= BYTE8_TO_CHAR (i
);
2185 /* A hex escape, as in ANSI C. */
2192 if (c
>= '0' && c
<= '9')
2197 else if ((c
>= 'a' && c
<= 'f')
2198 || (c
>= 'A' && c
<= 'F'))
2201 if (c
>= 'a' && c
<= 'f')
2212 error ("Hex character out of range: \\x%x...", i
);
2216 if (count
< 3 && i
>= 0x80)
2217 return BYTE8_TO_CHAR (i
);
2222 /* Post-Unicode-2.0: Up to eight hex chars. */
2223 unicode_hex_count
= 8;
2226 /* A Unicode escape. We only permit them in strings and characters,
2227 not arbitrarily in the source code, as in some other languages. */
2232 while (++count
<= unicode_hex_count
)
2235 /* isdigit and isalpha may be locale-specific, which we don't
2237 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2238 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2239 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2241 error ("Non-hex digit used for Unicode escape");
2244 error ("Non-Unicode character: 0x%x", i
);
2253 /* Return the digit that CHARACTER stands for in the given BASE.
2254 Return -1 if CHARACTER is out of range for BASE,
2255 and -2 if CHARACTER is not valid for any supported BASE. */
2257 digit_to_number (int character
, int base
)
2261 if ('0' <= character
&& character
<= '9')
2262 digit
= character
- '0';
2263 else if ('a' <= character
&& character
<= 'z')
2264 digit
= character
- 'a' + 10;
2265 else if ('A' <= character
&& character
<= 'Z')
2266 digit
= character
- 'A' + 10;
2270 return digit
< base
? digit
: -1;
2273 /* Read an integer in radix RADIX using READCHARFUN to read
2274 characters. RADIX must be in the interval [2..36]; if it isn't, a
2275 read error is signaled . Value is the integer read. Signals an
2276 error if encountering invalid read syntax or if RADIX is out of
2280 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2282 /* Room for sign, leading 0, other digits, trailing null byte.
2283 Also, room for invalid syntax diagnostic. */
2284 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2285 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2287 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2289 if (radix
< 2 || radix
> 36)
2297 if (c
== '-' || c
== '+')
2308 /* Ignore redundant leading zeros, so the buffer doesn't
2309 fill up with them. */
2315 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2322 if (p
< buf
+ sizeof buf
- 1)
2337 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2338 invalid_syntax (buf
);
2341 return string_to_number (buf
, radix
, 0);
2345 /* If the next token is ')' or ']' or '.', we store that character
2346 in *PCH and the return value is not interesting. Else, we store
2347 zero in *PCH and we read and return one lisp object.
2349 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2352 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2355 unsigned uninterned_symbol
= 0;
2363 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2365 end_of_file_error ();
2370 return read_list (0, readcharfun
);
2373 return read_vector (readcharfun
, 0);
2389 /* Accept extended format for hashtables (extensible to
2391 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2392 Lisp_Object tmp
= read_list (0, readcharfun
);
2393 Lisp_Object head
= CAR_SAFE (tmp
);
2394 Lisp_Object data
= Qnil
;
2395 Lisp_Object val
= Qnil
;
2396 /* The size is 2 * number of allowed keywords to
2398 Lisp_Object params
[10];
2400 Lisp_Object key
= Qnil
;
2401 int param_count
= 0;
2403 if (!EQ (head
, Qhash_table
))
2404 error ("Invalid extended read marker at head of #s list "
2405 "(only hash-table allowed)");
2407 tmp
= CDR_SAFE (tmp
);
2409 /* This is repetitive but fast and simple. */
2410 params
[param_count
] = QCsize
;
2411 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2412 if (!NILP (params
[param_count
+ 1]))
2415 params
[param_count
] = QCtest
;
2416 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2417 if (!NILP (params
[param_count
+ 1]))
2420 params
[param_count
] = QCweakness
;
2421 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2422 if (!NILP (params
[param_count
+ 1]))
2425 params
[param_count
] = QCrehash_size
;
2426 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2427 if (!NILP (params
[param_count
+ 1]))
2430 params
[param_count
] = QCrehash_threshold
;
2431 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2432 if (!NILP (params
[param_count
+ 1]))
2435 /* This is the hashtable data. */
2436 data
= Fplist_get (tmp
, Qdata
);
2438 /* Now use params to make a new hashtable and fill it. */
2439 ht
= Fmake_hash_table (param_count
, params
);
2441 while (CONSP (data
))
2446 error ("Odd number of elements in hashtable data");
2449 Fputhash (key
, val
, ht
);
2455 invalid_syntax ("#");
2463 tmp
= read_vector (readcharfun
, 0);
2464 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2465 error ("Invalid size char-table");
2466 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2475 EMACS_INT depth
, size
;
2477 tmp
= read_vector (readcharfun
, 0);
2478 if (!INTEGERP (AREF (tmp
, 0)))
2479 error ("Invalid depth in char-table");
2480 depth
= XINT (AREF (tmp
, 0));
2481 if (depth
< 1 || depth
> 3)
2482 error ("Invalid depth in char-table");
2483 size
= ASIZE (tmp
) - 2;
2484 if (chartab_size
[depth
] != size
)
2485 error ("Invalid size char-table");
2486 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2489 invalid_syntax ("#^^");
2491 invalid_syntax ("#^");
2496 length
= read1 (readcharfun
, pch
, first_in_list
);
2500 Lisp_Object tmp
, val
;
2501 EMACS_INT size_in_chars
2502 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2503 / BOOL_VECTOR_BITS_PER_CHAR
);
2506 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2507 if (STRING_MULTIBYTE (tmp
)
2508 || (size_in_chars
!= SCHARS (tmp
)
2509 /* We used to print 1 char too many
2510 when the number of bits was a multiple of 8.
2511 Accept such input in case it came from an old
2513 && ! (XFASTINT (length
)
2514 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2515 invalid_syntax ("#&...");
2517 val
= Fmake_bool_vector (length
, Qnil
);
2518 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2519 /* Clear the extraneous bits in the last byte. */
2520 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2521 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2522 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2525 invalid_syntax ("#&...");
2529 /* Accept compiled functions at read-time so that we don't have to
2530 build them using function calls. */
2532 tmp
= read_vector (readcharfun
, 1);
2533 return Fmake_byte_code (ASIZE (tmp
),
2534 XVECTOR (tmp
)->contents
);
2539 struct gcpro gcpro1
;
2542 /* Read the string itself. */
2543 tmp
= read1 (readcharfun
, &ch
, 0);
2544 if (ch
!= 0 || !STRINGP (tmp
))
2545 invalid_syntax ("#");
2547 /* Read the intervals and their properties. */
2550 Lisp_Object beg
, end
, plist
;
2552 beg
= read1 (readcharfun
, &ch
, 0);
2557 end
= read1 (readcharfun
, &ch
, 0);
2559 plist
= read1 (readcharfun
, &ch
, 0);
2561 invalid_syntax ("Invalid string property list");
2562 Fset_text_properties (beg
, end
, plist
, tmp
);
2568 /* #@NUMBER is used to skip NUMBER following characters.
2569 That's used in .elc files to skip over doc strings
2570 and function definitions. */
2573 enum { extra
= 100 };
2574 ptrdiff_t i
, nskip
= 0;
2577 /* Read a decimal integer. */
2578 while ((c
= READCHAR
) >= 0
2579 && c
>= '0' && c
<= '9')
2581 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2589 if (load_force_doc_strings
2590 && (EQ (readcharfun
, Qget_file_char
)
2591 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2593 /* If we are supposed to force doc strings into core right now,
2594 record the last string that we skipped,
2595 and record where in the file it comes from. */
2597 /* But first exchange saved_doc_string
2598 with prev_saved_doc_string, so we save two strings. */
2600 char *temp
= saved_doc_string
;
2601 ptrdiff_t temp_size
= saved_doc_string_size
;
2602 file_offset temp_pos
= saved_doc_string_position
;
2603 ptrdiff_t temp_len
= saved_doc_string_length
;
2605 saved_doc_string
= prev_saved_doc_string
;
2606 saved_doc_string_size
= prev_saved_doc_string_size
;
2607 saved_doc_string_position
= prev_saved_doc_string_position
;
2608 saved_doc_string_length
= prev_saved_doc_string_length
;
2610 prev_saved_doc_string
= temp
;
2611 prev_saved_doc_string_size
= temp_size
;
2612 prev_saved_doc_string_position
= temp_pos
;
2613 prev_saved_doc_string_length
= temp_len
;
2616 if (saved_doc_string_size
== 0)
2618 saved_doc_string_size
= nskip
+ extra
;
2619 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2621 if (nskip
> saved_doc_string_size
)
2623 saved_doc_string_size
= nskip
+ extra
;
2624 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2625 saved_doc_string_size
);
2628 saved_doc_string_position
= file_tell (instream
);
2630 /* Copy that many characters into saved_doc_string. */
2631 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2632 saved_doc_string
[i
] = c
= READCHAR
;
2634 saved_doc_string_length
= i
;
2638 /* Skip that many characters. */
2639 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2648 /* #! appears at the beginning of an executable file.
2649 Skip the first line. */
2650 while (c
!= '\n' && c
>= 0)
2655 return Vload_file_name
;
2657 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2658 /* #:foo is the uninterned symbol named foo. */
2661 uninterned_symbol
= 1;
2665 /* Reader forms that can reuse previously read objects. */
2666 if (c
>= '0' && c
<= '9')
2671 /* Read a non-negative integer. */
2672 while (c
>= '0' && c
<= '9')
2674 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2675 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2676 n
= MOST_POSITIVE_FIXNUM
+ 1;
2678 n
= n
* 10 + c
- '0';
2682 if (n
<= MOST_POSITIVE_FIXNUM
)
2684 if (c
== 'r' || c
== 'R')
2685 return read_integer (readcharfun
, n
);
2687 if (! NILP (Vread_circle
))
2689 /* #n=object returns object, but associates it with
2693 /* Make a placeholder for #n# to use temporarily */
2694 Lisp_Object placeholder
;
2697 placeholder
= Fcons (Qnil
, Qnil
);
2698 cell
= Fcons (make_number (n
), placeholder
);
2699 read_objects
= Fcons (cell
, read_objects
);
2701 /* Read the object itself. */
2702 tem
= read0 (readcharfun
);
2704 /* Now put it everywhere the placeholder was... */
2705 substitute_object_in_subtree (tem
, placeholder
);
2707 /* ...and #n# will use the real value from now on. */
2708 Fsetcdr (cell
, tem
);
2713 /* #n# returns a previously read object. */
2716 tem
= Fassq (make_number (n
), read_objects
);
2722 /* Fall through to error message. */
2724 else if (c
== 'x' || c
== 'X')
2725 return read_integer (readcharfun
, 16);
2726 else if (c
== 'o' || c
== 'O')
2727 return read_integer (readcharfun
, 8);
2728 else if (c
== 'b' || c
== 'B')
2729 return read_integer (readcharfun
, 2);
2732 invalid_syntax ("#");
2735 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2740 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2745 int next_char
= READCHAR
;
2747 /* Transition from old-style to new-style:
2748 If we see "(`" it used to mean old-style, which usually works
2749 fine because ` should almost never appear in such a position
2750 for new-style. But occasionally we need "(`" to mean new
2751 style, so we try to distinguish the two by the fact that we
2752 can either write "( `foo" or "(` foo", where the first
2753 intends to use new-style whereas the second intends to use
2754 old-style. For Emacs-25, we should completely remove this
2755 first_in_list exception (old-style can still be obtained via
2757 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2759 Vold_style_backquotes
= Qt
;
2766 new_backquote_flag
++;
2767 value
= read0 (readcharfun
);
2768 new_backquote_flag
--;
2770 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2775 int next_char
= READCHAR
;
2777 /* Transition from old-style to new-style:
2778 It used to be impossible to have a new-style , other than within
2779 a new-style `. This is sufficient when ` and , are used in the
2780 normal way, but ` and , can also appear in args to macros that
2781 will not interpret them in the usual way, in which case , may be
2782 used without any ` anywhere near.
2783 So we now use the same heuristic as for backquote: old-style
2784 unquotes are only recognized when first on a list, and when
2785 followed by a space.
2786 Because it's more difficult to peak 2 chars ahead, a new-style
2787 ,@ can still not be used outside of a `, unless it's in the middle
2789 if (new_backquote_flag
2791 || (next_char
!= ' ' && next_char
!= '@'))
2793 Lisp_Object comma_type
= Qnil
;
2798 comma_type
= Qcomma_at
;
2800 comma_type
= Qcomma_dot
;
2803 if (ch
>= 0) UNREAD (ch
);
2804 comma_type
= Qcomma
;
2807 value
= read0 (readcharfun
);
2808 return Fcons (comma_type
, Fcons (value
, Qnil
));
2812 Vold_style_backquotes
= Qt
;
2824 end_of_file_error ();
2826 /* Accept `single space' syntax like (list ? x) where the
2827 whitespace character is SPC or TAB.
2828 Other literal whitespace like NL, CR, and FF are not accepted,
2829 as there are well-established escape sequences for these. */
2830 if (c
== ' ' || c
== '\t')
2831 return make_number (c
);
2834 c
= read_escape (readcharfun
, 0);
2835 modifiers
= c
& CHAR_MODIFIER_MASK
;
2836 c
&= ~CHAR_MODIFIER_MASK
;
2837 if (CHAR_BYTE8_P (c
))
2838 c
= CHAR_TO_BYTE8 (c
);
2841 next_char
= READCHAR
;
2842 ok
= (next_char
<= 040
2843 || (next_char
< 0200
2844 && (strchr ("\"';()[]#?`,.", next_char
))));
2847 return make_number (c
);
2849 invalid_syntax ("?");
2854 char *p
= read_buffer
;
2855 char *end
= read_buffer
+ read_buffer_size
;
2857 /* Nonzero if we saw an escape sequence specifying
2858 a multibyte character. */
2859 int force_multibyte
= 0;
2860 /* Nonzero if we saw an escape sequence specifying
2861 a single-byte character. */
2862 int force_singlebyte
= 0;
2864 ptrdiff_t nchars
= 0;
2866 while ((ch
= READCHAR
) >= 0
2869 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2871 ptrdiff_t offset
= p
- read_buffer
;
2872 read_buffer
= (char *) xrealloc (read_buffer
,
2873 read_buffer_size
*= 2);
2874 p
= read_buffer
+ offset
;
2875 end
= read_buffer
+ read_buffer_size
;
2882 ch
= read_escape (readcharfun
, 1);
2884 /* CH is -1 if \ newline has just been seen */
2887 if (p
== read_buffer
)
2892 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2893 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2895 if (CHAR_BYTE8_P (ch
))
2896 force_singlebyte
= 1;
2897 else if (! ASCII_CHAR_P (ch
))
2898 force_multibyte
= 1;
2899 else /* i.e. ASCII_CHAR_P (ch) */
2901 /* Allow `\C- ' and `\C-?'. */
2902 if (modifiers
== CHAR_CTL
)
2905 ch
= 0, modifiers
= 0;
2907 ch
= 127, modifiers
= 0;
2909 if (modifiers
& CHAR_SHIFT
)
2911 /* Shift modifier is valid only with [A-Za-z]. */
2912 if (ch
>= 'A' && ch
<= 'Z')
2913 modifiers
&= ~CHAR_SHIFT
;
2914 else if (ch
>= 'a' && ch
<= 'z')
2915 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2918 if (modifiers
& CHAR_META
)
2920 /* Move the meta bit to the right place for a
2922 modifiers
&= ~CHAR_META
;
2923 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2924 force_singlebyte
= 1;
2928 /* Any modifiers remaining are invalid. */
2930 error ("Invalid modifier in string");
2931 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2935 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2936 if (CHAR_BYTE8_P (ch
))
2937 force_singlebyte
= 1;
2938 else if (! ASCII_CHAR_P (ch
))
2939 force_multibyte
= 1;
2945 end_of_file_error ();
2947 /* If purifying, and string starts with \ newline,
2948 return zero instead. This is for doc strings
2949 that we are really going to find in etc/DOC.nn.nn */
2950 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2951 return make_number (0);
2953 if (force_multibyte
)
2954 /* READ_BUFFER already contains valid multibyte forms. */
2956 else if (force_singlebyte
)
2958 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
2960 p
= read_buffer
+ nchars
;
2964 /* Otherwise, READ_BUFFER contains only ASCII. */
2967 /* We want readchar_count to be the number of characters, not
2968 bytes. Hence we adjust for multibyte characters in the
2969 string. ... But it doesn't seem to be necessary, because
2970 READCHAR *does* read multibyte characters from buffers. */
2971 /* readchar_count -= (p - read_buffer) - nchars; */
2973 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2975 || (p
- read_buffer
!= nchars
)));
2976 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2978 || (p
- read_buffer
!= nchars
)));
2983 int next_char
= READCHAR
;
2986 if (next_char
<= 040
2987 || (next_char
< 0200
2988 && (strchr ("\"';([#?`,", next_char
))))
2994 /* Otherwise, we fall through! Note that the atom-reading loop
2995 below will now loop at least once, assuring that we will not
2996 try to UNREAD two characters in a row. */
3000 if (c
<= 040) goto retry
;
3001 if (c
== 0x8a0) /* NBSP */
3004 char *p
= read_buffer
;
3008 char *end
= read_buffer
+ read_buffer_size
;
3012 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3014 ptrdiff_t offset
= p
- read_buffer
;
3015 read_buffer
= (char *) xrealloc (read_buffer
,
3016 read_buffer_size
*= 2);
3017 p
= read_buffer
+ offset
;
3018 end
= read_buffer
+ read_buffer_size
;
3025 end_of_file_error ();
3030 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3035 && c
!= 0x8a0 /* NBSP */
3037 || !(strchr ("\"';()[]#`,", c
))));
3041 ptrdiff_t offset
= p
- read_buffer
;
3042 read_buffer
= (char *) xrealloc (read_buffer
,
3043 read_buffer_size
*= 2);
3044 p
= read_buffer
+ offset
;
3045 end
= read_buffer
+ read_buffer_size
;
3052 if (!quoted
&& !uninterned_symbol
)
3054 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3055 if (! NILP (result
))
3059 Lisp_Object name
, result
;
3060 EMACS_INT nbytes
= p
- read_buffer
;
3063 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3067 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3068 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3070 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3071 result
= (uninterned_symbol
? Fmake_symbol (name
)
3072 : Fintern (name
, Qnil
));
3074 if (EQ (Vread_with_symbol_positions
, Qt
)
3075 || EQ (Vread_with_symbol_positions
, readcharfun
))
3076 Vread_symbol_positions_list
=
3077 /* Kind of a hack; this will probably fail if characters
3078 in the symbol name were escaped. Not really a big
3080 Fcons (Fcons (result
,
3081 make_number (readchar_count
3082 - XFASTINT (Flength (Fsymbol_name (result
))))),
3083 Vread_symbol_positions_list
);
3091 /* List of nodes we've seen during substitute_object_in_subtree. */
3092 static Lisp_Object seen_list
;
3095 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3097 Lisp_Object check_object
;
3099 /* We haven't seen any objects when we start. */
3102 /* Make all the substitutions. */
3104 = substitute_object_recurse (object
, placeholder
, object
);
3106 /* Clear seen_list because we're done with it. */
3109 /* The returned object here is expected to always eq the
3111 if (!EQ (check_object
, object
))
3112 error ("Unexpected mutation error in reader");
3115 /* Feval doesn't get called from here, so no gc protection is needed. */
3116 #define SUBSTITUTE(get_val, set_val) \
3118 Lisp_Object old_value = get_val; \
3119 Lisp_Object true_value \
3120 = substitute_object_recurse (object, placeholder, \
3123 if (!EQ (old_value, true_value)) \
3130 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3132 /* If we find the placeholder, return the target object. */
3133 if (EQ (placeholder
, subtree
))
3136 /* If we've been to this node before, don't explore it again. */
3137 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3140 /* If this node can be the entry point to a cycle, remember that
3141 we've seen it. It can only be such an entry point if it was made
3142 by #n=, which means that we can find it as a value in
3144 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3145 seen_list
= Fcons (subtree
, seen_list
);
3147 /* Recurse according to subtree's type.
3148 Every branch must return a Lisp_Object. */
3149 switch (XTYPE (subtree
))
3151 case Lisp_Vectorlike
:
3153 ptrdiff_t i
, length
= 0;
3154 if (BOOL_VECTOR_P (subtree
))
3155 return subtree
; /* No sub-objects anyway. */
3156 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3157 || COMPILEDP (subtree
))
3158 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3159 else if (VECTORP (subtree
))
3160 length
= ASIZE (subtree
);
3162 /* An unknown pseudovector may contain non-Lisp fields, so we
3163 can't just blindly traverse all its fields. We used to call
3164 `Flength' which signaled `sequencep', so I just preserved this
3166 wrong_type_argument (Qsequencep
, subtree
);
3168 for (i
= 0; i
< length
; i
++)
3169 SUBSTITUTE (AREF (subtree
, i
),
3170 ASET (subtree
, i
, true_value
));
3176 SUBSTITUTE (XCAR (subtree
),
3177 XSETCAR (subtree
, true_value
));
3178 SUBSTITUTE (XCDR (subtree
),
3179 XSETCDR (subtree
, true_value
));
3185 /* Check for text properties in each interval.
3186 substitute_in_interval contains part of the logic. */
3188 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3189 Lisp_Object arg
= Fcons (object
, placeholder
);
3191 traverse_intervals_noorder (root_interval
,
3192 &substitute_in_interval
, arg
);
3197 /* Other types don't recurse any further. */
3203 /* Helper function for substitute_object_recurse. */
3205 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3207 Lisp_Object object
= Fcar (arg
);
3208 Lisp_Object placeholder
= Fcdr (arg
);
3210 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3220 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3221 integer syntax and fits in a fixnum, else return the nearest float if CP has
3222 either floating point or integer syntax and BASE is 10, else return nil. If
3223 IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
3224 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3225 number has integer syntax but does not fit. */
3228 string_to_number (char const *string
, int base
, int ignore_trailing
)
3231 char const *cp
= string
;
3233 int float_syntax
= 0;
3236 /* Compute NaN and infinities using a variable, to cope with compilers that
3237 think they are smarter than we are. */
3240 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3241 IEEE floating point hosts, and works around a formerly-common bug where
3242 atof ("-0.0") drops the sign. */
3243 int negative
= *cp
== '-';
3245 int signedp
= negative
|| *cp
== '+';
3250 leading_digit
= digit_to_number (*cp
, base
);
3251 if (0 <= leading_digit
)
3256 while (0 <= digit_to_number (*cp
, base
));
3266 if ('0' <= *cp
&& *cp
<= '9')
3271 while ('0' <= *cp
&& *cp
<= '9');
3273 if (*cp
== 'e' || *cp
== 'E')
3275 char const *ecp
= cp
;
3277 if (*cp
== '+' || *cp
== '-')
3279 if ('0' <= *cp
&& *cp
<= '9')
3284 while ('0' <= *cp
&& *cp
<= '9');
3286 else if (cp
[-1] == '+'
3287 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3293 else if (cp
[-1] == '+'
3294 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3298 value
= zero
/ zero
;
3300 /* If that made a "negative" NaN, negate it. */
3303 union { double d
; char c
[sizeof (double)]; }
3304 u_data
, u_minus_zero
;
3306 u_minus_zero
.d
= -0.0;
3307 for (i
= 0; i
< sizeof (double); i
++)
3308 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3314 /* Now VALUE is a positive NaN. */
3320 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3321 || state
== (LEAD_INT
|E_EXP
));
3324 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3325 any prefix that matches. Otherwise, the entire string must match. */
3326 if (! (ignore_trailing
3327 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3328 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3331 /* If the number uses integer and not float syntax, and is in C-language
3332 range, use its value, preferably as a fixnum. */
3333 if (0 <= leading_digit
&& ! float_syntax
)
3337 /* Fast special case for single-digit integers. This also avoids a
3338 glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
3339 case some versions of strtoumax accept numbers like "0x1" that Emacs
3341 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3342 return make_number (negative
? -leading_digit
: leading_digit
);
3345 n
= strtoumax (string
+ signedp
, NULL
, base
);
3346 if (errno
== ERANGE
)
3348 /* Unfortunately there's no simple and accurate way to convert
3349 non-base-10 numbers that are out of C-language range. */
3351 xsignal1 (Qoverflow_error
, build_string (string
));
3353 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3355 EMACS_INT signed_n
= n
;
3356 return make_number (negative
? -signed_n
: signed_n
);
3362 /* Either the number uses float syntax, or it does not fit into a fixnum.
3363 Convert it from string to floating point, unless the value is already
3364 known because it is an infinity, a NAN, or its absolute value fits in
3367 value
= atof (string
+ signedp
);
3369 return make_float (negative
? -value
: value
);
3374 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3377 register Lisp_Object
*ptr
;
3378 register Lisp_Object tem
, item
, vector
;
3379 register struct Lisp_Cons
*otem
;
3382 tem
= read_list (1, readcharfun
);
3383 len
= Flength (tem
);
3384 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3386 size
= ASIZE (vector
);
3387 ptr
= XVECTOR (vector
)->contents
;
3388 for (i
= 0; i
< size
; i
++)
3391 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3392 bytecode object, the docstring containing the bytecode and
3393 constants values must be treated as unibyte and passed to
3394 Fread, to get the actual bytecode string and constants vector. */
3395 if (bytecodeflag
&& load_force_doc_strings
)
3397 if (i
== COMPILED_BYTECODE
)
3399 if (!STRINGP (item
))
3400 error ("Invalid byte code");
3402 /* Delay handling the bytecode slot until we know whether
3403 it is lazily-loaded (we can tell by whether the
3404 constants slot is nil). */
3405 ptr
[COMPILED_CONSTANTS
] = item
;
3408 else if (i
== COMPILED_CONSTANTS
)
3410 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3414 /* Coerce string to unibyte (like string-as-unibyte,
3415 but without generating extra garbage and
3416 guaranteeing no change in the contents). */
3417 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3418 STRING_SET_UNIBYTE (bytestr
);
3420 item
= Fread (Fcons (bytestr
, readcharfun
));
3422 error ("Invalid byte code");
3424 otem
= XCONS (item
);
3425 bytestr
= XCAR (item
);
3430 /* Now handle the bytecode slot. */
3431 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3433 else if (i
== COMPILED_DOC_STRING
3435 && ! STRING_MULTIBYTE (item
))
3437 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3438 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3440 item
= Fstring_as_multibyte (item
);
3443 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3451 /* FLAG = 1 means check for ] to terminate rather than ) and .
3452 FLAG = -1 means check for starting with defun
3453 and make structure pure. */
3456 read_list (int flag
, register Lisp_Object readcharfun
)
3458 /* -1 means check next element for defun,
3459 0 means don't check,
3460 1 means already checked and found defun. */
3461 int defunflag
= flag
< 0 ? -1 : 0;
3462 Lisp_Object val
, tail
;
3463 register Lisp_Object elt
, tem
;
3464 struct gcpro gcpro1
, gcpro2
;
3465 /* 0 is the normal case.
3466 1 means this list is a doc reference; replace it with the number 0.
3467 2 means this list is a doc reference; replace it with the doc string. */
3468 int doc_reference
= 0;
3470 /* Initialize this to 1 if we are reading a list. */
3471 int first_in_list
= flag
<= 0;
3480 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3485 /* While building, if the list starts with #$, treat it specially. */
3486 if (EQ (elt
, Vload_file_name
)
3488 && !NILP (Vpurify_flag
))
3490 if (NILP (Vdoc_file_name
))
3491 /* We have not yet called Snarf-documentation, so assume
3492 this file is described in the DOC-MM.NN file
3493 and Snarf-documentation will fill in the right value later.
3494 For now, replace the whole list with 0. */
3497 /* We have already called Snarf-documentation, so make a relative
3498 file name for this file, so it can be found properly
3499 in the installed Lisp directory.
3500 We don't use Fexpand_file_name because that would make
3501 the directory absolute now. */
3502 elt
= concat2 (build_string ("../lisp/"),
3503 Ffile_name_nondirectory (elt
));
3505 else if (EQ (elt
, Vload_file_name
)
3507 && load_force_doc_strings
)
3516 invalid_syntax (") or . in a vector");
3524 XSETCDR (tail
, read0 (readcharfun
));
3526 val
= read0 (readcharfun
);
3527 read1 (readcharfun
, &ch
, 0);
3531 if (doc_reference
== 1)
3532 return make_number (0);
3533 if (doc_reference
== 2)
3535 /* Get a doc string from the file we are loading.
3536 If it's in saved_doc_string, get it from there.
3538 Here, we don't know if the string is a
3539 bytecode string or a doc string. As a
3540 bytecode string must be unibyte, we always
3541 return a unibyte string. If it is actually a
3542 doc string, caller must make it
3545 EMACS_INT pos
= XINT (XCDR (val
));
3546 /* Position is negative for user variables. */
3547 if (pos
< 0) pos
= -pos
;
3548 if (pos
>= saved_doc_string_position
3549 && pos
< (saved_doc_string_position
3550 + saved_doc_string_length
))
3552 ptrdiff_t start
= pos
- saved_doc_string_position
;
3555 /* Process quoting with ^A,
3556 and find the end of the string,
3557 which is marked with ^_ (037). */
3558 for (from
= start
, to
= start
;
3559 saved_doc_string
[from
] != 037;)
3561 int c
= saved_doc_string
[from
++];
3564 c
= saved_doc_string
[from
++];
3566 saved_doc_string
[to
++] = c
;
3568 saved_doc_string
[to
++] = 0;
3570 saved_doc_string
[to
++] = 037;
3573 saved_doc_string
[to
++] = c
;
3576 return make_unibyte_string (saved_doc_string
+ start
,
3579 /* Look in prev_saved_doc_string the same way. */
3580 else if (pos
>= prev_saved_doc_string_position
3581 && pos
< (prev_saved_doc_string_position
3582 + prev_saved_doc_string_length
))
3585 pos
- prev_saved_doc_string_position
;
3588 /* Process quoting with ^A,
3589 and find the end of the string,
3590 which is marked with ^_ (037). */
3591 for (from
= start
, to
= start
;
3592 prev_saved_doc_string
[from
] != 037;)
3594 int c
= prev_saved_doc_string
[from
++];
3597 c
= prev_saved_doc_string
[from
++];
3599 prev_saved_doc_string
[to
++] = c
;
3601 prev_saved_doc_string
[to
++] = 0;
3603 prev_saved_doc_string
[to
++] = 037;
3606 prev_saved_doc_string
[to
++] = c
;
3609 return make_unibyte_string (prev_saved_doc_string
3614 return get_doc_string (val
, 1, 0);
3619 invalid_syntax (". in wrong context");
3621 invalid_syntax ("] in a list");
3623 tem
= (read_pure
&& flag
<= 0
3624 ? pure_cons (elt
, Qnil
)
3625 : Fcons (elt
, Qnil
));
3627 XSETCDR (tail
, tem
);
3632 defunflag
= EQ (elt
, Qdefun
);
3633 else if (defunflag
> 0)
3638 static Lisp_Object initial_obarray
;
3640 /* oblookup stores the bucket number here, for the sake of Funintern. */
3642 static size_t oblookup_last_bucket_number
;
3644 static size_t hash_string (const char *ptr
, size_t len
);
3646 /* Get an error if OBARRAY is not an obarray.
3647 If it is one, return it. */
3650 check_obarray (Lisp_Object obarray
)
3652 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3654 /* If Vobarray is now invalid, force it to be valid. */
3655 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3656 wrong_type_argument (Qvectorp
, obarray
);
3661 /* Intern the C string STR: return a symbol with that name,
3662 interned in the current obarray. */
3665 intern (const char *str
)
3668 ptrdiff_t len
= strlen (str
);
3669 Lisp_Object obarray
;
3672 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3673 obarray
= check_obarray (obarray
);
3674 tem
= oblookup (obarray
, str
, len
, len
);
3677 return Fintern (make_string (str
, len
), obarray
);
3681 intern_c_string (const char *str
)
3684 ptrdiff_t len
= strlen (str
);
3685 Lisp_Object obarray
;
3688 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3689 obarray
= check_obarray (obarray
);
3690 tem
= oblookup (obarray
, str
, len
, len
);
3694 if (NILP (Vpurify_flag
))
3695 /* Creating a non-pure string from a string literal not
3696 implemented yet. We could just use make_string here and live
3697 with the extra copy. */
3700 return Fintern (make_pure_c_string (str
), obarray
);
3703 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3704 doc
: /* Return the canonical symbol whose name is STRING.
3705 If there is none, one is created by this function and returned.
3706 A second optional argument specifies the obarray to use;
3707 it defaults to the value of `obarray'. */)
3708 (Lisp_Object string
, Lisp_Object obarray
)
3710 register Lisp_Object tem
, sym
, *ptr
;
3712 if (NILP (obarray
)) obarray
= Vobarray
;
3713 obarray
= check_obarray (obarray
);
3715 CHECK_STRING (string
);
3717 tem
= oblookup (obarray
, SSDATA (string
),
3720 if (!INTEGERP (tem
))
3723 if (!NILP (Vpurify_flag
))
3724 string
= Fpurecopy (string
);
3725 sym
= Fmake_symbol (string
);
3727 if (EQ (obarray
, initial_obarray
))
3728 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3730 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3732 if ((SREF (string
, 0) == ':')
3733 && EQ (obarray
, initial_obarray
))
3735 XSYMBOL (sym
)->constant
= 1;
3736 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3737 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3740 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3742 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3744 XSYMBOL (sym
)->next
= 0;
3749 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3750 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3751 NAME may be a string or a symbol. If it is a symbol, that exact
3752 symbol is searched for.
3753 A second optional argument specifies the obarray to use;
3754 it defaults to the value of `obarray'. */)
3755 (Lisp_Object name
, Lisp_Object obarray
)
3757 register Lisp_Object tem
, string
;
3759 if (NILP (obarray
)) obarray
= Vobarray
;
3760 obarray
= check_obarray (obarray
);
3762 if (!SYMBOLP (name
))
3764 CHECK_STRING (name
);
3768 string
= SYMBOL_NAME (name
);
3770 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3771 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3777 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3778 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3779 The value is t if a symbol was found and deleted, nil otherwise.
3780 NAME may be a string or a symbol. If it is a symbol, that symbol
3781 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3782 OBARRAY defaults to the value of the variable `obarray'. */)
3783 (Lisp_Object name
, Lisp_Object obarray
)
3785 register Lisp_Object string
, tem
;
3788 if (NILP (obarray
)) obarray
= Vobarray
;
3789 obarray
= check_obarray (obarray
);
3792 string
= SYMBOL_NAME (name
);
3795 CHECK_STRING (name
);
3799 tem
= oblookup (obarray
, SSDATA (string
),
3804 /* If arg was a symbol, don't delete anything but that symbol itself. */
3805 if (SYMBOLP (name
) && !EQ (name
, tem
))
3808 /* There are plenty of other symbols which will screw up the Emacs
3809 session if we unintern them, as well as even more ways to use
3810 `setq' or `fset' or whatnot to make the Emacs session
3811 unusable. Let's not go down this silly road. --Stef */
3812 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3813 error ("Attempt to unintern t or nil"); */
3815 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3817 hash
= oblookup_last_bucket_number
;
3819 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3821 if (XSYMBOL (tem
)->next
)
3822 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3824 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3828 Lisp_Object tail
, following
;
3830 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3831 XSYMBOL (tail
)->next
;
3834 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3835 if (EQ (following
, tem
))
3837 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3846 /* Return the symbol in OBARRAY whose names matches the string
3847 of SIZE characters (SIZE_BYTE bytes) at PTR.
3848 If there is no such symbol in OBARRAY, return nil.
3850 Also store the bucket number in oblookup_last_bucket_number. */
3853 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3857 register Lisp_Object tail
;
3858 Lisp_Object bucket
, tem
;
3860 if (!VECTORP (obarray
)
3861 || (obsize
= ASIZE (obarray
)) == 0)
3863 obarray
= check_obarray (obarray
);
3864 obsize
= ASIZE (obarray
);
3866 /* This is sometimes needed in the middle of GC. */
3867 obsize
&= ~ARRAY_MARK_FLAG
;
3868 hash
= hash_string (ptr
, size_byte
) % obsize
;
3869 bucket
= XVECTOR (obarray
)->contents
[hash
];
3870 oblookup_last_bucket_number
= hash
;
3871 if (EQ (bucket
, make_number (0)))
3873 else if (!SYMBOLP (bucket
))
3874 error ("Bad data in guts of obarray"); /* Like CADR error message */
3876 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3878 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3879 && SCHARS (SYMBOL_NAME (tail
)) == size
3880 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3882 else if (XSYMBOL (tail
)->next
== 0)
3885 XSETINT (tem
, hash
);
3890 hash_string (const char *ptr
, size_t len
)
3892 register const char *p
= ptr
;
3893 register const char *end
= p
+ len
;
3894 register unsigned char c
;
3895 register size_t hash
= 0;
3900 if (c
>= 0140) c
-= 40;
3901 hash
= (hash
<< 3) + (hash
>> (CHAR_BIT
* sizeof hash
- 4)) + c
;
3907 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3910 register Lisp_Object tail
;
3911 CHECK_VECTOR (obarray
);
3912 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3914 tail
= XVECTOR (obarray
)->contents
[i
];
3919 if (XSYMBOL (tail
)->next
== 0)
3921 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3927 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3929 call1 (function
, sym
);
3932 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3933 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3934 OBARRAY defaults to the value of `obarray'. */)
3935 (Lisp_Object function
, Lisp_Object obarray
)
3937 if (NILP (obarray
)) obarray
= Vobarray
;
3938 obarray
= check_obarray (obarray
);
3940 map_obarray (obarray
, mapatoms_1
, function
);
3944 #define OBARRAY_SIZE 1511
3949 Lisp_Object oblength
;
3951 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3953 Vobarray
= Fmake_vector (oblength
, make_number (0));
3954 initial_obarray
= Vobarray
;
3955 staticpro (&initial_obarray
);
3957 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3958 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3959 NILP (Vpurify_flag) check in intern_c_string. */
3960 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3961 Qnil
= intern_c_string ("nil");
3963 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3964 so those two need to be fixed manally. */
3965 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3966 XSYMBOL (Qunbound
)->function
= Qunbound
;
3967 XSYMBOL (Qunbound
)->plist
= Qnil
;
3968 /* XSYMBOL (Qnil)->function = Qunbound; */
3969 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3970 XSYMBOL (Qnil
)->constant
= 1;
3971 XSYMBOL (Qnil
)->plist
= Qnil
;
3973 Qt
= intern_c_string ("t");
3974 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3975 XSYMBOL (Qt
)->constant
= 1;
3977 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3980 Qvariable_documentation
= intern_c_string ("variable-documentation");
3981 staticpro (&Qvariable_documentation
);
3983 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3984 read_buffer
= (char *) xmalloc (read_buffer_size
);
3988 defsubr (struct Lisp_Subr
*sname
)
3991 sym
= intern_c_string (sname
->symbol_name
);
3992 XSETTYPED_PVECTYPE (sname
, size
, PVEC_SUBR
);
3993 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3996 #ifdef NOTDEF /* use fset in subr.el now */
3998 defalias (sname
, string
)
3999 struct Lisp_Subr
*sname
;
4003 sym
= intern (string
);
4004 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4008 /* Define an "integer variable"; a symbol whose value is forwarded to a
4009 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4010 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4012 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4013 const char *namestring
, EMACS_INT
*address
)
4016 sym
= intern_c_string (namestring
);
4017 i_fwd
->type
= Lisp_Fwd_Int
;
4018 i_fwd
->intvar
= address
;
4019 XSYMBOL (sym
)->declared_special
= 1;
4020 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4021 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4024 /* Similar but define a variable whose value is t if address contains 1,
4025 nil if address contains 0. */
4027 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4028 const char *namestring
, int *address
)
4031 sym
= intern_c_string (namestring
);
4032 b_fwd
->type
= Lisp_Fwd_Bool
;
4033 b_fwd
->boolvar
= address
;
4034 XSYMBOL (sym
)->declared_special
= 1;
4035 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4036 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4037 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4040 /* Similar but define a variable whose value is the Lisp Object stored
4041 at address. Two versions: with and without gc-marking of the C
4042 variable. The nopro version is used when that variable will be
4043 gc-marked for some other reason, since marking the same slot twice
4044 can cause trouble with strings. */
4046 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4047 const char *namestring
, Lisp_Object
*address
)
4050 sym
= intern_c_string (namestring
);
4051 o_fwd
->type
= Lisp_Fwd_Obj
;
4052 o_fwd
->objvar
= address
;
4053 XSYMBOL (sym
)->declared_special
= 1;
4054 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4055 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4059 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4060 const char *namestring
, Lisp_Object
*address
)
4062 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4063 staticpro (address
);
4066 /* Similar but define a variable whose value is the Lisp Object stored
4067 at a particular offset in the current kboard object. */
4070 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4071 const char *namestring
, int offset
)
4074 sym
= intern_c_string (namestring
);
4075 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4076 ko_fwd
->offset
= offset
;
4077 XSYMBOL (sym
)->declared_special
= 1;
4078 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4079 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4082 /* Record the value of load-path used at the start of dumping
4083 so we can see if the site changed it later during dumping. */
4084 static Lisp_Object dump_path
;
4090 int turn_off_warning
= 0;
4092 /* Compute the default load-path. */
4094 normal
= PATH_LOADSEARCH
;
4095 Vload_path
= decode_env_path (0, normal
);
4097 if (NILP (Vpurify_flag
))
4098 normal
= PATH_LOADSEARCH
;
4100 normal
= PATH_DUMPLOADSEARCH
;
4102 /* In a dumped Emacs, we normally have to reset the value of
4103 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4104 uses ../lisp, instead of the path of the installed elisp
4105 libraries. However, if it appears that Vload_path was changed
4106 from the default before dumping, don't override that value. */
4109 if (! NILP (Fequal (dump_path
, Vload_path
)))
4111 Vload_path
= decode_env_path (0, normal
);
4112 if (!NILP (Vinstallation_directory
))
4114 Lisp_Object tem
, tem1
, sitelisp
;
4116 /* Remove site-lisp dirs from path temporarily and store
4117 them in sitelisp, then conc them on at the end so
4118 they're always first in path. */
4122 tem
= Fcar (Vload_path
);
4123 tem1
= Fstring_match (build_string ("site-lisp"),
4127 Vload_path
= Fcdr (Vload_path
);
4128 sitelisp
= Fcons (tem
, sitelisp
);
4134 /* Add to the path the lisp subdir of the
4135 installation dir, if it exists. */
4136 tem
= Fexpand_file_name (build_string ("lisp"),
4137 Vinstallation_directory
);
4138 tem1
= Ffile_exists_p (tem
);
4141 if (NILP (Fmember (tem
, Vload_path
)))
4143 turn_off_warning
= 1;
4144 Vload_path
= Fcons (tem
, Vload_path
);
4148 /* That dir doesn't exist, so add the build-time
4149 Lisp dirs instead. */
4150 Vload_path
= nconc2 (Vload_path
, dump_path
);
4152 /* Add leim under the installation dir, if it exists. */
4153 tem
= Fexpand_file_name (build_string ("leim"),
4154 Vinstallation_directory
);
4155 tem1
= Ffile_exists_p (tem
);
4158 if (NILP (Fmember (tem
, Vload_path
)))
4159 Vload_path
= Fcons (tem
, Vload_path
);
4162 /* Add site-lisp under the installation dir, if it exists. */
4163 tem
= Fexpand_file_name (build_string ("site-lisp"),
4164 Vinstallation_directory
);
4165 tem1
= Ffile_exists_p (tem
);
4168 if (NILP (Fmember (tem
, Vload_path
)))
4169 Vload_path
= Fcons (tem
, Vload_path
);
4172 /* If Emacs was not built in the source directory,
4173 and it is run from where it was built, add to load-path
4174 the lisp, leim and site-lisp dirs under that directory. */
4176 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4180 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4181 Vinstallation_directory
);
4182 tem1
= Ffile_exists_p (tem
);
4184 /* Don't be fooled if they moved the entire source tree
4185 AFTER dumping Emacs. If the build directory is indeed
4186 different from the source dir, src/Makefile.in and
4187 src/Makefile will not be found together. */
4188 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4189 Vinstallation_directory
);
4190 tem2
= Ffile_exists_p (tem
);
4191 if (!NILP (tem1
) && NILP (tem2
))
4193 tem
= Fexpand_file_name (build_string ("lisp"),
4196 if (NILP (Fmember (tem
, Vload_path
)))
4197 Vload_path
= Fcons (tem
, Vload_path
);
4199 tem
= Fexpand_file_name (build_string ("leim"),
4202 if (NILP (Fmember (tem
, Vload_path
)))
4203 Vload_path
= Fcons (tem
, Vload_path
);
4205 tem
= Fexpand_file_name (build_string ("site-lisp"),
4208 if (NILP (Fmember (tem
, Vload_path
)))
4209 Vload_path
= Fcons (tem
, Vload_path
);
4212 if (!NILP (sitelisp
) && !no_site_lisp
)
4213 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4219 /* NORMAL refers to the lisp dir in the source directory. */
4220 /* We used to add ../lisp at the front here, but
4221 that caused trouble because it was copied from dump_path
4222 into Vload_path, above, when Vinstallation_directory was non-nil.
4223 It should be unnecessary. */
4224 Vload_path
= decode_env_path (0, normal
);
4225 dump_path
= Vload_path
;
4229 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4230 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4231 almost never correct, thereby causing a warning to be printed out that
4232 confuses users. Since PATH_LOADSEARCH is always overridden by the
4233 EMACSLOADPATH environment variable below, disable the warning on NT. */
4235 /* Warn if dirs in the *standard* path don't exist. */
4236 if (!turn_off_warning
)
4238 Lisp_Object path_tail
;
4240 for (path_tail
= Vload_path
;
4242 path_tail
= XCDR (path_tail
))
4244 Lisp_Object dirfile
;
4245 dirfile
= Fcar (path_tail
);
4246 if (STRINGP (dirfile
))
4248 dirfile
= Fdirectory_file_name (dirfile
);
4249 if (access (SSDATA (dirfile
), 0) < 0)
4250 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4255 #endif /* !(WINDOWSNT || HAVE_NS) */
4257 /* If the EMACSLOADPATH environment variable is set, use its value.
4258 This doesn't apply if we're dumping. */
4260 if (NILP (Vpurify_flag
)
4261 && egetenv ("EMACSLOADPATH"))
4263 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4267 load_in_progress
= 0;
4268 Vload_file_name
= Qnil
;
4270 load_descriptor_list
= Qnil
;
4272 Vstandard_input
= Qt
;
4273 Vloads_in_progress
= Qnil
;
4276 /* Print a warning, using format string FORMAT, that directory DIRNAME
4277 does not exist. Print it on stderr and put it in *Messages*. */
4280 dir_warning (const char *format
, Lisp_Object dirname
)
4283 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4285 fprintf (stderr
, format
, SDATA (dirname
));
4286 sprintf (buffer
, format
, SDATA (dirname
));
4287 /* Don't log the warning before we've initialized!! */
4289 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4293 syms_of_lread (void)
4296 defsubr (&Sread_from_string
);
4298 defsubr (&Sintern_soft
);
4299 defsubr (&Sunintern
);
4300 defsubr (&Sget_load_suffixes
);
4302 defsubr (&Seval_buffer
);
4303 defsubr (&Seval_region
);
4304 defsubr (&Sread_char
);
4305 defsubr (&Sread_char_exclusive
);
4306 defsubr (&Sread_event
);
4307 defsubr (&Sget_file_char
);
4308 defsubr (&Smapatoms
);
4309 defsubr (&Slocate_file_internal
);
4311 DEFVAR_LISP ("obarray", Vobarray
,
4312 doc
: /* Symbol table for use by `intern' and `read'.
4313 It is a vector whose length ought to be prime for best results.
4314 The vector's contents don't make sense if examined from Lisp programs;
4315 to find all the symbols in an obarray, use `mapatoms'. */);
4317 DEFVAR_LISP ("values", Vvalues
,
4318 doc
: /* List of values of all expressions which were read, evaluated and printed.
4319 Order is reverse chronological. */);
4321 DEFVAR_LISP ("standard-input", Vstandard_input
,
4322 doc
: /* Stream for read to get input from.
4323 See documentation of `read' for possible values. */);
4324 Vstandard_input
= Qt
;
4326 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4327 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4329 If this variable is a buffer, then only forms read from that buffer
4330 will be added to `read-symbol-positions-list'.
4331 If this variable is t, then all read forms will be added.
4332 The effect of all other values other than nil are not currently
4333 defined, although they may be in the future.
4335 The positions are relative to the last call to `read' or
4336 `read-from-string'. It is probably a bad idea to set this variable at
4337 the toplevel; bind it instead. */);
4338 Vread_with_symbol_positions
= Qnil
;
4340 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4341 doc
: /* A list mapping read symbols to their positions.
4342 This variable is modified during calls to `read' or
4343 `read-from-string', but only when `read-with-symbol-positions' is
4346 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4347 CHAR-POSITION is an integer giving the offset of that occurrence of the
4348 symbol from the position where `read' or `read-from-string' started.
4350 Note that a symbol will appear multiple times in this list, if it was
4351 read multiple times. The list is in the same order as the symbols
4353 Vread_symbol_positions_list
= Qnil
;
4355 DEFVAR_LISP ("read-circle", Vread_circle
,
4356 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4359 DEFVAR_LISP ("load-path", Vload_path
,
4360 doc
: /* *List of directories to search for files to load.
4361 Each element is a string (directory name) or nil (try default directory).
4362 Initialized based on EMACSLOADPATH environment variable, if any,
4363 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4365 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4366 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4367 This list should not include the empty string.
4368 `load' and related functions try to append these suffixes, in order,
4369 to the specified file name if a Lisp suffix is allowed or required. */);
4370 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4371 Fcons (make_pure_c_string (".el"), Qnil
));
4372 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4373 doc
: /* List of suffixes that indicate representations of \
4375 This list should normally start with the empty string.
4377 Enabling Auto Compression mode appends the suffixes in
4378 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4379 mode removes them again. `load' and related functions use this list to
4380 determine whether they should look for compressed versions of a file
4381 and, if so, which suffixes they should try to append to the file name
4382 in order to do so. However, if you want to customize which suffixes
4383 the loading functions recognize as compression suffixes, you should
4384 customize `jka-compr-load-suffixes' rather than the present variable. */);
4385 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4387 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4388 doc
: /* Non-nil if inside of `load'. */);
4389 Qload_in_progress
= intern_c_string ("load-in-progress");
4390 staticpro (&Qload_in_progress
);
4392 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4393 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4394 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4396 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4397 a symbol \(a feature name).
4399 When `load' is run and the file-name argument matches an element's
4400 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4401 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4403 An error in FORMS does not undo the load, but does prevent execution of
4404 the rest of the FORMS. */);
4405 Vafter_load_alist
= Qnil
;
4407 DEFVAR_LISP ("load-history", Vload_history
,
4408 doc
: /* Alist mapping loaded file names to symbols and features.
4409 Each alist element should be a list (FILE-NAME ENTRIES...), where
4410 FILE-NAME is the name of a file that has been loaded into Emacs.
4411 The file name is absolute and true (i.e. it doesn't contain symlinks).
4412 As an exception, one of the alist elements may have FILE-NAME nil,
4413 for symbols and features not associated with any file.
4415 The remaining ENTRIES in the alist element describe the functions and
4416 variables defined in that file, the features provided, and the
4417 features required. Each entry has the form `(provide . FEATURE)',
4418 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4419 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4420 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4421 SYMBOL was an autoload before this file redefined it as a function.
4423 During preloading, the file name recorded is relative to the main Lisp
4424 directory. These file names are converted to absolute at startup. */);
4425 Vload_history
= Qnil
;
4427 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4428 doc
: /* Full name of file being loaded by `load'. */);
4429 Vload_file_name
= Qnil
;
4431 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4432 doc
: /* File name, including directory, of user's initialization file.
4433 If the file loaded had extension `.elc', and the corresponding source file
4434 exists, this variable contains the name of source file, suitable for use
4435 by functions like `custom-save-all' which edit the init file.
4436 While Emacs loads and evaluates the init file, value is the real name
4437 of the file, regardless of whether or not it has the `.elc' extension. */);
4438 Vuser_init_file
= Qnil
;
4440 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4441 doc
: /* Used for internal purposes by `load'. */);
4442 Vcurrent_load_list
= Qnil
;
4444 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4445 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4446 The default is nil, which means use the function `read'. */);
4447 Vload_read_function
= Qnil
;
4449 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4450 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4451 This function is for doing code conversion before reading the source file.
4452 If nil, loading is done without any code conversion.
4453 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4454 FULLNAME is the full name of FILE.
4455 See `load' for the meaning of the remaining arguments. */);
4456 Vload_source_file_function
= Qnil
;
4458 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4459 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4460 This is useful when the file being loaded is a temporary copy. */);
4461 load_force_doc_strings
= 0;
4463 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4464 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4465 This is normally bound by `load' and `eval-buffer' to control `read',
4466 and is not meant for users to change. */);
4467 load_convert_to_unibyte
= 0;
4469 DEFVAR_LISP ("source-directory", Vsource_directory
,
4470 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4471 You cannot count on them to still be there! */);
4473 = Fexpand_file_name (build_string ("../"),
4474 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4476 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4477 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4478 Vpreloaded_file_list
= Qnil
;
4480 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4481 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4482 Vbyte_boolean_vars
= Qnil
;
4484 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4485 doc
: /* Non-nil means load dangerous compiled Lisp files.
4486 Some versions of XEmacs use different byte codes than Emacs. These
4487 incompatible byte codes can make Emacs crash when it tries to execute
4489 load_dangerous_libraries
= 0;
4491 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4492 doc
: /* Non-nil means force printing messages when loading Lisp files.
4493 This overrides the value of the NOMESSAGE argument to `load'. */);
4494 force_load_messages
= 0;
4496 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4497 doc
: /* Regular expression matching safe to load compiled Lisp files.
4498 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4499 from the file, and matches them against this regular expression.
4500 When the regular expression matches, the file is considered to be safe
4501 to load. See also `load-dangerous-libraries'. */);
4502 Vbytecomp_version_regexp
4503 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4505 Qlexical_binding
= intern ("lexical-binding");
4506 staticpro (&Qlexical_binding
);
4507 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4508 doc
: /* If non-nil, use lexical binding when evaluating code.
4509 This only applies to code evaluated by `eval-buffer' and `eval-region'.
4510 This variable is automatically set from the file variables of an interpreted
4511 Lisp file read using `load'. */);
4512 Fmake_variable_buffer_local (Qlexical_binding
);
4514 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4515 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4516 Veval_buffer_list
= Qnil
;
4518 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4519 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4520 Vold_style_backquotes
= Qnil
;
4521 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4522 staticpro (&Qold_style_backquotes
);
4524 /* Vsource_directory was initialized in init_lread. */
4526 load_descriptor_list
= Qnil
;
4527 staticpro (&load_descriptor_list
);
4529 Qcurrent_load_list
= intern_c_string ("current-load-list");
4530 staticpro (&Qcurrent_load_list
);
4532 Qstandard_input
= intern_c_string ("standard-input");
4533 staticpro (&Qstandard_input
);
4535 Qread_char
= intern_c_string ("read-char");
4536 staticpro (&Qread_char
);
4538 Qget_file_char
= intern_c_string ("get-file-char");
4539 staticpro (&Qget_file_char
);
4541 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4542 staticpro (&Qget_emacs_mule_file_char
);
4544 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4545 staticpro (&Qload_force_doc_strings
);
4547 Qbackquote
= intern_c_string ("`");
4548 staticpro (&Qbackquote
);
4549 Qcomma
= intern_c_string (",");
4550 staticpro (&Qcomma
);
4551 Qcomma_at
= intern_c_string (",@");
4552 staticpro (&Qcomma_at
);
4553 Qcomma_dot
= intern_c_string (",.");
4554 staticpro (&Qcomma_dot
);
4556 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4557 staticpro (&Qinhibit_file_name_operation
);
4559 Qascii_character
= intern_c_string ("ascii-character");
4560 staticpro (&Qascii_character
);
4562 Qfunction
= intern_c_string ("function");
4563 staticpro (&Qfunction
);
4565 Qload
= intern_c_string ("load");
4568 Qload_file_name
= intern_c_string ("load-file-name");
4569 staticpro (&Qload_file_name
);
4571 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4572 staticpro (&Qeval_buffer_list
);
4574 Qfile_truename
= intern_c_string ("file-truename");
4575 staticpro (&Qfile_truename
) ;
4577 Qdir_ok
= intern_c_string ("dir-ok");
4578 staticpro (&Qdir_ok
);
4580 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4581 staticpro (&Qdo_after_load_evaluation
) ;
4583 staticpro (&dump_path
);
4585 staticpro (&read_objects
);
4586 read_objects
= Qnil
;
4587 staticpro (&seen_list
);
4590 Vloads_in_progress
= Qnil
;
4591 staticpro (&Vloads_in_progress
);
4593 Qhash_table
= intern_c_string ("hash-table");
4594 staticpro (&Qhash_table
);
4595 Qdata
= intern_c_string ("data");
4597 Qtest
= intern_c_string ("test");
4599 Qsize
= intern_c_string ("size");
4601 Qweakness
= intern_c_string ("weakness");
4602 staticpro (&Qweakness
);
4603 Qrehash_size
= intern_c_string ("rehash-size");
4604 staticpro (&Qrehash_size
);
4605 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4606 staticpro (&Qrehash_threshold
);