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/>. */
24 #include <sys/types.h>
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 int saved_doc_string_size
;
124 /* Length of actual data in saved_doc_string. */
125 static int 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 int prev_saved_doc_string_size
;
135 /* Length of actual data in prev_saved_doc_string. */
136 static int 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 *, int) 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
)
835 if (i
< sizeof var
- 1)
837 UPDATE_BEG_END_STATE (ch
);
841 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
847 /* Read a variable value. */
850 while (ch
== ' ' || ch
== '\t')
854 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
856 if (i
< sizeof val
- 1)
858 UPDATE_BEG_END_STATE (ch
);
862 /* The value was terminated by an end-marker, which
865 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
869 if (strcmp (var
, "lexical-binding") == 0)
872 rv
= (strcmp (val
, "nil") != 0);
878 while (ch
!= '\n' && ch
!= EOF
)
885 /* Value is a version number of byte compiled code if the file
886 associated with file descriptor FD is a compiled Lisp file that's
887 safe to load. Only files compiled with Emacs are safe to load.
888 Files compiled with XEmacs can lead to a crash in Fbyte_code
889 because of an incompatible change in the byte compiler. */
892 safe_to_load_p (int fd
)
899 /* Read the first few bytes from the file, and look for a line
900 specifying the byte compiler version used. */
901 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
906 /* Skip to the next newline, skipping over the initial `ELC'
907 with NUL bytes following it, but note the version. */
908 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
913 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
920 lseek (fd
, 0, SEEK_SET
);
925 /* Callback for record_unwind_protect. Restore the old load list OLD,
926 after loading a file successfully. */
929 record_load_unwind (Lisp_Object old
)
931 return Vloads_in_progress
= old
;
934 /* This handler function is used via internal_condition_case_1. */
937 load_error_handler (Lisp_Object data
)
943 load_warn_old_style_backquotes (Lisp_Object file
)
945 if (!NILP (Vold_style_backquotes
))
948 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
955 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
956 doc
: /* Return the suffixes that `load' should try if a suffix is \
958 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
961 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
962 while (CONSP (suffixes
))
964 Lisp_Object exts
= Vload_file_rep_suffixes
;
965 suffix
= XCAR (suffixes
);
966 suffixes
= XCDR (suffixes
);
971 lst
= Fcons (concat2 (suffix
, ext
), lst
);
974 return Fnreverse (lst
);
977 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
978 doc
: /* Execute a file of Lisp code named FILE.
979 First try FILE with `.elc' appended, then try with `.el',
980 then try FILE unmodified (the exact suffixes in the exact order are
981 determined by `load-suffixes'). Environment variable references in
982 FILE are replaced with their values by calling `substitute-in-file-name'.
983 This function searches the directories in `load-path'.
985 If optional second arg NOERROR is non-nil,
986 report no error if FILE doesn't exist.
987 Print messages at start and end of loading unless
988 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
990 If optional fourth arg NOSUFFIX is non-nil, don't try adding
991 suffixes `.elc' or `.el' to the specified name FILE.
992 If optional fifth arg MUST-SUFFIX is non-nil, insist on
993 the suffix `.elc' or `.el'; don't accept just FILE unless
994 it ends in one of those suffixes or includes a directory name.
996 If this function fails to find a file, it may look for different
997 representations of that file before trying another file.
998 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
999 to the file name. Emacs uses this feature mainly to find compressed
1000 versions of files when Auto Compression mode is enabled.
1002 The exact suffixes that this function tries out, in the exact order,
1003 are given by the value of the variable `load-file-rep-suffixes' if
1004 NOSUFFIX is non-nil and by the return value of the function
1005 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1006 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1007 and then the former.
1009 Loading a file records its definitions, and its `provide' and
1010 `require' calls, in an element of `load-history' whose
1011 car is the file name loaded. See `load-history'.
1013 While the file is in the process of being loaded, the variable
1014 `load-in-progress' is non-nil and the variable `load-file-name'
1015 is bound to the file's name.
1017 Return t if the file exists and loads successfully. */)
1018 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1020 register FILE *stream
;
1021 register int fd
= -1;
1022 int count
= SPECPDL_INDEX ();
1023 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1024 Lisp_Object found
, efound
, hist_file_name
;
1025 /* 1 means we printed the ".el is newer" message. */
1027 /* 1 means we are loading a compiled file. */
1029 Lisp_Object handler
;
1031 const char *fmode
= "r";
1039 CHECK_STRING (file
);
1041 /* If file name is magic, call the handler. */
1042 /* This shouldn't be necessary any more now that `openp' handles it right.
1043 handler = Ffind_file_name_handler (file, Qload);
1044 if (!NILP (handler))
1045 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1047 /* Do this after the handler to avoid
1048 the need to gcpro noerror, nomessage and nosuffix.
1049 (Below here, we care only whether they are nil or not.)
1050 The presence of this call is the result of a historical accident:
1051 it used to be in every file-operation and when it got removed
1052 everywhere, it accidentally stayed here. Since then, enough people
1053 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1054 that it seemed risky to remove. */
1055 if (! NILP (noerror
))
1057 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1058 Qt
, load_error_handler
);
1063 file
= Fsubstitute_in_file_name (file
);
1066 /* Avoid weird lossage with null string as arg,
1067 since it would try to load a directory as a Lisp file */
1068 if (SCHARS (file
) > 0)
1070 int size
= SBYTES (file
);
1073 GCPRO2 (file
, found
);
1075 if (! NILP (must_suffix
))
1077 /* Don't insist on adding a suffix if FILE already ends with one. */
1079 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1082 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1084 /* Don't insist on adding a suffix
1085 if the argument includes a directory name. */
1086 else if (! NILP (Ffile_name_directory (file
)))
1090 fd
= openp (Vload_path
, file
,
1091 (!NILP (nosuffix
) ? Qnil
1092 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1093 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1094 tmp
[1] = Vload_file_rep_suffixes
,
1103 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1107 /* Tell startup.el whether or not we found the user's init file. */
1108 if (EQ (Qt
, Vuser_init_file
))
1109 Vuser_init_file
= found
;
1111 /* If FD is -2, that means openp found a magic file. */
1114 if (NILP (Fequal (found
, file
)))
1115 /* If FOUND is a different file name from FILE,
1116 find its handler even if we have already inhibited
1117 the `load' operation on FILE. */
1118 handler
= Ffind_file_name_handler (found
, Qt
);
1120 handler
= Ffind_file_name_handler (found
, Qload
);
1121 if (! NILP (handler
))
1122 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1125 /* Check if we're stuck in a recursive load cycle.
1127 2000-09-21: It's not possible to just check for the file loaded
1128 being a member of Vloads_in_progress. This fails because of the
1129 way the byte compiler currently works; `provide's are not
1130 evaluated, see font-lock.el/jit-lock.el as an example. This
1131 leads to a certain amount of ``normal'' recursion.
1133 Also, just loading a file recursively is not always an error in
1134 the general case; the second load may do something different. */
1138 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1139 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1143 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1145 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1146 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1149 /* All loads are by default dynamic, unless the file itself specifies
1150 otherwise using a file-variable in the first line. This is bound here
1151 so that it takes effect whether or not we use
1152 Vload_source_file_function. */
1153 specbind (Qlexical_binding
, Qnil
);
1155 /* Get the name for load-history. */
1156 hist_file_name
= (! NILP (Vpurify_flag
)
1157 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1158 tmp
[1] = Ffile_name_nondirectory (found
),
1164 /* Check for the presence of old-style quotes and warn about them. */
1165 specbind (Qold_style_backquotes
, Qnil
);
1166 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1168 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1169 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1170 /* Load .elc files directly, but not when they are
1171 remote and have no handler! */
1178 GCPRO3 (file
, found
, hist_file_name
);
1181 && ! (version
= safe_to_load_p (fd
)))
1184 if (!load_dangerous_libraries
)
1188 error ("File `%s' was not compiled in Emacs",
1191 else if (!NILP (nomessage
) && !force_load_messages
)
1192 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1197 efound
= ENCODE_FILE (found
);
1202 stat (SSDATA (efound
), &s1
);
1203 SSET (efound
, SBYTES (efound
) - 1, 0);
1204 result
= stat (SSDATA (efound
), &s2
);
1205 SSET (efound
, SBYTES (efound
) - 1, 'c');
1207 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1209 /* Make the progress messages mention that source is newer. */
1212 /* If we won't print another message, mention this anyway. */
1213 if (!NILP (nomessage
) && !force_load_messages
)
1215 Lisp_Object msg_file
;
1216 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1217 message_with_string ("Source file `%s' newer than byte-compiled file",
1226 /* We are loading a source file (*.el). */
1227 if (!NILP (Vload_source_file_function
))
1233 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1234 NILP (noerror
) ? Qnil
: Qt
,
1235 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1236 return unbind_to (count
, val
);
1240 GCPRO3 (file
, found
, hist_file_name
);
1244 efound
= ENCODE_FILE (found
);
1245 stream
= fopen (SSDATA (efound
), fmode
);
1246 #else /* not WINDOWSNT */
1247 stream
= fdopen (fd
, fmode
);
1248 #endif /* not WINDOWSNT */
1252 error ("Failure to create stdio stream for %s", SDATA (file
));
1255 if (! NILP (Vpurify_flag
))
1256 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1258 if (NILP (nomessage
) || force_load_messages
)
1261 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1264 message_with_string ("Loading %s (source)...", file
, 1);
1266 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1268 else /* The typical case; compiled file newer than source file. */
1269 message_with_string ("Loading %s...", file
, 1);
1272 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1273 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1274 specbind (Qload_file_name
, found
);
1275 specbind (Qinhibit_file_name_operation
, Qnil
);
1276 load_descriptor_list
1277 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1278 specbind (Qload_in_progress
, Qt
);
1281 if (lisp_file_lexically_bound_p (Qget_file_char
))
1282 Fset (Qlexical_binding
, Qt
);
1284 if (! version
|| version
>= 22)
1285 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1286 0, Qnil
, Qnil
, Qnil
, Qnil
);
1289 /* We can't handle a file which was compiled with
1290 byte-compile-dynamic by older version of Emacs. */
1291 specbind (Qload_force_doc_strings
, Qt
);
1292 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1293 0, Qnil
, Qnil
, Qnil
, Qnil
);
1295 unbind_to (count
, Qnil
);
1297 /* Run any eval-after-load forms for this file */
1298 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1299 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1303 xfree (saved_doc_string
);
1304 saved_doc_string
= 0;
1305 saved_doc_string_size
= 0;
1307 xfree (prev_saved_doc_string
);
1308 prev_saved_doc_string
= 0;
1309 prev_saved_doc_string_size
= 0;
1311 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1314 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1317 message_with_string ("Loading %s (source)...done", file
, 1);
1319 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1321 else /* The typical case; compiled file newer than source file. */
1322 message_with_string ("Loading %s...done", file
, 1);
1329 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1331 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1342 load_descriptor_unwind (Lisp_Object oldlist
)
1344 load_descriptor_list
= oldlist
;
1348 /* Close all descriptors in use for Floads.
1349 This is used when starting a subprocess. */
1352 close_load_descs (void)
1356 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1357 emacs_close (XFASTINT (XCAR (tail
)));
1362 complete_filename_p (Lisp_Object pathname
)
1364 register const unsigned char *s
= SDATA (pathname
);
1365 return (IS_DIRECTORY_SEP (s
[0])
1366 || (SCHARS (pathname
) > 2
1367 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1370 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1371 doc
: /* Search for FILENAME through PATH.
1372 Returns the file's name in absolute form, or nil if not found.
1373 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1374 file name when searching.
1375 If non-nil, PREDICATE is used instead of `file-readable-p'.
1376 PREDICATE can also be an integer to pass to the access(2) function,
1377 in which case file-name-handlers are ignored.
1378 This function will normally skip directories, so if you want it to find
1379 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1380 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1383 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1384 if (NILP (predicate
) && fd
> 0)
1389 static Lisp_Object Qdir_ok
;
1391 /* Search for a file whose name is STR, looking in directories
1392 in the Lisp list PATH, and trying suffixes from SUFFIX.
1393 On success, returns a file descriptor. On failure, returns -1.
1395 SUFFIXES is a list of strings containing possible suffixes.
1396 The empty suffix is automatically added if the list is empty.
1398 PREDICATE non-nil means don't open the files,
1399 just look for one that satisfies the predicate. In this case,
1400 returns 1 on success. The predicate can be a lisp function or
1401 an integer to pass to `access' (in which case file-name-handlers
1404 If STOREPTR is nonzero, it points to a slot where the name of
1405 the file actually found should be stored as a Lisp string.
1406 nil is stored there on failure.
1408 If the file we find is remote, return -2
1409 but store the found remote file name in *STOREPTR. */
1412 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1415 EMACS_INT fn_size
= 100;
1417 register char *fn
= buf
;
1419 EMACS_INT want_length
;
1420 Lisp_Object filename
;
1422 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1423 Lisp_Object string
, tail
, encoded_fn
;
1424 EMACS_INT max_suffix_len
= 0;
1428 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1430 CHECK_STRING_CAR (tail
);
1431 max_suffix_len
= max (max_suffix_len
,
1432 SBYTES (XCAR (tail
)));
1435 string
= filename
= encoded_fn
= Qnil
;
1436 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1441 if (complete_filename_p (str
))
1444 for (; CONSP (path
); path
= XCDR (path
))
1446 filename
= Fexpand_file_name (str
, XCAR (path
));
1447 if (!complete_filename_p (filename
))
1448 /* If there are non-absolute elts in PATH (eg ".") */
1449 /* Of course, this could conceivably lose if luser sets
1450 default-directory to be something non-absolute... */
1452 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1453 if (!complete_filename_p (filename
))
1454 /* Give up on this path element! */
1458 /* Calculate maximum length of any filename made from
1459 this path element/specified file name and any possible suffix. */
1460 want_length
= max_suffix_len
+ SBYTES (filename
);
1461 if (fn_size
<= want_length
)
1462 fn
= (char *) alloca (fn_size
= 100 + want_length
);
1464 /* Loop over suffixes. */
1465 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1466 CONSP (tail
); tail
= XCDR (tail
))
1468 int lsuffix
= SBYTES (XCAR (tail
));
1469 Lisp_Object handler
;
1472 /* Concatenate path element/specified name with the suffix.
1473 If the directory starts with /:, remove that. */
1474 if (SCHARS (filename
) > 2
1475 && SREF (filename
, 0) == '/'
1476 && SREF (filename
, 1) == ':')
1478 strncpy (fn
, SSDATA (filename
) + 2,
1479 SBYTES (filename
) - 2);
1480 fn
[SBYTES (filename
) - 2] = 0;
1484 strncpy (fn
, SSDATA (filename
),
1486 fn
[SBYTES (filename
)] = 0;
1489 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1490 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1492 /* Check that the file exists and is not a directory. */
1493 /* We used to only check for handlers on non-absolute file names:
1497 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1498 It's not clear why that was the case and it breaks things like
1499 (load "/bar.el") where the file is actually "/bar.el.gz". */
1500 string
= build_string (fn
);
1501 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1502 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1504 if (NILP (predicate
))
1505 exists
= !NILP (Ffile_readable_p (string
));
1508 Lisp_Object tmp
= call1 (predicate
, string
);
1509 exists
= !NILP (tmp
)
1510 && (EQ (tmp
, Qdir_ok
)
1511 || NILP (Ffile_directory_p (string
)));
1516 /* We succeeded; return this descriptor and filename. */
1527 encoded_fn
= ENCODE_FILE (string
);
1528 pfn
= SSDATA (encoded_fn
);
1529 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1532 /* Check that we can access or open it. */
1533 if (NATNUMP (predicate
))
1534 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1536 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1540 /* We succeeded; return this descriptor and filename. */
1558 /* Merge the list we've accumulated of globals from the current input source
1559 into the load_history variable. The details depend on whether
1560 the source has an associated file name or not.
1562 FILENAME is the file name that we are loading from.
1563 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1566 build_load_history (Lisp_Object filename
, int entire
)
1568 register Lisp_Object tail
, prev
, newelt
;
1569 register Lisp_Object tem
, tem2
;
1570 register int foundit
= 0;
1572 tail
= Vload_history
;
1575 while (CONSP (tail
))
1579 /* Find the feature's previous assoc list... */
1580 if (!NILP (Fequal (filename
, Fcar (tem
))))
1584 /* If we're loading the entire file, remove old data. */
1588 Vload_history
= XCDR (tail
);
1590 Fsetcdr (prev
, XCDR (tail
));
1593 /* Otherwise, cons on new symbols that are not already members. */
1596 tem2
= Vcurrent_load_list
;
1598 while (CONSP (tem2
))
1600 newelt
= XCAR (tem2
);
1602 if (NILP (Fmember (newelt
, tem
)))
1603 Fsetcar (tail
, Fcons (XCAR (tem
),
1604 Fcons (newelt
, XCDR (tem
))));
1617 /* If we're loading an entire file, cons the new assoc onto the
1618 front of load-history, the most-recently-loaded position. Also
1619 do this if we didn't find an existing member for the file. */
1620 if (entire
|| !foundit
)
1621 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1626 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1633 readevalloop_1 (Lisp_Object old
)
1635 load_convert_to_unibyte
= ! NILP (old
);
1639 /* Signal an `end-of-file' error, if possible with file name
1643 end_of_file_error (void)
1645 if (STRINGP (Vload_file_name
))
1646 xsignal1 (Qend_of_file
, Vload_file_name
);
1648 xsignal0 (Qend_of_file
);
1651 /* UNIBYTE specifies how to set load_convert_to_unibyte
1652 for this invocation.
1653 READFUN, if non-nil, is used instead of `read'.
1655 START, END specify region to read in current buffer (from eval-region).
1656 If the input is not from a buffer, they must be nil. */
1659 readevalloop (Lisp_Object readcharfun
,
1661 Lisp_Object sourcename
,
1663 Lisp_Object unibyte
, Lisp_Object readfun
,
1664 Lisp_Object start
, Lisp_Object end
)
1667 register Lisp_Object val
;
1668 int count
= SPECPDL_INDEX ();
1669 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1670 struct buffer
*b
= 0;
1671 int continue_reading_p
;
1672 Lisp_Object lex_bound
;
1673 /* Nonzero if reading an entire buffer. */
1674 int whole_buffer
= 0;
1675 /* 1 on the first time around. */
1678 if (MARKERP (readcharfun
))
1681 start
= readcharfun
;
1684 if (BUFFERP (readcharfun
))
1685 b
= XBUFFER (readcharfun
);
1686 else if (MARKERP (readcharfun
))
1687 b
= XMARKER (readcharfun
)->buffer
;
1689 /* We assume START is nil when input is not from a buffer. */
1690 if (! NILP (start
) && !b
)
1693 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1694 specbind (Qcurrent_load_list
, Qnil
);
1695 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1696 load_convert_to_unibyte
= !NILP (unibyte
);
1698 /* If lexical binding is active (either because it was specified in
1699 the file's header, or via a buffer-local variable), create an empty
1700 lexical environment, otherwise, turn off lexical binding. */
1701 lex_bound
= find_symbol_value (Qlexical_binding
);
1702 specbind (Qinternal_interpreter_environment
,
1703 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1704 ? Qnil
: Fcons (Qt
, Qnil
));
1706 GCPRO4 (sourcename
, readfun
, start
, end
);
1708 /* Try to ensure sourcename is a truename, except whilst preloading. */
1709 if (NILP (Vpurify_flag
)
1710 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1711 && !NILP (Ffboundp (Qfile_truename
)))
1712 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1714 LOADHIST_ATTACH (sourcename
);
1716 continue_reading_p
= 1;
1717 while (continue_reading_p
)
1719 int count1
= SPECPDL_INDEX ();
1721 if (b
!= 0 && NILP (BVAR (b
, name
)))
1722 error ("Reading from killed buffer");
1726 /* Switch to the buffer we are reading from. */
1727 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1728 set_buffer_internal (b
);
1730 /* Save point in it. */
1731 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1732 /* Save ZV in it. */
1733 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1734 /* Those get unbound after we read one expression. */
1736 /* Set point and ZV around stuff to be read. */
1739 Fnarrow_to_region (make_number (BEGV
), end
);
1741 /* Just for cleanliness, convert END to a marker
1742 if it is an integer. */
1744 end
= Fpoint_max_marker ();
1747 /* On the first cycle, we can easily test here
1748 whether we are reading the whole buffer. */
1749 if (b
&& first_sexp
)
1750 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1757 while ((c
= READCHAR
) != '\n' && c
!= -1);
1762 unbind_to (count1
, Qnil
);
1766 /* Ignore whitespace here, so we can detect eof. */
1767 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1768 || c
== 0x8a0) /* NBSP */
1771 if (!NILP (Vpurify_flag
) && c
== '(')
1773 record_unwind_protect (unreadpure
, Qnil
);
1774 val
= read_list (-1, readcharfun
);
1779 read_objects
= Qnil
;
1780 if (!NILP (readfun
))
1782 val
= call1 (readfun
, readcharfun
);
1784 /* If READCHARFUN has set point to ZV, we should
1785 stop reading, even if the form read sets point
1786 to a different value when evaluated. */
1787 if (BUFFERP (readcharfun
))
1789 struct buffer
*buf
= XBUFFER (readcharfun
);
1790 if (BUF_PT (buf
) == BUF_ZV (buf
))
1791 continue_reading_p
= 0;
1794 else if (! NILP (Vload_read_function
))
1795 val
= call1 (Vload_read_function
, readcharfun
);
1797 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1800 if (!NILP (start
) && continue_reading_p
)
1801 start
= Fpoint_marker ();
1803 /* Restore saved point and BEGV. */
1804 unbind_to (count1
, Qnil
);
1806 /* Now eval what we just read. */
1807 val
= eval_sub (val
);
1811 Vvalues
= Fcons (val
, Vvalues
);
1812 if (EQ (Vstandard_output
, Qt
))
1821 build_load_history (sourcename
,
1822 stream
|| whole_buffer
);
1826 unbind_to (count
, Qnil
);
1829 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1830 doc
: /* Execute the current buffer as Lisp code.
1831 When called from a Lisp program (i.e., not interactively), this
1832 function accepts up to five optional arguments:
1833 BUFFER is the buffer to evaluate (nil means use current buffer).
1834 PRINTFLAG controls printing of output:
1835 A value of nil means discard it; anything else is stream for print.
1836 FILENAME specifies the file name to use for `load-history'.
1837 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1839 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1840 functions should work normally even if PRINTFLAG is nil.
1842 This function preserves the position of point. */)
1843 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1845 int count
= SPECPDL_INDEX ();
1846 Lisp_Object tem
, buf
;
1849 buf
= Fcurrent_buffer ();
1851 buf
= Fget_buffer (buffer
);
1853 error ("No such buffer");
1855 if (NILP (printflag
) && NILP (do_allow_print
))
1860 if (NILP (filename
))
1861 filename
= BVAR (XBUFFER (buf
), filename
);
1863 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1864 specbind (Qstandard_output
, tem
);
1865 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1866 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1867 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1868 readevalloop (buf
, 0, filename
,
1869 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1870 unbind_to (count
, Qnil
);
1875 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1876 doc
: /* Execute the region as Lisp code.
1877 When called from programs, expects two arguments,
1878 giving starting and ending indices in the current buffer
1879 of the text to be executed.
1880 Programs can pass third argument PRINTFLAG which controls output:
1881 A value of nil means discard it; anything else is stream for printing it.
1882 Also the fourth argument READ-FUNCTION, if non-nil, is used
1883 instead of `read' to read each expression. It gets one argument
1884 which is the input stream for reading characters.
1886 This function does not move point. */)
1887 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1889 /* FIXME: Do the eval-sexp-add-defvars danse! */
1890 int count
= SPECPDL_INDEX ();
1891 Lisp_Object tem
, cbuf
;
1893 cbuf
= Fcurrent_buffer ();
1895 if (NILP (printflag
))
1899 specbind (Qstandard_output
, tem
);
1900 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1902 /* readevalloop calls functions which check the type of start and end. */
1903 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1904 !NILP (printflag
), Qnil
, read_function
,
1907 return unbind_to (count
, Qnil
);
1911 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1912 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1913 If STREAM is nil, use the value of `standard-input' (which see).
1914 STREAM or the value of `standard-input' may be:
1915 a buffer (read from point and advance it)
1916 a marker (read from where it points and advance it)
1917 a function (call it with no arguments for each character,
1918 call it with a char as argument to push a char back)
1919 a string (takes text from string, starting at the beginning)
1920 t (read text line using minibuffer and use it, or read from
1921 standard input in batch mode). */)
1922 (Lisp_Object stream
)
1925 stream
= Vstandard_input
;
1926 if (EQ (stream
, Qt
))
1927 stream
= Qread_char
;
1928 if (EQ (stream
, Qread_char
))
1929 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1931 return read_internal_start (stream
, Qnil
, Qnil
);
1934 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1935 doc
: /* Read one Lisp expression which is represented as text by STRING.
1936 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1937 START and END optionally delimit a substring of STRING from which to read;
1938 they default to 0 and (length STRING) respectively. */)
1939 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1942 CHECK_STRING (string
);
1943 /* read_internal_start sets read_from_string_index. */
1944 ret
= read_internal_start (string
, start
, end
);
1945 return Fcons (ret
, make_number (read_from_string_index
));
1948 /* Function to set up the global context we need in toplevel read
1951 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1952 /* start, end only used when stream is a string. */
1957 new_backquote_flag
= 0;
1958 read_objects
= Qnil
;
1959 if (EQ (Vread_with_symbol_positions
, Qt
)
1960 || EQ (Vread_with_symbol_positions
, stream
))
1961 Vread_symbol_positions_list
= Qnil
;
1963 if (STRINGP (stream
)
1964 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1966 EMACS_INT startval
, endval
;
1969 if (STRINGP (stream
))
1972 string
= XCAR (stream
);
1975 endval
= SCHARS (string
);
1979 endval
= XINT (end
);
1980 if (endval
< 0 || endval
> SCHARS (string
))
1981 args_out_of_range (string
, end
);
1988 CHECK_NUMBER (start
);
1989 startval
= XINT (start
);
1990 if (startval
< 0 || startval
> endval
)
1991 args_out_of_range (string
, start
);
1993 read_from_string_index
= startval
;
1994 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1995 read_from_string_limit
= endval
;
1998 retval
= read0 (stream
);
1999 if (EQ (Vread_with_symbol_positions
, Qt
)
2000 || EQ (Vread_with_symbol_positions
, stream
))
2001 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2006 /* Signal Qinvalid_read_syntax error.
2007 S is error string of length N (if > 0) */
2010 invalid_syntax (const char *s
, int n
)
2014 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
2018 /* Use this for recursive reads, in contexts where internal tokens
2022 read0 (Lisp_Object readcharfun
)
2024 register Lisp_Object val
;
2027 val
= read1 (readcharfun
, &c
, 0);
2031 xsignal1 (Qinvalid_read_syntax
,
2032 Fmake_string (make_number (1), make_number (c
)));
2035 static int read_buffer_size
;
2036 static char *read_buffer
;
2038 /* Read a \-escape sequence, assuming we already read the `\'.
2039 If the escape sequence forces unibyte, return eight-bit char. */
2042 read_escape (Lisp_Object readcharfun
, int stringp
)
2044 register int c
= READCHAR
;
2045 /* \u allows up to four hex digits, \U up to eight. Default to the
2046 behavior for \u, and change this value in the case that \U is seen. */
2047 int unicode_hex_count
= 4;
2052 end_of_file_error ();
2082 error ("Invalid escape character syntax");
2085 c
= read_escape (readcharfun
, 0);
2086 return c
| meta_modifier
;
2091 error ("Invalid escape character syntax");
2094 c
= read_escape (readcharfun
, 0);
2095 return c
| shift_modifier
;
2100 error ("Invalid escape character syntax");
2103 c
= read_escape (readcharfun
, 0);
2104 return c
| hyper_modifier
;
2109 error ("Invalid escape character syntax");
2112 c
= read_escape (readcharfun
, 0);
2113 return c
| alt_modifier
;
2117 if (stringp
|| c
!= '-')
2124 c
= read_escape (readcharfun
, 0);
2125 return c
| super_modifier
;
2130 error ("Invalid escape character syntax");
2134 c
= read_escape (readcharfun
, 0);
2135 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2136 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2137 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2138 return c
| ctrl_modifier
;
2139 /* ASCII control chars are made from letters (both cases),
2140 as well as the non-letters within 0100...0137. */
2141 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2142 return (c
& (037 | ~0177));
2143 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2144 return (c
& (037 | ~0177));
2146 return c
| ctrl_modifier
;
2156 /* An octal escape, as in ANSI C. */
2158 register int i
= c
- '0';
2159 register int count
= 0;
2162 if ((c
= READCHAR
) >= '0' && c
<= '7')
2174 if (i
>= 0x80 && i
< 0x100)
2175 i
= BYTE8_TO_CHAR (i
);
2180 /* A hex escape, as in ANSI C. */
2187 if (c
>= '0' && c
<= '9')
2192 else if ((c
>= 'a' && c
<= 'f')
2193 || (c
>= 'A' && c
<= 'F'))
2196 if (c
>= 'a' && c
<= 'f')
2209 if (count
< 3 && i
>= 0x80)
2210 return BYTE8_TO_CHAR (i
);
2215 /* Post-Unicode-2.0: Up to eight hex chars. */
2216 unicode_hex_count
= 8;
2219 /* A Unicode escape. We only permit them in strings and characters,
2220 not arbitrarily in the source code, as in some other languages. */
2225 while (++count
<= unicode_hex_count
)
2228 /* isdigit and isalpha may be locale-specific, which we don't
2230 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2231 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2232 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2235 error ("Non-hex digit used for Unicode escape");
2240 error ("Non-Unicode character: 0x%x", i
);
2249 /* Read an integer in radix RADIX using READCHARFUN to read
2250 characters. RADIX must be in the interval [2..36]; if it isn't, a
2251 read error is signaled . Value is the integer read. Signals an
2252 error if encountering invalid read syntax or if RADIX is out of
2256 read_integer (Lisp_Object readcharfun
, int radix
)
2258 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2259 /* We use a floating point number because */
2262 if (radix
< 2 || radix
> 36)
2266 number
= ndigits
= invalid_p
= 0;
2282 if (c
>= '0' && c
<= '9')
2284 else if (c
>= 'a' && c
<= 'z')
2285 digit
= c
- 'a' + 10;
2286 else if (c
>= 'A' && c
<= 'Z')
2287 digit
= c
- 'A' + 10;
2294 if (digit
< 0 || digit
>= radix
)
2297 number
= radix
* number
+ digit
;
2303 if (ndigits
== 0 || invalid_p
)
2306 sprintf (buf
, "integer, radix %d", radix
);
2307 invalid_syntax (buf
, 0);
2310 return make_fixnum_or_float (sign
* number
);
2314 /* If the next token is ')' or ']' or '.', we store that character
2315 in *PCH and the return value is not interesting. Else, we store
2316 zero in *PCH and we read and return one lisp object.
2318 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2321 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2324 unsigned uninterned_symbol
= 0;
2332 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2334 end_of_file_error ();
2339 return read_list (0, readcharfun
);
2342 return read_vector (readcharfun
, 0);
2358 /* Accept extended format for hashtables (extensible to
2360 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2361 Lisp_Object tmp
= read_list (0, readcharfun
);
2362 Lisp_Object head
= CAR_SAFE (tmp
);
2363 Lisp_Object data
= Qnil
;
2364 Lisp_Object val
= Qnil
;
2365 /* The size is 2 * number of allowed keywords to
2367 Lisp_Object params
[10];
2369 Lisp_Object key
= Qnil
;
2370 int param_count
= 0;
2372 if (!EQ (head
, Qhash_table
))
2373 error ("Invalid extended read marker at head of #s list "
2374 "(only hash-table allowed)");
2376 tmp
= CDR_SAFE (tmp
);
2378 /* This is repetitive but fast and simple. */
2379 params
[param_count
] = QCsize
;
2380 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2381 if (!NILP (params
[param_count
+ 1]))
2384 params
[param_count
] = QCtest
;
2385 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2386 if (!NILP (params
[param_count
+ 1]))
2389 params
[param_count
] = QCweakness
;
2390 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2391 if (!NILP (params
[param_count
+ 1]))
2394 params
[param_count
] = QCrehash_size
;
2395 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2396 if (!NILP (params
[param_count
+ 1]))
2399 params
[param_count
] = QCrehash_threshold
;
2400 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2401 if (!NILP (params
[param_count
+ 1]))
2404 /* This is the hashtable data. */
2405 data
= Fplist_get (tmp
, Qdata
);
2407 /* Now use params to make a new hashtable and fill it. */
2408 ht
= Fmake_hash_table (param_count
, params
);
2410 while (CONSP (data
))
2415 error ("Odd number of elements in hashtable data");
2418 Fputhash (key
, val
, ht
);
2424 invalid_syntax ("#", 1);
2432 tmp
= read_vector (readcharfun
, 0);
2433 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2434 error ("Invalid size char-table");
2435 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2446 tmp
= read_vector (readcharfun
, 0);
2447 if (!INTEGERP (AREF (tmp
, 0)))
2448 error ("Invalid depth in char-table");
2449 depth
= XINT (AREF (tmp
, 0));
2450 if (depth
< 1 || depth
> 3)
2451 error ("Invalid depth in char-table");
2452 size
= ASIZE (tmp
) - 2;
2453 if (chartab_size
[depth
] != size
)
2454 error ("Invalid size char-table");
2455 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2458 invalid_syntax ("#^^", 3);
2460 invalid_syntax ("#^", 2);
2465 length
= read1 (readcharfun
, pch
, first_in_list
);
2469 Lisp_Object tmp
, val
;
2471 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2472 / BOOL_VECTOR_BITS_PER_CHAR
);
2475 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2476 if (STRING_MULTIBYTE (tmp
)
2477 || (size_in_chars
!= SCHARS (tmp
)
2478 /* We used to print 1 char too many
2479 when the number of bits was a multiple of 8.
2480 Accept such input in case it came from an old
2482 && ! (XFASTINT (length
)
2483 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2484 invalid_syntax ("#&...", 5);
2486 val
= Fmake_bool_vector (length
, Qnil
);
2487 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2488 /* Clear the extraneous bits in the last byte. */
2489 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2490 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2491 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2494 invalid_syntax ("#&...", 5);
2498 /* Accept compiled functions at read-time so that we don't have to
2499 build them using function calls. */
2501 tmp
= read_vector (readcharfun
, 1);
2502 return Fmake_byte_code (ASIZE (tmp
),
2503 XVECTOR (tmp
)->contents
);
2508 struct gcpro gcpro1
;
2511 /* Read the string itself. */
2512 tmp
= read1 (readcharfun
, &ch
, 0);
2513 if (ch
!= 0 || !STRINGP (tmp
))
2514 invalid_syntax ("#", 1);
2516 /* Read the intervals and their properties. */
2519 Lisp_Object beg
, end
, plist
;
2521 beg
= read1 (readcharfun
, &ch
, 0);
2526 end
= read1 (readcharfun
, &ch
, 0);
2528 plist
= read1 (readcharfun
, &ch
, 0);
2530 invalid_syntax ("Invalid string property list", 0);
2531 Fset_text_properties (beg
, end
, plist
, tmp
);
2537 /* #@NUMBER is used to skip NUMBER following characters.
2538 That's used in .elc files to skip over doc strings
2539 and function definitions. */
2545 /* Read a decimal integer. */
2546 while ((c
= READCHAR
) >= 0
2547 && c
>= '0' && c
<= '9')
2555 if (load_force_doc_strings
2556 && (EQ (readcharfun
, Qget_file_char
)
2557 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2559 /* If we are supposed to force doc strings into core right now,
2560 record the last string that we skipped,
2561 and record where in the file it comes from. */
2563 /* But first exchange saved_doc_string
2564 with prev_saved_doc_string, so we save two strings. */
2566 char *temp
= saved_doc_string
;
2567 int temp_size
= saved_doc_string_size
;
2568 file_offset temp_pos
= saved_doc_string_position
;
2569 int temp_len
= saved_doc_string_length
;
2571 saved_doc_string
= prev_saved_doc_string
;
2572 saved_doc_string_size
= prev_saved_doc_string_size
;
2573 saved_doc_string_position
= prev_saved_doc_string_position
;
2574 saved_doc_string_length
= prev_saved_doc_string_length
;
2576 prev_saved_doc_string
= temp
;
2577 prev_saved_doc_string_size
= temp_size
;
2578 prev_saved_doc_string_position
= temp_pos
;
2579 prev_saved_doc_string_length
= temp_len
;
2582 if (saved_doc_string_size
== 0)
2584 saved_doc_string_size
= nskip
+ 100;
2585 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2587 if (nskip
> saved_doc_string_size
)
2589 saved_doc_string_size
= nskip
+ 100;
2590 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2591 saved_doc_string_size
);
2594 saved_doc_string_position
= file_tell (instream
);
2596 /* Copy that many characters into saved_doc_string. */
2597 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2598 saved_doc_string
[i
] = c
= READCHAR
;
2600 saved_doc_string_length
= i
;
2604 /* Skip that many characters. */
2605 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2614 /* #! appears at the beginning of an executable file.
2615 Skip the first line. */
2616 while (c
!= '\n' && c
>= 0)
2621 return Vload_file_name
;
2623 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2624 /* #:foo is the uninterned symbol named foo. */
2627 uninterned_symbol
= 1;
2631 /* Reader forms that can reuse previously read objects. */
2632 if (c
>= '0' && c
<= '9')
2637 /* Read a non-negative integer. */
2638 while (c
>= '0' && c
<= '9')
2644 /* #n=object returns object, but associates it with n for #n#. */
2645 if (c
== '=' && !NILP (Vread_circle
))
2647 /* Make a placeholder for #n# to use temporarily */
2648 Lisp_Object placeholder
;
2651 placeholder
= Fcons (Qnil
, Qnil
);
2652 cell
= Fcons (make_number (n
), placeholder
);
2653 read_objects
= Fcons (cell
, read_objects
);
2655 /* Read the object itself. */
2656 tem
= read0 (readcharfun
);
2658 /* Now put it everywhere the placeholder was... */
2659 substitute_object_in_subtree (tem
, placeholder
);
2661 /* ...and #n# will use the real value from now on. */
2662 Fsetcdr (cell
, tem
);
2666 /* #n# returns a previously read object. */
2667 if (c
== '#' && !NILP (Vread_circle
))
2669 tem
= Fassq (make_number (n
), read_objects
);
2672 /* Fall through to error message. */
2674 else if (c
== 'r' || c
== 'R')
2675 return read_integer (readcharfun
, n
);
2677 /* Fall through to error message. */
2679 else if (c
== 'x' || c
== 'X')
2680 return read_integer (readcharfun
, 16);
2681 else if (c
== 'o' || c
== 'O')
2682 return read_integer (readcharfun
, 8);
2683 else if (c
== 'b' || c
== 'B')
2684 return read_integer (readcharfun
, 2);
2687 invalid_syntax ("#", 1);
2690 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2695 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2700 int next_char
= READCHAR
;
2702 /* Transition from old-style to new-style:
2703 If we see "(`" it used to mean old-style, which usually works
2704 fine because ` should almost never appear in such a position
2705 for new-style. But occasionally we need "(`" to mean new
2706 style, so we try to distinguish the two by the fact that we
2707 can either write "( `foo" or "(` foo", where the first
2708 intends to use new-style whereas the second intends to use
2709 old-style. For Emacs-25, we should completely remove this
2710 first_in_list exception (old-style can still be obtained via
2712 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2714 Vold_style_backquotes
= Qt
;
2721 new_backquote_flag
++;
2722 value
= read0 (readcharfun
);
2723 new_backquote_flag
--;
2725 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2730 int next_char
= READCHAR
;
2732 /* Transition from old-style to new-style:
2733 It used to be impossible to have a new-style , other than within
2734 a new-style `. This is sufficient when ` and , are used in the
2735 normal way, but ` and , can also appear in args to macros that
2736 will not interpret them in the usual way, in which case , may be
2737 used without any ` anywhere near.
2738 So we now use the same heuristic as for backquote: old-style
2739 unquotes are only recognized when first on a list, and when
2740 followed by a space.
2741 Because it's more difficult to peak 2 chars ahead, a new-style
2742 ,@ can still not be used outside of a `, unless it's in the middle
2744 if (new_backquote_flag
2746 || (next_char
!= ' ' && next_char
!= '@'))
2748 Lisp_Object comma_type
= Qnil
;
2753 comma_type
= Qcomma_at
;
2755 comma_type
= Qcomma_dot
;
2758 if (ch
>= 0) UNREAD (ch
);
2759 comma_type
= Qcomma
;
2762 value
= read0 (readcharfun
);
2763 return Fcons (comma_type
, Fcons (value
, Qnil
));
2767 Vold_style_backquotes
= Qt
;
2779 end_of_file_error ();
2781 /* Accept `single space' syntax like (list ? x) where the
2782 whitespace character is SPC or TAB.
2783 Other literal whitespace like NL, CR, and FF are not accepted,
2784 as there are well-established escape sequences for these. */
2785 if (c
== ' ' || c
== '\t')
2786 return make_number (c
);
2789 c
= read_escape (readcharfun
, 0);
2790 modifiers
= c
& CHAR_MODIFIER_MASK
;
2791 c
&= ~CHAR_MODIFIER_MASK
;
2792 if (CHAR_BYTE8_P (c
))
2793 c
= CHAR_TO_BYTE8 (c
);
2796 next_char
= READCHAR
;
2797 ok
= (next_char
<= 040
2798 || (next_char
< 0200
2799 && (strchr ("\"';()[]#?`,.", next_char
))));
2802 return make_number (c
);
2804 invalid_syntax ("?", 1);
2809 char *p
= read_buffer
;
2810 char *end
= read_buffer
+ read_buffer_size
;
2812 /* Nonzero if we saw an escape sequence specifying
2813 a multibyte character. */
2814 int force_multibyte
= 0;
2815 /* Nonzero if we saw an escape sequence specifying
2816 a single-byte character. */
2817 int force_singlebyte
= 0;
2821 while ((ch
= READCHAR
) >= 0
2824 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2826 int offset
= p
- read_buffer
;
2827 read_buffer
= (char *) xrealloc (read_buffer
,
2828 read_buffer_size
*= 2);
2829 p
= read_buffer
+ offset
;
2830 end
= read_buffer
+ read_buffer_size
;
2837 ch
= read_escape (readcharfun
, 1);
2839 /* CH is -1 if \ newline has just been seen */
2842 if (p
== read_buffer
)
2847 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2848 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2850 if (CHAR_BYTE8_P (ch
))
2851 force_singlebyte
= 1;
2852 else if (! ASCII_CHAR_P (ch
))
2853 force_multibyte
= 1;
2854 else /* i.e. ASCII_CHAR_P (ch) */
2856 /* Allow `\C- ' and `\C-?'. */
2857 if (modifiers
== CHAR_CTL
)
2860 ch
= 0, modifiers
= 0;
2862 ch
= 127, modifiers
= 0;
2864 if (modifiers
& CHAR_SHIFT
)
2866 /* Shift modifier is valid only with [A-Za-z]. */
2867 if (ch
>= 'A' && ch
<= 'Z')
2868 modifiers
&= ~CHAR_SHIFT
;
2869 else if (ch
>= 'a' && ch
<= 'z')
2870 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2873 if (modifiers
& CHAR_META
)
2875 /* Move the meta bit to the right place for a
2877 modifiers
&= ~CHAR_META
;
2878 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2879 force_singlebyte
= 1;
2883 /* Any modifiers remaining are invalid. */
2885 error ("Invalid modifier in string");
2886 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2890 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2891 if (CHAR_BYTE8_P (ch
))
2892 force_singlebyte
= 1;
2893 else if (! ASCII_CHAR_P (ch
))
2894 force_multibyte
= 1;
2900 end_of_file_error ();
2902 /* If purifying, and string starts with \ newline,
2903 return zero instead. This is for doc strings
2904 that we are really going to find in etc/DOC.nn.nn */
2905 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2906 return make_number (0);
2908 if (force_multibyte
)
2909 /* READ_BUFFER already contains valid multibyte forms. */
2911 else if (force_singlebyte
)
2913 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
2915 p
= read_buffer
+ nchars
;
2919 /* Otherwise, READ_BUFFER contains only ASCII. */
2922 /* We want readchar_count to be the number of characters, not
2923 bytes. Hence we adjust for multibyte characters in the
2924 string. ... But it doesn't seem to be necessary, because
2925 READCHAR *does* read multibyte characters from buffers. */
2926 /* readchar_count -= (p - read_buffer) - nchars; */
2928 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2930 || (p
- read_buffer
!= nchars
)));
2931 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2933 || (p
- read_buffer
!= nchars
)));
2938 int next_char
= READCHAR
;
2941 if (next_char
<= 040
2942 || (next_char
< 0200
2943 && (strchr ("\"';([#?`,", next_char
))))
2949 /* Otherwise, we fall through! Note that the atom-reading loop
2950 below will now loop at least once, assuring that we will not
2951 try to UNREAD two characters in a row. */
2955 if (c
<= 040) goto retry
;
2956 if (c
== 0x8a0) /* NBSP */
2959 char *p
= read_buffer
;
2963 char *end
= read_buffer
+ read_buffer_size
;
2967 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2969 int offset
= p
- read_buffer
;
2970 read_buffer
= (char *) xrealloc (read_buffer
,
2971 read_buffer_size
*= 2);
2972 p
= read_buffer
+ offset
;
2973 end
= read_buffer
+ read_buffer_size
;
2980 end_of_file_error ();
2985 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2990 && c
!= 0x8a0 /* NBSP */
2992 || !(strchr ("\"';()[]#`,", c
))));
2996 int offset
= p
- read_buffer
;
2997 read_buffer
= (char *) xrealloc (read_buffer
,
2998 read_buffer_size
*= 2);
2999 p
= read_buffer
+ offset
;
3000 end
= read_buffer
+ read_buffer_size
;
3007 if (!quoted
&& !uninterned_symbol
)
3009 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3010 if (! NILP (result
))
3014 Lisp_Object name
, result
;
3015 EMACS_INT nbytes
= p
- read_buffer
;
3018 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3022 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3023 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3025 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3026 result
= (uninterned_symbol
? Fmake_symbol (name
)
3027 : Fintern (name
, Qnil
));
3029 if (EQ (Vread_with_symbol_positions
, Qt
)
3030 || EQ (Vread_with_symbol_positions
, readcharfun
))
3031 Vread_symbol_positions_list
=
3032 /* Kind of a hack; this will probably fail if characters
3033 in the symbol name were escaped. Not really a big
3035 Fcons (Fcons (result
,
3036 make_number (readchar_count
3037 - XFASTINT (Flength (Fsymbol_name (result
))))),
3038 Vread_symbol_positions_list
);
3046 /* List of nodes we've seen during substitute_object_in_subtree. */
3047 static Lisp_Object seen_list
;
3050 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3052 Lisp_Object check_object
;
3054 /* We haven't seen any objects when we start. */
3057 /* Make all the substitutions. */
3059 = substitute_object_recurse (object
, placeholder
, object
);
3061 /* Clear seen_list because we're done with it. */
3064 /* The returned object here is expected to always eq the
3066 if (!EQ (check_object
, object
))
3067 error ("Unexpected mutation error in reader");
3070 /* Feval doesn't get called from here, so no gc protection is needed. */
3071 #define SUBSTITUTE(get_val, set_val) \
3073 Lisp_Object old_value = get_val; \
3074 Lisp_Object true_value \
3075 = substitute_object_recurse (object, placeholder, \
3078 if (!EQ (old_value, true_value)) \
3085 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3087 /* If we find the placeholder, return the target object. */
3088 if (EQ (placeholder
, subtree
))
3091 /* If we've been to this node before, don't explore it again. */
3092 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3095 /* If this node can be the entry point to a cycle, remember that
3096 we've seen it. It can only be such an entry point if it was made
3097 by #n=, which means that we can find it as a value in
3099 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3100 seen_list
= Fcons (subtree
, seen_list
);
3102 /* Recurse according to subtree's type.
3103 Every branch must return a Lisp_Object. */
3104 switch (XTYPE (subtree
))
3106 case Lisp_Vectorlike
:
3109 if (BOOL_VECTOR_P (subtree
))
3110 return subtree
; /* No sub-objects anyway. */
3111 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3112 || COMPILEDP (subtree
))
3113 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3114 else if (VECTORP (subtree
))
3115 length
= ASIZE (subtree
);
3117 /* An unknown pseudovector may contain non-Lisp fields, so we
3118 can't just blindly traverse all its fields. We used to call
3119 `Flength' which signaled `sequencep', so I just preserved this
3121 wrong_type_argument (Qsequencep
, subtree
);
3123 for (i
= 0; i
< length
; i
++)
3124 SUBSTITUTE (AREF (subtree
, i
),
3125 ASET (subtree
, i
, true_value
));
3131 SUBSTITUTE (XCAR (subtree
),
3132 XSETCAR (subtree
, true_value
));
3133 SUBSTITUTE (XCDR (subtree
),
3134 XSETCDR (subtree
, true_value
));
3140 /* Check for text properties in each interval.
3141 substitute_in_interval contains part of the logic. */
3143 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3144 Lisp_Object arg
= Fcons (object
, placeholder
);
3146 traverse_intervals_noorder (root_interval
,
3147 &substitute_in_interval
, arg
);
3152 /* Other types don't recurse any further. */
3158 /* Helper function for substitute_object_recurse. */
3160 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3162 Lisp_Object object
= Fcar (arg
);
3163 Lisp_Object placeholder
= Fcdr (arg
);
3165 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3170 digit_to_number (int character
, int base
)
3174 if ('0' <= character
&& character
<= '9')
3175 digit
= character
- '0';
3176 else if ('a' <= character
&& character
<= 'z')
3177 digit
= character
- 'a' + 10;
3178 else if ('A' <= character
&& character
<= 'Z')
3179 digit
= character
- 'A' + 10;
3183 return digit
< base
? digit
: -1;
3192 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3193 integer syntax and fits in a fixnum, else return the nearest float if CP has
3194 either floating point or integer syntax and BASE is 10, else return nil. If
3195 IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
3196 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3197 number has integer syntax but does not fit. */
3200 string_to_number (char const *string
, int base
, int ignore_trailing
)
3203 char const *cp
= string
;
3205 int float_syntax
= 0;
3208 /* Compute NaN and infinities using a variable, to cope with compilers that
3209 think they are smarter than we are. */
3212 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3213 IEEE floating point hosts, and works around a formerly-common bug where
3214 atof ("-0.0") drops the sign. */
3215 int negative
= *cp
== '-';
3217 int signedp
= negative
|| *cp
== '+';
3222 leading_digit
= digit_to_number (*cp
, base
);
3223 if (0 <= leading_digit
)
3228 while (0 <= digit_to_number (*cp
, base
));
3238 if ('0' <= *cp
&& *cp
<= '9')
3243 while ('0' <= *cp
&& *cp
<= '9');
3245 if (*cp
== 'e' || *cp
== 'E')
3247 char const *ecp
= cp
;
3249 if (*cp
== '+' || *cp
== '-')
3251 if ('0' <= *cp
&& *cp
<= '9')
3256 while ('0' <= *cp
&& *cp
<= '9');
3258 else if (cp
[-1] == '+'
3259 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3265 else if (cp
[-1] == '+'
3266 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3270 value
= zero
/ zero
;
3272 /* If that made a "negative" NaN, negate it. */
3275 union { double d
; char c
[sizeof (double)]; }
3276 u_data
, u_minus_zero
;
3278 u_minus_zero
.d
= -0.0;
3279 for (i
= 0; i
< sizeof (double); i
++)
3280 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3286 /* Now VALUE is a positive NaN. */
3292 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3293 || state
== (LEAD_INT
|E_EXP
));
3296 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3297 any prefix that matches. Otherwise, the entire string must match. */
3298 if (! (ignore_trailing
3299 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3300 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3303 /* If the number uses integer and not float syntax, and is in C-language
3304 range, use its value, preferably as a fixnum. */
3305 if (0 <= leading_digit
&& ! float_syntax
)
3309 /* Fast special case for single-digit integers. This also avoids a
3310 glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
3311 case some versions of strtoumax accept numbers like "0x1" that Emacs
3313 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3314 return make_number (negative
? -leading_digit
: leading_digit
);
3317 n
= strtoumax (string
+ signedp
, NULL
, base
);
3318 if (errno
== ERANGE
)
3320 /* Unfortunately there's no simple and accurate way to convert
3321 non-base-10 numbers that are out of C-language range. */
3323 xsignal (Qoverflow_error
, list1 (build_string (string
)));
3325 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3327 EMACS_INT signed_n
= n
;
3328 return make_number (negative
? -signed_n
: signed_n
);
3334 /* Either the number uses float syntax, or it does not fit into a fixnum.
3335 Convert it from string to floating point, unless the value is already
3336 known because it is an infinity, a NAN, or its absolute value fits in
3339 value
= atof (string
+ signedp
);
3341 return make_float (negative
? -value
: value
);
3346 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3350 register Lisp_Object
*ptr
;
3351 register Lisp_Object tem
, item
, vector
;
3352 register struct Lisp_Cons
*otem
;
3355 tem
= read_list (1, readcharfun
);
3356 len
= Flength (tem
);
3357 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3359 size
= ASIZE (vector
);
3360 ptr
= XVECTOR (vector
)->contents
;
3361 for (i
= 0; i
< size
; i
++)
3364 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3365 bytecode object, the docstring containing the bytecode and
3366 constants values must be treated as unibyte and passed to
3367 Fread, to get the actual bytecode string and constants vector. */
3368 if (bytecodeflag
&& load_force_doc_strings
)
3370 if (i
== COMPILED_BYTECODE
)
3372 if (!STRINGP (item
))
3373 error ("Invalid byte code");
3375 /* Delay handling the bytecode slot until we know whether
3376 it is lazily-loaded (we can tell by whether the
3377 constants slot is nil). */
3378 ptr
[COMPILED_CONSTANTS
] = item
;
3381 else if (i
== COMPILED_CONSTANTS
)
3383 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3387 /* Coerce string to unibyte (like string-as-unibyte,
3388 but without generating extra garbage and
3389 guaranteeing no change in the contents). */
3390 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3391 STRING_SET_UNIBYTE (bytestr
);
3393 item
= Fread (Fcons (bytestr
, readcharfun
));
3395 error ("Invalid byte code");
3397 otem
= XCONS (item
);
3398 bytestr
= XCAR (item
);
3403 /* Now handle the bytecode slot. */
3404 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3406 else if (i
== COMPILED_DOC_STRING
3408 && ! STRING_MULTIBYTE (item
))
3410 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3411 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3413 item
= Fstring_as_multibyte (item
);
3416 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3424 /* FLAG = 1 means check for ] to terminate rather than ) and .
3425 FLAG = -1 means check for starting with defun
3426 and make structure pure. */
3429 read_list (int flag
, register Lisp_Object readcharfun
)
3431 /* -1 means check next element for defun,
3432 0 means don't check,
3433 1 means already checked and found defun. */
3434 int defunflag
= flag
< 0 ? -1 : 0;
3435 Lisp_Object val
, tail
;
3436 register Lisp_Object elt
, tem
;
3437 struct gcpro gcpro1
, gcpro2
;
3438 /* 0 is the normal case.
3439 1 means this list is a doc reference; replace it with the number 0.
3440 2 means this list is a doc reference; replace it with the doc string. */
3441 int doc_reference
= 0;
3443 /* Initialize this to 1 if we are reading a list. */
3444 int first_in_list
= flag
<= 0;
3453 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3458 /* While building, if the list starts with #$, treat it specially. */
3459 if (EQ (elt
, Vload_file_name
)
3461 && !NILP (Vpurify_flag
))
3463 if (NILP (Vdoc_file_name
))
3464 /* We have not yet called Snarf-documentation, so assume
3465 this file is described in the DOC-MM.NN file
3466 and Snarf-documentation will fill in the right value later.
3467 For now, replace the whole list with 0. */
3470 /* We have already called Snarf-documentation, so make a relative
3471 file name for this file, so it can be found properly
3472 in the installed Lisp directory.
3473 We don't use Fexpand_file_name because that would make
3474 the directory absolute now. */
3475 elt
= concat2 (build_string ("../lisp/"),
3476 Ffile_name_nondirectory (elt
));
3478 else if (EQ (elt
, Vload_file_name
)
3480 && load_force_doc_strings
)
3489 invalid_syntax (") or . in a vector", 18);
3497 XSETCDR (tail
, read0 (readcharfun
));
3499 val
= read0 (readcharfun
);
3500 read1 (readcharfun
, &ch
, 0);
3504 if (doc_reference
== 1)
3505 return make_number (0);
3506 if (doc_reference
== 2)
3508 /* Get a doc string from the file we are loading.
3509 If it's in saved_doc_string, get it from there.
3511 Here, we don't know if the string is a
3512 bytecode string or a doc string. As a
3513 bytecode string must be unibyte, we always
3514 return a unibyte string. If it is actually a
3515 doc string, caller must make it
3518 int pos
= XINT (XCDR (val
));
3519 /* Position is negative for user variables. */
3520 if (pos
< 0) pos
= -pos
;
3521 if (pos
>= saved_doc_string_position
3522 && pos
< (saved_doc_string_position
3523 + saved_doc_string_length
))
3525 int start
= pos
- saved_doc_string_position
;
3528 /* Process quoting with ^A,
3529 and find the end of the string,
3530 which is marked with ^_ (037). */
3531 for (from
= start
, to
= start
;
3532 saved_doc_string
[from
] != 037;)
3534 int c
= saved_doc_string
[from
++];
3537 c
= saved_doc_string
[from
++];
3539 saved_doc_string
[to
++] = c
;
3541 saved_doc_string
[to
++] = 0;
3543 saved_doc_string
[to
++] = 037;
3546 saved_doc_string
[to
++] = c
;
3549 return make_unibyte_string (saved_doc_string
+ start
,
3552 /* Look in prev_saved_doc_string the same way. */
3553 else if (pos
>= prev_saved_doc_string_position
3554 && pos
< (prev_saved_doc_string_position
3555 + prev_saved_doc_string_length
))
3557 int start
= pos
- prev_saved_doc_string_position
;
3560 /* Process quoting with ^A,
3561 and find the end of the string,
3562 which is marked with ^_ (037). */
3563 for (from
= start
, to
= start
;
3564 prev_saved_doc_string
[from
] != 037;)
3566 int c
= prev_saved_doc_string
[from
++];
3569 c
= prev_saved_doc_string
[from
++];
3571 prev_saved_doc_string
[to
++] = c
;
3573 prev_saved_doc_string
[to
++] = 0;
3575 prev_saved_doc_string
[to
++] = 037;
3578 prev_saved_doc_string
[to
++] = c
;
3581 return make_unibyte_string (prev_saved_doc_string
3586 return get_doc_string (val
, 1, 0);
3591 invalid_syntax (". in wrong context", 18);
3593 invalid_syntax ("] in a list", 11);
3595 tem
= (read_pure
&& flag
<= 0
3596 ? pure_cons (elt
, Qnil
)
3597 : Fcons (elt
, Qnil
));
3599 XSETCDR (tail
, tem
);
3604 defunflag
= EQ (elt
, Qdefun
);
3605 else if (defunflag
> 0)
3610 static Lisp_Object initial_obarray
;
3612 /* oblookup stores the bucket number here, for the sake of Funintern. */
3614 static int oblookup_last_bucket_number
;
3616 static int hash_string (const char *ptr
, int len
);
3618 /* Get an error if OBARRAY is not an obarray.
3619 If it is one, return it. */
3622 check_obarray (Lisp_Object obarray
)
3624 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3626 /* If Vobarray is now invalid, force it to be valid. */
3627 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3628 wrong_type_argument (Qvectorp
, obarray
);
3633 /* Intern the C string STR: return a symbol with that name,
3634 interned in the current obarray. */
3637 intern (const char *str
)
3640 int len
= strlen (str
);
3641 Lisp_Object obarray
;
3644 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3645 obarray
= check_obarray (obarray
);
3646 tem
= oblookup (obarray
, str
, len
, len
);
3649 return Fintern (make_string (str
, len
), obarray
);
3653 intern_c_string (const char *str
)
3656 int len
= strlen (str
);
3657 Lisp_Object obarray
;
3660 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3661 obarray
= check_obarray (obarray
);
3662 tem
= oblookup (obarray
, str
, len
, len
);
3666 if (NILP (Vpurify_flag
))
3667 /* Creating a non-pure string from a string literal not
3668 implemented yet. We could just use make_string here and live
3669 with the extra copy. */
3672 return Fintern (make_pure_c_string (str
), obarray
);
3675 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3676 doc
: /* Return the canonical symbol whose name is STRING.
3677 If there is none, one is created by this function and returned.
3678 A second optional argument specifies the obarray to use;
3679 it defaults to the value of `obarray'. */)
3680 (Lisp_Object string
, Lisp_Object obarray
)
3682 register Lisp_Object tem
, sym
, *ptr
;
3684 if (NILP (obarray
)) obarray
= Vobarray
;
3685 obarray
= check_obarray (obarray
);
3687 CHECK_STRING (string
);
3689 tem
= oblookup (obarray
, SSDATA (string
),
3692 if (!INTEGERP (tem
))
3695 if (!NILP (Vpurify_flag
))
3696 string
= Fpurecopy (string
);
3697 sym
= Fmake_symbol (string
);
3699 if (EQ (obarray
, initial_obarray
))
3700 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3702 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3704 if ((SREF (string
, 0) == ':')
3705 && EQ (obarray
, initial_obarray
))
3707 XSYMBOL (sym
)->constant
= 1;
3708 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3709 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3712 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3714 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3716 XSYMBOL (sym
)->next
= 0;
3721 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3722 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3723 NAME may be a string or a symbol. If it is a symbol, that exact
3724 symbol is searched for.
3725 A second optional argument specifies the obarray to use;
3726 it defaults to the value of `obarray'. */)
3727 (Lisp_Object name
, Lisp_Object obarray
)
3729 register Lisp_Object tem
, string
;
3731 if (NILP (obarray
)) obarray
= Vobarray
;
3732 obarray
= check_obarray (obarray
);
3734 if (!SYMBOLP (name
))
3736 CHECK_STRING (name
);
3740 string
= SYMBOL_NAME (name
);
3742 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3743 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3749 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3750 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3751 The value is t if a symbol was found and deleted, nil otherwise.
3752 NAME may be a string or a symbol. If it is a symbol, that symbol
3753 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3754 OBARRAY defaults to the value of the variable `obarray'. */)
3755 (Lisp_Object name
, Lisp_Object obarray
)
3757 register Lisp_Object string
, tem
;
3760 if (NILP (obarray
)) obarray
= Vobarray
;
3761 obarray
= check_obarray (obarray
);
3764 string
= SYMBOL_NAME (name
);
3767 CHECK_STRING (name
);
3771 tem
= oblookup (obarray
, SSDATA (string
),
3776 /* If arg was a symbol, don't delete anything but that symbol itself. */
3777 if (SYMBOLP (name
) && !EQ (name
, tem
))
3780 /* There are plenty of other symbols which will screw up the Emacs
3781 session if we unintern them, as well as even more ways to use
3782 `setq' or `fset' or whatnot to make the Emacs session
3783 unusable. Let's not go down this silly road. --Stef */
3784 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3785 error ("Attempt to unintern t or nil"); */
3787 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3789 hash
= oblookup_last_bucket_number
;
3791 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3793 if (XSYMBOL (tem
)->next
)
3794 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3796 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3800 Lisp_Object tail
, following
;
3802 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3803 XSYMBOL (tail
)->next
;
3806 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3807 if (EQ (following
, tem
))
3809 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3818 /* Return the symbol in OBARRAY whose names matches the string
3819 of SIZE characters (SIZE_BYTE bytes) at PTR.
3820 If there is no such symbol in OBARRAY, return nil.
3822 Also store the bucket number in oblookup_last_bucket_number. */
3825 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3829 register Lisp_Object tail
;
3830 Lisp_Object bucket
, tem
;
3832 if (!VECTORP (obarray
)
3833 || (obsize
= ASIZE (obarray
)) == 0)
3835 obarray
= check_obarray (obarray
);
3836 obsize
= ASIZE (obarray
);
3838 /* This is sometimes needed in the middle of GC. */
3839 obsize
&= ~ARRAY_MARK_FLAG
;
3840 hash
= hash_string (ptr
, size_byte
) % obsize
;
3841 bucket
= XVECTOR (obarray
)->contents
[hash
];
3842 oblookup_last_bucket_number
= hash
;
3843 if (EQ (bucket
, make_number (0)))
3845 else if (!SYMBOLP (bucket
))
3846 error ("Bad data in guts of obarray"); /* Like CADR error message */
3848 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3850 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3851 && SCHARS (SYMBOL_NAME (tail
)) == size
3852 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3854 else if (XSYMBOL (tail
)->next
== 0)
3857 XSETINT (tem
, hash
);
3862 hash_string (const char *ptr
, int len
)
3864 register const char *p
= ptr
;
3865 register const char *end
= p
+ len
;
3866 register unsigned char c
;
3867 register int hash
= 0;
3872 if (c
>= 0140) c
-= 40;
3873 hash
= ((hash
<<3) + (hash
>>28) + c
);
3875 return hash
& 07777777777;
3879 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3882 register Lisp_Object tail
;
3883 CHECK_VECTOR (obarray
);
3884 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3886 tail
= XVECTOR (obarray
)->contents
[i
];
3891 if (XSYMBOL (tail
)->next
== 0)
3893 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3899 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3901 call1 (function
, sym
);
3904 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3905 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3906 OBARRAY defaults to the value of `obarray'. */)
3907 (Lisp_Object function
, Lisp_Object obarray
)
3909 if (NILP (obarray
)) obarray
= Vobarray
;
3910 obarray
= check_obarray (obarray
);
3912 map_obarray (obarray
, mapatoms_1
, function
);
3916 #define OBARRAY_SIZE 1511
3921 Lisp_Object oblength
;
3923 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3925 Vobarray
= Fmake_vector (oblength
, make_number (0));
3926 initial_obarray
= Vobarray
;
3927 staticpro (&initial_obarray
);
3929 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3930 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3931 NILP (Vpurify_flag) check in intern_c_string. */
3932 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3933 Qnil
= intern_c_string ("nil");
3935 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3936 so those two need to be fixed manally. */
3937 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3938 XSYMBOL (Qunbound
)->function
= Qunbound
;
3939 XSYMBOL (Qunbound
)->plist
= Qnil
;
3940 /* XSYMBOL (Qnil)->function = Qunbound; */
3941 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3942 XSYMBOL (Qnil
)->constant
= 1;
3943 XSYMBOL (Qnil
)->plist
= Qnil
;
3945 Qt
= intern_c_string ("t");
3946 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3947 XSYMBOL (Qt
)->constant
= 1;
3949 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3952 Qvariable_documentation
= intern_c_string ("variable-documentation");
3953 staticpro (&Qvariable_documentation
);
3955 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3956 read_buffer
= (char *) xmalloc (read_buffer_size
);
3960 defsubr (struct Lisp_Subr
*sname
)
3963 sym
= intern_c_string (sname
->symbol_name
);
3964 XSETTYPED_PVECTYPE (sname
, size
, PVEC_SUBR
);
3965 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3968 #ifdef NOTDEF /* use fset in subr.el now */
3970 defalias (sname
, string
)
3971 struct Lisp_Subr
*sname
;
3975 sym
= intern (string
);
3976 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3980 /* Define an "integer variable"; a symbol whose value is forwarded to a
3981 C variable of type int. Sample call (munged w "xx" to fool make-docfile):
3982 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3984 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3985 const char *namestring
, EMACS_INT
*address
)
3988 sym
= intern_c_string (namestring
);
3989 i_fwd
->type
= Lisp_Fwd_Int
;
3990 i_fwd
->intvar
= address
;
3991 XSYMBOL (sym
)->declared_special
= 1;
3992 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3993 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
3996 /* Similar but define a variable whose value is t if address contains 1,
3997 nil if address contains 0. */
3999 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4000 const char *namestring
, int *address
)
4003 sym
= intern_c_string (namestring
);
4004 b_fwd
->type
= Lisp_Fwd_Bool
;
4005 b_fwd
->boolvar
= address
;
4006 XSYMBOL (sym
)->declared_special
= 1;
4007 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4008 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4009 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4012 /* Similar but define a variable whose value is the Lisp Object stored
4013 at address. Two versions: with and without gc-marking of the C
4014 variable. The nopro version is used when that variable will be
4015 gc-marked for some other reason, since marking the same slot twice
4016 can cause trouble with strings. */
4018 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4019 const char *namestring
, Lisp_Object
*address
)
4022 sym
= intern_c_string (namestring
);
4023 o_fwd
->type
= Lisp_Fwd_Obj
;
4024 o_fwd
->objvar
= address
;
4025 XSYMBOL (sym
)->declared_special
= 1;
4026 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4027 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4031 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4032 const char *namestring
, Lisp_Object
*address
)
4034 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4035 staticpro (address
);
4038 /* Similar but define a variable whose value is the Lisp Object stored
4039 at a particular offset in the current kboard object. */
4042 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4043 const char *namestring
, int offset
)
4046 sym
= intern_c_string (namestring
);
4047 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4048 ko_fwd
->offset
= offset
;
4049 XSYMBOL (sym
)->declared_special
= 1;
4050 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4051 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4054 /* Record the value of load-path used at the start of dumping
4055 so we can see if the site changed it later during dumping. */
4056 static Lisp_Object dump_path
;
4062 int turn_off_warning
= 0;
4064 /* Compute the default load-path. */
4066 normal
= PATH_LOADSEARCH
;
4067 Vload_path
= decode_env_path (0, normal
);
4069 if (NILP (Vpurify_flag
))
4070 normal
= PATH_LOADSEARCH
;
4072 normal
= PATH_DUMPLOADSEARCH
;
4074 /* In a dumped Emacs, we normally have to reset the value of
4075 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4076 uses ../lisp, instead of the path of the installed elisp
4077 libraries. However, if it appears that Vload_path was changed
4078 from the default before dumping, don't override that value. */
4081 if (! NILP (Fequal (dump_path
, Vload_path
)))
4083 Vload_path
= decode_env_path (0, normal
);
4084 if (!NILP (Vinstallation_directory
))
4086 Lisp_Object tem
, tem1
, sitelisp
;
4088 /* Remove site-lisp dirs from path temporarily and store
4089 them in sitelisp, then conc them on at the end so
4090 they're always first in path. */
4094 tem
= Fcar (Vload_path
);
4095 tem1
= Fstring_match (build_string ("site-lisp"),
4099 Vload_path
= Fcdr (Vload_path
);
4100 sitelisp
= Fcons (tem
, sitelisp
);
4106 /* Add to the path the lisp subdir of the
4107 installation dir, if it exists. */
4108 tem
= Fexpand_file_name (build_string ("lisp"),
4109 Vinstallation_directory
);
4110 tem1
= Ffile_exists_p (tem
);
4113 if (NILP (Fmember (tem
, Vload_path
)))
4115 turn_off_warning
= 1;
4116 Vload_path
= Fcons (tem
, Vload_path
);
4120 /* That dir doesn't exist, so add the build-time
4121 Lisp dirs instead. */
4122 Vload_path
= nconc2 (Vload_path
, dump_path
);
4124 /* Add leim under the installation dir, if it exists. */
4125 tem
= Fexpand_file_name (build_string ("leim"),
4126 Vinstallation_directory
);
4127 tem1
= Ffile_exists_p (tem
);
4130 if (NILP (Fmember (tem
, Vload_path
)))
4131 Vload_path
= Fcons (tem
, Vload_path
);
4134 /* Add site-lisp under the installation dir, if it exists. */
4135 tem
= Fexpand_file_name (build_string ("site-lisp"),
4136 Vinstallation_directory
);
4137 tem1
= Ffile_exists_p (tem
);
4140 if (NILP (Fmember (tem
, Vload_path
)))
4141 Vload_path
= Fcons (tem
, Vload_path
);
4144 /* If Emacs was not built in the source directory,
4145 and it is run from where it was built, add to load-path
4146 the lisp, leim and site-lisp dirs under that directory. */
4148 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4152 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4153 Vinstallation_directory
);
4154 tem1
= Ffile_exists_p (tem
);
4156 /* Don't be fooled if they moved the entire source tree
4157 AFTER dumping Emacs. If the build directory is indeed
4158 different from the source dir, src/Makefile.in and
4159 src/Makefile will not be found together. */
4160 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4161 Vinstallation_directory
);
4162 tem2
= Ffile_exists_p (tem
);
4163 if (!NILP (tem1
) && NILP (tem2
))
4165 tem
= Fexpand_file_name (build_string ("lisp"),
4168 if (NILP (Fmember (tem
, Vload_path
)))
4169 Vload_path
= Fcons (tem
, Vload_path
);
4171 tem
= Fexpand_file_name (build_string ("leim"),
4174 if (NILP (Fmember (tem
, Vload_path
)))
4175 Vload_path
= Fcons (tem
, Vload_path
);
4177 tem
= Fexpand_file_name (build_string ("site-lisp"),
4180 if (NILP (Fmember (tem
, Vload_path
)))
4181 Vload_path
= Fcons (tem
, Vload_path
);
4184 if (!NILP (sitelisp
) && !no_site_lisp
)
4185 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4191 /* NORMAL refers to the lisp dir in the source directory. */
4192 /* We used to add ../lisp at the front here, but
4193 that caused trouble because it was copied from dump_path
4194 into Vload_path, above, when Vinstallation_directory was non-nil.
4195 It should be unnecessary. */
4196 Vload_path
= decode_env_path (0, normal
);
4197 dump_path
= Vload_path
;
4201 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4202 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4203 almost never correct, thereby causing a warning to be printed out that
4204 confuses users. Since PATH_LOADSEARCH is always overridden by the
4205 EMACSLOADPATH environment variable below, disable the warning on NT. */
4207 /* Warn if dirs in the *standard* path don't exist. */
4208 if (!turn_off_warning
)
4210 Lisp_Object path_tail
;
4212 for (path_tail
= Vload_path
;
4214 path_tail
= XCDR (path_tail
))
4216 Lisp_Object dirfile
;
4217 dirfile
= Fcar (path_tail
);
4218 if (STRINGP (dirfile
))
4220 dirfile
= Fdirectory_file_name (dirfile
);
4221 if (access (SSDATA (dirfile
), 0) < 0)
4222 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4227 #endif /* !(WINDOWSNT || HAVE_NS) */
4229 /* If the EMACSLOADPATH environment variable is set, use its value.
4230 This doesn't apply if we're dumping. */
4232 if (NILP (Vpurify_flag
)
4233 && egetenv ("EMACSLOADPATH"))
4235 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4239 load_in_progress
= 0;
4240 Vload_file_name
= Qnil
;
4242 load_descriptor_list
= Qnil
;
4244 Vstandard_input
= Qt
;
4245 Vloads_in_progress
= Qnil
;
4248 /* Print a warning, using format string FORMAT, that directory DIRNAME
4249 does not exist. Print it on stderr and put it in *Messages*. */
4252 dir_warning (const char *format
, Lisp_Object dirname
)
4255 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4257 fprintf (stderr
, format
, SDATA (dirname
));
4258 sprintf (buffer
, format
, SDATA (dirname
));
4259 /* Don't log the warning before we've initialized!! */
4261 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4265 syms_of_lread (void)
4268 defsubr (&Sread_from_string
);
4270 defsubr (&Sintern_soft
);
4271 defsubr (&Sunintern
);
4272 defsubr (&Sget_load_suffixes
);
4274 defsubr (&Seval_buffer
);
4275 defsubr (&Seval_region
);
4276 defsubr (&Sread_char
);
4277 defsubr (&Sread_char_exclusive
);
4278 defsubr (&Sread_event
);
4279 defsubr (&Sget_file_char
);
4280 defsubr (&Smapatoms
);
4281 defsubr (&Slocate_file_internal
);
4283 DEFVAR_LISP ("obarray", Vobarray
,
4284 doc
: /* Symbol table for use by `intern' and `read'.
4285 It is a vector whose length ought to be prime for best results.
4286 The vector's contents don't make sense if examined from Lisp programs;
4287 to find all the symbols in an obarray, use `mapatoms'. */);
4289 DEFVAR_LISP ("values", Vvalues
,
4290 doc
: /* List of values of all expressions which were read, evaluated and printed.
4291 Order is reverse chronological. */);
4293 DEFVAR_LISP ("standard-input", Vstandard_input
,
4294 doc
: /* Stream for read to get input from.
4295 See documentation of `read' for possible values. */);
4296 Vstandard_input
= Qt
;
4298 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4299 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4301 If this variable is a buffer, then only forms read from that buffer
4302 will be added to `read-symbol-positions-list'.
4303 If this variable is t, then all read forms will be added.
4304 The effect of all other values other than nil are not currently
4305 defined, although they may be in the future.
4307 The positions are relative to the last call to `read' or
4308 `read-from-string'. It is probably a bad idea to set this variable at
4309 the toplevel; bind it instead. */);
4310 Vread_with_symbol_positions
= Qnil
;
4312 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4313 doc
: /* A list mapping read symbols to their positions.
4314 This variable is modified during calls to `read' or
4315 `read-from-string', but only when `read-with-symbol-positions' is
4318 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4319 CHAR-POSITION is an integer giving the offset of that occurrence of the
4320 symbol from the position where `read' or `read-from-string' started.
4322 Note that a symbol will appear multiple times in this list, if it was
4323 read multiple times. The list is in the same order as the symbols
4325 Vread_symbol_positions_list
= Qnil
;
4327 DEFVAR_LISP ("read-circle", Vread_circle
,
4328 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4331 DEFVAR_LISP ("load-path", Vload_path
,
4332 doc
: /* *List of directories to search for files to load.
4333 Each element is a string (directory name) or nil (try default directory).
4334 Initialized based on EMACSLOADPATH environment variable, if any,
4335 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4337 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4338 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4339 This list should not include the empty string.
4340 `load' and related functions try to append these suffixes, in order,
4341 to the specified file name if a Lisp suffix is allowed or required. */);
4342 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4343 Fcons (make_pure_c_string (".el"), Qnil
));
4344 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4345 doc
: /* List of suffixes that indicate representations of \
4347 This list should normally start with the empty string.
4349 Enabling Auto Compression mode appends the suffixes in
4350 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4351 mode removes them again. `load' and related functions use this list to
4352 determine whether they should look for compressed versions of a file
4353 and, if so, which suffixes they should try to append to the file name
4354 in order to do so. However, if you want to customize which suffixes
4355 the loading functions recognize as compression suffixes, you should
4356 customize `jka-compr-load-suffixes' rather than the present variable. */);
4357 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4359 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4360 doc
: /* Non-nil if inside of `load'. */);
4361 Qload_in_progress
= intern_c_string ("load-in-progress");
4362 staticpro (&Qload_in_progress
);
4364 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4365 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4366 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4368 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4369 a symbol \(a feature name).
4371 When `load' is run and the file-name argument matches an element's
4372 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4373 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4375 An error in FORMS does not undo the load, but does prevent execution of
4376 the rest of the FORMS. */);
4377 Vafter_load_alist
= Qnil
;
4379 DEFVAR_LISP ("load-history", Vload_history
,
4380 doc
: /* Alist mapping loaded file names to symbols and features.
4381 Each alist element should be a list (FILE-NAME ENTRIES...), where
4382 FILE-NAME is the name of a file that has been loaded into Emacs.
4383 The file name is absolute and true (i.e. it doesn't contain symlinks).
4384 As an exception, one of the alist elements may have FILE-NAME nil,
4385 for symbols and features not associated with any file.
4387 The remaining ENTRIES in the alist element describe the functions and
4388 variables defined in that file, the features provided, and the
4389 features required. Each entry has the form `(provide . FEATURE)',
4390 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4391 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4392 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4393 SYMBOL was an autoload before this file redefined it as a function.
4395 During preloading, the file name recorded is relative to the main Lisp
4396 directory. These file names are converted to absolute at startup. */);
4397 Vload_history
= Qnil
;
4399 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4400 doc
: /* Full name of file being loaded by `load'. */);
4401 Vload_file_name
= Qnil
;
4403 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4404 doc
: /* File name, including directory, of user's initialization file.
4405 If the file loaded had extension `.elc', and the corresponding source file
4406 exists, this variable contains the name of source file, suitable for use
4407 by functions like `custom-save-all' which edit the init file.
4408 While Emacs loads and evaluates the init file, value is the real name
4409 of the file, regardless of whether or not it has the `.elc' extension. */);
4410 Vuser_init_file
= Qnil
;
4412 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4413 doc
: /* Used for internal purposes by `load'. */);
4414 Vcurrent_load_list
= Qnil
;
4416 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4417 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4418 The default is nil, which means use the function `read'. */);
4419 Vload_read_function
= Qnil
;
4421 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4422 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4423 This function is for doing code conversion before reading the source file.
4424 If nil, loading is done without any code conversion.
4425 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4426 FULLNAME is the full name of FILE.
4427 See `load' for the meaning of the remaining arguments. */);
4428 Vload_source_file_function
= Qnil
;
4430 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4431 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4432 This is useful when the file being loaded is a temporary copy. */);
4433 load_force_doc_strings
= 0;
4435 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4436 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4437 This is normally bound by `load' and `eval-buffer' to control `read',
4438 and is not meant for users to change. */);
4439 load_convert_to_unibyte
= 0;
4441 DEFVAR_LISP ("source-directory", Vsource_directory
,
4442 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4443 You cannot count on them to still be there! */);
4445 = Fexpand_file_name (build_string ("../"),
4446 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4448 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4449 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4450 Vpreloaded_file_list
= Qnil
;
4452 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4453 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4454 Vbyte_boolean_vars
= Qnil
;
4456 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4457 doc
: /* Non-nil means load dangerous compiled Lisp files.
4458 Some versions of XEmacs use different byte codes than Emacs. These
4459 incompatible byte codes can make Emacs crash when it tries to execute
4461 load_dangerous_libraries
= 0;
4463 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4464 doc
: /* Non-nil means force printing messages when loading Lisp files.
4465 This overrides the value of the NOMESSAGE argument to `load'. */);
4466 force_load_messages
= 0;
4468 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4469 doc
: /* Regular expression matching safe to load compiled Lisp files.
4470 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4471 from the file, and matches them against this regular expression.
4472 When the regular expression matches, the file is considered to be safe
4473 to load. See also `load-dangerous-libraries'. */);
4474 Vbytecomp_version_regexp
4475 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4477 Qlexical_binding
= intern ("lexical-binding");
4478 staticpro (&Qlexical_binding
);
4479 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4480 doc
: /* If non-nil, use lexical binding when evaluating code.
4481 This only applies to code evaluated by `eval-buffer' and `eval-region'.
4482 This variable is automatically set from the file variables of an interpreted
4483 Lisp file read using `load'. */);
4484 Fmake_variable_buffer_local (Qlexical_binding
);
4486 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4487 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4488 Veval_buffer_list
= Qnil
;
4490 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4491 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4492 Vold_style_backquotes
= Qnil
;
4493 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4494 staticpro (&Qold_style_backquotes
);
4496 /* Vsource_directory was initialized in init_lread. */
4498 load_descriptor_list
= Qnil
;
4499 staticpro (&load_descriptor_list
);
4501 Qcurrent_load_list
= intern_c_string ("current-load-list");
4502 staticpro (&Qcurrent_load_list
);
4504 Qstandard_input
= intern_c_string ("standard-input");
4505 staticpro (&Qstandard_input
);
4507 Qread_char
= intern_c_string ("read-char");
4508 staticpro (&Qread_char
);
4510 Qget_file_char
= intern_c_string ("get-file-char");
4511 staticpro (&Qget_file_char
);
4513 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4514 staticpro (&Qget_emacs_mule_file_char
);
4516 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4517 staticpro (&Qload_force_doc_strings
);
4519 Qbackquote
= intern_c_string ("`");
4520 staticpro (&Qbackquote
);
4521 Qcomma
= intern_c_string (",");
4522 staticpro (&Qcomma
);
4523 Qcomma_at
= intern_c_string (",@");
4524 staticpro (&Qcomma_at
);
4525 Qcomma_dot
= intern_c_string (",.");
4526 staticpro (&Qcomma_dot
);
4528 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4529 staticpro (&Qinhibit_file_name_operation
);
4531 Qascii_character
= intern_c_string ("ascii-character");
4532 staticpro (&Qascii_character
);
4534 Qfunction
= intern_c_string ("function");
4535 staticpro (&Qfunction
);
4537 Qload
= intern_c_string ("load");
4540 Qload_file_name
= intern_c_string ("load-file-name");
4541 staticpro (&Qload_file_name
);
4543 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4544 staticpro (&Qeval_buffer_list
);
4546 Qfile_truename
= intern_c_string ("file-truename");
4547 staticpro (&Qfile_truename
) ;
4549 Qdir_ok
= intern_c_string ("dir-ok");
4550 staticpro (&Qdir_ok
);
4552 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4553 staticpro (&Qdo_after_load_evaluation
) ;
4555 staticpro (&dump_path
);
4557 staticpro (&read_objects
);
4558 read_objects
= Qnil
;
4559 staticpro (&seen_list
);
4562 Vloads_in_progress
= Qnil
;
4563 staticpro (&Vloads_in_progress
);
4565 Qhash_table
= intern_c_string ("hash-table");
4566 staticpro (&Qhash_table
);
4567 Qdata
= intern_c_string ("data");
4569 Qtest
= intern_c_string ("test");
4571 Qsize
= intern_c_string ("size");
4573 Qweakness
= intern_c_string ("weakness");
4574 staticpro (&Qweakness
);
4575 Qrehash_size
= intern_c_string ("rehash-size");
4576 staticpro (&Qrehash_size
);
4577 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4578 staticpro (&Qrehash_threshold
);